From ebe81e975882ca3d4fcfe8e80fe9747f0128e2bc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Jul 2017 22:18:29 -0400 Subject: Added Mount.isMounted. * Added Mount.isMounted. * Grub.bootsMounted: Bugfix. --- debian/changelog | 7 +++++++ src/Propellor/Property/Grub.hs | 11 ++++++++--- src/Propellor/Property/Mount.hs | 9 ++++++++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/debian/changelog b/debian/changelog index c87c4868..3d064864 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +propellor (4.7.1) UNRELEASED; urgency=medium + + * Added Mount.isMounted. + * Grub.bootsMounted: Bugfix. + + -- Joey Hess Fri, 28 Jul 2017 22:18:07 -0400 + propellor (4.7.0) unstable; urgency=medium * Add Apt.proxy property to set a host's apt proxy. diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs index dbc34f4b..d0516dc8 100644 --- a/src/Propellor/Property/Grub.hs +++ b/src/Propellor/Property/Grub.hs @@ -132,7 +132,12 @@ bootsMounted mnt wholediskdev = combineProperties desc $ props cleanupmounts :: Property Linux cleanupmounts = property desc $ liftIO $ do - umountLazy (inmnt "/sys") - umountLazy (inmnt "/proc") - umountLazy (inmnt "/dev") + cleanup "/sys" + cleanup "/proc" + cleanup "/dev" return NoChange + where + cleanup m = + let mp = inmnt m + in whenM (isMounted mp) $ + umountLazy mp diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 5dcc5fe1..2c4d9620 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -78,6 +78,10 @@ mount fs src mnt opts = boolSystem "mount" $ mountPoints :: IO [MountPoint] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] +-- | Checks if anything is mounted at the MountPoint. +isMounted :: MountPoint -> IO Bool +isMounted mnt = isJust <$> getFsType mnt + -- | Finds all filesystems mounted inside the specified directory. mountPointsBelow :: FilePath -> IO [MountPoint] mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) @@ -129,12 +133,15 @@ blkidTag tag dev = catchDefaultIO Nothing $ -- | Unmounts a device or mountpoint, -- lazily so any running processes don't block it. +-- +-- Note that this will fail if it's not mounted. umountLazy :: FilePath -> IO () umountLazy mnt = unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ stopPropellorMessage $ "failed unmounting " ++ mnt --- | Unmounts anything mounted inside the specified directory. +-- | Unmounts anything mounted inside the specified directory, +-- not including the directory itself. unmountBelow :: FilePath -> IO () unmountBelow d = do submnts <- mountPointsBelow d -- cgit v1.2.3