diff --git a/.gitignore b/.gitignore index a2d84e4..19bd3f0 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,7 @@ Setup Setup.hi Setup.o docker +chroot propellor.1 +.lock +.lastchecked diff --git a/config-joey.hs b/config-joey.hs index 73c9687..dec2701 100644 --- 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 diff --git a/debian/changelog b/debian/changelog index 6a10580..f4459a2 100644 --- 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 Thu, 07 May 2015 12:08:34 -0400 diff --git a/propellor.cabal b/propellor.cabal index 16dffe3..9edc143 100644 --- 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 diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 0e9d00d..ded108b 100644 --- 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" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index fd7e37b..1dcc352 100644 --- 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. diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ab57b12..d643b18 100644 --- 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 :- diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 3c63872..7007596 100644 --- 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" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index c698f78..1784998 100644 --- 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 diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs index ac9295d..3fe78f7 100644 --- 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 diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs new file mode 100644 index 0000000..d21bada --- /dev/null +++ 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 + diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 58bd809..c46d9a2 100644 --- 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) diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 82e3504..9102b72 100644 --- 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:"./"