Merge branch 'joeyconfig'

propellor.cabal

@@ -113,8 +113,10 @@ Library
     Propellor.Engine
     Propellor.Exception
     Propellor.Types
-    Propellor.Types.OS
+    Propellor.Types.Chroot
+    Propellor.Types.Docker
     Propellor.Types.Dns
+    Propellor.Types.OS
     Propellor.Types.PrivData
   Other-Modules:
     Propellor.Git

src/Propellor/Property/Chroot.hs

@@ -10,6 +10,7 @@ module Propellor.Property.Chroot (
 ) where
 
 import Propellor
+import Propellor.Types.Chroot
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
 import qualified Propellor.Shim as Shim

src/Propellor/Property/Docker.hs

@@ -39,6 +39,7 @@ module Propellor.Property.Docker (
 ) where
 
 import Propellor hiding (init)
+import Propellor.Types.Docker
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Shim as Shim
@@ -523,7 +524,7 @@ genProp :: String -> (HostName -> RunParam) -> Property
 genProp field mkval = pureInfoProperty field $ dockerInfo $
 	mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
 
-dockerInfo :: DockerInfo -> Info
+dockerInfo :: DockerInfo Host -> Info
 dockerInfo i = mempty { _dockerinfo = i }
 
 -- | The ContainerIdent of a container is written to

src/Propellor/Property/Systemd.hs

@@ -5,12 +5,16 @@ module Propellor.Property.Systemd (
 	enabled,
 	disabled,
 	persistentJournal,
+	daemonReloaded,
 	Container,
 	container,
 	nspawned,
+	containerCfg,
+	resolvConfed,
 ) where
 
 import Propellor
+import Propellor.Types.Chroot
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.File as File
@@ -18,13 +22,16 @@ import Propellor.Property.Systemd.Core
 import Utility.SafeCommand
 import Utility.FileMode
 
+import Data.List
 import Data.List.Utils
+import qualified Data.Map as M
 
 type ServiceName = String
 
 type MachineName = String
 
 data Container = Container MachineName Chroot.Chroot Host
+	deriving (Show)
 
 instance Hostlike Container where
         (Container n c h) & p = Container n c (h & p)
@@ -63,6 +70,10 @@ persistentJournal = check (not <$> doesDirectoryExist dir) $
   where
 	dir = "/var/log/journal"
 
+-- | Causes systemd to reload its configuration files.
+daemonReloaded :: Property
+daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"]
+
 -- | Defines a container with a given machine name.
 --
 -- Properties can be added to configure the Container.
@@ -73,6 +84,7 @@ persistentJournal = check (not <$> doesDirectoryExist dir) $
 container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
 container name mkchroot = Container name c h
 	& os system
+	& resolvConfed
   where
 	c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name)
 	h = Host name [] mempty
@@ -102,7 +114,7 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) =
 	steps =
 		[ enterScript c
 		, chrootprovisioned
-		, nspawnService c
+		, nspawnService c (_chrootCfg $ _chrootinfo $ hostInfo h)
 		]
 
 	-- Chroot provisioning is run in systemd-only mode,
@@ -118,19 +130,47 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) =
 
 	chroot = Chroot.Chroot loc system builderconf h
 
-nspawnService :: Container -> RevertableProperty
-nspawnService (Container name _ _) = RevertableProperty setup teardown
+-- | Sets up the service file for the container, and then starts
+-- it running.
+nspawnService :: Container -> ChrootCfg -> RevertableProperty
+nspawnService (Container name _ _) cfg = RevertableProperty setup teardown
   where
 	service = nspawnServiceName name
 	servicefile = "/etc/systemd/system/multi-user.target.wants" </> service
 
-	setup = check (not <$> doesFileExist servicefile) $
-		started service
-			`requires` enabled service
+	servicefilecontent = do
+		ls <- lines <$> readFile "/lib/systemd/system/systemd-nspawn@.service"
+		return $ unlines $
+			"# deployed by propellor" : map addparams ls
+	addparams l
+		| "ExecStart=" `isPrefixOf` l =
+			l ++ " " ++ unwords (nspawnServiceParams cfg)
+		| otherwise = l
+	
+	goodservicefile = (==)
+		<$> servicefilecontent
+		<*> catchDefaultIO "" (readFile servicefile)
+
+	writeservicefile = property servicefile $ liftIO $ do
+		viaTmp writeFile servicefile =<< servicefilecontent
+		return MadeChange
+
+	setupservicefile = check (not <$> goodservicefile) $
+		-- if it's running, it has the wrong configuration,
+		-- so stop it
+		stopped service
+			`requires` daemonReloaded
+			`requires` writeservicefile
+
+	setup = started service `requires` setupservicefile
 
 	teardown = check (doesFileExist servicefile) $
-		disabled service
-			`requires` stopped service
+		disabled service `requires` stopped service
+
+nspawnServiceParams :: ChrootCfg -> [String]
+nspawnServiceParams NoChrootCfg = []
+nspawnServiceParams (SystemdNspawnCfg ps) =
+	M.keys $ M.filter id $ M.fromList ps
 
 -- | Installs a "enter-machinename" script that root can use to run a
 -- command inside the container.
