summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Partition.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Partition.hs')
-rw-r--r--src/Propellor/Property/Partition.hs24
1 files changed, 20 insertions, 4 deletions
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 2bf5b927..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
@@ -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