Merge branch 'joeyconfig'

6 files changed, 109 insertions, 20 deletions

diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index d3f47a80..69144d72 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -254,3 +254,9 @@ trustsKey k = RevertableProperty trust untrust
 				hPutStr h (pubkey k)
 				hClose h
 		nukeFile $ f ++ "~" -- gpg dropping
+
+-- | Cleans apt's cache of downloaded packages to avoid using up disk
+-- space.
+cacheCleaned :: Property
+cacheCleaned = cmdProperty "apt-get" ["clean"]
+	`describe` "apt cache cleaned" 
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 3e5c7828..50ce649e 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -339,7 +339,7 @@ genZone hosts zdomain soa =
 		, map hostrecords inzdomain
 		, map addcnames (M.elems m)
 		]
-	in (Zone zdomain soa (nub zhosts), warnings)
+	in (Zone zdomain soa (simplify zhosts), warnings)
   where
 	m = hostMap hosts
 	-- Known hosts with hostname located in the zone's domain.
@@ -390,6 +390,17 @@ genZone hosts zdomain soa =
 		l = zip (repeat $ AbsDomain $ hostName h)
 			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
 
+	-- Simplifies the list of hosts. Remove duplicate entries.
+	-- Also, filter out any CHAMES where the same domain has an
+	-- IP address, since that's not legal.
+	simplify :: [(BindDomain, Record)] -> [(BindDomain, Record)]
+	simplify l = nub $ filter (not . dupcname ) l
+	  where
+		dupcname (d, CNAME _) | any (matchingaddr d) l = True
+		dupcname _ = False
+		matchingaddr d (d', (Address _)) | d == d' = True
+		matchingaddr _ _ = False
+
 inDomain :: Domain -> BindDomain -> Bool
 inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d
 inDomain _ _ = False -- can't tell, so assume not
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 8e081ae4..fa3e2344 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -5,7 +5,33 @@
 -- The existance of a docker container is just another Property of a system,
 -- which propellor can set up. See config.hs for an example.
 
-module Propellor.Property.Docker where
+module Propellor.Property.Docker (
+	-- * Host properties
+	installed,
+	configured,
+	container,
+	docked,
+	memoryLimited,
+	garbageCollected,
+	Image,
+	ContainerName,
+	-- * Container configuration
+	dns,
+	hostname,
+	name,
+	publish,
+	expose,
+	user,
+	volume,
+	volumes_from,
+	workdir,
+	memory,
+	cpuShares,
+	link,
+	ContainerAlias,
+	-- * Internal use
+	chain,
+) where
 
 import Propellor
 import Propellor.SimpleSh
@@ -16,24 +42,24 @@ import qualified Propellor.Property.Docker.Shim as Shim
 import Utility.SafeCommand
 import Utility.Path
 
-import Control.Concurrent.Async
+import Control.Concurrent.Async hiding (link)
 import System.Posix.Directory
 import System.Posix.Process
 import Data.List
 import Data.List.Utils
 import qualified Data.Set as S
 
+installed :: Property
+installed = Apt.installed ["docker.io"]
+
 -- | Configures docker with an authentication file, so that images can be
--- pushed to index.docker.io.
+-- pushed to index.docker.io. Optional.
 configured :: Property
 configured = property "docker configured" go `requires` installed
   where
 	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
 		"/root/.dockercfg" `File.hasContent` (lines cfg)
 
-installed :: Property
-installed = Apt.installed ["docker.io"]
-
 -- | A short descriptive name for a container.
 -- Should not contain whitespace or other unusual characters,
 -- only [a-zA-Z0-9_-] are allowed
@@ -48,15 +74,17 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] attr
   where
