Merge branch 'joeyconfig'

Conflicts: privdata.joey/privdata.gpg
2015-06-03 12:17:56 -04:00 · 2015-06-03 12:17:56 -04:00 · 5d3408d322
parent ce0e1a6dc8 fd9d172bcd
commit 5d3408d322
13 changed files with 320 additions and 158 deletions
--- a/.gitignore
+++ b/.gitignore
@ -7,4 +7,7 @@ Setup
 Setup.hi
 Setup.o
 docker
+chroot
 propellor.1
+.lock
+.lastchecked
--- a/config-joey.hs
+++ b/config-joey.hs
@ -76,7 +76,6 @@ darkstar = host "darkstar.kitenet.net"
 	& ipv6 "2001:4830:1600:187::2" -- sixxs tunnel

 	& Apt.buildDep ["git-annex"] `period` Daily
-	& Docker.configured

 	& JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")
 	& JoeySites.dkimMilter
@ -84,7 +83,6 @@ darkstar = host "darkstar.kitenet.net"
 gnu :: Host
 gnu = host "gnu.kitenet.net"
 	& Apt.buildDep ["git-annex"] `period` Daily
-	& Docker.configured

 	& JoeySites.postfixClientRelay (Context "gnu.kitenet.net")
 	& JoeySites.dkimMilter
@ -98,18 +96,18 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	& Ssh.randomHostKeys
 	& Apt.unattendedUpgrades
 	& Network.ipv6to4
+
 	& Tor.isRelay
 	& Tor.named "kite1"
 	& Tor.bandwidthRate (Tor.PerMonth "400 GB")

-	& Docker.configured
-	& Docker.garbageCollected `period` Daily
-	& Docker.docked webserver
+	& Systemd.nspawned webserver
 	& File.dirExists "/var/www/html"
-	& File.notPresent "/var/www/html/index.html"
-	& "/var/www/index.html" `File.hasContent` ["hello, world"]
+	& File.notPresent "/var/www/index.html"
+	& "/var/www/html/index.html" `File.hasContent` ["hello, world"]
 	& alias "helloworld.kitenet.net"
-	& Docker.docked oldusenetShellBox
+	
+	& Systemd.nspawned oldusenetShellBox

 	& JoeySites.scrollBox
 	& alias "scroll.joeyh.name"
@ -133,9 +131,11 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 	& Apt.serviceInstalledRunning "ntp"
 	& Systemd.persistentJournal

-	& Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer
+	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+		GitAnnexBuilder.standardAutoBuilder
 		(System (Debian Testing) "amd64") fifteenpast "2h")
-	& Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer
+	& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+		GitAnnexBuilder.standardAutoBuilder
 		(System (Debian Testing) "i386") fifteenpast "2h")
 	& Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer
 		(Cron.Times "1 1 * * *") "3h")
@ -151,15 +151,20 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"
 	-- (Also, system is not currently running a stock kernel,
 	-- although it should be able to.)
 	& Postfix.satellite
-	& Apt.serviceInstalledRunning "ntp"
 	& Apt.serviceInstalledRunning "aiccu"
+	& Apt.serviceInstalledRunning "swapspace"
+	& Apt.serviceInstalledRunning "ntp"

 	-- Not using systemd-nspawn because it's broken (kernel issue?)
-	-- & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer
-	-- 	osver Cron.Daily "22h")
+	-- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
+	-- 	GitAnnexBuilder.armAutoBuilder
+	-- 		builderos Cron.Daily "22h")
 	& Chroot.provisioned 
 		(Chroot.debootstrapped builderos mempty "/var/lib/container/armel-git-annex-builder"
-			& GitAnnexBuilder.standardAutoBuilder builderos Cron.Daily "22h")
+			& "/etc/timezone" `File.hasContent` ["America/New_York"]
+			& GitAnnexBuilder.armAutoBuilder
+				builderos (Cron.Times "1 1 * * *") "12h"
+		)
  where
 	-- Using unstable to get new enough ghc for TH on arm.
 	builderos = System (Debian Unstable) "armel"
@ -247,9 +252,6 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
 		, "zsh"
 		]
 	
-	& Docker.configured
-	& Docker.garbageCollected `period` Daily
-	
 	& alias "nntp.olduse.net"
 	& JoeySites.oldUseNetServer hosts
 	
@ -306,13 +308,14 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	& myDnsSecondary
 	
 	& Docker.configured
