diff options
| author | Joey Hess <joeyh@joeyh.name> | 2016-03-26 14:28:38 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-03-26 14:28:38 -0400 |
| commit | 3218e344d117701066ced6c13927318ea2938ad4 (patch) | |
| tree | b8980b2f3c51b4d81d37779608750cdfd1bf562e /src/Propellor/Property/Partition.hs | |
| parent | 2962f5c783db7a0f7014a8745768948c15d6a8ea (diff) | |
more porting
Diffstat (limited to 'src/Propellor/Property/Partition.hs')
| -rw-r--r-- | src/Propellor/Property/Partition.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs index b2f50339..5aff4ba4 100644 --- a/src/Propellor/Property/Partition.hs +++ b/src/Propellor/Property/Partition.hs @@ -16,7 +16,7 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | Linu data Eep = YesReallyFormatPartition -- | Formats a partition. -formatted :: Eep -> Fs -> FilePath -> Property NoInfo +formatted :: Eep -> Fs -> FilePath -> Property DebianLike formatted = formatted' [] -- | Options passed to a mkfs.* command when making a filesystem. @@ -24,7 +24,7 @@ formatted = formatted' [] -- Eg, ["-m0"] type MkfsOpts = [String] -formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property NoInfo +formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property DebianLike formatted' opts YesReallyFormatPartition fs dev = cmdProperty cmd opts' `assume` MadeChange `requires` Apt.installed [pkg] @@ -64,17 +64,18 @@ isLoopDev' f -- 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 -> ([LoopDev] -> Property NoInfo) -> Property NoInfo +kpartx :: FilePath -> ([LoopDev] -> Property DebianLike) -> Property DebianLike kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"] where - go = property (propertyDesc (mkprop [])) $ do + go :: Property DebianLike + go = property' (propertyDesc (mkprop [])) $ \w -> do cleanup -- idempotency loopdevs <- liftIO $ kpartxParse <$> readProcess "kpartx" ["-avs", diskimage] bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs unless (null bad) $ error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad - r <- ensureProperty (mkprop loopdevs) + r <- ensureProperty w (mkprop loopdevs) cleanup return r cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage] |