From b3240a7eb4bfb9e446e781a17e88a98c6b811f00 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 01:38:32 -0400 Subject: reorder for doc clarity --- src/Propellor/Property/Chroot.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index d17edae7..2b5391fa 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -1,13 +1,13 @@ {-# LANGUAGE FlexibleContexts, GADTs #-} module Propellor.Property.Chroot ( + debootstrapped, + bootstrapped, + provisioned, Chroot(..), ChrootBootstrapper(..), Debootstrapped(..), ChrootTarball(..), - debootstrapped, - bootstrapped, - provisioned, -- * Internal use provisioned', propagateChrootInfo, -- cgit v1.2.3 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. --- debian/changelog | 2 + src/Propellor/Property/DiskImage.hs | 17 ++-- src/Propellor/Property/Mount.hs | 158 +++++++++++++++++++++++++++++++----- 3 files changed, 146 insertions(+), 31 deletions(-) (limited to 'src/Propellor') diff --git a/debian/changelog b/debian/changelog index 051a9748..487826e1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,8 @@ propellor (2.11.1) UNRELEASED; urgency=medium * The DiskImage module can now make bootable images using grub. * Add a ChrootTarball chroot type, for using pre-built tarballs as chroots. Thanks, Ben Boeckel. + * Added Mount.fstabbed property to generate /etc/fstab to replicate + current mounts. -- Joey Hess Thu, 22 Oct 2015 20:24:18 -0400 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 diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 09016011..315e2d48 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -1,29 +1,159 @@ module Propellor.Property.Mount where import Propellor.Base +import qualified Propellor.Property.File as File import Utility.Path +import Data.Char +import Data.List +import Utility.Table + type FsType = String -- ^ type of filesystem to mount ("auto" to autodetect) type Source = String +type MountPoint = FilePath + +-- | Mounts a device. +mounted :: FsType -> Source -> MountPoint -> Property NoInfo +mounted fs src mnt = property (mnt ++ " mounted") $ + toResult <$> liftIO (mount fs src mnt) + +-- | Bind mounts the first directory so its contents also appear +-- in the second directory. +bindMount :: FilePath -> FilePath -> Property NoInfo +bindMount src dest = cmdProperty "mount" ["--bind", src, dest] + `describe` ("bind mounted " ++ src ++ " to " ++ dest) + +mount :: FsType -> Source -> MountPoint -> IO Bool +mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] + +newtype SwapPartition = SwapPartition FilePath + +-- | Replaces /etc/fstab with a file that should cause the currently +-- mounted partitions to be re-mounted the same way on boot. +-- +-- For each specified MountPoint, the UUID of each partition +-- (or if there is no UUID, its label), its filesystem type, +-- and its mount options are all automatically probed. +-- +-- The SwapPartitions are also included in the generated fstab. +fstabbed :: [MountPoint] -> [SwapPartition] -> Property NoInfo +fstabbed mnts swaps = property "fstabbed" $ do + fstab <- liftIO $ genFstab mnts swaps id + ensureProperty $ + "/etc/fstab" `File.hasContent` fstab + +genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String] +genFstab mnts swaps mnttransform = do + fstab <- liftIO $ mapM getcfg (sort mnts) + swapfstab <- liftIO $ mapM getswapcfg swaps + return $ header ++ formatTable (legend : fstab ++ swapfstab) + where + header = + [ "# /etc/fstab: static file system information. See fstab(5)" + , "# " + ] + legend = ["# ", "", "", "", "", ""] + getcfg mnt = sequence + [ fromMaybe (error "unable to find mount source") + <$> getM (\a -> a mnt) + [ uuidprefix getMountUUID + , sourceprefix getMountLabel + , getMountSource + ] + , pure (mnttransform mnt) + , fromMaybe "auto" <$> getFsType mnt + , fromMaybe "defaults" <$> getFsOptions mnt + , pure "0" + , pure (if mnt == "/" then "1" else "2") + ] + getswapcfg (SwapPartition swap) = sequence + [ fromMaybe swap <$> getM (\a -> a swap) + [ uuidprefix getSourceUUID + , sourceprefix getSourceLabel + ] + , pure "none" + , pure "swap" + , pure "defaults" + , pure "0" + , pure "0" + ] + prefix s getter m = fmap (s ++) <$> getter m + uuidprefix = prefix "UUID=" + sourceprefix = prefix "LABEL=" + +-- | Checks if /etc/fstab is not configured. This is the case if it doesn't +-- exist, or consists entirely of blank lines or comments. +-- +-- So, if you want to only replace the fstab once, and then never touch it +-- again, allowing local modifications: +-- +-- > check noFstab (fstabbed mnts []) +noFstab :: IO Bool +noFstab = ifM (doesFileExist "/etc/fstab") + ( null . filter iscfg . lines <$> readFile "/etc/fstab" + , return True + ) + where + iscfg l + | null l = False + | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l + -- | Lists all mount points of the system. -mountPoints :: IO [FilePath] +mountPoints :: IO [MountPoint] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] -- | Finds all filesystems mounted inside the specified directory. -mountPointsBelow :: FilePath -> IO [FilePath] +mountPointsBelow :: FilePath -> IO [MountPoint] mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) . filter (dirContains target) <$> mountPoints -- | Filesystem type mounted at a given location. -getFsType :: FilePath -> IO (Maybe FsType) -getFsType mnt = catchDefaultIO Nothing $ - headMaybe . lines - <$> readProcess "findmnt" ["-n", mnt, "--output", "fstype"] +getFsType :: MountPoint -> IO (Maybe FsType) +getFsType = findmntField "fstype" + +-- | Mount options for the filesystem mounted at a given location. +getFsOptions :: MountPoint -> IO (Maybe String) +getFsOptions = findmntField "fs-options" + +type UUID = String + +-- | UUID of filesystem mounted at a given location. +getMountUUID :: MountPoint -> IO (Maybe UUID) +getMountUUID = findmntField "uuid" --- | Unmounts a device, lazily so any running processes don't block it. +-- | UUID of a device +getSourceUUID :: Source -> IO (Maybe UUID) +getSourceUUID = blkidTag "UUID" + +type Label = String + +-- | Label of filesystem mounted at a given location. +getMountLabel :: MountPoint -> IO (Maybe Label) +getMountLabel = findmntField "label" + +-- | Label of a device +getSourceLabel :: Source -> IO (Maybe UUID) +getSourceLabel = blkidTag "LABEL" + +-- | Device mounted at a given location. +getMountSource :: MountPoint -> IO (Maybe Source) +getMountSource = findmntField "source" + +findmntField :: String -> FilePath -> IO (Maybe String) +findmntField field mnt = catchDefaultIO Nothing $ + headMaybe . filter (not . null) . lines + <$> readProcess "findmnt" ["-n", mnt, "--output", field] + +blkidTag :: String -> Source -> IO (Maybe String) +blkidTag tag dev = catchDefaultIO Nothing $ + headMaybe . filter (not . null) . lines + <$> readProcess "blkid" [dev, "-s", tag] + +-- | Unmounts a device or mountpoint, +-- lazily so any running processes don't block it. umountLazy :: FilePath -> IO () umountLazy mnt = unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ @@ -34,17 +164,3 @@ unmountBelow :: FilePath -> IO () unmountBelow d = do submnts <- mountPointsBelow d forM_ submnts umountLazy - --- | Mounts a device. -mounted :: FsType -> Source -> FilePath -> Property NoInfo -mounted fs src mnt = property (mnt ++ " mounted") $ - toResult <$> liftIO (mount fs src mnt) - --- | Bind mounts the first directory so its contents also appear --- in the second directory. -bindMount :: FilePath -> FilePath -> Property NoInfo -bindMount src dest = cmdProperty "mount" ["--bind", src, dest] - `describe` ("bind mounted " ++ src ++ " to " ++ dest) - -mount :: FsType -> Source -> FilePath -> IO Bool -mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] -- 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') 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 04209e7763547af4fa3527cb9e5e7d0d964edb97 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:30:27 -0400 Subject: propellor spin --- src/Propellor/Property/Mount.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 315e2d48..2496b1cc 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -56,7 +56,7 @@ genFstab mnts swaps mnttransform = do ] legend = ["# ", "", "", "", "", ""] getcfg mnt = sequence - [ fromMaybe (error "unable to find mount source") + [ fromMaybe (error $ "unable to find mount source for " ++ mnt) <$> getM (\a -> a mnt) [ uuidprefix getMountUUID , sourceprefix getMountLabel -- 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') 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') 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') 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 a1183efbcb6a2a3f62027aa452c99ac3be17c6b8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 11:51:14 -0400 Subject: propellor spin --- config-joey.hs | 3 ++- src/Propellor/Property/Mount.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'src/Propellor') diff --git a/config-joey.hs b/config-joey.hs index 6ec80f92..ceabc252 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -84,8 +84,9 @@ 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 100 + `addFreeSpace` MegaBytes 200 , swapPartition (MegaBytes 256) ] where diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 2496b1cc..a08f9e3b 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -150,7 +150,7 @@ findmntField field mnt = catchDefaultIO Nothing $ blkidTag :: String -> Source -> IO (Maybe String) blkidTag tag dev = catchDefaultIO Nothing $ headMaybe . filter (not . null) . lines - <$> readProcess "blkid" [dev, "-s", tag] + <$> readProcess "blkid" [dev, "-s", tag, "-o", "value"] -- | Unmounts a device or mountpoint, -- lazily so any running processes don't block it. -- 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') 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') 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') 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') 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') 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') 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