summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--debian/changelog4
-rw-r--r--src/Propellor/Property/Chroot.hs41
-rw-r--r--src/Propellor/Property/Systemd.hs6
3 files changed, 28 insertions, 23 deletions
diff --git a/debian/changelog b/debian/changelog
index 7fc68fe0..07027273 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-propellor (3.4.2) UNRELEASED; urgency=medium
+propellor (3.5.0) UNRELEASED; urgency=medium
* Added Apache.confEnabled.
* Makefile: Removed "run" target which was default target.
@@ -8,6 +8,8 @@ propellor (3.4.2) UNRELEASED; urgency=medium
directly to this version from 1.0.0 would break that cron job.
* Remove make from propellor's dependency list; it's not used by
propellor any longer.
+ * Changed Chroot data type to include Info propigation.
+ (API change)
-- 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 5f2e6b32..9624a0f3 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -40,18 +40,18 @@ import System.Console.Concurrent
-- | Specification of a chroot. Normally you'll use `debootstrapped` or
-- `bootstrapped` to construct a Chroot value.
data Chroot where
- Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
+ Chroot :: ChrootBootstrapper b => FilePath -> b -> InfoPropagator -> Host -> Chroot
instance IsContainer Chroot where
- containerProperties (Chroot _ _ h) = containerProperties h
- containerInfo (Chroot _ _ h) = containerInfo h
- setContainerProperties (Chroot loc b h) ps = Chroot loc b (setContainerProperties h ps)
+ containerProperties (Chroot _ _ _ h) = containerProperties h
+ containerInfo (Chroot _ _ _ h) = containerInfo h
+ setContainerProperties (Chroot loc b p h) ps = Chroot loc b p (setContainerProperties h ps)
chrootSystem :: Chroot -> Maybe System
chrootSystem = fromInfoVal . fromInfo . containerInfo
instance Show Chroot where
- show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
+ show c@(Chroot loc _ _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
-- | Class of things that can do initial bootstrapping of an operating
-- System in a chroot.
@@ -115,7 +115,9 @@ debootstrapped conf = bootstrapped (Debootstrapped conf)
-- | Defines a Chroot at the given location, bootstrapped with the
-- specified ChrootBootstrapper.
bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
-bootstrapped bootstrapper location ps = Chroot location bootstrapper (host location ps)
+bootstrapped bootstrapper location ps = c
+ where
+ c = Chroot location bootstrapper (propagateChrootInfo c) (host location ps)
-- | Ensures that the chroot exists and is provisioned according to its
-- properties.
@@ -124,15 +126,14 @@ bootstrapped bootstrapper location ps = Chroot location bootstrapper (host locat
-- is first unmounted. Note that it does not ensure that any processes
-- that might be running inside the chroot are stopped.
provisioned :: Chroot -> RevertableProperty (HasInfo + Linux) Linux
-provisioned c = provisioned' (propagateChrootInfo c) c False
+provisioned c = provisioned' c False
provisioned'
- :: (Property Linux -> Property (HasInfo + Linux))
- -> Chroot
+ :: Chroot
-> Bool
-> RevertableProperty (HasInfo + Linux) Linux
-provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
- (propigator $ setup `describe` chrootDesc c "exists")
+provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
+ (infopropigator $ setup `describe` chrootDesc c "exists")
<!>
(teardown `describe` chrootDesc c "removed")
where
@@ -151,17 +152,19 @@ provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
property ("removed " ++ loc) $
makeChange (removeChroot loc)
-propagateChrootInfo :: Chroot -> Property Linux -> Property (HasInfo + Linux)
-propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c $
+type InfoPropagator = Property Linux -> Property (HasInfo + Linux)
+
+propagateChrootInfo :: Chroot -> InfoPropagator
+propagateChrootInfo c@(Chroot location _ _ _) p = propagateContainer location c $
p `setInfoProperty` chrootInfo c
chrootInfo :: Chroot -> Info
-chrootInfo (Chroot loc _ h) = mempty `addInfo`
+chrootInfo (Chroot loc _ _ h) = mempty `addInfo`
mempty { _chroots = M.singleton loc h }
-- | Propellor is run inside the chroot to provision it.
propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property UnixLike
-propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
let d = localdir </> shimdir c
let me = localdir </> "propellor"
shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -200,7 +203,7 @@ propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "pr
return r
toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _) systemdonly = do
+toChain parenthost (Chroot loc _ _ _) systemdonly = do
onconsole <- isConsole <$> getMessageHandle
return $ ChrootChain parenthost loc systemdonly onconsole
@@ -225,7 +228,7 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
chain _ _ = errorMessage "bad chain command"
inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
-inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
+inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
mountproc
return (proc "chroot" (loc:cmd), cleanup)
where
@@ -245,13 +248,13 @@ provisioningLock :: FilePath -> FilePath
provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
shimdir :: Chroot -> FilePath
-shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
+shimdir (Chroot loc _ _ _) = "chroot" </> mungeloc loc ++ ".shim"
mungeloc :: FilePath -> String
mungeloc = replace "/" "_"
chrootDesc :: Chroot -> String -> String
-chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
-- | Adding this property to a chroot prevents daemons and other services
-- from being started, which is often something you want to prevent when
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e1e20974..8f9c3beb 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -259,7 +259,7 @@ debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
-- Reverting this property stops the container, removes the systemd unit,
-- and deletes the chroot and all its contents.
nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
-nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
+nspawned c@(Container name (Chroot.Chroot loc builder _ _) h) =
p `describe` ("nspawned " ++ name)
where
p :: RevertableProperty (HasInfo + Linux) Linux
@@ -271,7 +271,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
-- Chroot provisioning is run in systemd-only mode,
-- which sets up the chroot and ensures systemd and dbus are
-- installed, but does not handle the other properties.
- chrootprovisioned = Chroot.provisioned' (Chroot.propagateChrootInfo chroot) chroot True
+ chrootprovisioned = Chroot.provisioned' chroot True
-- Use nsenter to enter container and and run propellor to
-- finish provisioning.
@@ -281,7 +281,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
<!>
doNothing
- chroot = Chroot.Chroot loc builder h
+ chroot = Chroot.Chroot loc builder (Chroot.propagateChrootInfo chroot) h
-- | Sets up the service file for the container, and then starts
-- it running.
generated by cgit v1.3-2-g0d8e (git 2.53.0) at 2026-06-14 04:48:20 +0000