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.

2 files changed, 24 insertions, 9 deletions

diff --git a/debian/changelog b/debian/changelog
index 6c9bd36f..c466530e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,10 +3,9 @@ propellor (4.0.1) UNRELEASED; urgency=medium
   * Fix build with pre-AMP ghc.
   * Tor.named, Tor.torPrivKey: Include the new ed25519 public/private key
     pair in addition to the old secret_id_key.
-  * Property.Partition: Improve loop device detection code used with kpartx
-    when building disk images. /dev/mapper/loop* symlinks are now detected
-    as block devices.
-
+  * Property.Partition: Update kpartx output parser, as its output format
+    changed around version 0.6. Both output formats are supported now.
+   
  -- Joey Hess <id@joeyh.name>  Sat, 18 Mar 2017 19:40:35 -0400
 
 propellor (4.0.0) unstable; urgency=medium
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