summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-11-21 17:11:26 -0400
committerJoey Hess2014-11-21 17:11:26 -0400
commit6e8b28cd3ce4264927cb9e9475b77954663c2ffa (patch)
treeed00dabb51281d572e9af3b4781fa96f33c620c8
parent435244353c998c55e1342e375eaec33619ecfe8f (diff)
propellor spin
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/CmdLine.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs43
-rw-r--r--src/Propellor/Property/Systemd.hs25
-rw-r--r--src/Propellor/Property/Systemd/Core.hs10
-rw-r--r--src/Propellor/Types.hs2
6 files changed, 47 insertions, 36 deletions
diff --git a/propellor.cabal b/propellor.cabal
index f45900cf..e40b6e64 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -96,6 +96,7 @@ Library
Propellor.Property.Ssh
Propellor.Property.Sudo
Propellor.Property.Systemd
+ Propellor.Property.Systemd.Core
Propellor.Property.Tor
Propellor.Property.User
Propellor.Property.HostingProvider.CloudAtCost
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index a26e2559..142efa1d 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -85,7 +85,7 @@ defaultMain hostlist = do
go _ (Edit field context) = editPrivData field context
go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid
- go _ (ChrootChain hn loc onconsole) = Chroot.chain hostlist hn loc onconsole
+ go _ c@(ChrootChain _ _ _ _) = Chroot.chain hostlist c
go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
go _ (DockerInit hn) = Docker.init hn
go _ (GitPush fin fout) = gitPushHelper fin fout
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 8d4a0364..7246e7eb 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Chroot (
import Propellor
import qualified Propellor.Property.Debootstrap as Debootstrap
+import qualified Propellor.Property.Systemd.Core as Systemd
import qualified Propellor.Shim as Shim
import Utility.SafeCommand
@@ -52,16 +53,17 @@ debootstrapped system conf location = case system of
-- Reverting this property removes the chroot. Note that it does not ensure
-- that any processes that might be running inside the chroot are stopped.
provisioned :: Chroot -> RevertableProperty
-provisioned c = provisioned' (propigateChrootInfo c) c
+provisioned c = provisioned' (propigateChrootInfo c) c False
-provisioned' :: (Property -> Property) -> Chroot -> RevertableProperty
-provisioned' propigator c@(Chroot loc system builderconf _) = RevertableProperty
+provisioned' :: (Property -> Property) -> Chroot -> Bool -> RevertableProperty
+provisioned' propigator c@(Chroot loc system builderconf _) systemdonly = RevertableProperty
(propigator $ go "exists" setup)
(go "removed" teardown)
where
go desc a = property (chrootDesc c desc) $ ensureProperties [a]
- setup = propellChroot c (inChrootProcess c) `requires` toProp built
+ setup = propellChroot c (inChrootProcess c) systemdonly
+ `requires` toProp built
built = case (system, builderconf) of
((System (Debian _) _), UsingDeboostrap cf) -> debootstrap cf
@@ -79,8 +81,8 @@ chrootInfo (Chroot loc _ _ h) =
mempty { _chrootinfo = mempty { _chroots = M.singleton loc h } }
-- | Propellor is run inside the chroot to provision it.
-propellChroot :: Chroot -> ([String] -> CreateProcess) -> Property
-propellChroot c@(Chroot loc _ _ _) mkproc = property (chrootDesc c "provisioned") $ do
+propellChroot :: Chroot -> ([String] -> CreateProcess) -> Bool -> Property
+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)
@@ -105,7 +107,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc = property (chrootDesc c "provisioned"
chainprovision shim = do
parenthost <- asks hostName
- cmd <- liftIO $ toChain parenthost c
+ cmd <- liftIO $ toChain parenthost c systemdonly
let p = mkproc
[ shim
, "--continue"
@@ -114,24 +116,29 @@ propellChroot c@(Chroot loc _ _ _) mkproc = property (chrootDesc c "provisioned"
liftIO $ withHandle StdoutHandle createProcessSuccess p
processChainOutput
-toChain :: HostName -> Chroot -> IO CmdLine
-toChain parenthost (Chroot loc _ _ _) = do
+toChain :: HostName -> Chroot -> Bool -> IO CmdLine
+toChain parenthost (Chroot loc _ _ _) systemdonly = do
onconsole <- isConsole <$> mkMessageHandle
- return $ ChrootChain parenthost loc onconsole
-
-chain :: [Host] -> HostName -> FilePath -> Bool -> IO ()
-chain hostlist hn loc onconsole = case findHostNoAlias hostlist hn of
- Nothing -> errorMessage ("cannot find host " ++ hn)
- Just parenthost -> case M.lookup loc (_chroots $ _chrootinfo $ hostInfo parenthost) of
- Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
- Just h -> go h
+ return $ ChrootChain parenthost loc systemdonly onconsole
+
+chain :: [Host] -> CmdLine -> IO ()
+chain hostlist (ChrootChain hn loc systemdonly onconsole) =
+ case findHostNoAlias hostlist hn of
+ Nothing -> errorMessage ("cannot find host " ++ hn)
+ Just parenthost -> case M.lookup loc (_chroots $ _chrootinfo $ hostInfo parenthost) of
+ Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn)
+ Just h -> go h
where
go h = do
changeWorkingDirectory localdir
when onconsole forceConsole
onlyProcess (provisioningLock loc) $ do
- r <- runPropellor h $ ensureProperties $ hostProperties h
+ r <- runPropellor h $ ensureProperties $
+ if systemdonly
+ then [Systemd.installed]
+ else hostProperties h
putStrLn $ "\n" ++ show r
+chain _ _ = errorMessage "bad chain command"
inChrootProcess :: Chroot -> [String] -> CreateProcess
inChrootProcess (Chroot loc _ _ _) cmd = proc "chroot" (loc:cmd)
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index d1b6bde6..b50194fa 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -1,5 +1,5 @@
module Propellor.Property.Systemd (
- installed,
+ module Propellor.Property.Systemd.Core,
started,
stopped,
enabled,
@@ -14,6 +14,7 @@ import Propellor
import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
+import Propellor.Property.Systemd.Core
import Utility.SafeCommand
import Utility.FileMode
@@ -30,12 +31,6 @@ instance Hostlike Container where
(Container n c h) &^ p = Container n c (h &^ p)
getHost (Container _ _ h) = h
--- dbus is only a Recommends of systemd, but is needed for communication
--- from the systemd inside a container to the one outside, so make sure it
--- gets installed.
-installed :: Property
-installed = Apt.installed ["systemd", "dbus"]
-
-- | Starts a systemd service.
started :: ServiceName -> Property
started n = trivial $ cmdProperty "systemctl" ["start", n]
@@ -110,20 +105,18 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) =
, nspawnService c
]
- -- When provisioning the chroot, pass a version of the Host
- -- that only has the Property of systemd being installed.
- -- This is to avoid starting any daemons in the chroot,
- -- which would not run in the container's namespace.
- chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) $
- mkChroot $ h { hostProperties = [installed] }
+ -- 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 provisions.
+ chrootprovisioned = Chroot.provisioned'
+ (Chroot.propigateChrootInfo chroot) chroot True
-- Use nsenter to enter container and and run propellor to
-- finish provisioning.
containerprovisioned = Chroot.propellChroot chroot
- (enterContainerProcess c)
+ (enterContainerProcess c) False
- mkChroot = Chroot.Chroot loc system builderconf
- chroot = mkChroot h
+ chroot = Chroot.Chroot loc system builderconf h
nspawnService :: Container -> RevertableProperty
nspawnService (Container name _ _) = RevertableProperty setup teardown
diff --git a/src/Propellor/Property/Systemd/Core.hs b/src/Propellor/Property/Systemd/Core.hs
new file mode 100644
index 00000000..441717e1
--- /dev/null
+++ b/src/Propellor/Property/Systemd/Core.hs
@@ -0,0 +1,10 @@
+module Propellor.Property.Systemd.Core where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+
+-- dbus is only a Recommends of systemd, but is needed for communication
+-- from the systemd inside a container to the one outside, so make sure it
+-- gets installed.
+installed :: Property
+installed = Apt.installed ["systemd", "dbus"]
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 65dbd3c5..a6c5aafa 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -155,7 +155,7 @@ data CmdLine
| Update HostName
| DockerInit HostName
| DockerChain HostName String
- | ChrootChain HostName FilePath Bool
+ | ChrootChain HostName FilePath Bool Bool
| GitPush Fd Fd
deriving (Read, Show, Eq)