@@ -171,3 +211,25 @@ containerDir name = "/var/lib/container" </> mungename name
 
 mungename :: MachineName -> String
 mungename = replace "/" "_"
+
+-- | This configures how systemd-nspawn(1) starts the container,
+-- by specifying a parameter, such as "--private-network", or
+-- "--link-journal=guest"
+--
+-- When there is no leading dash, "--" is prepended to the parameter.
+--
+-- Reverting the property will remove a parameter, if it's present.
+containerCfg :: String -> RevertableProperty
+containerCfg p = RevertableProperty (mk True) (mk False)
+  where
+	mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
+		mempty { _chrootinfo = mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] } }
+	p' = case p of
+		('-':_) -> p
+		_ -> "--" ++ p
+
+-- | Bind mounts /etc/resolv.conf from the host into the container.
+--
+-- This property is enabled by default. Revert it to disable it.
+resolvConfed :: RevertableProperty
+resolvConfed = containerCfg "bind=/etc/resolv.conf"

src/Propellor/Types.hs

@@ -23,9 +23,6 @@ module Propellor.Types
 	, SshKeyType(..)
 	, Val(..)
 	, fromVal
-	, DockerInfo(..)
-	, DockerRunParam(..)
-	, ChrootInfo(..)
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	) where
@@ -37,11 +34,12 @@ import System.Posix.Types
 import "mtl" Control.Monad.Reader
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import qualified Data.Set as S
-import qualified Data.Map as M
 import qualified Propellor.Types.Dns as Dns
 
 import Propellor.Types.OS
+import Propellor.Types.Chroot
 import Propellor.Types.Dns
+import Propellor.Types.Docker
 import Propellor.Types.PrivData
 
 -- | Everything Propellor knows about a system: Its hostname,
@@ -167,8 +165,8 @@ data Info = Info
 	, _aliases :: S.Set HostName
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: Dns.NamedConfMap
-	, _dockerinfo :: DockerInfo
-	, _chrootinfo :: ChrootInfo
+	, _dockerinfo :: DockerInfo Host
+	, _chrootinfo :: ChrootInfo Host
 	}
 	deriving (Show)
 
@@ -197,32 +195,3 @@ instance Monoid (Val a) where
 fromVal :: Val a -> Maybe a
 fromVal (Val a) = Just a
 fromVal NoVal = Nothing
-
-data DockerInfo = DockerInfo
-	{ _dockerRunParams :: [DockerRunParam]
-	, _dockerContainers :: M.Map String Host
-	}
-	deriving (Show)
-
-instance Monoid DockerInfo where
-	mempty = DockerInfo mempty mempty
-	mappend old new = DockerInfo
-		{ _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
-		, _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
-		}
-
-newtype DockerRunParam = DockerRunParam (HostName -> String)
-
-instance Show DockerRunParam where
-	show (DockerRunParam a) = a ""
-
-data ChrootInfo = ChrootInfo
-	{ _chroots :: M.Map FilePath Host
-	}
-	deriving (Show)
-
-instance Monoid ChrootInfo where
-	mempty = ChrootInfo mempty
-	mappend old new = ChrootInfo
-		{ _chroots = M.union (_chroots old) (_chroots new)
-		}

src/Propellor/Types/Chroot.hs

@@ -0,0 +1,29 @@
+module Propellor.Types.Chroot where
+
+import Data.Monoid
+import qualified Data.Map as M
+
+data ChrootInfo host = ChrootInfo
+	{ _chroots :: M.Map FilePath host
+	, _chrootCfg :: ChrootCfg
+	}
+	deriving (Show)
+
+instance Monoid (ChrootInfo host) where
+	mempty = ChrootInfo mempty mempty
+	mappend old new = ChrootInfo
+		{ _chroots = M.union (_chroots old) (_chroots new)
+		, _chrootCfg = _chrootCfg old <> _chrootCfg new
+		}
+
+data ChrootCfg
+	= NoChrootCfg
+	| SystemdNspawnCfg [(String, Bool)]
+	deriving (Show)
+
+instance Monoid ChrootCfg where
+	mempty = NoChrootCfg
+	mappend v NoChrootCfg = v
+	mappend NoChrootCfg v = v
+	mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) =
+		SystemdNspawnCfg (l1 <> l2)

src/Propellor/Types/Docker.hs

@@ -0,0 +1,24 @@
+module Propellor.Types.Docker where
+
+import Propellor.Types.OS
+
+import Data.Monoid
+import qualified Data.Map as M
+
+data DockerInfo h = DockerInfo
+	{ _dockerRunParams :: [DockerRunParam]
+	, _dockerContainers :: M.Map String h
+	}
+	deriving (Show)
+
+instance Monoid (DockerInfo h) where
+	mempty = DockerInfo mempty mempty
+	mappend old new = DockerInfo
+		{ _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		, _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
+		}
+
+newtype DockerRunParam = DockerRunParam (HostName -> String)
+
+instance Show DockerRunParam where
+	show (DockerRunParam a) = a ""