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