-	& Docker.docked oldusenetShellBox
 	& Docker.docked openidProvider
 		`requires` Apt.serviceInstalledRunning "ntp"
 	& Docker.docked ancientKitenet
 	& Docker.docked jerryPlay
 	& Docker.garbageCollected `period` (Weekly (Just 1))
 	
+	& Systemd.nspawned oldusenetShellBox
+	
 	& JoeySites.scrollBox
 	& alias "scroll.joeyh.name"
 	& alias "eu.scroll.joeyh.name"
@ -320,7 +323,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	-- For https port 443, shellinabox with ssh login to
 	-- kitenet.net
 	& alias "shell.kitenet.net"
-	& Docker.docked kiteShellBox
+	& Systemd.nspawned kiteShellBox
 	-- Nothing is using http port 80, so listen on
 	-- that port for ssh, for traveling on bad networks that
 	-- block 22.
@ -397,22 +400,21 @@ iabak = host "iabak.archiveteam.org"
       --'                        __|II|      ,.
     ----                      __|II|II|__   (  \_,/\
 --'-------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/   __/ -'-.-'-.-'-.-'-.-'-.-'-
-------------------------- |      [Docker]       / --------------------------
+-------------------------- |   [Containers]      / --------------------------
 -------------------------- :                    / ---------------------------
 --------------------------- \____, o          ,' ----------------------------
 ---------------------------- '--,___________,'  -----------------------------

 -- Simple web server, publishing the outside host's /var/www
-webserver :: Docker.Container
+webserver :: Systemd.Container
 webserver = standardStableContainer "webserver"
-	& Docker.publish "80:80"
-	& Docker.volume "/var/www:/var/www"
+	& Systemd.bind "/var/www"
 	& Apt.serviceInstalledRunning "apache2"

 -- My own openid provider. Uses php, so containerized for security
 -- and administrative sanity.
 openidProvider :: Docker.Container
-openidProvider = standardStableContainer "openid-provider"
+openidProvider = standardStableDockerContainer "openid-provider"
 	& alias "openid.kitenet.net"
 	& Docker.publish "8081:80"
 	& OpenId.providerFor [User "joey", User "liw"]
@ -420,32 +422,30 @@ openidProvider = standardStableContainer "openid-provider"

 -- Exhibit: kite's 90's website.
 ancientKitenet :: Docker.Container
-ancientKitenet = standardStableContainer "ancient-kitenet"
+ancientKitenet = standardStableDockerContainer "ancient-kitenet"
 	& alias "ancient.kitenet.net"
 	& Docker.publish "1994:80"
 	& Apt.serviceInstalledRunning "apache2"
-	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www"
+	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"
 		(Just "remotes/origin/old-kitenet.net")

-oldusenetShellBox :: Docker.Container
+oldusenetShellBox :: Systemd.Container
 oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
 	& alias "shell.olduse.net"
-	& Docker.publish "4200:4200"
 	& JoeySites.oldUseNetShellBox

 jerryPlay :: Docker.Container
-jerryPlay = standardContainer "jerryplay" Unstable "amd64"
+jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64"
 	& alias "jerryplay.kitenet.net"
 	& Docker.publish "2202:22"
 	& Docker.publish "8001:80"
 	& Apt.installed ["ssh"]
 	& User.hasSomePassword (User "root")
 	& Ssh.permitRootLogin True
-	
-kiteShellBox :: Docker.Container
+
+kiteShellBox :: Systemd.Container
 kiteShellBox = standardStableContainer "kiteshellbox"
 	& JoeySites.kiteShellBox
-	& Docker.publish "443:443"

 type Motd = [String]

@ -476,12 +476,25 @@ standardSystemUnhardened hn suite arch motd = host hn
 	& Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
 		`onChange` Apt.autoRemove

-standardStableContainer :: Docker.ContainerName -> Docker.Container
+-- This is my standard container setup, Featuring automatic upgrades.
+standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container
+standardContainer name suite arch = Systemd.container name chroot
+	& os system
+	& Apt.stdSourcesList `onChange` Apt.upgrade
+	& Apt.unattendedUpgrades
+	& Apt.cacheCleaned
+  where
+	system = System (Debian suite) arch
+	chroot = Chroot.debootstrapped system mempty
+
+standardStableContainer :: Systemd.MachineName -> Systemd.Container
 standardStableContainer name = standardContainer name (Stable "jessie") "amd64"

-- This is my standard container setup, Featuring automatic upgrades.
-standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container
-standardContainer name suite arch = Docker.container name (dockerImage system)
+standardStableDockerContainer :: Docker.ContainerName -> Docker.Container
+standardStableDockerContainer name = standardDockerContainer name (Stable "jessie") "amd64"
+
+standardDockerContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container
+standardDockerContainer name suite arch = Docker.container name (dockerImage system)
 	& os system
 	& Apt.stdSourcesList `onChange` Apt.upgrade
 	& Apt.unattendedUpgrades
--- a/debian/changelog
+++ b/debian/changelog
@ -8,13 +8,22 @@ propellor (2.5.0) UNRELEASED; urgency=medium
  * createProcess from Propellor.Property.Cmd, so they are available
    for use in constricting your own Properties when using propellor
    as a library.
-  * Improve enter-machine scripts for nspawn containers to unset most
+  * Improve enter-machine scripts for systemd-nspawn containers to unset most
    environment variables.
  * Fix Postfix.satellite bug; the default relayhost was set to the
    domain, not to smtp.domain as documented.
  * Mount /proc inside a chroot before provisioning it, to work around #787227
  * --spin now works when given a short hostname that only resolves to an
    ipv6 address.
+  * Added publish property for systemd-spawn containers, for port publishing.
+    (Needs systemd version 220.)
+  * Added bind and bindRo properties for systemd-spawn containers.
+  * Firewall: Port was changed to a newtype, and the Port and PortRange
+    constructors of Rules were changed to DPort and DportRange, respectively.
+    (API change)
+  * Docker: volume and publish accept Bound FilePath and Bound Port,
+    respectively. They also continue to accept Strings, for backwards
+    compatability.

 -- Joey Hess <id@joeyh.name>  Thu, 07 May 2015 12:08:34 -0400

--- a/propellor.cabal
+++ b/propellor.cabal
@ -121,6 +121,7 @@ Library
    Propellor.Exception
    Propellor.Types
    Propellor.Types.Chroot
+    Propellor.Types.Container
    Propellor.Types.Docker
    Propellor.Types.Dns
    Propellor.Types.Empty
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@ -16,10 +16,10 @@ import Propellor
 import Propellor.Types.CmdLine
 import Propellor.Types.Chroot
 import Propellor.Property.Chroot.Util
-import Propellor.Property.Mount
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
 import qualified Propellor.Shim as Shim
+import Propellor.Property.Mount

 import qualified Data.Map as M
 import Data.List.Utils
@ -70,7 +70,7 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly =
  where
 	go desc a = propertyList (chrootDesc c desc) [a]

-	setup = propellChroot c (inChrootProcess c) systemdonly
+	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
 		`requires` toProp built
 	
 	built = case (system, builderconf) of
@ -95,7 +95,7 @@ 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) -> Bool -> Property NoInfo
+propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo
 propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir </> shimdir c
 	let me = localdir </> "propellor"
