summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog4
-rw-r--r--debian/control2
-rw-r--r--propellor.cabal6
-rw-r--r--src/Propellor/Property/DiskImage.hs114
-rw-r--r--src/Propellor/Property/Parted.hs18
-rw-r--r--src/Propellor/Property/Systemd.hs17
6 files changed, 119 insertions, 42 deletions
diff --git a/debian/changelog b/debian/changelog
index 214038c3..33d44b02 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,10 @@ propellor (2.7.3) UNRELEASED; urgency=medium
* Added Propellor.Property.Parted, for disk partitioning.
* Added Propellor.Property.Partition, for partition formatting etc.
* Added Propellor.Property.DiskImage, for bootable disk image creation.
+ (Not yet complete.)
+ * Dropped support for ghc 7.4.
+ * 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 cb373c94..5bdd8f1a 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -3,56 +3,116 @@
module Propellor.Property.DiskImage (
built,
rebuilt,
- DiskImageConfig(..),
+ MountPoint,
+ MkPartTable,
+ fitChrootSize,
+ freeSpace,
DiskImageFinalization,
grubBooted,
+ Grub.BIOS(..),
) where
import Propellor
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.
--- Then a disk image is created, large enough to fit the chroot, which
--- is copied into it. Finally, the DiskImageFinalization property is
+--
+-- Then, the disk image is set up, and the chroot is copied into the
+-- appropriate partition(s) of it.
+--
+-- Finally, the DiskImageFinalization property is
-- satisfied to make the disk image bootable.
--
-- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d
--- > & Apt.installed ["openssh-server"]
--- > & Grub.installed Grub.PC
--- > & ...
--- > in DiskImage.built mempty chroot DiskImage.grubBooted
-built :: DiskImageConfig -> (FilePath -> Chroot) -> DiskImageFinalization -> RevertableProperty
+-- > & Apt.installed ["openssh-server"]
+-- > & ...
+-- > partitions = fitChrootSize MSDOS
+-- > [ (Just "/boot", mkPartiton EXT2)
+-- > , (Just "/", mkPartition EXT4)
+-- > , (Nothing, const (mkPartition LinuxSwap (MegaBytes 256)))
+-- > ]
+-- > in built chroot partitions (grubBooted PC)
+built :: (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty
built = built' False
-- | Like 'built', but the chroot is deleted and rebuilt from scratch each
-- time. This is more expensive, but useful to ensure reproducible results
-- when the properties of the chroot have been changed.
-rebuilt :: DiskImageConfig -> (FilePath -> Chroot) -> DiskImageFinalization -> RevertableProperty
+rebuilt :: (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty
rebuilt = built' True
-built' :: Bool -> DiskImageConfig -> (FilePath -> Chroot) -> DiskImageFinalization -> RevertableProperty
-built' rebuild c mkchroot final = undefined
+built' :: Bool -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty
+built' rebuild mkparttable mkchroot final = undefined
-data DiskImageConfig = DiskImageConfig
- { freeSpace :: MegaBytes -- ^ A disk image is sized to fit the system installed in it. This adds some extra free space. (mempty default: 256 Megabytes)
- }
+-- TODO tie the knot
+-- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)]
+-- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts)
-instance Monoid DiskImageConfig where
- mempty = DiskImageConfig (MegaBytes 256)
- mappend a b = a
- { freeSpace = freeSpace a <> freeSpace b
- }
+-- | 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
--- | This is a property that is run, chrooted into the disk image. It's
--- typically only used to set up the boot loader.
-type DiskImageFinalization = Property NoInfo
+-- | Where a partition is mounted. Use Nothing for eg, LinuxSwap.
+type MountPoint = Maybe FilePath
--- | Makes grub be the boot loader of the disk image.
+-- | This is provided with a list of the sizes of directories in the chroot
+-- under each mount point. The input list corresponds to the list of mount
+-- points that the function returns! This trick is accomplished by
+-- exploiting laziness and tying the knot.
--
--- This does not cause grub to be installed. Use `Grub.installed` when
--- setting up the Chroot to do that.
-grubBooted :: DiskImageFinalization
-grubBooted = undefined
+-- (Partitions that are not mounted (ie, LinuxSwap) will have 128 MegaBytes
+-- provided as a default size.)
+type MkPartTable = [PartSize] -> ([MountPoint], PartTable)
+
+-- | The constructor for each Partition is passed the size of the files
+-- from the chroot that will be put in that partition.
+--
+-- Partitions that are not mounted (ie, LinuxSwap) will have their size
+-- set to 128 MegaBytes, unless it's overridden.
+fitChrootSize :: TableType -> [(MountPoint, PartSize -> Partition)] -> MkPartTable
+fitChrootSize tt l basesizes = (mounts, parttable)
+ where
+ (mounts, sizers) = unzip l
+ parttable = PartTable tt (map (uncurry id) (zip sizers basesizes))
+
+-- | After populating the partitions with files from the chroot,
+-- they will have remaining free space equal to the sizes of the input
+-- partitions.
+freeSpace :: TableType -> [(MountPoint, Partition)] -> MkPartTable
+freeSpace tt = fitChrootSize tt . map (\(mnt, p) -> (mnt, adjustsz p))
+ where
+ adjustsz p basesize = p { partSize = partSize p <> basesize }
+
+-- | A pair of properties. The first property is satisfied within the
+-- chroot, and is typically used to download the boot loader.
+-- The second property is satisfied chrooted into the resulting
+-- disk image, and will typically take care of installing the boot loader
+-- to the disk image.
+type DiskImageFinalization = (Property NoInfo, Property NoInfo)
+
+-- | Makes grub be the boot loader of the disk image.
+grubBooted :: Grub.BIOS -> DiskImageFinalization
+grubBooted bios = (Grub.installed bios, undefined)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index aa7bece4..29d94b4c 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -6,9 +6,9 @@ module Propellor.Property.Parted (
Partition(..),
mkPartition,
Partition.Fs(..),
- MegaBytes(..),
+ PartSize(..),
ByteSize,
- toMegaBytes,
+ toPartSize,
Partition.MkfsOpts,
PartType(..),
PartFlag(..),
@@ -48,7 +48,7 @@ instance Monoid PartTable where
-- | A partition on the disk.
data Partition = Partition
{ partType :: PartType
- , partSize :: MegaBytes
+ , partSize :: PartSize
, partFs :: Partition.Fs
, partMkFsOpts :: Partition.MkfsOpts
, partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default)
@@ -57,7 +57,7 @@ data Partition = Partition
deriving (Show)
-- | Makes a Partition with defaults for non-important values.
-mkPartition :: Partition.Fs -> MegaBytes -> Partition
+mkPartition :: Partition.Fs -> PartSize -> Partition
mkPartition fs sz = Partition
{ partType = Primary
, partSize = sz
@@ -80,16 +80,16 @@ instance PartedVal PartType where
-- automatically lay out the partitions.
--
-- Note that these are SI megabytes, not mebibytes.
-newtype MegaBytes = MegaBytes Integer
+newtype PartSize = MegaBytes Integer
deriving (Show)
-instance PartedVal MegaBytes where
+instance PartedVal PartSize where
val (MegaBytes n) = show n ++ "MB"
-toMegaBytes :: ByteSize -> MegaBytes
-toMegaBytes b = MegaBytes (b `div` 1000000)
+toPartSize :: ByteSize -> PartSize
+toPartSize b = MegaBytes (b `div` 1000000)
-instance Monoid MegaBytes where
+instance Monoid PartSize where
mempty = MegaBytes 0
mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 5c8a35e3..4da5b3f2 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -20,7 +20,8 @@ module Propellor.Property.Systemd (
-- * Journal
persistentJournal,
journaldConfigured,
- -- * Containers
+ -- * Containers and machined
+ machined,
MachineName,
Container,
container,
@@ -160,6 +161,18 @@ journaldConfigured option value =
configured "/etc/systemd/journald.conf" option value
`onChange` restarted journald
+-- | Ensures machined and machinectl are installed
+machined :: Property NoInfo
+machined = go `describe` "machined installed"
+ where
+ go = withOS ("standard sources.list") $ \o ->
+ case o of
+ -- Split into separate debian package since systemd 225.
+ (Just (System (Debian suite) _))
+ | not (isStable suite) -> ensureProperty $
+ Apt.installed ["systemd-container"]
+ _ -> noChange
+
-- | Defines a container with a given machine name.
--
-- Properties can be added to configure the Container.
@@ -250,7 +263,7 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
`requires` daemonReloaded
`requires` writeservicefile
- setup = started service `requires` setupservicefile
+ setup = started service `requires` setupservicefile `requires` machined
teardown = check (doesFileExist servicefile) $
disabled service `requires` stopped service