summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-11-21 20:57:53 -0400
committerJoey Hess2014-11-21 20:57:53 -0400
commit91d58380b4fe3dd4dca5668ef6c7b2bf1edef79c (patch)
tree5dde66ff4e0ecf12e654c30f13aceeda913f201d /src
parente60b261daea356a2fcab424a276a491fdd3f956c (diff)
parent6cdd37d9ff3ff3e3b8439445c1363b9bdc77a5da (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Chroot.hs1
-rw-r--r--src/Propellor/Property/Docker.hs3
-rw-r--r--src/Propellor/Property/Systemd.hs78
-rw-r--r--src/Propellor/Types.hs39
-rw-r--r--src/Propellor/Types/Chroot.hs29
-rw-r--r--src/Propellor/Types/Docker.hs24
6 files changed, 130 insertions, 44 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 7246e7eb..c3b14a8e 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/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
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 5cf60ff9..460bc3ec 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/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
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index b50194fa..a2130a21 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/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"
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index a6c5aafa..e7d63547 100644
--- a/src/Propellor/Types.hs
+++ b/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)
- }
diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs
new file mode 100644
index 00000000..b7ed7807
--- /dev/null
+++ b/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)
diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs
new file mode 100644
index 00000000..42a65923
--- /dev/null
+++ b/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 ""