@ -103,7 +103,6 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
 		( pure (Shim.file me d)
 		, Shim.setup me Nothing d
 		)
-	liftIO mountproc
 	ifM (liftIO $ bindmount shim)
 		( chainprovision shim
 		, return FailedChange
@ -119,25 +118,21 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
 				, File localdir, File mntpnt
 				]
 		)
-	
-	-- /proc needs to be mounted in the chroot for the linker to use
-	-- /proc/self/exe which is necessary for some commands to work
-	mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $
-		void $ mount "proc" "proc" procloc
-	procloc = loc </> "proc"

 	chainprovision shim = do
 		parenthost <- asks hostName
 		cmd <- liftIO $ toChain parenthost c systemdonly
 		pe <- liftIO standardPathEnv
-		let p = mkproc
+		(p, cleanup) <- liftIO $ mkproc
 			[ shim
 			, "--continue"
 			, show cmd
 			]
 		let p' = p { env = Just pe }
-		liftIO $ withHandle StdoutHandle createProcessSuccess p'
+		r <- liftIO $ withHandle StdoutHandle createProcessSuccess p'
 			processChainOutput
+		liftIO cleanup
+		return r

 toChain :: HostName -> Chroot -> Bool -> IO CmdLine
 toChain parenthost (Chroot loc _ _ _) systemdonly = do
@ -164,8 +159,22 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) =
 			putStrLn $ "\n" ++ show r
 chain _ _ = errorMessage "bad chain command"

