systemd container may be mostly done (untested)

config-joey.hs

@@ -25,6 +25,7 @@ import qualified Propellor.Property.Grub as Grub
 import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Gpg as Gpg
 import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Systemd as Systemd
 import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean
 import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost
 import qualified Propellor.Property.HostingProvider.Linode as Linode
@@ -80,7 +81,13 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	! Ssh.listenPort 80
 	! Ssh.listenPort 443
 
-	& Chroot.provisioned testChroot
+	! Chroot.provisioned testChroot
+	& Systemd.persistentJournal
+	& Systemd.nspawned meow
+	
+meow :: Systemd.Container
+meow = Systemd.container "meow" (System (Debian Unstable) "amd64") []
+	& Apt.serviceInstalledRunning ["fingerd"]
 	
 testChroot :: Chroot.Chroot
 testChroot = Chroot.chroot "/tmp/chroot" (System (Debian Unstable) "amd64")

src/Propellor/Property/Chroot.hs

@@ -2,6 +2,8 @@ module Propellor.Property.Chroot (
 	Chroot(..),
 	chroot,
 	provisioned,
+	-- * Internal use
+	propellChroot,
 	chain,
 ) where
 
@@ -42,7 +44,7 @@ provisioned c@(Chroot loc system _) = RevertableProperty
   where
 	go desc a = property (chrootDesc c desc) $ ensureProperties [a]
 
-	setup = provisionChroot c `requires` toProp built
+	setup = propellChroot c (inChrootProcess c) `requires` toProp built
 	
 	built = case system of
 		(System (Debian _) _) -> debootstrap
@@ -60,11 +62,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
--- Strange and wonderful tricks let the host's /usr/local/propellor
+propellChroot c@(Chroot loc _ _) mkproc = property (chrootDesc c "provisioned") $ do
--- be used inside the chroot, without needing to install anything.
-provisionChroot :: Chroot -> Property
-provisionChroot c@(Chroot loc _ _) = property (chrootDesc c "provisioned") $ do
 	let d = localdir </> shimdir c
 	let me = localdir </> "propellor"
 	shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -90,7 +89,7 @@ provisionChroot c@(Chroot loc _ _) = property (chrootDesc c "provisioned") $ do
 	chainprovision shim = do
 		parenthost <- asks hostName
 		cmd <- liftIO $ toChain parenthost c
-		let p = inChrootProcess c
+		let p = mkproc
 			[ shim
 			, "--continue"
 			, show cmd

src/Propellor/Property/Systemd.hs

@@ -8,7 +8,9 @@ module Propellor.Property.Systemd (
 import Propellor
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
 import Utility.SafeCommand
+import Utility.FileMode
 
 import Data.List.Utils
 
@@ -29,7 +31,7 @@ instance Hostlike Container where
 installed :: Property
 installed = Apt.installed ["systemd", "dbus"]
 
--- | Sets up persistent storage of the journal.
+-- | Enables persistent storage of the journal.
 persistentJournal :: Property
 persistentJournal = check (not <$> doesDirectoryExist dir) $ 
 	combineProperties "persistent systetemd journal"
@@ -64,21 +66,29 @@ container name system ps = Container name system ps (Host name [] mempty)
 nspawned :: Container -> RevertableProperty
 nspawned c@(Container name system _ h) = RevertableProperty setup teardown
   where
-	-- TODO after container is running, use nsenter to enter it
+	setup = containerprovisioned
-	-- and run propellor to finish provisioning.
+		`requires` toProp (nspawnService c)
-	setup = toProp (nspawnService c)
 		`requires` toProp chrootprovisioned
+		`requires` toProp (enterScript c)
 
 	teardown = toProp (revert (chrootprovisioned))
 		`requires` toProp (revert (nspawnService c))
+		`requires` toProp (revert (enterScript 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.Chroot (containerDir name) system $
+		mkChroot $ h { hostProperties = [installed] }
-			h { hostProperties = [installed] }
+
+	-- Use nsenter to enter container and and run propellor to
+	-- finish provisioning.
+	containerprovisioned = Chroot.propellChroot
+		(mkChroot h)
+		(enterContainerProcess c)
+
+	mkChroot = Chroot.Chroot (containerDir name) system
 
 nspawnService :: Container -> RevertableProperty
 nspawnService (Container name _ ps _) = RevertableProperty setup teardown
@@ -91,13 +101,45 @@ nspawnService (Container name _ ps _) = RevertableProperty setup teardown
 			[ cmdProperty "systemctl" ["enable", service]
 			, cmdProperty "systemctl" ["start", service]
 			]
-
+	-- TODO ^ adjust execStart line to reflect ps
-	-- TODO adjust execStart line to reflect ps
 
 	teardown = undefined
 
+-- | Installs a "enter-machinename" script that root can use to run a
+-- command inside the container.
+--
+-- This uses nsenter to enter the container, by looking up the pid of the
+-- container's init process and using its namespace.
+enterScript :: Container -> RevertableProperty
+enterScript c@(Container name _ _ _) = RevertableProperty setup teardown
+  where
+	setup = combineProperties ("generated " ++ enterScriptFile c)
+		[ scriptfile `File.hasContent`
+			[ "#!/bin/sh"
+			, "# Generated by propellor"
+			, "pid=\"$(machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2)\" || true"
+			, "if [ -n \"$pid\" ]; then"
+			, "\tnsenter -p -u -n -i -m -t \"$pid\""
+			, "else"
+			, "\texit 1"
+			, "fi"
+			]
+		, scriptfile `File.mode` combineModes (readModes ++ executeModes)
+		]
+	teardown = File.notPresent scriptfile
+	scriptfile = enterScriptFile c
+
+enterScriptFile :: Container -> FilePath
+enterScriptFile (Container name _ _ _ ) = "enter-" ++ mungename name
+
+enterContainerProcess :: Container -> [String] -> CreateProcess
+enterContainerProcess = proc . enterScriptFile
+
 nspawnServiceName :: MachineName -> String
 nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service"
 
 containerDir :: MachineName -> FilePath
-containerDir name = "/var/lib/container" ++ replace "/" "_" name
+containerDir name = "/var/lib/container" ++ mungename name
+
+mungename :: MachineName -> String
+mungename = replace "/" "_"