From 3c0575f156eead78ed98a8cd9276bc663c8d587c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 03:30:03 -0400 Subject: Added Mount.fstabbed property to generate /etc/fstab to replicate current mounts. --- src/Propellor/Property/DiskImage.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 1e3a5407..b65d399c 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -133,7 +133,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg imageFinalized final mnts devs rmimg = File.notPresent img -partitionsPopulated :: FilePath -> [MountPoint] -> [LoopDev] -> Property NoInfo +partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [LoopDev] -> Property NoInfo partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs where desc = "partitions populated from " ++ chrootdir @@ -197,14 +197,14 @@ dirSizes top = go M.empty top [top] else go (M.insertWith (+) dir sz m) dir is subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent -getMountSz :: (M.Map FilePath PartSize) -> [MountPoint] -> MountPoint -> Maybe PartSize +getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize getMountSz _ _ Nothing = Nothing getMountSz szm l (Just mntpt) = fmap (`reducePartSize` childsz) (M.lookup mntpt szm) where childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l) -isChild :: FilePath -> MountPoint -> Bool +isChild :: FilePath -> Maybe MountPoint -> Bool isChild mntpt (Just d) | d `equalFilePath` mntpt = False | otherwise = mntpt `dirContains` d @@ -217,9 +217,6 @@ toSysDir chrootdir d = case makeRelative chrootdir d of "." -> "/" sysdir -> "/" ++ sysdir --- | Where a partition is mounted. Use Nothing for eg, LinuxSwap. -type MountPoint = Maybe FilePath - defSz :: PartSize defSz = MegaBytes 128 @@ -240,7 +237,7 @@ fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3) -- (Partitions that are not to be mounted (ie, LinuxSwap), or that have -- no corresponding directory in the chroot will have 128 MegaBytes -- provided as a default size.) -type PartSpec = (MountPoint, PartSize -> Partition) +type PartSpec = (Maybe MountPoint, PartSize -> Partition) -- | Specifies a swap partition of a given size. swapPartition :: PartSize -> PartSpec @@ -279,7 +276,7 @@ adjustp (mp, p) f = (mp, f . p) -- | The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition. -fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([MountPoint], PartTable) +fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([Maybe MountPoint], PartTable) fitChrootSize tt l basesizes = (mounts, parttable) where (mounts, sizers) = unzip l @@ -297,7 +294,7 @@ fitChrootSize tt l basesizes = (mounts, parttable) -- in the partition tree. type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo)) -imageFinalized :: Finalization -> [MountPoint] -> [LoopDev] -> Property NoInfo +imageFinalized :: Finalization -> [Maybe MountPoint] -> [LoopDev] -> Property NoInfo imageFinalized (_, final) mnts devs = property "disk image finalized" $ withTmpDir "mnt" $ \top -> go top `finally` liftIO (unmountall top) @@ -308,7 +305,7 @@ imageFinalized (_, final) mnts devs = property "disk image finalized" $ -- Ordered lexographically by mount point, so / comes before /usr -- comes before /usr/local - orderedmntsdevs :: [(MountPoint, LoopDev)] + orderedmntsdevs :: [(Maybe MountPoint, LoopDev)] orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts devs mountall top = forM_ orderedmntsdevs $ \(mp, loopdev) -> case mp of -- cgit v1.2.3 From 12cdc6d324c7d7abd62cc05aea2490b3cbdab059 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:26:39 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 36 +++++++++++++++++++++++------------- src/Propellor/Property/Partition.hs | 2 +- 2 files changed, 24 insertions(+), 14 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index b65d399c..f1f2f79e 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -119,18 +119,18 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg <$> liftIO (dirSizes chrootdir) let calcsz mnts = maybe defSz fudge . getMountSz szm mnts -- tie the knot! - let (mnts, t) = fitChrootSize tabletype partspec $ + let (mnts, parttable) = fitChrootSize tabletype partspec $ map (calcsz mnts) mnts ensureProperty $ - imageExists img (partTableSize t) + imageExists img (partTableSize parttable) `before` - partitioned YesReallyDeleteDiskContents img t + partitioned YesReallyDeleteDiskContents img parttable `before` - kpartx img (mkimg' mnts) - mkimg' mnts devs = + kpartx img (mkimg' mnts parttable) + mkimg' mnts parttable devs = partitionsPopulated chrootdir mnts devs `before` - imageFinalized final mnts devs + imageFinalized final mnts devs parttable rmimg = File.notPresent img partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [LoopDev] -> Property NoInfo @@ -294,14 +294,16 @@ fitChrootSize tt l basesizes = (mounts, parttable) -- in the partition tree. type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo)) -imageFinalized :: Finalization -> [Maybe MountPoint] -> [LoopDev] -> Property NoInfo -imageFinalized (_, final) mnts devs = property "disk image finalized" $ - withTmpDir "mnt" $ \top -> - go top `finally` liftIO (unmountall top) +imageFinalized :: Finalization -> [Maybe MountPoint] -> [LoopDev] -> PartTable -> Property NoInfo +imageFinalized (_, final) mnts devs (PartTable _ parts) = + property "disk image finalized" $ + withTmpDir "mnt" $ \top -> + go top `finally` liftIO (unmountall top) where - go mnt = do - liftIO $ mountall mnt - ensureProperty $ final mnt devs + go top = do + liftIO $ mountall top + liftIO $ writefstab top + ensureProperty $ final top devs -- Ordered lexographically by mount point, so / comes before /usr -- comes before /usr/local @@ -319,6 +321,14 @@ imageFinalized (_, final) mnts devs = property "disk image finalized" $ unmountall top = do unmountBelow top umountLazy top + + writefstab top = do + old <- catchDefaultIO "" $ readFileStrict "/etc/fstab" + new <- genFstab (catMaybes mnts) swaps (toSysDir top) + writeFile "/etc/fstab" (unlines new ++ old) + swaps = map (SwapPartition . partitionLoopDev . snd) $ + filter ((== LinuxSwap) . partFs . fst) $ + zip parts devs noFinalization :: Finalization noFinalization = (doNothing, \_ _ -> doNothing) diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs index fd3c7930..d39ceea6 100644 --- a/src/Propellor/Property/Partition.hs +++ b/src/Propellor/Property/Partition.hs @@ -11,7 +11,7 @@ import Data.List -- | Filesystems etc that can be used for a partition. data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap - deriving (Show) + deriving (Show, Eq) data Eep = YesReallyFormatPartition -- cgit v1.2.3 From 27635a19c9d9ff654b95e5685a19661272732dd6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:32:49 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index f1f2f79e..56ee2a8c 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -324,7 +324,8 @@ imageFinalized (_, final) mnts devs (PartTable _ parts) = writefstab top = do old <- catchDefaultIO "" $ readFileStrict "/etc/fstab" - new <- genFstab (catMaybes mnts) swaps (toSysDir top) + new <- genFstab (map (top ++) (catMaybes mnts)) + swaps (toSysDir top) writeFile "/etc/fstab" (unlines new ++ old) swaps = map (SwapPartition . partitionLoopDev . snd) $ filter ((== LinuxSwap) . partFs . fst) $ -- cgit v1.2.3 From 2e42b9db53ecf8cc33d92e2374e0d5ca24013a85 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:42:59 -0400 Subject: propellor spin --- config-joey.hs | 1 + src/Propellor/Property/DiskImage.hs | 16 ++++++++++------ 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/config-joey.hs b/config-joey.hs index 81e97af4..6ec80f92 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -91,6 +91,7 @@ darkstar = host "darkstar.kitenet.net" where c d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d & Apt.installed ["linux-image-amd64"] + & User "root" `User.hasInsecurePassword` "root" gnu :: Host gnu = host "gnu.kitenet.net" diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 56ee2a8c..af8a020b 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -47,7 +47,7 @@ import Propellor.Property.Partition import Propellor.Property.Rsync import Utility.Path -import Data.List (isPrefixOf, sortBy) +import Data.List (isPrefixOf, isInfixOf, sortBy) import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.ByteString.Lazy as L @@ -309,6 +309,10 @@ imageFinalized (_, final) mnts devs (PartTable _ parts) = -- comes before /usr/local orderedmntsdevs :: [(Maybe MountPoint, LoopDev)] orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts devs + + swaps = map (SwapPartition . partitionLoopDev . snd) $ + filter ((== LinuxSwap) . partFs . fst) $ + zip parts devs mountall top = forM_ orderedmntsdevs $ \(mp, loopdev) -> case mp of Nothing -> noop @@ -323,13 +327,13 @@ imageFinalized (_, final) mnts devs (PartTable _ parts) = umountLazy top writefstab top = do - old <- catchDefaultIO "" $ readFileStrict "/etc/fstab" + old <- catchDefaultIO [] $ filter (not . unconfigured) . lines + <$> readFileStrict (top ++ "/etc/fstab") new <- genFstab (map (top ++) (catMaybes mnts)) swaps (toSysDir top) - writeFile "/etc/fstab" (unlines new ++ old) - swaps = map (SwapPartition . partitionLoopDev . snd) $ - filter ((== LinuxSwap) . partFs . fst) $ - zip parts devs + writeFile "/etc/fstab" $ unlines $ new ++ old + -- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM" + unconfigured s = "UNCONFIGURED" `isInfixOf` s noFinalization :: Finalization noFinalization = (doNothing, \_ _ -> doNothing) -- cgit v1.2.3 From 83a07d5c56223fe31d64a691c9775b5d237a9f3f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:46:11 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index af8a020b..9da374c7 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -77,6 +77,10 @@ type DiskImage = FilePath -- > `addFreeSpace` MegaBytes 100 -- > , swapPartition (MegaBytes 256) -- > ] +-- +-- Note that the disk image file is reused if it already exists, +-- to avoid expensive IO to generate a new one. And, it's updated in-place, +-- so its contents are undefined during the build process. imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty imageBuilt = imageBuilt' False @@ -327,11 +331,12 @@ imageFinalized (_, final) mnts devs (PartTable _ parts) = umountLazy top writefstab top = do + let fstab = top ++ "/etc/fstab" old <- catchDefaultIO [] $ filter (not . unconfigured) . lines - <$> readFileStrict (top ++ "/etc/fstab") + <$> readFileStrict fstab new <- genFstab (map (top ++) (catMaybes mnts)) swaps (toSysDir top) - writeFile "/etc/fstab" $ unlines $ new ++ old + writeFile fstab $ unlines $ new ++ old -- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM" unconfigured s = "UNCONFIGURED" `isInfixOf` s -- cgit v1.2.3 From b66f8eecfc0a507c1fee38070885b94f84b49f7a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:55:18 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 9da374c7..607c7b61 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -352,6 +352,7 @@ grubBooted bios = (Grub.installed' bios, boots) [ bindMount "/dev" (inmnt "/dev") , mounted "proc" "proc" (inmnt "/proc") , mounted "sysfs" "sys" (inmnt "/sys") + , inchroot "update-initramfs" ["-u"] -- work around for http://bugs.debian.org/802717 , check haveosprober $ inchroot "chmod" ["-x", osprober] , inchroot "update-grub" [] -- cgit v1.2.3 From 02faa876dbf3000fb091be6a4a3ab5b6a26ed028 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:59:13 -0400 Subject: propellor spin --- config-joey.hs | 4 ++-- src/Propellor/Property/DiskImage.hs | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/config-joey.hs b/config-joey.hs index ceabc252..9148fe4e 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -84,9 +84,9 @@ darkstar = host "darkstar.kitenet.net" & imageBuilt "/tmp/img" c MSDOS (grubBooted PC) [ partition EXT2 `mountedAt` "/boot" `setFlag` BootFlag - `addFreeSpace` MegaBytes 200 + -- `addFreeSpace` MegaBytes 200 , partition EXT4 `mountedAt` "/" - `addFreeSpace` MegaBytes 200 + -- `addFreeSpace` MegaBytes 200 , swapPartition (MegaBytes 256) ] where diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 607c7b61..b6cfbc1a 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -352,6 +352,7 @@ grubBooted bios = (Grub.installed' bios, boots) [ bindMount "/dev" (inmnt "/dev") , mounted "proc" "proc" (inmnt "/proc") , mounted "sysfs" "sys" (inmnt "/sys") + -- update the initramfs so it gets the uuid of the root partition , inchroot "update-initramfs" ["-u"] -- work around for http://bugs.debian.org/802717 , check haveosprober $ inchroot "chmod" ["-x", osprober] -- cgit v1.2.3 From 72f956788ef144a3a516e759335d2e7fbc6931ec Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 12:04:03 -0400 Subject: propellor spin --- config-joey.hs | 2 -- src/Propellor/Property/DiskImage.hs | 5 +++-- 2 files changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/config-joey.hs b/config-joey.hs index 9148fe4e..fce4f7a1 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -84,9 +84,7 @@ darkstar = host "darkstar.kitenet.net" & imageBuilt "/tmp/img" c MSDOS (grubBooted PC) [ partition EXT2 `mountedAt` "/boot" `setFlag` BootFlag - -- `addFreeSpace` MegaBytes 200 , partition EXT4 `mountedAt` "/" - -- `addFreeSpace` MegaBytes 200 , swapPartition (MegaBytes 256) ] where diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index b6cfbc1a..19c3a545 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -227,9 +227,10 @@ defSz = MegaBytes 128 -- Add 2% for filesystem overhead. Rationalle for picking 2%: -- A filesystem with 1% overhead might just sneak by as acceptable. -- Double that just in case. Add an additional 3 mb to deal with --- non-scaling overhead, of filesystems (eg, superblocks). +-- non-scaling overhead of filesystems (eg, superblocks). +-- Add an additional 100 mb for temp files etc. fudge :: PartSize -> PartSize -fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3) +fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 100) -- | Specifies a mount point and a constructor for a Partition. -- -- cgit v1.2.3 From af218b839b371dcddb0948fa385fc98c9abf4273 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 12:08:54 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 19c3a545..c13fa064 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -125,6 +125,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg -- tie the knot! let (mnts, parttable) = fitChrootSize tabletype partspec $ map (calcsz mnts) mnts + liftIO $ print mnts ensureProperty $ imageExists img (partTableSize parttable) `before` -- cgit v1.2.3 From 40f92a43b4506cbd69e8589228e17ace044be4ca Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 12:20:25 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index c13fa064..eea33706 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -125,7 +125,6 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg -- tie the knot! let (mnts, parttable) = fitChrootSize tabletype partspec $ map (calcsz mnts) mnts - liftIO $ print mnts ensureProperty $ imageExists img (partTableSize parttable) `before` @@ -229,9 +228,9 @@ defSz = MegaBytes 128 -- A filesystem with 1% overhead might just sneak by as acceptable. -- Double that just in case. Add an additional 3 mb to deal with -- non-scaling overhead of filesystems (eg, superblocks). --- Add an additional 100 mb for temp files etc. +-- Add an additional 200 mb for temp files, journals, etc. fudge :: PartSize -> PartSize -fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 100) +fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200) -- | Specifies a mount point and a constructor for a Partition. -- -- cgit v1.2.3 From 6dc70ff8d01871d2e37a3c5dfea8912737cb63c2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 12:27:45 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index eea33706..97880cf4 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -159,6 +159,8 @@ partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go m -- Include the child mount point, but exclude its contents. [ Include (Pattern m) , Exclude (filesUnder m) + -- Preserve any lost+found directory that mkfs made + , Exclude (Pattern "lost+found") ]) childmnts -- | Ensures that a disk image file of the specified size exists. -- cgit v1.2.3