-inChrootProcess :: Chroot -> [String] -> CreateProcess
-inChrootProcess (Chroot loc _ _ _) cmd = proc "chroot" (loc:cmd)
+inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
+inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
+	mountproc
+	return (proc "chroot" (loc:cmd), cleanup)
+  where
+	-- /proc needs to be mounted in the chroot for the linker to use
+	-- /proc/self/exe which is necessary for some commands to work
+	mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $
+		void $ mount "proc" "proc" procloc
+	
+	procloc = loc </> "proc"
+
+	cleanup
+		| keepprocmounted = noop
+		| otherwise = whenM (elem procloc <$> mountPointsBelow loc) $
+			umountLazy procloc

 provisioningLock :: FilePath -> FilePath
 provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@ -23,9 +23,11 @@ module Propellor.Property.Docker (
 	-- * Container configuration
 	dns,
 	hostname,
+	Publishable,
 	publish,
 	expose,
 	user,
+	Mountable,
 	volume,
 	volumes_from,
 	workdir,
@ -43,6 +45,7 @@ module Propellor.Property.Docker (

 import Propellor hiding (init)
 import Propellor.Types.Docker
+import Propellor.Types.Container
 import Propellor.Types.CmdLine
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
@ -254,10 +257,19 @@ hostname = runProp "hostname"
 name :: String -> Property HasInfo
 name = runProp "name"

+class Publishable p where
+	toPublish :: p -> String
+
+instance Publishable (Bound Port) where
+	toPublish p = show (hostSide p) ++ ":" ++ show (containerSide p)
+
+-- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort
+instance Publishable String where
+	toPublish = id
+
 -- | Publish a container's port to the host
-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> Property HasInfo
-publish = runProp "publish"
+publish :: Publishable p => p -> Property HasInfo
+publish = runProp "publish" . toPublish

 -- | Expose a container's port without publishing it.
 expose :: String -> Property HasInfo
@ -267,11 +279,21 @@ expose = runProp "expose"
 user :: String -> Property HasInfo
 user = runProp "user"

-- | Mount a volume
-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
+class Mountable p where
+	toMount :: p -> String
+
+instance Mountable (Bound FilePath) where
+	toMount p = hostSide p ++ ":" ++ containerSide p
+
+-- | string format: [host-dir]:[container-dir]:[rw|ro]
+--
 -- With just a directory, creates a volume in the container.
-volume :: String -> Property HasInfo
-volume = runProp "volume"
+instance Mountable String where
+	toMount = id
+
+-- | Mount a volume
+volume :: Mountable v => v -> Property HasInfo
+volume = runProp "volume" . toMount

 -- | Mount a volume from the specified container into the current
 -- container.
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@ -9,7 +9,6 @@ module Propellor.Property.Firewall (
 	Target(..),
 	Proto(..),
 	Rules(..),
-	Port,
 	ConnectionState(..)
 ) where

@ -45,8 +44,8 @@ toIpTable r =  map Param $
 toIpTableArg :: Rules -> [String]
 toIpTableArg Everything        = []
 toIpTableArg (Proto proto)     = ["-p", map toLower $ show proto]
-toIpTableArg (Port port)       = ["--dport", show port]
-toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t]
+toIpTableArg (DPort port)       = ["--dport", show port]
+toIpTableArg (DPortRange (f,t)) = ["--dport", show f ++ ":" ++ show t]
 toIpTableArg (IFace iface)     = ["-i", iface]
 toIpTableArg (Ctstate states)  = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)]
 toIpTableArg (r :- r')         = toIpTableArg r <> toIpTableArg r'
@ -55,33 +54,31 @@ data Rule = Rule
 	{ ruleChain :: Chain
 	, ruleTarget :: Target
 	, ruleRules :: Rules
-	} deriving (Eq, Show, Read)
+	} deriving (Eq, Show)

 data Chain = INPUT | OUTPUT | FORWARD
-	deriving (Eq,Show,Read)
+	deriving (Eq, Show)

 data Target = ACCEPT | REJECT | DROP | LOG
-	deriving (Eq,Show,Read)
+	deriving (Eq, Show)

 data Proto = TCP | UDP | ICMP
-	deriving (Eq,Show,Read)
-
-type Port = Int
+	deriving (Eq, Show)

 data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
-	deriving (Eq,Show,Read)
+	deriving (Eq, Show)

 data Rules
 	= Everything
 	| Proto Proto
 	-- ^There is actually some order dependency between proto and port so this should be a specific
 	-- data type with proto + ports
