From 5fc482fff3dcd9c809c275856adff1851b47160d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 24 Mar 2017 10:11:57 -0400 Subject: 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. --- src/Propellor/Property/Partition.hs | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property/Partition.hs') 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 -- cgit v1.2.3