From 7c4b1537391d801855e28a61c896efcc70cfaa81 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 21:18:36 -0400
Subject: simplify monoid instance with some helper types

---
 src/Propellor/Property/Docker.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 8e081ae4..ce10d318 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -48,7 +48,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] attr
   where
-	attr = mempty { _dockerImage = Just image }
+	attr = mempty { _dockerImage = Val image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -116,7 +116,7 @@ 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'
-- 
cgit v1.3-2-g0d8e


From 31d9dd297db1a27c121df484c8f71ccfb612f375 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 21:36:09 -0400
Subject: propellor spin

---
 src/Propellor/Property/Docker.hs | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ce10d318..b0af14c1 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -5,7 +5,29 @@
 -- 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 (
+	Image,
+	ContainerName,
+	configured,
+	installed,
+	container,
+	docked,
+	garbageCollected,
+	-- * Container configuration
+	dns,
+	hostname,
+	name,
+	publish,
+	expose,
+	user,
+	volume,
+	volumes_from,
+	workdir,
+	memory,
+	link,
+	-- * Internal use
+	chain,
+) where
 
 import Propellor
 import Propellor.SimpleSh
@@ -16,7 +38,7 @@ 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
@@ -218,9 +240,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
-- 
cgit v1.3-2-g0d8e


From b0f2478bcbfcf5adc2d6f1692d667d42b108ca04 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 21:44:50 -0400
Subject: docker haddock

---
 src/Propellor/Property/Docker.hs | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index b0af14c1..f23738b3 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -6,13 +6,14 @@
 -- which propellor can set up. See config.hs for an example.
 
 module Propellor.Property.Docker (
-	Image,
-	ContainerName,
-	configured,
+	-- * Host properties
 	installed,
+	configured,
 	container,
 	docked,
 	garbageCollected,
+	Image,
+	ContainerName,
 	-- * Container configuration
 	dns,
 	hostname,
@@ -25,6 +26,7 @@ module Propellor.Property.Docker (
 	workdir,
 	memory,
 	link,
+	ContainerAlias,
 	-- * Internal use
 	chain,
 ) where
@@ -45,17 +47,17 @@ 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
@@ -76,9 +78,11 @@ container cn image = Host hn [] attr
 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.
-- 
cgit v1.3-2-g0d8e


From cae7e15f569dfe672b1a667e468447f6153ea5f0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 31 May 2014 22:00:11 -0400
Subject: split out DockerAttr

---
 src/Propellor/Property/Docker.hs | 11 +++++----
 src/Propellor/Types/Attr.hs      | 50 ++++++++++++++++++++++++----------------
 2 files changed, 37 insertions(+), 24 deletions(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index f23738b3..fbf34965 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -72,7 +72,7 @@ type ContainerName = String
 container :: ContainerName -> Image -> Host
 container cn image = Host hn [] attr
   where
-	attr = mempty { _dockerImage = Val image }
+	attr = dockerAttr $ mempty { _dockerImage = Val image }
 	hn = cn2hn cn
 
 cn2hn :: ContainerName -> HostName
@@ -145,7 +145,7 @@ mkContainer cid@(ContainerId hn _cn) h = Container
 	<$> 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)
@@ -443,15 +443,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/Types/Attr.hs b/src/Propellor/Types/Attr.hs
index b41a813b..e8c22a94 100644
--- a/src/Propellor/Types/Attr.hs
+++ b/src/Propellor/Types/Attr.hs
@@ -12,32 +12,18 @@ data Attr = Attr
 	, _sshPubKey :: Val String
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: Dns.NamedConfMap
-
-	, _dockerImage :: Val String
-	, _dockerRunParams :: [HostName -> String]
+	, _dockerattr :: DockerAttr
 	}
-
-instance Eq Attr where
-	x == y = and
-		[ _os x == _os y
-		, _dns x == _dns y
-		, _namedconf x == _namedconf y
-		, _sshPubKey x == _sshPubKey y
-
-		, _dockerImage x == _dockerImage y
-		, let simpl v = map (\a -> a "") (_dockerRunParams v)
-		  in simpl x == simpl y
-		]
+	deriving (Eq)
 
 instance Monoid Attr where
-	mempty = Attr mempty mempty mempty mempty mempty mempty
+	mempty = Attr mempty mempty mempty mempty mempty
 	mappend old new = Attr
 		{ _os = _os old <> _os new
 		, _sshPubKey = _sshPubKey old <> _sshPubKey new
 		, _dns = _dns old <> _dns new
 		, _namedconf = _namedconf old <> _namedconf new
-		, _dockerImage = _dockerImage old <> _dockerImage new
-		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		, _dockerattr = _dockerattr old <> _dockerattr new
 		}
 
 instance Show Attr where
@@ -46,8 +32,7 @@ instance Show Attr where
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "dns " ++ show (_dns a)
 		, "namedconf " ++ show (_namedconf a)
-		, "docker image " ++ show (_dockerImage a)
-		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+		, show (_dockerattr a)
 		]
 
 data Val a = Val a | NoVal
