summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-09-02 11:13:36 -0700
committerJoey Hess2015-09-02 11:13:36 -0700
commitd2393d8141ac302eff5dc29d32d68014b630d166 (patch)
tree629d1e427e8dd53033bf8e3717e91497dcc51a3f
parentbce9d314a94a1378ee35a4575aa7ecadf5967e62 (diff)
propellor spin
-rw-r--r--src/Propellor/Property/Chroot/Util.hs4
-rw-r--r--src/Propellor/Property/DiskImage.hs8
-rw-r--r--src/Propellor/Property/Mount.hs6
3 files changed, 13 insertions, 5 deletions
diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs
index 73cf094a..ea0df780 100644
--- a/src/Propellor/Property/Chroot/Util.hs
+++ b/src/Propellor/Property/Chroot/Util.hs
@@ -4,7 +4,6 @@ import Propellor.Property.Mount
import Utility.Env
import Control.Applicative
-import Control.Monad
import System.Directory
-- When chrooting, it's useful to ensure that PATH has all the standard
@@ -23,6 +22,5 @@ stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
-- mounted within it.
removeChroot :: FilePath -> IO ()
removeChroot c = do
- submnts <- mountPointsBelow c
- forM_ submnts umountLazy
+ unmountBelow c
removeDirectoryRecursive c
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 6f2af863..00bb465f 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -20,9 +20,10 @@ import Propellor
import Propellor.Property.Chroot (Chroot)
import Propellor.Property.Chroot.Util (removeChroot)
import qualified Propellor.Property.Chroot as Chroot
-import Propellor.Property.Parted
import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.File as File
+import Propellor.Property.Parted
+import Propellor.Property.Mount
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Lazy as L
@@ -73,6 +74,9 @@ built' rebuild img mkchroot mkparttable final =
unmkimg = File.notPresent img
chrootdir = img ++ ".chroot"
mkimg = property desc $ do
+ -- unmount helper filesystems such as proc from the chroot
+ -- before getting sizes
+ liftIO $ unmountBelow chrootdir
szm <- liftIO $ M.map toPartSize <$> dirSizes chrootdir
-- tie the knot!
let (mnts, t) = mkparttable (map (getMountSz szm) mnts)
@@ -112,7 +116,7 @@ dirSizes :: FilePath -> IO (M.Map FilePath Integer)
dirSizes top = go M.empty top [top]
where
go m _ [] = return m
- go m dir (i:is) = do
+ go m dir (i:is) = flip catchIO (\_ioerr -> go m dir is) $ do
s <- getSymbolicLinkStatus i
let sz = fromIntegral (fileSize s)
if isDirectory s
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 43ca0cc6..4070ebcb 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -29,6 +29,12 @@ umountLazy mnt =
unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $
errorMessage $ "failed unmounting " ++ mnt
+-- | Unmounts anything mounted inside the specified directory.
+unmountBelow :: FilePath -> IO ()
+unmountBelow d = do
+ submnts <- mountPointsBelow d
+ forM_ submnts umountLazy
+
-- | Mounts a device.
mount :: FsType -> Source -> FilePath -> IO Bool
mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt]