diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2017-11-19 12:04:26 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2017-11-19 12:04:26 -0700 |
| commit | 05e5308ee7cef99b24b4f9d9755e5488f8d92a39 (patch) | |
| tree | 256b8f20bddf0f0701a3247228f9c2dd77be6e64 /src/Propellor/Property/Mount.hs | |
| parent | 38d039310e4db6ffaf5c8ca51c339421e6865eff (diff) | |
| parent | 12beba0367d14f9c52adf72dd36e9cf5a8e35761 (diff) | |
Merge branch 'master' of https://git.joeyh.name/git/propellor into sbuild-overhaul
Diffstat (limited to 'src/Propellor/Property/Mount.hs')
| -rw-r--r-- | src/Propellor/Property/Mount.hs | 20 |
1 files changed, 12 insertions, 8 deletions
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 2c4d9620..c047161d 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -90,18 +90,18 @@ mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) -- | Filesystem type mounted at a given location. getFsType :: MountPoint -> IO (Maybe FsType) -getFsType = findmntField "fstype" +getFsType p = findmntField "fstype" [p] -- | Mount options for the filesystem mounted at a given location. getFsMountOpts :: MountPoint -> IO MountOpts getFsMountOpts p = maybe mempty toMountOpts - <$> findmntField "fs-options" p + <$> findmntField "fs-options" [p] type UUID = String -- | UUID of filesystem mounted at a given location. getMountUUID :: MountPoint -> IO (Maybe UUID) -getMountUUID = findmntField "uuid" +getMountUUID p = findmntField "uuid" [p] -- | UUID of a device getSourceUUID :: Source -> IO (Maybe UUID) @@ -111,7 +111,7 @@ type Label = String -- | Label of filesystem mounted at a given location. getMountLabel :: MountPoint -> IO (Maybe Label) -getMountLabel = findmntField "label" +getMountLabel p = findmntField "label" [p] -- | Label of a device getSourceLabel :: Source -> IO (Maybe UUID) @@ -119,12 +119,16 @@ getSourceLabel = blkidTag "LABEL" -- | Device mounted at a given location. getMountSource :: MountPoint -> IO (Maybe Source) -getMountSource = findmntField "source" +getMountSource p = findmntField "source" [p] -findmntField :: String -> FilePath -> IO (Maybe String) -findmntField field mnt = catchDefaultIO Nothing $ +-- | Device that a given path is located within. +getMountContaining :: FilePath -> IO (Maybe Source) +getMountContaining p = findmntField "source" ["-T", p] + +findmntField :: String -> [String] -> IO (Maybe String) +findmntField field ps = catchDefaultIO Nothing $ headMaybe . filter (not . null) . lines - <$> readProcess "findmnt" ["-n", mnt, "--output", field] + <$> readProcess "findmnt" ("-n" : ps ++ ["--output", field]) blkidTag :: String -> Source -> IO (Maybe String) blkidTag tag dev = catchDefaultIO Nothing $ |