-	| Port Port
-	| PortRange (Port,Port)
+	| DPort Port
+	| DPortRange (Port,Port)
 	| IFace Network.Interface
 	| Ctstate [ ConnectionState ]
 	| Rules :- Rules   -- ^Combine two rules
-	deriving (Eq,Show,Read)
+	deriving (Eq, Show)

 infixl 0 :-

--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@ -6,9 +6,7 @@ import Propellor
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.User as User
 import qualified Propellor.Property.Cron as Cron
-import qualified Propellor.Property.Ssh as Ssh
 import qualified Propellor.Property.File as File
-import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Systemd as Systemd
 import qualified Propellor.Property.Chroot as Chroot
 import Propellor.Property.Cron (Times)
@ -50,8 +48,6 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
 tree :: Architecture -> Property HasInfo
 tree buildarch = combineProperties "gitannexbuilder tree" $ props
 	& Apt.installed ["git"]
-	-- gitbuilderdir directory already exists when docker volume is used,
-	-- but with wrong owner.
 	& File.dirExists gitbuilderdir
 	& File.ownerGroup gitbuilderdir (User builduser) (Group builduser)
 	& gitannexbuildercloned
@ -86,6 +82,13 @@ buildDepsNoHaskellLibs = Apt.installed
 	"alex", "happy", "c2hs"
 	]

+haskellPkgsInstalled :: String -> Property NoInfo
+haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")
+  where
+	go = userScriptProperty (User builduser)
+		[ "cd " ++ builddir ++ " && ./standalone/ " ++ dir ++ "/install-haskell-packages"
+		]
+
 -- Installs current versions of git-annex's deps from cabal, but only
 -- does so once.
 cabalDeps :: Property NoInfo
@ -94,23 +97,36 @@ cabalDeps = flagFile go cabalupdated
 		go = userScriptProperty (User builduser) ["cabal update && cabal install git-annex --only-dependencies || true"]
 		cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"

-standardAutoBuilderContainer :: System -> Times -> TimeOut -> Systemd.Container
-standardAutoBuilderContainer osver@(System _ arch) crontime timeout =
+autoBuilderContainer :: (System -> Property HasInfo) -> System -> Times -> TimeOut -> Systemd.Container
+autoBuilderContainer mkprop osver@(System _ arch) crontime timeout =
 	Systemd.container name bootstrap
-		& standardAutoBuilder osver crontime timeout
+		& mkprop osver
+		& buildDepsApt
+		& autobuilder arch crontime timeout
  where
 	name = arch ++ "-git-annex-builder"
 	bootstrap = Chroot.debootstrapped osver mempty

-standardAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo
-standardAutoBuilder osver@(System _ arch) crontime timeout =
-	propertyList "git-annex-builder" $ props
+standardAutoBuilder :: System -> Property HasInfo
+standardAutoBuilder osver@(System _ arch) =
+	propertyList "standard git-annex autobuilder" $ props
 		& os osver
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
 		& User.accountFor (User builduser)
 		& tree arch
-		& buildDepsApt
+
+armAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo
+armAutoBuilder osver@(System _ arch) crontime timeout = 
+	propertyList "arm git-annex autobuilder" $ props
+		& standardAutoBuilder osver
+		& buildDepsNoHaskellLibs
+		-- Works around ghc crash with parallel builds on arm.
+		& (homedir </> ".cabal" </> "config")
+			`File.lacksLine` "jobs: $ncpus"
+		-- Install patched haskell packages for portability to
+		-- arm NAS's using old kernel versions.
+		& haskellPkgsInstalled "linux"
 		& autobuilder arch crontime timeout

 androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
@ -135,7 +151,7 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot
 	& flagFile chrootsetup ("/chrootsetup")
 		`requires` setupgitannexdir
 	& buildDepsApt
-	& flagFile haskellpkgsinstalled ("/haskellpkgsinstalled")
+	& haskellPkgsInstalled "android"
  where
 	-- Use git-annex's android chroot setup script, which will install
 	-- ghc-android and the NDK, all build deps, etc, in the home
@ -143,55 +159,5 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot
 	chrootsetup = scriptProperty
 		[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
 		]
-	haskellpkgsinstalled = userScriptProperty (User builduser)
-		[ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages"
-		]
 	osver = System (Debian Testing) "i386"
 	bootstrap = Chroot.debootstrapped osver mempty
