From 4ba09ab6844cc3fc3e94856da22190555b697193 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 15:00:33 -0400 Subject: added Propellor.Property.Bootstrap (untested) This commit was sponsored by Jake Vosloo on Patreon. --- src/Propellor/Property/Bootstrap.hs | 95 +++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 src/Propellor/Property/Bootstrap.hs (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs new file mode 100644 index 00000000..6158d967 --- /dev/null +++ b/src/Propellor/Property/Bootstrap.hs @@ -0,0 +1,95 @@ +module Propellor.Property.Bootstrap (RepoSource(..), bootstrappedFrom, clonedFrom) where + +import Propellor.Base +import Propellor.Bootstrap +import Propellor.Property.Chroot + +import Data.List + +-- | Where a propellor repository should be bootstrapped from. +data RepoSource + = GitRepoUrl String + | GitRepoOutsideChroot + +-- | Bootstraps a propellor installation into +-- /usr/local/propellor/ +-- +-- Normally, propellor is already bootstrapped when it runs, so this +-- property is not useful. However, this can be useful inside a +-- chroot used to build a disk image, to make the disk image +-- have propellor installed. +-- +-- The git repository is cloned (or pulled to update if it already exists). +-- +-- All build dependencies are installed, using distribution packages +-- or falling back to using cabal. +bootstrappedFrom :: RepoSource -> Property Linux +bootstrappedFrom reposource = go `requires` clonedFrom reposource + where + go :: Property Linux + go = property "Propellor bootstrapped" $ do + system <- getOS + assumeChange $ exposeTrueLocaldir $ buildShellCommand + [ "cd " ++ localdir + , bootstrapPropellorCommand system + ] + +-- | Clones the propellor repeository into /usr/local/propellor/ +-- +-- GitRepoOutsideChroot can be used when this is used in a chroot. +-- In that case, it clones the /usr/local/propellor/ from outside the +-- chroot into the same path inside the chroot. +-- +-- If the propellor repo has already been cloned, pulls to get it +-- up-to-date. +clonedFrom :: RepoSource -> Property Linux +clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ do + ifM needclone + ( do + let tmpclone = localdir ++ ".tmpclone" + system <- getOS + assumeChange $ exposeTrueLocaldir $ buildShellCommand + [ installGitCommand system + , "rm -rf " ++ tmpclone + , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone + , "mkdir -p " ++ localdir + -- This is done rather than deleting + -- the old localdir, because if it is bound + -- mounted from outside the chroot, deleting + -- it after unmounting in unshare will remove + -- the bind mount outside the unshare. + , "(cd " ++ tmpclone ++ " && tar c) | (cd " ++ localdir ++ " && tar x)" + , "rm -rf " ++ tmpclone + ] + , assumeChange $ exposeTrueLocaldir $ buildShellCommand + [ "cd " ++ localdir + , "git pull" + ] + ) + where + needclone = (inChroot <&&> truelocaldirisempty) + <||> (liftIO (not <$> doesDirectoryExist localdir)) + truelocaldirisempty = exposeTrueLocaldir $ + "test ! -d " ++ localdir ++ "/.git" + originloc = case reposource of + GitRepoUrl s -> s + GitRepoOutsideChroot -> localdir + +-- | Runs the shell command with the true localdir exposed, +-- not the one bind-mounted into a chroot. +exposeTrueLocaldir :: String -> Propellor Bool +exposeTrueLocaldir s = do + s' <- ifM inChroot + ( return $ "unshare -m sh -c " ++ shellEscape + ("umount " ++ localdir ++ " && ( " ++ s ++ ")") + , return s + ) + liftIO $ boolSystem "sh" [ Param "-c", Param s'] + +assumeChange :: Propellor Bool -> Propellor Result +assumeChange a = do + ok <- a + return (cmdResult ok <> MadeChange) + +buildShellCommand :: [String] -> String +buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")") -- cgit v1.3-2-g0d8e From 9dbd25a91c88a99832db5a2b31f0e87f0bff47e8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 16:49:38 -0400 Subject: well, that didnt work :( --- .../comment_2_9fea601af57777e1cb49952483f4da63._comment | 7 +++++++ src/Propellor/Property/Bootstrap.hs | 3 +++ 2 files changed, 10 insertions(+) create mode 100644 doc/todo/property_to_install_propellor/comment_2_9fea601af57777e1cb49952483f4da63._comment (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/doc/todo/property_to_install_propellor/comment_2_9fea601af57777e1cb49952483f4da63._comment b/doc/todo/property_to_install_propellor/comment_2_9fea601af57777e1cb49952483f4da63._comment new file mode 100644 index 00000000..f862f79b --- /dev/null +++ b/doc/todo/property_to_install_propellor/comment_2_9fea601af57777e1cb49952483f4da63._comment @@ -0,0 +1,7 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2017-04-09T20:49:04Z" + content=""" +Well, seems that `unshare` does not work in a chroot. Hmm. +"""]] diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 6158d967..4a60276e 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -77,6 +77,9 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ -- | Runs the shell command with the true localdir exposed, -- not the one bind-mounted into a chroot. +-- +-- FIXME: unshare -m does not work in a chroot! +-- "unshare: cannot change root filesystem propagation: Invalid argument" exposeTrueLocaldir :: String -> Propellor Bool exposeTrueLocaldir s = do s' <- ifM inChroot -- cgit v1.3-2-g0d8e From 9b8ca1509060a355966a6377615e3f9e91a655da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 17:11:34 -0400 Subject: new approach for exposing the underlying localdir inside a chroot --- src/Propellor/Property/Bootstrap.hs | 42 ++++++++++++++++++++++++------------- 1 file changed, 27 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 4a60276e..8d0c4db9 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -29,7 +29,7 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource go :: Property Linux go = property "Propellor bootstrapped" $ do system <- getOS - assumeChange $ exposeTrueLocaldir $ buildShellCommand + assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand [ "cd " ++ localdir , bootstrapPropellorCommand system ] @@ -48,7 +48,7 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ ( do let tmpclone = localdir ++ ".tmpclone" system <- getOS - assumeChange $ exposeTrueLocaldir $ buildShellCommand + assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand [ installGitCommand system , "rm -rf " ++ tmpclone , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone @@ -61,7 +61,7 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ , "(cd " ++ tmpclone ++ " && tar c) | (cd " ++ localdir ++ " && tar x)" , "rm -rf " ++ tmpclone ] - , assumeChange $ exposeTrueLocaldir $ buildShellCommand + , assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand [ "cd " ++ localdir , "git pull" ] @@ -69,25 +69,34 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ where needclone = (inChroot <&&> truelocaldirisempty) <||> (liftIO (not <$> doesDirectoryExist localdir)) - truelocaldirisempty = exposeTrueLocaldir $ + truelocaldirisempty = exposeTrueLocaldir $ runShellCommand $ "test ! -d " ++ localdir ++ "/.git" originloc = case reposource of GitRepoUrl s -> s GitRepoOutsideChroot -> localdir --- | Runs the shell command with the true localdir exposed, +-- | Runs an action with the true localdir exposed, -- not the one bind-mounted into a chroot. -- --- FIXME: unshare -m does not work in a chroot! --- "unshare: cannot change root filesystem propagation: Invalid argument" -exposeTrueLocaldir :: String -> Propellor Bool -exposeTrueLocaldir s = do - s' <- ifM inChroot - ( return $ "unshare -m sh -c " ++ shellEscape - ("umount " ++ localdir ++ " && ( " ++ s ++ ")") - , return s - ) - liftIO $ boolSystem "sh" [ Param "-c", Param s'] +-- In a chroot, this is accomplished by temporily bind mounting the localdir +-- to a temp directory, to preserve access to the original bind mount. Then +-- we unmount the localdir to expose the true localdir. Finally, to cleanup, +-- the temp directory is bind mounted back to the localdir. +exposeTrueLocaldir :: IO a -> Propellor a +exposeTrueLocaldir a = ifM inChroot + ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> + bracket_ + (movebindmount localdir tmpdir) + (movebindmount tmpdir localdir) + a + , liftIO a + ) + where + movebindmount from to = do + run "mount" [Param "--bind", File from, File to] + run "umount" [File from] + run cmd ps = unlessM (boolSystem cmd ps) $ + error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps) assumeChange :: Propellor Bool -> Propellor Result assumeChange a = do @@ -96,3 +105,6 @@ assumeChange a = do buildShellCommand :: [String] -> String buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")") + +runShellCommand :: String -> IO Bool +runShellCommand s = liftIO $ boolSystem "sh" [ Param "-c", Param s] -- cgit v1.3-2-g0d8e From e976032e98788907052cae09be639a99d25de0d1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 17:17:54 -0400 Subject: propellor spin --- src/Propellor/Property/Bootstrap.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 8d0c4db9..fa240782 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -94,7 +94,9 @@ exposeTrueLocaldir a = ifM inChroot where movebindmount from to = do run "mount" [Param "--bind", File from, File to] - run "umount" [File from] + -- Have to lazy unmount, because the propellor process + -- is running in the localdir that it's unmounting.. + run "umount" [Param "-l", File from] run cmd ps = unlessM (boolSystem cmd ps) $ error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps) -- cgit v1.3-2-g0d8e From 4a0f3076a6f3269409e7bf33120b0cc9cfa65630 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 17:23:53 -0400 Subject: propellor spin --- src/Propellor/Property/Bootstrap.hs | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index fa240782..7fd9595b 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -5,6 +5,7 @@ import Propellor.Bootstrap import Propellor.Property.Chroot import Data.List +import System.Posix.Directory -- | Where a propellor repository should be bootstrapped from. data RepoSource @@ -97,6 +98,12 @@ exposeTrueLocaldir a = ifM inChroot -- Have to lazy unmount, because the propellor process -- is running in the localdir that it's unmounting.. run "umount" [Param "-l", File from] + -- We were in the old localdir; move to the new one after + -- flipping the bind mounts. Otherwise, commands that try + -- to access the cwd will fail because it got umounted out + -- from under. + changeWorkingDirectory "/" + changeWorkingDirectory localdir run cmd ps = unlessM (boolSystem cmd ps) $ error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps) -- cgit v1.3-2-g0d8e From 547a04ea0a9d085432fe33c916e337b49a2d3715 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 17:32:15 -0400 Subject: propellor spin --- src/Propellor/Property/Bootstrap.hs | 63 ++++++++++++++++++++----------------- 1 file changed, 35 insertions(+), 28 deletions(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 7fd9595b..68506918 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -30,10 +30,11 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource go :: Property Linux go = property "Propellor bootstrapped" $ do system <- getOS - assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand - [ "cd " ++ localdir - , bootstrapPropellorCommand system - ] + assumeChange $ exposeTrueLocaldir $ const $ + runShellCommand $ buildShellCommand + [ "cd " ++ localdir + , bootstrapPropellorCommand system + ] -- | Clones the propellor repeository into /usr/local/propellor/ -- @@ -44,53 +45,59 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. clonedFrom :: RepoSource -> Property Linux -clonedFrom reposource = property ("Propellor repo cloned from " ++ originloc) $ do +clonedFrom reposource = property ("Propellor repo cloned from " ++ sourcedesc) $ do ifM needclone ( do let tmpclone = localdir ++ ".tmpclone" system <- getOS - assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand - [ installGitCommand system - , "rm -rf " ++ tmpclone - , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone - , "mkdir -p " ++ localdir - -- This is done rather than deleting - -- the old localdir, because if it is bound - -- mounted from outside the chroot, deleting - -- it after unmounting in unshare will remove - -- the bind mount outside the unshare. - , "(cd " ++ tmpclone ++ " && tar c) | (cd " ++ localdir ++ " && tar x)" - , "rm -rf " ++ tmpclone + assumeChange $ exposeTrueLocaldir $ \sysdir -> do + let originloc = case reposource of + GitRepoUrl s -> s + GitRepoOutsideChroot -> sysdir + runShellCommand $ buildShellCommand + [ installGitCommand system + , "rm -rf " ++ tmpclone + , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone + , "mkdir -p " ++ localdir + -- This is done rather than deleting + -- the old localdir, because if it is bound + -- mounted from outside the chroot, deleting + -- it after unmounting in unshare will remove + -- the bind mount outside the unshare. + , "(cd " ++ tmpclone ++ " && tar c) | (cd " ++ localdir ++ " && tar x)" + , "rm -rf " ++ tmpclone + ] + , assumeChange $ exposeTrueLocaldir $ const $ + runShellCommand $ buildShellCommand + [ "cd " ++ localdir + , "git pull" ] - , assumeChange $ exposeTrueLocaldir $ runShellCommand $ buildShellCommand - [ "cd " ++ localdir - , "git pull" - ] ) where needclone = (inChroot <&&> truelocaldirisempty) <||> (liftIO (not <$> doesDirectoryExist localdir)) - truelocaldirisempty = exposeTrueLocaldir $ runShellCommand $ - "test ! -d " ++ localdir ++ "/.git" - originloc = case reposource of + truelocaldirisempty = exposeTrueLocaldir $ const $ + runShellCommand ("test ! -d " ++ localdir ++ "/.git") + sourcedesc = case reposource of GitRepoUrl s -> s GitRepoOutsideChroot -> localdir -- | Runs an action with the true localdir exposed, --- not the one bind-mounted into a chroot. +-- not the one bind-mounted into a chroot. The action is passed the +-- path containing the contents of the localdir outside the chroot. -- -- In a chroot, this is accomplished by temporily bind mounting the localdir -- to a temp directory, to preserve access to the original bind mount. Then -- we unmount the localdir to expose the true localdir. Finally, to cleanup, -- the temp directory is bind mounted back to the localdir. -exposeTrueLocaldir :: IO a -> Propellor a +exposeTrueLocaldir :: (FilePath -> IO a) -> Propellor a exposeTrueLocaldir a = ifM inChroot ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> bracket_ (movebindmount localdir tmpdir) (movebindmount tmpdir localdir) - a - , liftIO a + (a tmpdir) + , liftIO $ a localdir ) where movebindmount from to = do -- cgit v1.3-2-g0d8e From ffc328a5842e154eb3fce66d628cbc4a26d7b254 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 9 Apr 2017 17:33:26 -0400 Subject: propellor spin --- src/Propellor/Property/Bootstrap.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 68506918..5f64fd69 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -64,7 +64,7 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ sourcedesc) $ -- mounted from outside the chroot, deleting -- it after unmounting in unshare will remove -- the bind mount outside the unshare. - , "(cd " ++ tmpclone ++ " && tar c) | (cd " ++ localdir ++ " && tar x)" + , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)" , "rm -rf " ++ tmpclone ] , assumeChange $ exposeTrueLocaldir $ const $ -- cgit v1.3-2-g0d8e From 983ee62929037c7297e2281ea3910e94a85bead5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 10 Apr 2017 10:52:33 -0400 Subject: reorg --- src/Propellor/Property/Bootstrap.hs | 39 ++----------------------------------- src/Propellor/Property/Chroot.hs | 33 +++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 37 deletions(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 5f64fd69..dc1c2e0f 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -5,12 +5,13 @@ import Propellor.Bootstrap import Propellor.Property.Chroot import Data.List -import System.Posix.Directory -- | Where a propellor repository should be bootstrapped from. data RepoSource = GitRepoUrl String | GitRepoOutsideChroot + -- ^ When used in a chroot, this clones the git repository from + -- outside the chroot. -- | Bootstraps a propellor installation into -- /usr/local/propellor/ @@ -38,10 +39,6 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource -- | Clones the propellor repeository into /usr/local/propellor/ -- --- GitRepoOutsideChroot can be used when this is used in a chroot. --- In that case, it clones the /usr/local/propellor/ from outside the --- chroot into the same path inside the chroot. --- -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. clonedFrom :: RepoSource -> Property Linux @@ -82,38 +79,6 @@ clonedFrom reposource = property ("Propellor repo cloned from " ++ sourcedesc) $ GitRepoUrl s -> s GitRepoOutsideChroot -> localdir --- | Runs an action with the true localdir exposed, --- not the one bind-mounted into a chroot. The action is passed the --- path containing the contents of the localdir outside the chroot. --- --- In a chroot, this is accomplished by temporily bind mounting the localdir --- to a temp directory, to preserve access to the original bind mount. Then --- we unmount the localdir to expose the true localdir. Finally, to cleanup, --- the temp directory is bind mounted back to the localdir. -exposeTrueLocaldir :: (FilePath -> IO a) -> Propellor a -exposeTrueLocaldir a = ifM inChroot - ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> - bracket_ - (movebindmount localdir tmpdir) - (movebindmount tmpdir localdir) - (a tmpdir) - , liftIO $ a localdir - ) - where - movebindmount from to = do - run "mount" [Param "--bind", File from, File to] - -- Have to lazy unmount, because the propellor process - -- is running in the localdir that it's unmounting.. - run "umount" [Param "-l", File from] - -- We were in the old localdir; move to the new one after - -- flipping the bind mounts. Otherwise, commands that try - -- to access the cwd will fail because it got umounted out - -- from under. - changeWorkingDirectory "/" - changeWorkingDirectory localdir - run cmd ps = unlessM (boolSystem cmd ps) $ - error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps) - assumeChange :: Propellor Bool -> Propellor Result assumeChange a = do ok <- a diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 7738d97e..96c75846 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -11,6 +11,7 @@ module Propellor.Property.Chroot ( ChrootTarball(..), noServices, inChroot, + exposeTrueLocaldir, -- * Internal use provisioned', propagateChrootInfo, @@ -295,6 +296,38 @@ setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) } newtype InChroot = InChroot Bool deriving (Typeable, Show) +-- | Runs an action with the true localdir exposed, +-- not the one bind-mounted into a chroot. The action is passed the +-- path containing the contents of the localdir outside the chroot. +-- +-- In a chroot, this is accomplished by temporily bind mounting the localdir +-- to a temp directory, to preserve access to the original bind mount. Then +-- we unmount the localdir to expose the true localdir. Finally, to cleanup, +-- the temp directory is bind mounted back to the localdir. +exposeTrueLocaldir :: (FilePath -> IO a) -> Propellor a +exposeTrueLocaldir a = ifM inChroot + ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> + bracket_ + (movebindmount localdir tmpdir) + (movebindmount tmpdir localdir) + (a tmpdir) + , liftIO $ a localdir + ) + where + movebindmount from to = do + run "mount" [Param "--bind", File from, File to] + -- Have to lazy unmount, because the propellor process + -- is running in the localdir that it's unmounting.. + run "umount" [Param "-l", File from] + -- We were in the old localdir; move to the new one after + -- flipping the bind mounts. Otherwise, commands that try + -- to access the cwd will fail because it got umounted out + -- from under. + changeWorkingDirectory "/" + changeWorkingDirectory localdir + run cmd ps = unlessM (boolSystem cmd ps) $ + error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps) + -- | Generates a Chroot that has all the properties of a Host. -- -- Note that it's possible to create loops using this, where a host -- cgit v1.3-2-g0d8e From 03950541b77405b8822dd2cadb47bc249a2bb5d3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 10 Apr 2017 11:12:17 -0400 Subject: copy git configuration into chroot --- src/Propellor/Property/Bootstrap.hs | 82 +++++++++++++++++++++++-------------- src/Propellor/Property/Chroot.hs | 8 ++-- 2 files changed, 55 insertions(+), 35 deletions(-) (limited to 'src/Propellor/Property/Bootstrap.hs') diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index dc1c2e0f..5678a865 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -5,13 +5,14 @@ import Propellor.Bootstrap import Propellor.Property.Chroot import Data.List +import qualified Data.ByteString as B -- | Where a propellor repository should be bootstrapped from. data RepoSource = GitRepoUrl String | GitRepoOutsideChroot - -- ^ When used in a chroot, this clones the git repository from - -- outside the chroot. + -- ^ When used in a chroot, this copies the git repository from + -- outside the chroot, including its configuration. -- | Bootstraps a propellor installation into -- /usr/local/propellor/ @@ -42,42 +43,61 @@ bootstrappedFrom reposource = go `requires` clonedFrom reposource -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. clonedFrom :: RepoSource -> Property Linux -clonedFrom reposource = property ("Propellor repo cloned from " ++ sourcedesc) $ do - ifM needclone - ( do - let tmpclone = localdir ++ ".tmpclone" - system <- getOS - assumeChange $ exposeTrueLocaldir $ \sysdir -> do - let originloc = case reposource of - GitRepoUrl s -> s - GitRepoOutsideChroot -> sysdir - runShellCommand $ buildShellCommand - [ installGitCommand system - , "rm -rf " ++ tmpclone - , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone - , "mkdir -p " ++ localdir - -- This is done rather than deleting - -- the old localdir, because if it is bound - -- mounted from outside the chroot, deleting - -- it after unmounting in unshare will remove - -- the bind mount outside the unshare. - , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)" - , "rm -rf " ++ tmpclone - ] - , assumeChange $ exposeTrueLocaldir $ const $ +clonedFrom reposource = case reposource of + GitRepoOutsideChroot -> go `onChange` copygitconfig + _ -> go + where + go :: Property Linux + go = property ("Propellor repo cloned from " ++ sourcedesc) $ + ifM needclone (makeclone, updateclone) + + makeclone = do + let tmpclone = localdir ++ ".tmpclone" + system <- getOS + assumeChange $ exposeTrueLocaldir $ \sysdir -> do + let originloc = case reposource of + GitRepoUrl s -> s + GitRepoOutsideChroot -> sysdir runShellCommand $ buildShellCommand - [ "cd " ++ localdir - , "git pull" + [ installGitCommand system + , "rm -rf " ++ tmpclone + , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone + , "mkdir -p " ++ localdir + -- This is done rather than deleting + -- the old localdir, because if it is bound + -- mounted from outside the chroot, deleting + -- it after unmounting in unshare will remove + -- the bind mount outside the unshare. + , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)" + , "rm -rf " ++ tmpclone ] - ) - where + + updateclone = assumeChange $ exposeTrueLocaldir $ const $ + runShellCommand $ buildShellCommand + [ "cd " ++ localdir + , "git pull" + ] + + -- Copy the git config of the repo outside the chroot into the + -- chroot. This way it has the same remote urls, and other git + -- configuration. + copygitconfig :: Property Linux + copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do + let gitconfig = localdir <> ".git" <> "config" + cfg <- liftIO $ B.readFile gitconfig + exposeTrueLocaldir $ const $ + liftIO $ B.writeFile gitconfig cfg + return MadeChange + needclone = (inChroot <&&> truelocaldirisempty) <||> (liftIO (not <$> doesDirectoryExist localdir)) + truelocaldirisempty = exposeTrueLocaldir $ const $ runShellCommand ("test ! -d " ++ localdir ++ "/.git") + sourcedesc = case reposource of GitRepoUrl s -> s - GitRepoOutsideChroot -> localdir + GitRepoOutsideChroot -> localdir ++ " outside the chroot" assumeChange :: Propellor Bool -> Propellor Result assumeChange a = do @@ -87,5 +107,5 @@ assumeChange a = do buildShellCommand :: [String] -> String buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")") -runShellCommand :: String -> IO Bool +runShellCommand :: String -> Propellor Bool runShellCommand s = liftIO $ boolSystem "sh" [ Param "-c", Param s] diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 96c75846..5f764d47 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -304,17 +304,17 @@ newtype InChroot = InChroot Bool -- to a temp directory, to preserve access to the original bind mount. Then -- we unmount the localdir to expose the true localdir. Finally, to cleanup, -- the temp directory is bind mounted back to the localdir. -exposeTrueLocaldir :: (FilePath -> IO a) -> Propellor a +exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a exposeTrueLocaldir a = ifM inChroot - ( liftIO $ withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> + ( withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir -> bracket_ (movebindmount localdir tmpdir) (movebindmount tmpdir localdir) (a tmpdir) - , liftIO $ a localdir + , a localdir ) where - movebindmount from to = do + movebindmount from to = liftIO $ do run "mount" [Param "--bind", File from, File to] -- Have to lazy unmount, because the propellor process -- is running in the localdir that it's unmounting.. -- cgit v1.3-2-g0d8e