From b3c3a7029020126b1ab5e2d5999b7b2707078150 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 25 Aug 2015 18:50:35 -0700
Subject: formatting for partitions set up by parted

Including support for formatting partitions of a disk image file.
---
 src/Propellor/Property/Partition.hs | 54 +++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 src/Propellor/Property/Partition.hs

(limited to 'src/Propellor/Property/Partition.hs')

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
-- 
cgit v1.3-2-g0d8e


From 474119770bd54a905fcdda25a7bb12f2b1ea1307 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 25 Aug 2015 21:48:31 -0700
Subject: idempotency fix for kpartx

noticed kpartx could get confused if a disk image it had mapped was deleted and a fresh one mapped
---
 src/Propellor/Property/Parted.hs    | 2 +-
 src/Propellor/Property/Partition.hs | 4 +++-
 2 files changed, 4 insertions(+), 2 deletions(-)

(limited to 'src/Propellor/Property/Partition.hs')

diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index f463164e..aa7bece4 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -77,7 +77,7 @@ instance PartedVal PartType where
 	val Extended = "extended"
 
 -- | All partition sizing is done in megabytes, so that parted can
--- automatically lay out the partitions. 
+-- automatically lay out the partitions.
 --
 -- Note that these are SI megabytes, not mebibytes.
 newtype MegaBytes = MegaBytes Integer
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 53d8a946..41bdf795 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -45,10 +45,12 @@ kpartx :: FilePath -> ([FilePath] -> 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))
-		void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+		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]
-- 
cgit v1.3-2-g0d8e