-
-- armel builder has a companion container using amd64 that
-- runs the build first to get TH splices. They need
-- to have the same versions of all haskell libraries installed.
-armelCompanionContainer :: (System -> Docker.Image) -> Docker.Container
-armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion"
-	(dockerImage $ System (Debian Unstable) "amd64")
-	& os (System (Debian Testing) "amd64")
-	& Apt.stdSourcesList
-	& Apt.installed ["systemd"]
-	-- This volume is shared with the armel builder.
-	& Docker.volume gitbuilderdir
-	& User.accountFor (User builduser)
-	-- Install current versions of build deps from cabal.
-	& tree "armel"
-	& buildDepsNoHaskellLibs
-	& cabalDeps
-	-- The armel builder can ssh to this companion.
-	& Docker.expose "22"
-	& Apt.serviceInstalledRunning "ssh"
-	& Ssh.authorizedKeys (User builduser) (Context "armel-git-annex-builder")
-	& Docker.tweaked
-
-armelAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container
-armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
-	(dockerImage $ System (Debian Unstable) "armel")
-	& os (System (Debian Testing) "armel")
-	& Apt.stdSourcesList
-	& Apt.installed ["systemd"]
-	& Apt.installed ["openssh-client"]
-	& Docker.link "armel-git-annex-builder-companion" "companion"
-	& Docker.volumes_from "armel-git-annex-builder-companion"
-	& User.accountFor (User builduser)
-	-- TODO: automate installing haskell libs
-	-- (Currently have to run
-	-- git-annex/standalone/linux/install-haskell-packages
-	-- which is not fully automated.)
-	& buildDepsNoHaskellLibs
-	& autobuilder "armel" crontimes timeout
-		`requires` tree "armel"
-	& Ssh.keyImported SshRsa (User builduser) (Context "armel-git-annex-builder")
-	& trivial writecompanionaddress
-	& Docker.tweaked
-  where
-	writecompanionaddress = scriptProperty
-		[ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir </> "companion_address"
-		] `describe` "companion_address file"
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@ -1,26 +1,46 @@
+{-# LANGUAGE FlexibleInstances #-}
+
 module Propellor.Property.Systemd (
-	module Propellor.Property.Systemd.Core,
+	-- * Services
 	ServiceName,
-	MachineName,
 	started,
 	stopped,
 	enabled,
 	disabled,
+	running,
 	restarted,
-	persistentJournal,
+	networkd,
+	journald,
+	-- * Configuration
+	installed,
 	Option,
 	configured,
-	journaldConfigured,
 	daemonReloaded,
+	-- * Journal
+	persistentJournal,
+	journaldConfigured,
+	-- * Containers
+	MachineName,
 	Container,
 	container,
 	nspawned,
+	-- * Container configuration
 	containerCfg,
 	resolvConfed,
+	linkJournal,
+	privateNetwork,
+	module Propellor.Types.Container,
+	Proto(..),
+	Publishable,
+	publish,
+	Bindable,
+	bind,
+	bindRo,
 ) where

 import Propellor
 import Propellor.Types.Chroot
+import Propellor.Types.Container
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.File as File
@ -44,6 +64,9 @@ instance PropAccum Container where
 	getProperties (Container _ _ h) = hostProperties h

 -- | Starts a systemd service.
+--
+-- Note that this does not configure systemd to start the service on boot,
+-- it only ensures that the service is currently running.
 started :: ServiceName -> Property NoInfo
 started n = trivial $ cmdProperty "systemctl" ["start", n]
 	`describe` ("service " ++ n ++ " started")
@ -54,6 +77,9 @@ stopped n = trivial $ cmdProperty "systemctl" ["stop", n]
 	`describe` ("service " ++ n ++ " stopped")

 -- | Enables a systemd service.
+--
+-- This does not ensure the service is started, it only configures systemd
+-- to start it on boot.
 enabled :: ServiceName -> Property NoInfo
 enabled n = trivial $ cmdProperty "systemctl" ["enable", n]
 	`describe` ("service " ++ n ++ " enabled")
@ -63,11 +89,23 @@ disabled :: ServiceName -> Property NoInfo
 disabled n = trivial $ cmdProperty "systemctl" ["disable", n]
 	`describe` ("service " ++ n ++ " disabled")

+-- | Ensures that a service is both enabled and started
+running :: ServiceName -> Property NoInfo
+running n = trivial $ started n `requires` enabled n
+
 -- | Restarts a systemd service.
 restarted :: ServiceName -> Property NoInfo
 restarted n = trivial $ cmdProperty "systemctl" ["restart", n]
 	`describe` ("service " ++ n ++ " restarted")

+-- | The systemd-networkd service.
+networkd :: ServiceName
+networkd = "systemd-networkd"
+
+-- | The systemd-journald service.
+journald :: ServiceName
+journald = "systemd-journald"
+
 -- | Enables persistent storage of the journal.
 persistentJournal :: Property NoInfo
 persistentJournal = check (not <$> doesDirectoryExist dir) $ 
@ -101,15 +139,15 @@ configured cfgfile option value = combineProperties desc
 		| setting `isPrefixOf` l = Nothing
 		| otherwise = Just l

+-- | Causes systemd to reload its configuration files.
+daemonReloaded :: Property NoInfo
+daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"]
+
 -- | Configures journald, restarting it so the changes take effect.
 journaldConfigured :: Option -> String -> Property NoInfo
 journaldConfigured option value =
 	configured "/etc/systemd/journald.conf" option value
-		`onChange` restarted "systemd-journald"
-
-- | Causes systemd to reload its configuration files.
-daemonReloaded :: Property NoInfo
-daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"]
+		`onChange` restarted journald

 -- | Defines a container with a given machine name.
 --
@ -122,6 +160,7 @@ container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
 container name mkchroot = Container name c h
 	& os system
 	& resolvConfed
+	& linkJournal
  where
 	c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name)
 	h = Host name [] mempty