-	attr = mempty { _dockerImage = Just image }
+	attr = dockerAttr $ mempty { _dockerImage = Val image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
 cn2hn cn = cn ++ ".docker"
 
--- | 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. 
+-- | Ensures that a docker container is set up and running, finding
+-- its configuration in the passed list of hosts.
+-- 
+-- The container has its own Properties which are handled by running
+-- propellor inside the container.
 --
 -- Additionally, the container can have DNS attributes, such as a CNAME.
 -- These become attributes of the host(s) it's docked in.
@@ -116,10 +144,10 @@ findContainer mhost cid cn mk = case mhost of
 
 mkContainer :: ContainerId -> Host -> Maybe Container
 mkContainer cid@(ContainerId hn _cn) h = Container
-	<$> _dockerImage attr
+	<$> fromVal (_dockerImage attr)
 	<*> pure (map (\a -> a hn) (_dockerRunParams attr))
   where
-	attr = hostAttr h'
+	attr = _dockerattr $ hostAttr h'
   	h' = h
 		-- expose propellor directory inside the container
 		& volume (localdir++":"++localdir)
@@ -144,6 +172,20 @@ garbageCollected = propertyList "docker garbage collected"
 	gcimages = property "docker images garbage collected" $ do
 		liftIO $ report <$> (mapM removeImage =<< listImages)
 
+-- | Configures the kernel to respect docker memory limits. 
+--
+-- This assumes the system boots using grub 2. And that you don't need any
+-- other GRUB_CMDLINE_LINUX_DEFAULT settings.
+--
+-- Only takes effect after reboot. (Not automated.)
+memoryLimited :: Property
+memoryLimited = "/etc/default/grub" `File.containsLine` cfg
+	`describe` "docker memory limited" 
+	`onChange` cmdProperty "update-grub" []
+  where
+	cmdline = "cgroup_enable=memory swapaccount=1"
+	cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
+
 data Container = Container Image [RunParam]
 
 -- | Parameters to pass to `docker run` when creating a container.
@@ -194,10 +236,20 @@ workdir :: String -> Property
 workdir = runProp "workdir"
 
 -- | Memory limit for container.
---Format: <number><optional unit>, where unit = b, k, m or g
+-- Format: <number><optional unit>, where unit = b, k, m or g
+--
+-- Note: Only takes effect when the host has the memoryLimited property
+-- enabled.
 memory :: String -> Property
 memory = runProp "memory"
 
+-- | CPU shares (relative weight).
+--
+-- By default, all containers run at the same priority, but you can tell
+-- the kernel to give more CPU time to a container using this property.
+cpuShares :: Int -> Property
+cpuShares = runProp "cpu-shares" . show
+
 -- | Link with another container on the same host.
 link :: ContainerName -> ContainerAlias -> Property
 link linkwith calias = genProp "link" $ \hn ->
@@ -218,9 +270,6 @@ data ContainerId = ContainerId HostName ContainerName
 data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
 	deriving (Read, Show, Eq)
 
-ident2id :: ContainerIdent -> ContainerId
-ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
-
 toContainerId :: String -> Maybe ContainerId
 toContainerId s
 	| myContainerSuffix `isSuffixOf` s = case separate (== '.') (desuffix s) of
@@ -420,15 +469,18 @@ listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Property
-runProp field val = pureAttrProperty (param) $
+runProp field val = pureAttrProperty (param) $ dockerAttr $
 	mempty { _dockerRunParams = [\_ -> "--"++param] }
   where
 	param = field++"="++val
 
 genProp :: String -> (HostName -> RunParam) -> Property
-genProp field mkval = pureAttrProperty field $
+genProp field mkval = pureAttrProperty field $ dockerAttr $
 	mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
 
+dockerAttr :: DockerAttr -> Attr
+dockerAttr a = mempty { _dockerattr = a }
+
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
 -- the container has the same ident later.
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 32374b57..e5ef7365 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -38,8 +38,12 @@ data NumClients = OnlyClient | MultipleClients
 --
 -- How awesome is that?
 backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
-backup dir crontimes params numclients = cronjob `describe` desc
+backup dir crontimes params numclients = backup' dir crontimes params numclients
 	`requires` restored dir params
+
+-- | Does a backup, but does not automatically restore.
+backup' :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
+backup' dir crontimes params numclients = cronjob `describe` desc
   where
 	desc = dir ++ " backed up by obnam"
 	cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 3dcafa35..6e4ca81a 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -99,7 +99,9 @@ cabalDeps = flagFile go cabalupdated
 standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host
 standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder")
 	(dockerImage $ System (Debian Unstable) arch)
+	& os (System (Debian Unstable) arch)
 	& Apt.stdSourcesList Unstable
+	& Apt.installed ["systemd"]
 	& Apt.unattendedUpgrades
 	& buildDepsApt
 	& autobuilder (show buildminute ++ " * * * *") timeout True
@@ -115,7 +117,9 @@ androidAutoBuilderContainer dockerImage crontimes timeout =
 androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
 androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name
 	(dockerImage $ System (Debian Stable) "i386")
+	& os (System (Debian Stable) "i386")
 	& Apt.stdSourcesList Stable
+	& Apt.installed ["systemd"]
 	& User.accountFor builduser
 	& File.dirExists gitbuilderdir
 	& File.ownerGroup homedir builduser builduser
@@ -140,7 +144,9 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe
 armelCompanionContainer :: (System -> Docker.Image) -> Host
 armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion"
 	(dockerImage $ System (Debian Unstable) "amd64")
+	& os (System (Debian Unstable) "amd64")
 	& Apt.stdSourcesList Unstable
+	& Apt.installed ["systemd"]
 	& Apt.unattendedUpgrades
 	-- This volume is shared with the armel builder.
 	& Docker.volume gitbuilderdir
@@ -156,8 +162,10 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
 armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
 armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
 	(dockerImage $ System (Debian Unstable) "armel")
+	& os (System (Debian Unstable) "armel")
 	& Apt.stdSourcesList Unstable
 	& Apt.unattendedUpgrades
+	& Apt.installed ["systemd"]
 	& Apt.installed ["openssh-client"]
 	& Docker.link "armel-git-annex-builder-companion" "companion"
 	& Docker.volumes_from "armel-git-annex-builder-companion"
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index f6e1e37f..b44401ea 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -330,3 +330,11 @@ kiteShellBox = propertyList "kitenet.net shellinabox"
 		`onChange` Service.restarted "shellinabox"
 	, Service.running "shellinabox"
 	]
+
+githubBackup :: Property
+githubBackup = propertyList "github-backup box"
+	[ Apt.installed ["github-backup", "moreutils"]
+	, let f = "/home/joey/.github-keys"
+	  in File.hasPrivContent f
+		`onChange` File.ownerGroup f "joey" "joey"
+	]