@@ -62,3 +47,28 @@ instance Monoid (Val a) where
 fromVal :: Val a -> Maybe a
 fromVal (Val a) = Just a
 fromVal NoVal = Nothing
+
+data DockerAttr = DockerAttr
+	{ _dockerImage :: Val String
+	, _dockerRunParams :: [HostName -> String]
+	}
+
+instance Eq DockerAttr where
+	x == y = and
+		[ _dockerImage x == _dockerImage y
+		, let simpl v = map (\a -> a "") (_dockerRunParams v)
+		  in simpl x == simpl y
+		]
+
+instance Monoid DockerAttr where
+	mempty = DockerAttr mempty mempty
+	mappend old new = DockerAttr
+		{ _dockerImage = _dockerImage old <> _dockerImage new
+		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		}
+
+instance Show DockerAttr where
+	show a = unlines
+		[ "docker image " ++ show (_dockerImage a)
+		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+		]
-- 
cgit v1.3-2-g0d8e


From c224625734fb4b6ae11f6fdd897ed83fc7f7bab5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 1 Jun 2014 13:35:21 -0400
Subject: propellor spin

---
 config-joey.hs                   |  2 +-
 src/Propellor/Property/Docker.hs | 25 ++++++++++++++++++++++++-
 2 files changed, 25 insertions(+), 2 deletions(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/config-joey.hs b/config-joey.hs
index 9f5005b3..3f0d5154 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -224,7 +224,7 @@ hosts =                 --                  (o)  `
 	  in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
 		& Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
 
-	-- temp for an aqquantance
+	-- temp for an accuantance
 	, standardContainer "voltagex" Stable "amd64"
 		& Docker.publish "22022:22"
 		& Apt.serviceInstalledRunning "ssh"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index fbf34965..adaea548 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Docker (
 	configured,
 	container,
 	docked,
+	memoryLimited,
 	garbageCollected,
 	Image,
 	ContainerName,
@@ -25,6 +26,7 @@ module Propellor.Property.Docker (
 	volumes_from,
 	workdir,
 	memory,
+	cpuShares,
 	link,
 	ContainerAlias,
 	-- * Internal use
@@ -170,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.
@@ -220,10 +236,17 @@ 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).
+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 ->
-- 
cgit v1.3-2-g0d8e


From 3df3fd1746c2721d6b1dc08bb1422422abf07f6f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 1 Jun 2014 13:40:06 -0400
Subject: propellor spin

---
 config-joey.hs                   | 4 +++-
 src/Propellor/Property/Docker.hs | 3 +++
 2 files changed, 6 insertions(+), 1 deletion(-)

(limited to 'src/Propellor/Property/Docker.hs')

diff --git a/config-joey.hs b/config-joey.hs
index 3f0d5154..6d3505ed 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -224,9 +224,11 @@ hosts =                 --                  (o)  `
 	  in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
 		& Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
 
-	-- temp for an accuantance
+	-- temp for an acquantance
 	, standardContainer "voltagex" Stable "amd64"
 		& Docker.publish "22022:22"
+		& Docker.memory "500m"
+		& Docker.cpuShares 1
 		& Apt.serviceInstalledRunning "ssh"
 		& Ssh.permitRootLogin True
 		& Ssh.passwordAuthentication True
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index adaea548..fa3e2344 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -244,6 +244,9 @@ 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
 
-- 
cgit v1.3-2-g0d8e