@ -152,8 +191,7 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) 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 provisions.
-	chrootprovisioned = Chroot.provisioned'
-		(Chroot.propigateChrootInfo chroot) chroot True
+	chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True

 	-- Use nsenter to enter container and and run propellor to
 	-- finish provisioning.
@ -177,8 +215,14 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
 		return $ unlines $
 			"# deployed by propellor" : map addparams ls
 	addparams l
-		| "ExecStart=" `isPrefixOf` l =
-			l ++ " " ++ unwords (nspawnServiceParams cfg)
+		| "ExecStart=" `isPrefixOf` l = unwords $
+			[ "ExecStart = /usr/bin/systemd-nspawn"
+			, "--quiet"
+			, "--keep-unit"
+			, "--boot"
+			, "--directory=" ++ containerDir name
+			, "--machine=%i"
+			] ++ nspawnServiceParams cfg
 		| otherwise = l
 	
 	goodservicefile = (==)
@ -237,8 +281,8 @@ enterScript c@(Container name _ _) = setup <!> teardown
 enterScriptFile :: Container -> FilePath
 enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name

-enterContainerProcess :: Container -> [String] -> CreateProcess
-enterContainerProcess = proc . enterScriptFile
+enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
+enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop)

 nspawnServiceName :: MachineName -> ServiceName
 nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service"
@ -270,3 +314,68 @@ containerCfg p = RevertableProperty (mk True) (mk False)
 -- This property is enabled by default. Revert it to disable it.
 resolvConfed :: RevertableProperty
 resolvConfed = containerCfg "bind=/etc/resolv.conf"
+
+-- | Link the container's journal to the host's if possible.
+-- (Only works if the host has persistent journal enabled.)
+--
+-- This property is enabled by default. Revert it to disable it.
+linkJournal :: RevertableProperty
+linkJournal = containerCfg "link-journal=try-guest"
+
+-- | Disconnect networking of the container from the host.
+privateNetwork :: RevertableProperty
+privateNetwork = containerCfg "private-network"
+
+class Publishable a where
+	toPublish :: a -> String
+
+instance Publishable Port where
+	toPublish (Port n) = show n
+
+instance Publishable (Bound Port) where
+	toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
+
+data Proto = TCP | UDP
+
+instance Publishable (Proto, Bound Port) where
+	toPublish (TCP, fp) = "tcp:" ++ toPublish fp
+	toPublish (UDP, fp) = "udp:" ++ toPublish fp
+
+-- | Publish a port from the container to the host.
+-- 
+-- This feature was first added in systemd version 220.
+--
+-- This property is only needed (and will only work) if the container
+-- is configured to use private networking. Also, networkd should be enabled
+-- both inside the container, and on the host. For example:
+--
+-- > foo :: Host
+-- > foo = host "foo.example.com"
+-- >	& Systemd.running Systemd.networkd
+-- >	& Systemd.nspawned webserver
+-- >
+-- > webserver :: Systemd.container
+-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty)
+-- >	& Systemd.privateNetwork
+-- >	& Systemd.running Systemd.networkd
+-- >	& Systemd.publish (Port 80 ->- Port 8080)
+-- >	& Apt.installedRunning "apache2"
+publish :: Publishable p => p -> RevertableProperty
+publish p = containerCfg $ "--port=" ++ toPublish p
+
+class Bindable a where
+	toBind :: a -> String
+
+instance Bindable FilePath where
+	toBind f = f
+
+instance Bindable (Bound FilePath) where
+	toBind v = hostSide v ++ ":" ++ containerSide v
+
+-- | Bind mount a file or directory from the host into the container.
+bind :: Bindable p => p -> RevertableProperty
+bind p = containerCfg $ "--bind=" ++ toBind p
+
+-- | Read-only mind mount.
+bindRo :: Bindable p => p -> RevertableProperty
+bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@ -22,7 +22,8 @@ sshCachingParams hn = do
 	let ps =
 		[ Param "-o"
 		, Param ("ControlPath=" ++ socketfile)
-		, Params "-o ControlMaster=auto -o ControlPersist=yes"
+		, Param "-o", Param "ControlMaster=auto"
+		, Param "-o", Param "ControlPersist=yes"
 		]

 	maybe noop (expireold ps socketfile)
