diff options
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | debian/control | 2 | ||||
| -rw-r--r-- | propellor.cabal | 6 | ||||
| -rw-r--r-- | src/Propellor/Property/DiskImage.hs | 31 |
4 files changed, 32 insertions, 8 deletions
diff --git a/debian/changelog b/debian/changelog index d56ac606..2431969e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,7 @@ propellor (2.7.3) UNRELEASED; urgency=medium * Added Propellor.Property.DiskImage, for bootable disk image creation. (Not yet complete.) * Update for Debian systemd-container package split. + * Dropped support for ghc 7.4. -- Joey Hess <id@joeyh.name> Tue, 25 Aug 2015 13:45:39 -0700 diff --git a/debian/control b/debian/control index 25c3d474..05101be0 100644 --- a/debian/control +++ b/debian/control @@ -4,7 +4,7 @@ Priority: optional Build-Depends: debhelper (>= 9), git, - ghc (>= 7.4), + ghc (>= 7.6), cabal-install, libghc-async-dev, libghc-missingh-dev, diff --git a/propellor.cabal b/propellor.cabal index 329739be..e455d1a7 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -38,7 +38,7 @@ Executable propellor Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck, mtl, transformers, + containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers, exceptions (>= 0.6) if (! os(windows)) @@ -50,7 +50,7 @@ Executable propellor-config Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck, mtl, transformers, + containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers, exceptions if (! os(windows)) @@ -61,7 +61,7 @@ Library Hs-Source-Dirs: src Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck, mtl, transformers, + containers (>= 0.5), network, async, time, QuickCheck, mtl, transformers, exceptions if (! os(windows)) diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 691f79bc..5bdd8f1a 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -17,6 +17,9 @@ import Propellor.Property.Chroot import Propellor.Property.Parted import qualified Propellor.Property.Grub as Grub +import qualified Data.Map.Strict as M +import System.Posix.Files + -- | Creates a bootable disk image. -- -- First the specified Chroot is set up, and its properties are satisfied. @@ -48,6 +51,30 @@ rebuilt = built' True built' :: Bool -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty built' rebuild mkparttable mkchroot final = undefined +-- TODO tie the knot +-- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)] +-- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts) + +-- | Generates a map of the sizes of the contents of +-- every directory in a filesystem tree. +-- +-- Should be same values as du -b +dirSizes :: FilePath -> IO (M.Map FilePath Integer) +dirSizes top = go M.empty top [top] + where + go m _ [] = return m + go m dir (i:is) = do + s <- getSymbolicLinkStatus i + let sz = fromIntegral (fileSize s) + if isDirectory s + then do + subm <- go M.empty i =<< dirContents i + let sz' = M.foldr' (+) sz + (M.filterWithKey (const . subdirof i) subm) + go (M.insertWith (+) i sz' (M.union m subm)) dir is + else go (M.insertWith (+) dir sz m) dir is + subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent + -- | Where a partition is mounted. Use Nothing for eg, LinuxSwap. type MountPoint = Maybe FilePath @@ -60,10 +87,6 @@ type MountPoint = Maybe FilePath -- provided as a default size.) type MkPartTable = [PartSize] -> ([MountPoint], PartTable) --- TODO tie the knot --- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)] --- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts) - -- | The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition. -- |