summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog4
-rw-r--r--src/Propellor/Property/Chroot.hs21
-rw-r--r--src/Propellor/Property/DiskImage.hs46
3 files changed, 58 insertions, 13 deletions
diff --git a/debian/changelog b/debian/changelog
index 07027273..2791e714 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -10,6 +10,10 @@ propellor (3.5.0) UNRELEASED; urgency=medium
propellor any longer.
* Changed Chroot data type to include Info propigation.
(API change)
+ * Implemented hostChroot, as originally seen in my slides at
+ Linux.Conf.Au 2017 in January. Now that it's not vaporware, it allows
+ one Host to build a disk image that has all the properties of another
+ Host.
-- Joey Hess <id@joeyh.name> Wed, 08 Mar 2017 14:02:10 -0400
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 9624a0f3..4b9b48e1 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -1,9 +1,11 @@
{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Propellor.Property.Chroot (
debootstrapped,
bootstrapped,
provisioned,
+ hostChroot,
Chroot(..),
ChrootBootstrapper(..),
Debootstrapped(..),
@@ -290,3 +292,22 @@ setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) }
newtype InChroot = InChroot Bool
deriving (Typeable, Show)
+
+-- | Generates a Chroot that has all the properties of a Host.
+--
+-- Note that it's possible to create loops using this, where a host
+-- contains a Chroot containing itself etc. Such loops will be detected at
+-- runtime.
+hostChroot :: ChrootBootstrapper bootstrapper => Host -> bootstrapper -> FilePath -> Chroot
+hostChroot h bootstrapper d = chroot
+ where
+ chroot = Chroot d bootstrapper pinfo h
+ pinfo = propagateHostChrootInfo h chroot
+
+-- This is different than propagateChrootInfo in that Info using
+-- HostContext is not made to use the name of the chroot as its context,
+-- but instead uses the hostname of the Host.
+propagateHostChrootInfo :: Host -> Chroot -> InfoPropagator
+propagateHostChrootInfo h c p =
+ propagateContainer (hostName h) c $
+ p `setInfoProperty` chrootInfo c
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 64ab8bd5..c7868c47 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -63,19 +63,20 @@ type DiskImage = FilePath
-- Example use:
--
-- > import Propellor.Property.DiskImage
+-- > import Propellor.Property.Chroot
-- >
--- > ...
--- > & imageBuilt "/srv/images/foo.img" mychroot
--- > MSDOS (grubBooted PC)
--- > [ partition EXT2 `mountedAt` "/boot"
--- > `setFlag` BootFlag
--- > , partition EXT4 `mountedAt` "/"
--- > `addFreeSpace` MegaBytes 100
--- > `mountOpt` errorReadonly
--- > , swapPartition (MegaBytes 256)
--- > ]
--- > where
--- > mychroot d = Chroot.debootstrapped mempty d $ props
+-- > foo = host "foo.example.com" $ props
+-- > & imageBuilt "/srv/diskimages/disk.img" mychroot
+-- > MSDOS (grubBooted PC)
+-- > [ partition EXT2 `mountedAt` "/boot"
+-- > `setFlag` BootFlag
+-- > , partition EXT4 `mountedAt` "/"
+-- > `addFreeSpace` MegaBytes 100
+-- > `mountOpt` errorReadonly
+-- > , swapPartition (MegaBytes 256)
+-- > ]
+-- > where
+-- > mychroot d = debootstrapped mempty d $ props
-- > & osDebian Unstable X86_64
-- > & Apt.installed ["linux-image-amd64"]
-- > & User.hasPassword (User "root")
@@ -84,7 +85,26 @@ type DiskImage = FilePath
-- > & User.hasDesktopGroups (User "demo")
-- > & ...
--
---
+-- This can also be used with `Chroot.hostChroot` to build a disk image
+-- that has all the properties of a Host. For example:
+--
+-- > foo :: Host
+-- > foo = host "foo.example.com" $ props
+-- > & imageBuilt "/srv/diskimages/bar-disk.img"
+-- > (hostChroot bar (Debootstrapped mempty))
+-- > MSDOS (grubBooted PC)
+-- > [ partition EXT2 `mountedAt` "/boot"
+-- > `setFlag` BootFlag
+-- > , partition EXT4 `mountedAt` "/"
+-- > `addFreeSpace` MegaBytes 5000
+-- > , swapPartition (MegaBytes 256)
+-- > ]
+-- >
+-- > bar :: Host
+-- > bar = host "bar.example.com" $ props
+-- > & osDebian Unstable X86_64
+-- > & Apt.installed ["linux-image-amd64"]
+-- > & hasPassword (User "root")
imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageBuilt = imageBuilt' False