@ -37,7 +38,7 @@ sshCachingParams hn = do
 			then touchFile f
 			else do
 				void $ boolSystem "ssh" $
-					[ Params "-O stop" ] ++ ps ++
+					[ Param "-O", Param "stop" ] ++ ps ++
 					[ Param "localhost" ]
 				nukeFile f
 	tenminutes = 600
--- a/src/Propellor/Types/Container.hs
+++ b/src/Propellor/Types/Container.hs
@ -0,0 +1,30 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Propellor.Types.Container where
+
+-- | A value that can be bound between the host and a container.
+--
+-- For example, a Bound Port is a Port on the container that is bound to
+-- a Port on the host.
+data Bound v = Bound
+	{ hostSide :: v
+	, containerSide :: v
+	}
+
+-- | Create a Bound value, from two different values for the host and
+-- container.
+--
+-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host
+-- is bound to port 80 from the container.
+(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v
+(-<-) hostv containerv = Bound hostv containerv
+
+-- | Flipped version of -<- with the container value first and host value
+-- second.
+(->-) :: (containerv ~ v, hostv ~ v) => hostv -> containerv -> Bound v
+(->-) containerv hostv = Bound hostv containerv
+
+-- | Create a Bound value, that is the same on both the host and container.
+same :: v -> Bound v
+same v = Bound v v
+
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@ -10,6 +10,7 @@ module Propellor.Types.OS (
 	User(..),
 	Group(..),
 	userGroup,
+	Port(..),
 ) where

 import Network.BSD (HostName)
@ -42,3 +43,6 @@ newtype Group = Group String
 -- | Makes a Group with the same name as the User.
 userGroup :: User -> Group
 userGroup (User u) = Group u
+
+newtype Port = Port Int
+	deriving (Eq, Show)
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@ -19,25 +19,23 @@ import Prelude

 -- | Parameters that can be passed to a shell command.
 data CommandParam
-	= Params String -- ^ Contains multiple parameters, separated by whitespace
-	| Param String -- ^ A single parameter
+	= Param String -- ^ A parameter
 	| File FilePath -- ^ The name of a file
 	deriving (Eq, Show, Ord)

 -- | Used to pass a list of CommandParams to a function that runs
 -- a command and expects Strings. -}
 toCommand :: [CommandParam] -> [String]
-toCommand = concatMap unwrap
+toCommand = map unwrap
  where
-	unwrap (Param s) = [s]
-	unwrap (Params s) = filter (not . null) (split " " s)
+	unwrap (Param s) = s
 	-- Files that start with a non-alphanumeric that is not a path
 	-- separator are modified to avoid the command interpreting them as
 	-- options or other special constructs.
 	unwrap (File s@(h:_))
-		| isAlphaNum h || h `elem` pathseps = [s]
-		| otherwise = ["./" ++ s]
-	unwrap (File s) = [s]
+		| isAlphaNum h || h `elem` pathseps = s
+		| otherwise = "./" ++ s
+	unwrap (File s) = s
 	-- '/' is explicitly included because it's an alternative
 	-- path separator on Windows.
 	pathseps = pathSeparator:"./"