summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Propellor/Property/Bootstrap.hs39
-rw-r--r--src/Propellor/Property/Chroot.hs33
2 files changed, 35 insertions, 37 deletions
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