summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Mount.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Mount.hs')
-rw-r--r--src/Propellor/Property/Mount.hs23
1 files changed, 22 insertions, 1 deletions
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 026509a9..2c4d9620 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -40,6 +40,9 @@ formatMountOpts (MountOpts []) = "defaults"
formatMountOpts (MountOpts l) = intercalate "," l
-- | Mounts a device, without listing it in </etc/fstab>.
+--
+-- Note that this property will fail if the device is already mounted
+-- at the MountPoint.
mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
mounted fs src mnt opts = property (mnt ++ " mounted") $
toResult <$> liftIO (mount fs src mnt opts)
@@ -52,6 +55,17 @@ bindMount src dest = tightenTargets $
`assume` MadeChange
`describe` ("bind mounted " ++ src ++ " to " ++ dest)
+-- | Enables swapping to a device, which must be formatted already as a swap
+-- partition.
+swapOn :: Source -> RevertableProperty Linux Linux
+swapOn mnt = tightenTargets doswapon <!> tightenTargets doswapoff
+ where
+ swaps = lines <$> readProcess "swapon" ["--show=NAME"]
+ doswapon = check (notElem mnt <$> swaps) $
+ cmdProperty "swapon" [mnt]
+ doswapoff = check (elem mnt <$> swaps) $
+ cmdProperty "swapoff" [mnt]
+
mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool
mount fs src mnt opts = boolSystem "mount" $
[ Param "-t", Param fs
@@ -64,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)
@@ -115,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