summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--config-joey.hs111
-rw-r--r--config-simple.hs19
-rw-r--r--debian/changelog3
-rw-r--r--src/Propellor/Property.hs33
-rw-r--r--src/Propellor/Property/Docker.hs63
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs10
-rw-r--r--src/Propellor/Types/Info.hs14
7 files changed, 117 insertions, 136 deletions
diff --git a/config-joey.hs b/config-joey.hs
index 2866e797..d6f174dc 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -45,7 +45,7 @@ hosts = -- (o) `
, kite
, diatom
, elephant
- ] ++ containers ++ monsters
+ ] ++ monsters
darkstar :: Host
darkstar = host "darkstar.kitenet.net"
@@ -53,8 +53,7 @@ darkstar = host "darkstar.kitenet.net"
& Apt.buildDep ["git-annex"] `period` Daily
& Docker.configured
- ! Docker.docked hosts "android-git-annex"
- ! Docker.docked hosts "simple-debian"
+ ! Docker.docked gitAnnexAndroidDev
clam :: Host
clam = standardSystem "clam.kitenet.net" Unstable "amd64"
@@ -69,7 +68,7 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
& Docker.configured
& Docker.garbageCollected `period` Daily
- & Docker.docked hosts "webserver"
+ & Docker.docked webserver
& File.dirExists "/var/www/html"
& File.notPresent "/var/www/html/index.html"
& "/var/www/index.html" `File.hasContent` ["hello, world"]
@@ -91,11 +90,11 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
& Apt.unattendedUpgrades
& Postfix.satellite
& Docker.configured
- & Docker.docked hosts "amd64-git-annex-builder"
- & Docker.docked hosts "i386-git-annex-builder"
- & Docker.docked hosts "android-git-annex-builder"
- & Docker.docked hosts "armel-git-annex-builder-companion"
- & Docker.docked hosts "armel-git-annex-builder"
+ & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h")
+ & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h")
+ & Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage)
+ & Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h")
+ & Docker.docked (GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h")
& Docker.garbageCollected `period` Daily
& Apt.buildDep ["git-annex"] `period` Daily
@@ -258,11 +257,10 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
& myDnsSecondary
& Docker.configured
- & Docker.docked hosts "oldusenet-shellbox"
- & Docker.docked hosts "openid-provider"
+ & Docker.docked oldusenetShellBox
+ & Docker.docked openidProvider
`requires` Apt.serviceInstalledRunning "ntp"
- & Docker.docked hosts "ancient-kitenet"
-
+ & Docker.docked ancientKitenet
& Docker.garbageCollected `period` (Weekly (Just 1))
-- For https port 443, shellinabox with ssh login to
@@ -284,52 +282,43 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
----------------------- : / -----------------------
------------------------ \____, o ,' ------------------------
------------------------- '--,___________,' -------------------------
-containers :: [Host]
-containers =
- -- Simple web server, publishing the outside host's /var/www
- [ standardStableContainer "webserver"
- & Docker.publish "80:80"
- & Docker.volume "/var/www:/var/www"
- & Apt.serviceInstalledRunning "apache2"
-
- -- My own openid provider. Uses php, so containerized for security
- -- and administrative sanity.
- , standardStableContainer "openid-provider"
- & alias "openid.kitenet.net"
- & Docker.publish "8081:80"
- & OpenId.providerFor ["joey", "liw"]
- "openid.kitenet.net:8081"
-
- -- Exhibit: kite's 90's website.
- , standardStableContainer "ancient-kitenet"
- & alias "ancient.kitenet.net"
- & Docker.publish "1994:80"
- & Apt.serviceInstalledRunning "apache2"
- & Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
- (Just "remotes/origin/old-kitenet.net")
-
- , standardStableContainer "oldusenet-shellbox"
- & alias "shell.olduse.net"
- & Docker.publish "4200:4200"
- & JoeySites.oldUseNetShellBox
-
- , Docker.container "simple-debian" "debian"
- & "/hello" `File.containsLine` "hello"
- & Docker.publish "8081:80"
-
- -- git-annex autobuilder containers
- , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
- , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"
- , GitAnnexBuilder.armelCompanionContainer dockerImage
- , GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h"
- , GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h"
-
- -- for development of git-annex for android, using my git-annex
- -- work tree
- , let gitannexdir = GitAnnexBuilder.homedir </> "git-annex"
- in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
- & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
- ]
+-- Simple web server, publishing the outside host's /var/www
+webserver :: Docker.Container
+webserver = standardStableContainer "webserver"
+ & Docker.publish "80:80"
+ & Docker.volume "/var/www:/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"
+ & alias "openid.kitenet.net"
+ & Docker.publish "8081:80"
+ & OpenId.providerFor ["joey", "liw"]
+ "openid.kitenet.net:8081"
+
+-- Exhibit: kite's 90's website.
+ancientKitenet :: Docker.Container
+ancientKitenet = standardStableContainer "ancient-kitenet"
+ & alias "ancient.kitenet.net"
+ & Docker.publish "1994:80"
+ & Apt.serviceInstalledRunning "apache2"
+ & Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
+ (Just "remotes/origin/old-kitenet.net")
+
+oldusenetShellBox :: Docker.Container
+oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
+ & alias "shell.olduse.net"
+ & Docker.publish "4200:4200"
+ & JoeySites.oldUseNetShellBox
+
+-- for development of git-annex for android, using my git-annex work tree
+gitAnnexAndroidDev :: Docker.Container
+gitAnnexAndroidDev = GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
+ & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
+ where
+ gitannexdir = GitAnnexBuilder.homedir </> "git-annex"
type Motd = [String]
@@ -363,11 +352,11 @@ standardSystemUnhardened hn suite arch motd = host hn
& Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
`onChange` Apt.autoRemove
-standardStableContainer :: Docker.ContainerName -> Host
+standardStableContainer :: Docker.ContainerName -> Docker.Container
standardStableContainer name = standardContainer name (Stable "wheezy") "amd64"
-- This is my standard container setup, featuring automatic upgrades.
-standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host
+standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container
standardContainer name suite arch = Docker.container name (dockerImage system)
& os system
& Apt.stdSourcesList `onChange` Apt.upgrade
diff --git a/config-simple.hs b/config-simple.hs
index dcdc51a3..fb02e279 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -32,18 +32,19 @@ hosts =
& User.hasSomePassword "root" (Context "mybox.example.com")
& Network.ipv6to4
& File.dirExists "/var/www"
- & Docker.docked hosts "webserver"
+ & Docker.docked webserverContainer
& Docker.garbageCollected `period` Daily
& Cron.runPropellor "30 * * * *"
- -- A generic webserver in a Docker container.
- , Docker.container "webserver" "joeyh/debian-stable"
- & os (System (Debian (Stable "wheezy")) "amd64")
- & Apt.stdSourcesList
- & Docker.publish "80:80"
- & Docker.volume "/var/www:/var/www"
- & Apt.serviceInstalledRunning "apache2"
-
-- add more hosts here...
--, host "foo.example.com" = ...
]
+
+-- A generic webserver in a Docker container.
+webserverContainer :: Docker.Container
+webserverContainer = Docker.container "webserver" "joeyh/debian-stable"
+ & os (System (Debian (Stable "wheezy")) "amd64")
+ & Apt.stdSourcesList
+ & Docker.publish "80:80"
+ & Docker.volume "/var/www:/var/www"
+ & Apt.serviceInstalledRunning "apache2"
diff --git a/debian/changelog b/debian/changelog
index 83958a16..155d5124 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,6 +15,9 @@ propellor (1.0.0) UNRELEASED; urgency=medium
* Avoid outputting color setting sequences when not run on a terminal.
* Run remote propellor --spin with a controlling terminal.
* Docker code simplified by using `docker exec`; needs docker 1.3.1.
+ * Docker containers are now a separate data type, cannot be included
+ in the main host list, and are instead passed to
+ Docker.docked. (API change)
* Added support for using debootstrap from propellor.
-- Joey Hess <id@joeyh.name> Mon, 10 Nov 2014 11:15:27 -0400
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 7000b2a3..bf69ff60 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -144,27 +144,28 @@ unrevertable (RevertableProperty p1 _p2) = p1
host :: HostName -> Host
host hn = Host hn [] mempty
--- | Adds a property to a Host
---
--- Can add Properties and RevertableProperties
-(&) :: IsProp p => Host -> p -> Host
-(Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
-
-infixl 1 &
+class Hostlike h where
+ -- | Adds a property to a Host
+ --
+ -- Can add Properties and RevertableProperties
+ (&) :: IsProp p => h -> p -> h
+ -- | Like (&), but adds the property as the
+ -- first property of the host. Normally, property
+ -- order should not matter, but this is useful
+ -- when it does.
+ (&^) :: IsProp p => h -> p -> h
+
+instance Hostlike Host where
+ (Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p)
+ (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
-- | Adds a property to the Host in reverted form.
-(!) :: Host -> RevertableProperty -> Host
+(!) :: Hostlike h => h -> RevertableProperty -> h
h ! p = h & revert p
-infixl 1 !
-
--- | Like (&), but adds the property as the first property of the host.
--- Normally, property order should not matter, but this is useful
--- when it does.
-(&^) :: IsProp p => Host -> p -> Host
-(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is)
-
infixl 1 &^
+infixl 1 &
+infixl 1 !
-- Changes the action that is performed to satisfy a property.
adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 96405108..ce9fb7d7 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -16,6 +16,7 @@ module Propellor.Property.Docker (
tweaked,
Image,
ContainerName,
+ Container,
-- * Container configuration
dns,
hostname,
@@ -71,55 +72,60 @@ configured = prop `requires` installed
-- only [a-zA-Z0-9_-] are allowed
type ContainerName = String
--- | Starts accumulating the properties of a Docker container.
+-- | A docker container.
+data Container = Container Image Host
+
+instance Hostlike Container where
+ (Container i h) & p = Container i (h & p)
+ (Container i h) &^ p = Container i (h &^ p)
+
+-- | Builds a Container with a given name, image, and properties.
--
-- > container "web-server" "debian"
-- > & publish "80:80"
-- > & Apt.installed {"apache2"]
-- > & ...
-container :: ContainerName -> Image -> Host
-container cn image = Host hn [] info
+container :: ContainerName -> Image -> Container
+container cn image = Container image (Host hn [] info)
where
- info = dockerInfo $ mempty { _dockerImage = Val image }
+ info = dockerInfo mempty
hn = cn2hn cn
cn2hn :: ContainerName -> HostName
cn2hn cn = cn ++ ".docker"
--- | Ensures that a docker container is set up and running, finding
--- its configuration in the passed list of hosts.
+-- | Ensures that a docker container is set up and running.
--
-- The container has its own Properties which are handled by running
-- propellor inside the container.
--
-- When the container's Properties include DNS info, such as a CNAME,
--- that is propigated to the Info of the host(s) it's docked in.
+-- that is propigated to the Info of the Host it's docked in.
--
-- Reverting this property ensures that the container is stopped and
-- removed.
docked
- :: [Host]
- -> ContainerName
+ :: Container
-> RevertableProperty
-docked hosts cn = RevertableProperty
- ((maybe id propigateInfo mhost) (go "docked" setup))
+docked ctr@(Container _ h) = RevertableProperty
+ (propigateInfo h (go "docked" setup))
(go "undocked" teardown)
where
+ cn = hostName h
+
go desc a = property (desc ++ " " ++ cn) $ do
hn <- asks hostName
let cid = ContainerId hn cn
- ensureProperties [findContainer mhost cid cn $ a cid]
-
- mhost = findHostNoAlias hosts (cn2hn cn)
+ ensureProperties [a cid (mkContainerInfo cid ctr)]
- setup cid (Container image runparams) =
+ setup cid (ContainerInfo image runparams) =
provisionContainer cid
`requires`
runningContainer cid image runparams
`requires`
installed
- teardown cid (Container image _runparams) =
+ teardown cid (ContainerInfo image _runparams) =
combineProperties ("undocked " ++ fromContainerId cid)
[ stoppedContainer cid
, property ("cleaned up " ++ fromContainerId cid) $
@@ -136,26 +142,11 @@ propigateInfo (Host _ _ containerinfo) p =
dnsprops = map addDNS (S.toList $ _dns containerinfo)
privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
-findContainer
- :: Maybe Host
- -> ContainerId
- -> ContainerName
- -> (Container -> Property)
- -> Property
-findContainer mhost cid cn mk = case mhost of
- Nothing -> cantfind
- Just h -> maybe cantfind mk (mkContainer cid h)
- where
- cantfind = containerDesc cid $ property "" $ do
- liftIO $ warningMessage $
- "missing definition for docker container \"" ++ cn2hn cn
- return FailedChange
-
-mkContainer :: ContainerId -> Host -> Maybe Container
-mkContainer cid@(ContainerId hn _cn) h = Container
- <$> fromVal (_dockerImage info)
- <*> pure (map (\mkparam -> mkparam hn) (_dockerRunParams info))
+mkContainerInfo :: ContainerId -> Container -> ContainerInfo
+mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
+ ContainerInfo img runparams
where
+ runparams = map (\mkparam -> mkparam hn) (_dockerRunParams info)
info = _dockerinfo $ hostInfo h'
h' = h
-- Restart by default so container comes up on
@@ -209,7 +200,7 @@ memoryLimited = "/etc/default/grub" `File.containsLine` cfg
cmdline = "cgroup_enable=memory swapaccount=1"
cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
-data Container = Container Image [RunParam]
+data ContainerInfo = ContainerInfo Image [RunParam]
-- | Parameters to pass to `docker run` when creating a container.
type RunParam = String
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 901eba2e..0208dea6 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -88,7 +88,7 @@ cabalDeps = flagFile go cabalupdated
go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"]
cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"
-standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host
+standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Docker.Container
standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder")
(dockerImage $ System (Debian Testing) arch)
& os (System (Debian Testing) arch)
@@ -101,14 +101,14 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta
& autobuilder arch (show buildminute ++ " * * * *") timeout
& Docker.tweaked
-androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
+androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Docker.Container
androidAutoBuilderContainer dockerImage crontimes timeout =
androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
& Apt.unattendedUpgrades
& autobuilder "android" crontimes timeout
-- Android is cross-built in a Debian i386 container, using the Android NDK.
-androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
+androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Docker.Container
androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name
(dockerImage osver)
& os osver
@@ -137,7 +137,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe
-- 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) -> Host
+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")
@@ -156,7 +156,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
& Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
& Docker.tweaked
-armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
+armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Docker.Container
armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
(dockerImage $ System (Debian Unstable) "armel")
& os (System (Debian Testing) "armel")
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index de072aa0..6aba1f9f 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -45,26 +45,22 @@ fromVal (Val a) = Just a
fromVal NoVal = Nothing
data DockerInfo = DockerInfo
- { _dockerImage :: Val String
- , _dockerRunParams :: [HostName -> String]
+ { _dockerRunParams :: [HostName -> String]
}
instance Eq DockerInfo where
x == y = and
- [ _dockerImage x == _dockerImage y
- , let simpl v = map (\a -> a "") (_dockerRunParams v)
+ [ let simpl v = map (\a -> a "") (_dockerRunParams v)
in simpl x == simpl y
]
instance Monoid DockerInfo where
- mempty = DockerInfo mempty mempty
+ mempty = DockerInfo mempty
mappend old new = DockerInfo
- { _dockerImage = _dockerImage old <> _dockerImage new
- , _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+ { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
}
instance Show DockerInfo where
show a = unlines
- [ "docker image " ++ show (_dockerImage a)
- , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+ [ "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
]