diff options
Diffstat (limited to 'src/Propellor/Property/Chroot.hs')
| -rw-r--r-- | src/Propellor/Property/Chroot.hs | 37 |
1 files changed, 23 insertions, 14 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 0e9d00d8..ded108bc 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -16,10 +16,10 @@ import Propellor import Propellor.Types.CmdLine import Propellor.Types.Chroot import Propellor.Property.Chroot.Util -import Propellor.Property.Mount import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim +import Propellor.Property.Mount import qualified Data.Map as M import Data.List.Utils @@ -70,7 +70,7 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly = where go desc a = propertyList (chrootDesc c desc) [a] - setup = propellChroot c (inChrootProcess c) systemdonly + setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly `requires` toProp built built = case (system, builderconf) of @@ -95,7 +95,7 @@ chrootInfo (Chroot loc _ _ h) = mempty { _chrootinfo = mempty { _chroots = M.singleton loc h } } -- | Propellor is run inside the chroot to provision it. -propellChroot :: Chroot -> ([String] -> CreateProcess) -> Bool -> Property NoInfo +propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do let d = localdir </> shimdir c let me = localdir </> "propellor" @@ -103,7 +103,6 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " ( pure (Shim.file me d) , Shim.setup me Nothing d ) - liftIO mountproc ifM (liftIO $ bindmount shim) ( chainprovision shim , return FailedChange @@ -119,25 +118,21 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " , File localdir, File mntpnt ] ) - - -- /proc needs to be mounted in the chroot for the linker to use - -- /proc/self/exe which is necessary for some commands to work - mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ - void $ mount "proc" "proc" procloc - procloc = loc </> "proc" chainprovision shim = do parenthost <- asks hostName cmd <- liftIO $ toChain parenthost c systemdonly pe <- liftIO standardPathEnv - let p = mkproc + (p, cleanup) <- liftIO $ mkproc [ shim , "--continue" , show cmd ] let p' = p { env = Just pe } - liftIO $ withHandle StdoutHandle createProcessSuccess p' + r <- liftIO $ withHandle StdoutHandle createProcessSuccess p' processChainOutput + liftIO cleanup + return r toChain :: HostName -> Chroot -> Bool -> IO CmdLine toChain parenthost (Chroot loc _ _ _) systemdonly = do @@ -164,8 +159,22 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = putStrLn $ "\n" ++ show r chain _ _ = errorMessage "bad chain command" -inChrootProcess :: Chroot -> [String] -> CreateProcess -inChrootProcess (Chroot loc _ _ _) cmd = proc "chroot" (loc:cmd) +inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ()) +inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do + mountproc + return (proc "chroot" (loc:cmd), cleanup) + where + -- /proc needs to be mounted in the chroot for the linker to use + -- /proc/self/exe which is necessary for some commands to work + mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ + void $ mount "proc" "proc" procloc + + procloc = loc </> "proc" + + cleanup + | keepprocmounted = noop + | otherwise = whenM (elem procloc <$> mountPointsBelow loc) $ + umountLazy procloc provisioningLock :: FilePath -> FilePath provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock" |