From 626f1af56f12be63cd78fa4910c55453c23cf5a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 12:38:45 -0400 Subject: Export CommandParam, boolSystem, safeSystem and shellEscape from Propellor.Property.Cmd, so they are available for use in constricting your own Properties when using propellor as a library. Several imports of Utility.SafeCommand now redundant. --- src/Propellor/Property/Chroot.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index e56cb6ed..ec2b6679 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -19,7 +19,6 @@ import Propellor.Property.Chroot.Util import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim -import Utility.SafeCommand import qualified Data.Map as M import Data.List.Utils -- cgit v1.2.3 From 95b6d711e7da7f13d064086b30727e00ad72ecf5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 10:26:43 -0400 Subject: Mount /proc inside a chroot before provisioning it, to work around #787227 --- debian/changelog | 1 + src/Propellor/Property/Chroot.hs | 13 +++++++++++-- src/Propellor/Property/Debootstrap.hs | 4 +--- src/Propellor/Property/Mount.hs | 11 +++++++++++ 4 files changed, 24 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/debian/changelog b/debian/changelog index e40f5d3a..d18d61cf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -11,6 +11,7 @@ propellor (2.5.0) UNRELEASED; urgency=medium environment variables. * Fix Postfix.satellite bug; the default relayhost was set to the domain, not to smtp.domain as documented. + * Mount /proc inside a chroot before provisioning it, to work around #787227 -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index ec2b6679..0e9d00d8 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -16,6 +16,7 @@ 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 @@ -55,8 +56,9 @@ debootstrapped system conf location = case system of -- | Ensures that the chroot exists and is provisioned according to its -- properties. -- --- Reverting this property removes the chroot. Note that it does not ensure --- that any processes that might be running inside the chroot are stopped. +-- Reverting this property removes the chroot. Anything mounted inside it +-- is first unmounted. Note that it does not ensure that any processes +-- that might be running inside the chroot are stopped. provisioned :: Chroot -> RevertableProperty provisioned c = provisioned' (propigateChrootInfo c) c False @@ -101,6 +103,7 @@ 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 @@ -117,6 +120,12 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " ] ) + -- /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 diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index f29ae56b..8d974eba 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -106,9 +106,7 @@ unpopulated d = null <$> catchDefaultIO [] (dirContents d) removetarget :: FilePath -> IO () removetarget target = do - submnts <- filter (\p -> simplifyPath p /= simplifyPath target) - . filter (dirContains target) - <$> mountPoints + submnts <- mountPointsBelow target forM_ submnts umountLazy removeDirectoryRecursive target diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index a081b1e7..ff47f4d9 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -1,22 +1,33 @@ module Propellor.Property.Mount where import Propellor +import Utility.Path type FsType = String type Source = String +-- | Lists all mount points of the system. mountPoints :: IO [FilePath] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] +-- | Finds all filesystems mounted inside the specified directory. +mountPointsBelow :: FilePath -> IO [FilePath] +mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) + . filter (dirContains target) + <$> mountPoints + +-- | Filesystem type mounted at a given location. getFsType :: FilePath -> IO (Maybe FsType) getFsType mnt = catchDefaultIO Nothing $ headMaybe . lines <$> readProcess "findmnt" ["-n", mnt, "--output", "fstype"] +-- | Unmounts a device, lazily so any running processes don't block it. umountLazy :: FilePath -> IO () umountLazy mnt = unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ errorMessage $ "failed unmounting " ++ mnt +-- | Mounts a device. mount :: FsType -> Source -> FilePath -> IO Bool mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] -- cgit v1.2.3 From c0b9c708c93b104dfca1bff80e082e2d2b0ad0a6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 16:22:15 -0400 Subject: don't mount /proc when provisioning systemd-nspawn container While needed for chroot provisioning, it confuses system when systemd-nspawn runs it inside the container. --- src/Propellor/Property/Chroot.hs | 23 ++++++++++++----------- src/Propellor/Property/Systemd.hs | 4 ++-- 2 files changed, 14 insertions(+), 13 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 0e9d00d8..7e7d1611 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -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) -> 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,18 +118,12 @@ 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 <- liftIO $ mkproc [ shim , "--continue" , show cmd @@ -164,8 +157,16 @@ 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 :: Chroot -> [String] -> IO CreateProcess +inChrootProcess (Chroot loc _ _ _) cmd = do + mountproc + return $ proc "chroot" (loc:cmd) + 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" provisioningLock :: FilePath -> FilePath provisioningLock containerloc = "chroot" mungeloc containerloc ++ ".lock" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 9e5ca432..c2446b2e 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -250,8 +250,8 @@ enterScript c@(Container name _ _) = setup teardown enterScriptFile :: Container -> FilePath enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name -enterContainerProcess :: Container -> [String] -> CreateProcess -enterContainerProcess = proc . enterScriptFile +enterContainerProcess :: Container -> [String] -> IO CreateProcess +enterContainerProcess c ps = pure $ proc (enterScriptFile c) ps nspawnServiceName :: MachineName -> ServiceName nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service" -- cgit v1.2.3 From ef1307652e502882cecdccdfc1773f4cf390ad17 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 18:14:47 -0400 Subject: another try at unmounting /proc for systemd-nspawn --- src/Propellor/Property/Chroot.hs | 24 ++++++++++++++++-------- src/Propellor/Property/Systemd.hs | 24 ++++++------------------ 2 files changed, 22 insertions(+), 26 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 7e7d1611..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] -> IO 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" @@ -123,14 +123,16 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " parenthost <- asks hostName cmd <- liftIO $ toChain parenthost c systemdonly pe <- liftIO standardPathEnv - p <- liftIO $ 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 @@ -157,17 +159,23 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = putStrLn $ "\n" ++ show r chain _ _ = errorMessage "bad chain command" -inChrootProcess :: Chroot -> [String] -> IO CreateProcess -inChrootProcess (Chroot loc _ _ _) cmd = do +inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ()) +inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do mountproc - return $ proc "chroot" (loc:cmd) + 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" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 83cc1eaa..a46fe4f8 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -39,7 +39,6 @@ import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import Propellor.Property.Systemd.Core -import Propellor.Property.Mount import Utility.FileMode import Data.List @@ -168,19 +167,7 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) = -- Chroot provisioning is run in systemd-only mode, -- which sets up the chroot and ensures systemd and dbus are -- installed, but does not handle the other provisions. - chrootprovisioned = - (toProp provisioner `onChange` umountProc) - - (toProp (revert provisioner)) - provisioner = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True - - -- The chroot's /proc is left mounted by the chroot provisioning, - -- but that will prevent systemd-nspawn from starting systemd in - -- it, so unmount. - umountProc = check (elem procloc <$> mountPointsBelow loc) $ - property (procloc ++ " unmounted") $ do - makeChange $ umountLazy procloc - procloc = loc "proc" + chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True -- Use nsenter to enter container and and run propellor to -- finish provisioning. @@ -269,8 +256,8 @@ enterScript c@(Container name _ _) = setup teardown enterScriptFile :: Container -> FilePath enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name -enterContainerProcess :: Container -> [String] -> IO CreateProcess -enterContainerProcess c ps = pure $ proc (enterScriptFile c) ps +enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ()) +enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop) nspawnServiceName :: MachineName -> ServiceName nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service" @@ -338,8 +325,9 @@ instance Publishable PortSpec where -- | Publish a port from the container on the host. -- --- Note that this will only work if the container's network is set up --- by other properties. +-- Note that this will only work if the container is set up to use +-- private networking. If the container does not use private networking, +-- this property is not needed. -- -- This feature was first added in systemd version 220. publish :: Publishable p => p -> RevertableProperty -- cgit v1.2.3