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(-) 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.2.3