summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Partition.hs
diff options
context:
space:
mode:
authorJoey Hess2017-03-24 10:11:57 -0400
committerJoey Hess2017-03-24 10:11:57 -0400
commit5fc482fff3dcd9c809c275856adff1851b47160d (patch)
tree4b6728e3b1e8f8c9bb83effceb0b3addeb25e061 /src/Propellor/Property/Partition.hs
parent4bf95542a83ca1acaf627da547fa85c57583e4c2 (diff)
Property.Partition: Update kpartx output parser, as its output format changed around version 0.6. Both output formats are supported now.
Do we trust kpartx to not change again, given how little documented its output format is and that it's changed w/o warning? Little other things like vmdebootstrap depend on its output in the same way.. This commit was sponsored by Ignacio on Patreon.
Diffstat (limited to 'src/Propellor/Property/Partition.hs')
-rw-r--r--src/Propellor/Property/Partition.hs26
1 files changed, 21 insertions, 5 deletions
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 756e2b6b..679675b7 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -9,6 +9,7 @@ import Utility.Applicative
import System.Posix.Files
import Data.List
+import Data.Char
-- | Filesystems etc that can be used for a partition.
data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap
@@ -58,7 +59,7 @@ isLoopDev l = isLoopDev' (partitionLoopDev l) <&&> isLoopDev' (wholeDiskLoopDev
isLoopDev' :: FilePath -> IO Bool
isLoopDev' f
| "loop" `isInfixOf` f = catchBoolIO $
- isBlockDevice <$> getSymbolicLinkStatus f
+ isBlockDevice <$> getFileStatus f
| otherwise = return False
-- | Uses the kpartx utility to create device maps for partitions contained
@@ -81,11 +82,26 @@ kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
return r
cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+-- kpartx's output includes the device for the loop partition, and some
+-- information about the whole disk loop device. In earlier versions,
+-- this was simply the path to the loop device. But, in kpartx 0.6,
+-- this changed to the major:minor of the block device. Either is handled
+-- by this parser.
kpartxParse :: String -> [LoopDev]
kpartxParse = mapMaybe (finddev . words) . lines
where
- finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev
- { partitionLoopDev = "/dev/mapper/" ++ ld
- , wholeDiskLoopDev = wd
- }
+ finddev ("add":"map":ld:_:_:_:_:s:_) = do
+ wd <- if isAbsolute s
+ then Just s
+ -- A loop partition name loop0pn corresponds to
+ -- /dev/loop0. It would be more robust to check
+ -- that the major:minor matches, but haskell's
+ -- unix library lacks a way to do that.
+ else case takeWhile isDigit (dropWhile (not . isDigit) ld) of
+ [] -> Nothing
+ n -> Just $ "/dev" </> "loop" ++ n
+ Just $ LoopDev
+ { partitionLoopDev = "/dev/mapper/" ++ ld
+ , wholeDiskLoopDev = wd
+ }
finddev _ = Nothing