summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Partition.hs
diff options
context:
space:
mode:
authorJoey Hess2015-08-25 18:50:35 -0700
committerJoey Hess2015-08-25 18:56:22 -0700
commitb3c3a7029020126b1ab5e2d5999b7b2707078150 (patch)
tree6820944d88b562fed2c1cb5031d510630be12f97 /src/Propellor/Property/Partition.hs
parent5462723243355c387746b10298db747d95e3e2c9 (diff)
formatting for partitions set up by parted
Including support for formatting partitions of a disk image file.
Diffstat (limited to 'src/Propellor/Property/Partition.hs')
-rw-r--r--src/Propellor/Property/Partition.hs54
1 files changed, 54 insertions, 0 deletions
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
new file mode 100644
index 00000000..53d8a946
--- /dev/null
+++ b/src/Propellor/Property/Partition.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Propellor.Property.Partition where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+
+-- | Filesystems etc that can be used for a partition.
+data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap
+ deriving (Show)
+
+data Eep = YesReallyFormatPartition
+
+-- | Formats a partition.
+formatted :: Eep -> Fs -> FilePath -> Property NoInfo
+formatted = formatted' []
+
+-- | Options passed to a mkfs.* command when making a filesystem.
+--
+-- Eg, ["-m0"]
+type MkfsOpts = [String]
+
+formatted' :: MkfsOpts -> Eep -> Fs -> FilePath -> Property NoInfo
+formatted' opts YesReallyFormatPartition fs dev =
+ cmdProperty cmd opts' `requires` Apt.installed [pkg]
+ where
+ (cmd, opts', pkg) = case fs of
+ EXT2 -> ("mkfs.ext2", optsdev, "e2fsprogs")
+ EXT3 -> ("mkfs.ext3", optsdev, "e2fsprogs")
+ EXT4 -> ("mkfs.ext4", optsdev, "e2fsprogs")
+ BTRFS -> ("mkfs.btrfs", optsdev, "btrfs-tools")
+ REISERFS -> ("mkfs.reiserfs", optsdev, "reiserfsprogs")
+ XFS -> ("mkfs.xfs", optsdev, "xfsprogs")
+ FAT -> ("mkfs.fat", optsdev, "dosfstools")
+ VFAT -> ("mkfs.vfat", optsdev, "dosfstools")
+ NTFS -> ("mkfs.ntfs", optsdev, "ntfs-3g")
+ LinuxSwap -> ("mkswap", optsdev, "util-linux")
+ optsdev = opts++[dev]
+
+-- | Uses the kpartx utility to create device maps for partitions contained
+-- within a disk image file. The resulting 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 diskimage mkprop = go `requires` Apt.installed ["kpartx"]
+ where
+ go = property (propertyDesc (mkprop [])) $ do
+ s <- liftIO $ readProcess "kpartx" ["-avs", diskimage]
+ r <- ensureProperty (mkprop (devlist s))
+ void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+ return r
+ devlist = mapMaybe (finddev . words) . lines
+ finddev ("add":"map":s:_) = Just ("/dev/mapper/" ++ s)
+ finddev _ = Nothing