summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-04-10 11:12:17 -0400
committerJoey Hess2017-04-10 11:12:17 -0400
commit03950541b77405b8822dd2cadb47bc249a2bb5d3 (patch)
tree26cf2669776118e7e0ab481377b223eb578c7845
parent983ee62929037c7297e2281ea3910e94a85bead5 (diff)
copy git configuration into chroot
-rw-r--r--src/Propellor/Property/Bootstrap.hs82
-rw-r--r--src/Propellor/Property/Chroot.hs8
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..