summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2015-10-22 16:23:24 -0400
committerJoey Hess2015-10-22 16:23:24 -0400
commit6399d6d2722320346877071866414e450701fbf9 (patch)
treea7874c1402142abef5b08799adf284ba0035b683 /src/Propellor/Property
parentd18f1e9e49eff5ca8d43845e2b9ce6483d219ffc (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/DiskImage.hs6
-rw-r--r--src/Propellor/Property/Parted.hs2
-rw-r--r--src/Propellor/Property/Partition.hs23
3 files changed, 21 insertions, 10 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 3c2b2200..8b74f478 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -130,14 +130,14 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg <!> rmimg
kpartx img (partitionsPopulated chrootdir mnts)
rmimg = File.notPresent img
-partitionsPopulated :: FilePath -> [MountPoint] -> [FilePath] -> Property NoInfo
+partitionsPopulated :: FilePath -> [MountPoint] -> [LoopDev] -> Property NoInfo
partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs
where
desc = "partitions populated from " ++ chrootdir
go Nothing _ = noChange
- go (Just mnt) dev = withTmpDir "mnt" $ \tmpdir -> bracket
- (liftIO $ mount "auto" dev tmpdir)
+ go (Just mnt) loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
+ (liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir)
(const $ liftIO $ umountLazy tmpdir)
$ \mounted -> if mounted
then ensureProperty $
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index 7bd38a65..834b6c7d 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -160,7 +160,7 @@ partitioned eep disk (PartTable tabletype parts) = property desc $ do
[ parted eep disk partedparams
, if isdev
then formatl (map (\n -> disk ++ show n) [1 :: Int ..])
- else Partition.kpartx disk formatl
+ else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)
]
where
desc = disk ++ " partitioned"
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 56bc1575..fa381d5d 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -41,20 +41,31 @@ formatted' opts YesReallyFormatPartition fs dev =
-- Be quiet.
q l = "-q":l
+data LoopDev = LoopDev
+ { partitionLoopDev :: FilePath -- ^ device for a loop partition
+ , wholeDiskLoopDev :: FilePath -- ^ corresponding device for the whole loop disk
+ } deriving (Show)
+
-- | Uses the kpartx utility to create device maps for partitions contained
--- within a disk image file. The resulting devices are passed to the
+-- within a disk image file. The resulting loop devices are passed to the
-- property, which can operate on them. Always cleans up after itself,
-- by removing the device maps after the property is run.
-kpartx :: FilePath -> ([FilePath] -> Property NoInfo) -> Property NoInfo
+kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo
kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
where
go = property (propertyDesc (mkprop [])) $ do
cleanup -- idempotency
s <- liftIO $ readProcess "kpartx" ["-avs", diskimage]
- r <- ensureProperty (mkprop (devlist s))
+ r <- ensureProperty (mkprop (kpartxParse s))
cleanup
return r
- devlist = mapMaybe (finddev . words) . lines
- finddev ("add":"map":s:_) = Just ("/dev/mapper/" ++ s)
- finddev _ = Nothing
cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+
+kpartxParse :: String -> [LoopDev]
+kpartxParse = mapMaybe (finddev . words) . lines
+ where
+ finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev
+ { partitionLoopDev = "/dev/mapper/" ++ ld
+ , wholeDiskLoopDev = wd
+ }
+ finddev _ = Nothing