Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg
This commit is contained in:
Joey Hess 2015-06-03 12:17:56 -04:00
commit 5d3408d322
13 changed files with 320 additions and 158 deletions

3
.gitignore vendored
View File

@ -7,4 +7,7 @@ Setup
Setup.hi
Setup.o
docker
chroot
propellor.1
.lock
.lastchecked

View File

@ -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,21 +422,20 @@ 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"
@ -442,10 +443,9 @@ jerryPlay = standardContainer "jerryplay" Unstable "amd64"
& 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

11
debian/changelog vendored
View File

@ -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

View File

@ -121,6 +121,7 @@ Library
Propellor.Exception
Propellor.Types
Propellor.Types.Chroot
Propellor.Types.Container
Propellor.Types.Docker
Propellor.Types.Dns
Propellor.Types.Empty

View File

@ -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
@ -120,24 +119,20 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "
]
)
-- /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"

View File

@ -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.

View File

@ -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 :-

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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:"./"