From dac6a874195a521714db48083b3222c2c8b41fa9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 22:10:50 -0400
Subject: [PATCH 01/52] broke out Server module

---
 propellor.cabal           |   1 +
 src/Propellor/CmdLine.hs  | 137 +++----------------------------------
 src/Propellor/Protocol.hs |   4 ++
 src/Propellor/Server.hs   | 140 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 154 insertions(+), 128 deletions(-)
 create mode 100644 src/Propellor/Server.hs

diff --git a/propellor.cabal b/propellor.cabal
index 2a8e3a0..c0b8624 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -115,6 +115,7 @@ Library
     Propellor.CmdLine
     Propellor.Git
     Propellor.Gpg
+    Propellor.Server
     Propellor.SimpleSh
     Propellor.Ssh
     Propellor.PrivData.Paths
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ee56301..0ae79ac 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -6,19 +6,15 @@ import System.Exit
 import System.PosixCompat
 import Control.Exception (bracket)
 import System.Posix.IO
-import Control.Concurrent.Async
-import qualified Data.ByteString as B
-import System.Process (std_in, std_out)
 
 import Propellor
 import Propellor.Protocol
-import Propellor.PrivData.Paths
 import Propellor.Gpg
 import Propellor.Git
 import Propellor.Ssh
+import Propellor.Server
 import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Docker.Shim as DockerShim
-import Utility.FileMode
 import Utility.SafeCommand
 
 usage :: Handle -> IO ()
@@ -91,7 +87,7 @@ defaultMain hostlist = do
 		r <- runPropellor h $ ensureProperties $ hostProperties h
 		putStrLn $ "\n" ++ show r
 	go _ (Docker hn) = Docker.chain hn
-	go _ (GitPush fin fout) = gitPush fin fout
+	go _ (GitPush fin fout) = gitPushHelper fin fout
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
 	go False (Spin hn) = withhost hn $ spin hn
@@ -172,9 +168,6 @@ updateFirst' cmdline next = do
 			, errorMessage "Propellor build failed!" 
 			)
 
--- spin handles deploying propellor to a remote host, if it's not already
--- installed there, or updating it if it is. Once the remote propellor is
--- updated, it's run.
 spin :: HostName -> Host -> IO ()
 spin hn hst = do
 	void $ actionMessage "Git commit (signed)" $
@@ -187,8 +180,12 @@ spin hn hst = do
 			boolSystem "git" [Param "push"]
 	
 	cacheparams <- toCommand <$> sshCachingParams hn
-	comm hn hst $ withBothHandles createProcessSuccess
-		(proc "ssh" $ cacheparams ++ [user, bootstrapcmd])
+
+	-- Install, or update the remote propellor.
+	updateServer hn hst $ withBothHandles createProcessSuccess
+		(proc "ssh" $ cacheparams ++ [user, updatecmd])
+
+	-- And now we can run it.
 	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
 		error $ "remote propellor failed (running: " ++ runcmd ++")"
   where
@@ -196,7 +193,7 @@ spin hn hst = do
 
 	mkcmd = shellWrap . intercalate " ; "
 
-	bootstrapcmd = mkcmd
+	updatecmd = mkcmd
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then " ++ intercalate " && "
 			[ "apt-get update"
@@ -213,119 +210,3 @@ spin hn hst = do
 
 	runcmd = mkcmd
 		[ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (SimpleRun hn)) ]
-
--- Update the privdata, repo url, and git repo over the ssh
--- connection from the client that ran propellor --spin.
-update :: IO ()
-update = do
-	req NeedRepoUrl repoUrlMarker setRepoUrl
-	makePrivDataDir
-	req NeedPrivData privDataMarker $
-		writeFileProtected privDataLocal
-	req NeedGitPush gitPushMarker $ \_ -> do
-		hin <- dup stdInput
-		hout <- dup stdOutput
-		hClose stdin
-		hClose stdout
-		unlessM (boolSystem "git" (pullparams hin hout)) $
-			errorMessage "git pull from client failed"
-  where
-	pullparams hin hout =
-		[ Param "pull"
-		, Param "--progress"
-		, Param "--upload-pack"
-		, Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout
-		, Param "."
-		]
-
-comm :: HostName  -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
-comm hn hst connect = connect go
-  where
-	go (toh, fromh) = do
-		let loop = go (toh, fromh)
-		v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
-		case v of
-			(Just NeedRepoUrl) -> do
-				sendRepoUrl toh
-				loop
-			(Just NeedPrivData) -> do
-				sendPrivData hn hst toh
-				loop
-			(Just NeedGitPush) -> do
-				sendGitUpdate hn fromh toh
-				-- no more protocol possible after git push
-				hClose fromh
-				hClose toh
-			(Just NeedGitClone) -> do
-				hClose toh
-				hClose fromh
-				sendGitClone hn
-				comm hn hst connect
-			Nothing -> return ()
-
-sendRepoUrl :: Handle -> IO ()
-sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
-
-sendPrivData :: HostName -> Host -> Handle -> IO ()
-sendPrivData hn hst toh = do
-	privdata <- show . filterPrivData hst <$> decryptPrivData
-	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
-		sendMarked toh privDataMarker privdata
-		return True
-
-sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
-sendGitUpdate hn fromh toh =
-	void $ actionMessage ("Sending git update to " ++ hn) $ do
-		sendMarked toh gitPushMarker ""
-		(Nothing, Nothing, Nothing, h) <- createProcess p
-		(==) ExitSuccess <$> waitForProcess h
-  where
-	p = (proc "git" ["upload-pack", "."])
-		{ std_in = UseHandle fromh
-		, std_out = UseHandle toh
-		}
-
--- Initial git clone, used for bootstrapping.
-sendGitClone :: HostName -> IO ()
-sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
-	branch <- getCurrentBranch
-	cacheparams <- sshCachingParams hn
-	withTmpFile "propellor.git" $ \tmp _ -> allM id
-		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
-		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
-		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
-		]
-  where
-	remotebundle = "/usr/local/propellor.git"
-	unpackcmd branch = shellWrap $ intercalate " && "
-		[ "git clone " ++ remotebundle ++ " " ++ localdir
-		, "cd " ++ localdir
-		, "git checkout -b " ++ branch
-		, "git remote rm origin"
-		, "rm -f " ++ remotebundle
-		]
-
--- Shim for git push over the propellor ssh channel.
--- Reads from stdin and sends it to hout;
--- reads from hin and sends it to stdout.
-gitPush :: Fd -> Fd -> IO ()
-gitPush hin hout = void $ fromstdin `concurrently` tostdout
-  where
-	fromstdin = do
-		h <- fdToHandle hout
-		connect stdin h
-	tostdout = do
-		h <- fdToHandle hin
-		connect h stdout
-	connect fromh toh = do
-		hSetBinaryMode fromh True
-		hSetBinaryMode toh True
-		b <- B.hGetSome fromh 40960
-		if B.null b
-			then do
-				hClose fromh
-				hClose toh
-			else do
-				B.hPut toh b
-				hFlush toh
-				connect fromh toh
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index f8b706c..68c2443 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -2,6 +2,10 @@
 -- a local and remote propellor. It's sent over a ssh channel, and lines of
 -- the protocol can be interspersed with other, non-protocol lines
 -- that should be passed through to be displayed.
+--
+-- Avoid making backwards-incompatible changes to this protocol,
+-- since propellor needs to use this protocol to update itself to new
+-- versions speaking newer versions of the protocol.
 
 module Propellor.Protocol where
 
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
new file mode 100644
index 0000000..1b31234
--- /dev/null
+++ b/src/Propellor/Server.hs
@@ -0,0 +1,140 @@
+module Propellor.Server (
+	update,
+	updateServer,
+	gitPushHelper
+) where
+
+import Data.List
+import System.Exit
+import System.PosixCompat
+import System.Posix.IO
+import Control.Concurrent.Async
+import qualified Data.ByteString as B
+import System.Process (std_in, std_out)
+
+import Propellor
+import Propellor.Protocol
+import Propellor.PrivData.Paths
+import Propellor.Git
+import Propellor.Ssh
+import Utility.FileMode
+import Utility.SafeCommand
+
+-- Update the privdata, repo url, and git repo over the ssh
+-- connection, talking the the user's local propellor instance which is
+-- running the updateServer
+update :: IO ()
+update = do
+	req NeedRepoUrl repoUrlMarker setRepoUrl
+	makePrivDataDir
+	req NeedPrivData privDataMarker $
+		writeFileProtected privDataLocal
+	req NeedGitPush gitPushMarker $ \_ -> do
+		hin <- dup stdInput
+		hout <- dup stdOutput
+		hClose stdin
+		hClose stdout
+		unlessM (boolSystem "git" (pullparams hin hout)) $
+			errorMessage "git pull from client failed"
+  where
+	pullparams hin hout =
+		[ Param "pull"
+		, Param "--progress"
+		, Param "--upload-pack"
+		, Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout
+		, Param "."
+		]
+
+-- The connect action should ssh to the remote host and run the provided
+-- calback action.
+updateServer :: HostName  -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
+updateServer hn hst connect = connect go
+  where
+	go (toh, fromh) = do
+		let loop = go (toh, fromh)
+		v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
+		case v of
+			(Just NeedRepoUrl) -> do
+				sendRepoUrl toh
+				loop
+			(Just NeedPrivData) -> do
+				sendPrivData hn hst toh
+				loop
+			(Just NeedGitPush) -> do
+				sendGitUpdate hn fromh toh
+				-- no more protocol possible after git push
+				hClose fromh
+				hClose toh
+			(Just NeedGitClone) -> do
+				hClose toh
+				hClose fromh
+				sendGitClone hn
+				updateServer hn hst connect
+			Nothing -> return ()
+
+sendRepoUrl :: Handle -> IO ()
+sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
+
+sendPrivData :: HostName -> Host -> Handle -> IO ()
+sendPrivData hn hst toh = do
+	privdata <- show . filterPrivData hst <$> decryptPrivData
+	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
+		sendMarked toh privDataMarker privdata
+		return True
+
+sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
+sendGitUpdate hn fromh toh =
+	void $ actionMessage ("Sending git update to " ++ hn) $ do
+		sendMarked toh gitPushMarker ""
+		(Nothing, Nothing, Nothing, h) <- createProcess p
+		(==) ExitSuccess <$> waitForProcess h
+  where
+	p = (proc "git" ["upload-pack", "."])
+		{ std_in = UseHandle fromh
+		, std_out = UseHandle toh
+		}
+
+-- Initial git clone, used for bootstrapping.
+sendGitClone :: HostName -> IO ()
+sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
+	branch <- getCurrentBranch
+	cacheparams <- sshCachingParams hn
+	withTmpFile "propellor.git" $ \tmp _ -> allM id
+		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
+		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
+		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
+		]
+  where
+	remotebundle = "/usr/local/propellor.git"
+	unpackcmd branch = shellWrap $ intercalate " && "
+		[ "git clone " ++ remotebundle ++ " " ++ localdir
+		, "cd " ++ localdir
+		, "git checkout -b " ++ branch
+		, "git remote rm origin"
+		, "rm -f " ++ remotebundle
+		]
+
+-- Shim for git push over the propellor ssh channel.
+-- Reads from stdin and sends it to hout;
+-- reads from hin and sends it to stdout.
+gitPushHelper :: Fd -> Fd -> IO ()
+gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout
+  where
+	fromstdin = do
+		h <- fdToHandle hout
+		connect stdin h
+	tostdout = do
+		h <- fdToHandle hin
+		connect h stdout
+	connect fromh toh = do
+		hSetBinaryMode fromh True
+		hSetBinaryMode toh True
+		b <- B.hGetSome fromh 40960
+		if B.null b
+			then do
+				hClose fromh
+				hClose toh
+			else do
+				B.hPut toh b
+				hFlush toh
+				connect fromh toh

From 745f9e268511fb13743dfa10476fa03c616fcdf1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 23:50:38 -0400
Subject: [PATCH 02/52] clean up Propellr.CmdLine exports

---
 propellor.cabal          | 2 +-
 src/Propellor/CmdLine.hs | 6 +++++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/propellor.cabal b/propellor.cabal
index c0b8624..82880d1 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -101,6 +101,7 @@ Library
     Propellor.Property.SiteSpecific.GitHome
     Propellor.Property.SiteSpecific.JoeySites
     Propellor.Property.SiteSpecific.GitAnnexBuilder
+    Propellor.CmdLine
     Propellor.Info
     Propellor.Message
     Propellor.PrivData
@@ -112,7 +113,6 @@ Library
     Propellor.Types.PrivData
   Other-Modules:
     Propellor.Types.Info
-    Propellor.CmdLine
     Propellor.Git
     Propellor.Gpg
     Propellor.Server
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 0ae79ac..9006d90 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -1,4 +1,7 @@
-module Propellor.CmdLine where
+module Propellor.CmdLine (
+	defaultMain,
+	processCmdLine,
+) where
 
 import System.Environment (getArgs)
 import Data.List
@@ -68,6 +71,7 @@ processCmdLine = go =<< getArgs
 		Just pf -> return $ f pf (Context c)
 		Nothing -> errorMessage $ "Unknown privdata field " ++ s
 
+-- | Runs propellor on hosts, as controlled by command-line options.
 defaultMain :: [Host] -> IO ()
 defaultMain hostlist = do
 	DockerShim.cleanEnv

From 6dc7176e7a9cea91ea370dc8a7f166cff2459d05 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 23:51:37 -0400
Subject: [PATCH 03/52] fix haddock filename display

---
 src/Propellor/Property/Hostname.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index c489e2f..4a5e77d 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -7,14 +7,14 @@ import Data.List
 
 -- | Ensures that the hostname is set using best practices.
 --
--- Configures /etc/hostname and the current hostname.
+-- Configures `/etc/hostname` and the current hostname.
 --
--- Configures /etc/mailname with the domain part of the hostname.
+-- Configures `/etc/mailname` with the domain part of the hostname.
 --
--- /etc/hosts is also configured, with an entry for 127.0.1.1, which is
+-- `/etc/hosts` is also configured, with an entry for 127.0.1.1, which is
 -- standard at least on Debian to set the FDQN.
 --
--- Also, the /etc/hosts 127.0.0.1 line is set to localhost. Putting any
+-- Also, the `/etc/hosts` 127.0.0.1 line is set to localhost. Putting any
 -- other hostnames there is not best practices and can lead to annoying
 -- messages from eg, apache.
 sane :: Property
@@ -44,7 +44,7 @@ setTo hn = combineProperties desc go
 		(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
 	hasip ip l = headMaybe (words l) == Just ip
 
--- | Makes /etc/resolv.conf contain search and domain lines for 
+-- | Makes `/etc/resolv.conf` contain search and domain lines for 
 -- the domain that the hostname is in.
 searchDomain :: Property
 searchDomain = property desc (ensureProperty . go =<< asks hostName)

From 111e08e156df5a41d61c370ebd077174e35f5d9b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 23:54:49 -0400
Subject: [PATCH 04/52] typo

---
 src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 4a95067..ad1c661 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -1,4 +1,4 @@
--- | Specific configuation for Joey Hess's sites. Probably not useful to
+-- | Specific configuration for Joey Hess's sites. Probably not useful to
 -- others except as an example.
 
 module Propellor.Property.SiteSpecific.JoeySites where

From 325fe4037bf5b027191ab88dd90f05d81f61fd0a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:30:06 -0400
Subject: [PATCH 05/52] propellor spin

---
 config-joey.hs                   |  4 +++
 src/Propellor/CmdLine.hs         |  3 +--
 src/Propellor/Property/Docker.hs | 42 +++++++++++++++-----------------
 src/Propellor/Types.hs           |  2 +-
 4 files changed, 25 insertions(+), 26 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index 7d48aee..abd20e5 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,6 +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"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"
@@ -309,6 +310,9 @@ containers =
 		& Docker.publish "4200:4200"
 		& JoeySites.oldUseNetShellBox
 
+	, Docker.container "simple-debian" "debian"
+		& "/hello" `File.containsLine` "hello"
+
 	-- git-annex autobuilder containers
 	, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
 	, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 9006d90..e41ab39 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -86,8 +86,7 @@ defaultMain hostlist = do
 	go _ (Edit field context) = editPrivData field context
 	go _ ListFields = listPrivDataFields hostlist
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain hn isconsole) = withhost hn $ \h -> do
-		when isconsole forceConsole
+	go _ (Chain hn) = withhost hn $ \h -> do
 		r <- runPropellor h $ ensureProperties $ hostProperties h
 		putStrLn $ "\n" ++ show r
 	go _ (Docker hn) = Docker.chain hn
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 491955d..2b4faf7 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -416,7 +416,7 @@ chain s = case toContainerId s of
 		-- to avoid ever provisioning twice at the same time.
 		whenM (checkProvisionedFlag cid) $ do
 			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid) False]) $
+			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid)]) $
 				warningMessage "Boot provision failed!"
 		void $ async $ job reapzombies
 		void $ async $ job $ simpleSh $ namedPipe cid
@@ -432,36 +432,28 @@ chain s = case toContainerId s of
 
 -- | Once a container is running, propellor can be run inside
 -- it to provision it.
---
--- Note that there is a race here, between the simplesh
--- server starting up in the container, and this property
--- being run. So, retry connections to the client for up to
--- 1 minute.
 provisionContainer :: ContainerId -> Property
 provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
+	let params = ["--continue", show $ Chain (containerHostName cid)]
 	msgh <- mkMessageHandle
-	let params = ["--continue", show $ Chain (containerHostName cid) (isConsole msgh)]
-	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
+	r <- inContainer cid
+		[ if isConsole msgh then "-it" else "-i" ]
+		(shim : params)
+		(processoutput Nothing)
 	when (r /= FailedChange) $
 		setProvisionedFlag cid 
 	return r
   where
-	go lastline (v:rest) = case v of
-		StdoutLine s -> do
-			maybe noop putStrLn lastline
-			hFlush stdout
-			go (Just s) rest
-		StderrLine s -> do
-			maybe noop putStrLn lastline
-			hFlush stdout
-			hPutStrLn stderr s
-			hFlush stderr
-			go Nothing rest
-		Done -> ret lastline
-	go lastline [] = ret lastline
-
-	ret lastline = pure $ fromMaybe FailedChange $ readish =<< lastline
+	processoutput lastline h = do
+		v <- catchMaybeIO (hGetLine h)
+		case v of
+			Nothing -> pure $ fromMaybe FailedChange $
+				readish =<< lastline
+			Just s -> do
+				maybe noop putStrLn lastline
+				hFlush stdout
+				processoutput (Just s) h
 
 stopContainer :: ContainerId -> IO Bool
 stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
@@ -496,6 +488,10 @@ runContainer :: Image -> [RunParam] -> [String] -> IO Bool
 runContainer image ps cmd = boolSystem dockercmd $ map Param $
 	"run" : (ps ++ image : cmd)
 
+inContainer :: ContainerId -> [String] -> [String] -> (Handle -> IO a) -> IO a
+inContainer cid ps cmd = withHandle StdinHandle createProcessSuccess
+	(proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd))
+
 commitContainer :: ContainerId -> IO (Maybe Image)
 commitContainer cid = catchMaybeIO $
 	takeWhile (/= '\n') 
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index a1d25b4..00da749 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -145,7 +145,7 @@ data CmdLine
 	| ListFields
 	| AddKey String
 	| Continue CmdLine
-	| Chain HostName Bool
+	| Chain HostName
 	| Update HostName
 	| Docker HostName
 	| GitPush Fd Fd

From 669305d75f44d6ca199849cfe1ef097aba5e300c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:30:23 -0400
Subject: [PATCH 06/52] propellor spin


From 29f3337034366b20271426fb899e30a1f690a805 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:31:04 -0400
Subject: [PATCH 07/52] propellor spin


From f8b71c0ab4e09a90aeced9a563465c0b89ee1a16 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:38:11 -0400
Subject: [PATCH 08/52] propellor spin

---
 src/Propellor/Property/Docker.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 2b4faf7..e5d488c 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -489,7 +489,7 @@ runContainer image ps cmd = boolSystem dockercmd $ map Param $
 	"run" : (ps ++ image : cmd)
 
 inContainer :: ContainerId -> [String] -> [String] -> (Handle -> IO a) -> IO a
-inContainer cid ps cmd = withHandle StdinHandle createProcessSuccess
+inContainer cid ps cmd = withHandle StdoutHandle createProcessSuccess
 	(proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd))
 
 commitContainer :: ContainerId -> IO (Maybe Image)

From fb3a6947c57caf10e755ab98c52aa401902eddb0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:38:35 -0400
Subject: [PATCH 09/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index abd20e5..57db1d4 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +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 hosts "simple-debian"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"

From 492c2b98a5e001c5ad3d99710c2540b4b95642df Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:39:35 -0400
Subject: [PATCH 10/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index 57db1d4..abd20e5 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +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 hosts "simple-debian"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"

From 9a779939c4252dc99b888d9fa6cd6d8f3b169610 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 00:54:35 -0400
Subject: [PATCH 11/52] merge from git-annex

---
 src/Utility/Process.hs     | 3 ++-
 src/Utility/SafeCommand.hs | 1 -
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index cd3826d..e25618e 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -10,7 +10,7 @@
 
 module Utility.Process (
 	module X,
-	CreateProcess,
+	CreateProcess(..),
 	StdHandle(..),
 	readProcess,
 	readProcessEnv,
@@ -31,6 +31,7 @@ module Utility.Process (
 	stdinHandle,
 	stdoutHandle,
 	stderrHandle,
+	bothHandles,
 	processHandle,
 	devNull,
 ) where
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 04fcf39..86e60db 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -9,7 +9,6 @@ module Utility.SafeCommand where
 
 import System.Exit
 import Utility.Process
-import System.Process (env)
 import Data.String.Utils
 import Control.Applicative
 import System.FilePath

From 05086b3abe8d633ae788354a3cc9bb0bd72f6159 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:02:13 -0400
Subject: [PATCH 12/52] propellor spin

---
 src/Propellor/Property/Docker.hs | 45 +++++++++++++++-----------------
 src/Utility/Process.hs           | 13 +++++----
 2 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index e5d488c..64276e8 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -37,13 +37,13 @@ module Propellor.Property.Docker (
 ) where
 
 import Propellor
-import Propellor.SimpleSh
 import Propellor.Types.Info
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Docker.Shim as Shim
 import Utility.SafeCommand
 import Utility.Path
+import Utility.ThreadScheduler
 
 import Control.Concurrent.Async hiding (link)
 import System.Posix.Directory
@@ -339,7 +339,7 @@ runningContainer :: ContainerId -> Image -> [RunParam] -> Property
 runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
 	l <- liftIO $ listContainers RunningContainers
 	if cid `elem` l
-		then checkident =<< liftIO (getrunningident simpleShClient)
+		then checkident =<< liftIO getrunningident
 		else ifM (liftIO $ elem cid <$> listContainers AllContainers)
 			( do
 				-- The container exists, but is not
@@ -348,9 +348,9 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 				-- starting it up first.
 				void $ liftIO $ startContainer cid
 				-- It can take a while for the container to
-				-- start up enough to get its ident, so
-				-- retry for up to 60 seconds.
-				checkident =<< liftIO (getrunningident (simpleShClientRetry 60))
+				-- start up enough for its ident file to be
+				-- written, so retry for up to 60 seconds.
+				checkident =<< liftIO (retry 60 $ getrunningident)
 			, go image
 			)
   where
@@ -370,12 +370,18 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 		void $ liftIO $ removeContainer cid
 		go oldimage
 
-	getrunningident shclient = shclient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
-		let !v = extractident rs
-		return v
+	getrunningident = readish
+		<$> readProcess' (inContainerProcess cid [] ["cat", propellorIdent])
 
-	extractident :: [Resp] -> Maybe ContainerIdent
-	extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
+	retry :: Int -> IO (Maybe a) -> IO (Maybe a)
+	retry 0 _ = return Nothing
+	retry n a = do
+		v <- a
+		case v of
+			Just _ -> return v
+			Nothing -> do
+				threadDelaySeconds (Seconds 1)				
+				retry (n-1) a
 
 	go img = do
 		liftIO $ do
@@ -393,7 +399,6 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 -- This process is effectively init inside the container.
 -- It even needs to wait on zombie processes!
 --
--- Fork a thread to run the SimpleSh server in the background.
 -- In the foreground, run an interactive bash (or sh) shell,
 -- so that the user can interact with it when attached to the container.
 --
@@ -412,14 +417,11 @@ chain s = case toContainerId s of
 	Just cid -> do
 		changeWorkingDirectory localdir
 		writeFile propellorIdent . show =<< readIdentFile cid
-		-- Run boot provisioning before starting simpleSh,
-		-- to avoid ever provisioning twice at the same time.
 		whenM (checkProvisionedFlag cid) $ do
 			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid)]) $
 				warningMessage "Boot provision failed!"
 		void $ async $ job reapzombies
-		void $ async $ job $ simpleSh $ namedPipe cid
 		job $ do
 			void $ tryIO $ ifM (inPath "bash")
 				( boolSystem "bash" [Param "-l"]
@@ -437,10 +439,11 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 	let params = ["--continue", show $ Chain (containerHostName cid)]
 	msgh <- mkMessageHandle
-	r <- inContainer cid
+	let p = inContainerProcess cid
 		[ if isConsole msgh then "-it" else "-i" ]
 		(shim : params)
-		(processoutput Nothing)
+	r <- withHandle StdoutHandle createProcessSuccess p $
+		processoutput Nothing
 	when (r /= FailedChange) $
 		setProvisionedFlag cid 
 	return r
@@ -471,7 +474,6 @@ stoppedContainer cid = containerDesc cid $ property desc $
   where
 	desc = "stopped"
 	cleanup = do
-		nukeFile $ namedPipe cid
 		nukeFile $ identFile cid
 		removeDirectoryRecursive $ shimdir cid
 		clearProvisionedFlag cid
@@ -488,9 +490,8 @@ runContainer :: Image -> [RunParam] -> [String] -> IO Bool
 runContainer image ps cmd = boolSystem dockercmd $ map Param $
 	"run" : (ps ++ image : cmd)
 
-inContainer :: ContainerId -> [String] -> [String] -> (Handle -> IO a) -> IO a
-inContainer cid ps cmd = withHandle StdoutHandle createProcessSuccess
-	(proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd))
+inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess
+inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd)
 
 commitContainer :: ContainerId -> IO (Maybe Image)
 commitContainer cid = catchMaybeIO $
@@ -534,10 +535,6 @@ dockerInfo i = mempty { _dockerinfo = i }
 propellorIdent :: FilePath
 propellorIdent = "/.propellor-ident"
 
--- | Named pipe used for communication with the container.
-namedPipe :: ContainerId -> FilePath
-namedPipe cid = "docker" </> fromContainerId cid
-
 provisionedFlag :: ContainerId -> FilePath
 provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
 
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index e25618e..4550d94 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -13,6 +13,7 @@ module Utility.Process (
 	CreateProcess(..),
 	StdHandle(..),
 	readProcess,
+	readProcess',
 	readProcessEnv,
 	writeReadProcessEnv,
 	forceSuccessProcess,
@@ -66,17 +67,19 @@ readProcess :: FilePath	-> [String] -> IO String
 readProcess cmd args = readProcessEnv cmd args Nothing
 
 readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String
-readProcessEnv cmd args environ =
-	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		output  <- hGetContentsStrict h
-		hClose h
-		return output
+readProcessEnv cmd args environ = readProcess' p
   where
 	p = (proc cmd args)
 		{ std_out = CreatePipe
 		, env = environ
 		}
 
+readProcess' :: CreateProcess -> IO String
+readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
+	output  <- hGetContentsStrict h
+	hClose h
+	return output
+
 {- Runs an action to write to a process on its stdin, 
  - returns its output, and also allows specifying the environment.
  -}

From f0675727c2833a8ebe8b954384ca484559b3b378 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:02:54 -0400
Subject: [PATCH 13/52] propellor spin

---
 src/Propellor/Server.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index 1b31234..182cc2b 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -10,7 +10,6 @@ import System.PosixCompat
 import System.Posix.IO
 import Control.Concurrent.Async
 import qualified Data.ByteString as B
-import System.Process (std_in, std_out)
 
 import Propellor
 import Propellor.Protocol

From c3962dcf7db5f4692a45fe0ff9802f819a97e2d7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:04:11 -0400
Subject: [PATCH 14/52] propellor spin

---
 debian/changelog          |   1 +
 propellor.cabal           |   1 -
 src/Propellor/SimpleSh.hs | 101 --------------------------------------
 3 files changed, 1 insertion(+), 102 deletions(-)
 delete mode 100644 src/Propellor/SimpleSh.hs

diff --git a/debian/changelog b/debian/changelog
index 1e16fe4..d29da29 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,6 +14,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium
     kernel when necessary.
   * 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.2.0.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 10 Nov 2014 11:15:27 -0400
 
diff --git a/propellor.cabal b/propellor.cabal
index 82880d1..d8a2ec4 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -116,7 +116,6 @@ Library
     Propellor.Git
     Propellor.Gpg
     Propellor.Server
-    Propellor.SimpleSh
     Propellor.Ssh
     Propellor.PrivData.Paths
     Propellor.Protocol
diff --git a/src/Propellor/SimpleSh.hs b/src/Propellor/SimpleSh.hs
deleted file mode 100644
index cc5c62c..0000000
--- a/src/Propellor/SimpleSh.hs
+++ /dev/null
@@ -1,101 +0,0 @@
--- | Simple server, using a named pipe. Client connects, sends a command,
--- and gets back all the output from the command, in a stream.
---
--- This is useful for eg, docker.
-
-module Propellor.SimpleSh where
-
-import Network.Socket
-import Control.Concurrent
-import Control.Concurrent.Async
-import System.Process (std_in, std_out, std_err)
-
-import Propellor
-import Utility.FileMode
-import Utility.ThreadScheduler
-
-data Cmd = Cmd String [String]
-	deriving (Read, Show)
-
-data Resp = StdoutLine String | StderrLine String | Done
-	deriving (Read, Show)
-
-simpleSh :: FilePath -> IO ()
-simpleSh namedpipe = do
-	nukeFile namedpipe
-	let dir = takeDirectory namedpipe
-	createDirectoryIfMissing True dir
-	modifyFileMode dir (removeModes otherGroupModes)
-	s <- socket AF_UNIX Stream defaultProtocol
-	bindSocket s (SockAddrUnix namedpipe)
-	listen s 2
-	forever $ do
-		(client, _addr) <- accept s
-		forkIO $ do
-			h <- socketToHandle client ReadWriteMode
-			maybe noop (run h) . readish =<< hGetLine h
-  where
-	run h (Cmd cmd params) = do
-		chan <- newChan
-		let runwriter = do
-			v <- readChan chan
-			hPutStrLn h (show v)
-			hFlush h
-			case v of
-				Done -> noop
-				_ -> runwriter
-		writer <- async runwriter
-
-		flip catchIO (\_e -> writeChan chan Done) $ do
-			let p = (proc cmd params)
-				{ std_in = Inherit
-				, std_out = CreatePipe
-				, std_err = CreatePipe
-				}
-			(Nothing, Just outh, Just errh, pid) <- createProcess p
-
-			let mkreader t from = maybe noop (const $ mkreader t from) 
-				=<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
-			void $ concurrently
-				(mkreader StdoutLine outh)
-				(mkreader StderrLine errh)
-		
-			void $ tryIO $ waitForProcess pid
-
-			writeChan chan Done
-
-			hClose outh
-			hClose errh
-
-		wait writer
-		hClose h
-
-simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
-simpleShClient namedpipe cmd params handler = do
-	s <- socket AF_UNIX Stream defaultProtocol
-	connect s (SockAddrUnix namedpipe)
-	h <- socketToHandle s ReadWriteMode
-	hPutStrLn h $ show $ Cmd cmd params
-	hFlush h
-	resps <- catMaybes . map readish . lines <$> hGetContents h
-	v <- hClose h `after` handler resps
-	return v
-
-simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
-simpleShClientRetry retries namedpipe cmd params handler = go retries
-  where
-	run = simpleShClient namedpipe cmd params handler
-	go n
-		| n < 1 = run
-		| otherwise = do
-			v <- tryIO run
-			case v of
-				Right r -> return r
-				Left e -> do
-					debug ["simplesh connection retry", show e]
-					threadDelaySeconds (Seconds 1)
-					go (n - 1)
-
-getStdout :: Resp -> Maybe String
-getStdout (StdoutLine s) = Just s
-getStdout _ = Nothing

From 818fcdfb344f170f887e7480e04150e224b2f61e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:05:10 -0400
Subject: [PATCH 15/52] propellor spin

---
 config-joey.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/config-joey.hs b/config-joey.hs
index abd20e5..a7f613d 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -312,6 +312,7 @@ containers =
 
 	, Docker.container "simple-debian" "debian"
 		& "/hello" `File.containsLine` "hello"
+		& Docker.publish "8081:80"
 
 	-- git-annex autobuilder containers
 	, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"

From 4dddbb725d9694b575bb665fa2369278b383f661 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:28:38 -0400
Subject: [PATCH 16/52] prevent multiple concurrent provisioning inside docker
 container

Lock a lock file while provisioning inside, otherwise propellor could be
running to init the container when the system has just booted, or the
container was just started from being stopped, and at the same time,
propellor run outside the container chains into it to provision.

Previously, simplesh prevented this in a different way.
---
 src/Propellor/CmdLine.hs         | 26 ++++++--------------------
 src/Propellor/Engine.hs          | 15 +++++++++++++++
 src/Propellor/Property/Docker.hs | 28 ++++++++++++++++++++--------
 src/Propellor/Types.hs           |  4 ++--
 4 files changed, 43 insertions(+), 30 deletions(-)

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index e41ab39..d9a95de 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -7,8 +7,6 @@ import System.Environment (getArgs)
 import Data.List
 import System.Exit
 import System.PosixCompat
-import Control.Exception (bracket)
-import System.Posix.IO
 
 import Propellor
 import Propellor.Protocol
@@ -86,10 +84,8 @@ defaultMain hostlist = do
 	go _ (Edit field context) = editPrivData field context
 	go _ ListFields = listPrivDataFields hostlist
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain hn) = withhost hn $ \h -> do
-		r <- runPropellor h $ ensureProperties $ hostProperties h
-		putStrLn $ "\n" ++ show r
-	go _ (Docker hn) = Docker.chain hn
+	go _ (DockerChain hn s) = withhost hn $ Docker.chain s
+	go _ (DockerInit hn) = Docker.init hn
 	go _ (GitPush fin fout) = gitPushHelper fin fout
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
@@ -97,27 +93,17 @@ defaultMain hostlist = do
 	go False cmdline@(SimpleRun hn) = buildFirst cmdline $
 		go False (Run hn)
 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
-		( onlyProcess $ withhost hn mainProperties
+		( onlyprocess $ withhost hn mainProperties
 		, go True (Spin hn)
 		)
 	go False (Update _) = do
 		forceConsole
-		onlyProcess update
+		onlyprocess update
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
 	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
-
-onlyProcess :: IO a -> IO a
-onlyProcess a = bracket lock unlock (const a)
-  where
-	lock = do
-		l <- createFile lockfile stdFileMode
-		setLock l (WriteLock, AbsoluteSeek, 0, 0)
-			`catchIO` const alreadyrunning
-		return l
-	unlock = closeFd
-	alreadyrunning = error "Propellor is already running on this host!"
-	lockfile = localdir </> ".lock"
+	
+	onlyprocess = onlyProcess (localdir </> ".lock")
 
 unknownhost :: HostName -> [Host] -> IO a
 unknownhost h hosts = errorMessage $ unlines
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index a3fc0f3..3fa9ffc 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -8,11 +8,15 @@ import Data.Monoid
 import Control.Applicative
 import System.Console.ANSI
 import "mtl" Control.Monad.Reader
+import Control.Exception (bracket)
+import System.PosixCompat
+import System.Posix.IO
 
 import Propellor.Types
 import Propellor.Message
 import Propellor.Exception
 import Propellor.Info
+import Utility.Exception
 
 runPropellor :: Host -> Propellor a -> IO a
 runPropellor host a = runReaderT (runWithHost a) host
@@ -47,3 +51,14 @@ fromHost l hn getter = case findHost l hn of
 	Nothing -> return Nothing
 	Just h -> liftIO $ Just <$>
 		runReaderT (runWithHost getter) h
+
+onlyProcess :: FilePath -> IO a -> IO a
+onlyProcess lockfile a = bracket lock unlock (const a)
+  where
+	lock = do
+		l <- createFile lockfile stdFileMode
+		setLock l (WriteLock, AbsoluteSeek, 0, 0)
+			`catchIO` const alreadyrunning
+		return l
+	unlock = closeFd
+	alreadyrunning = error "Propellor is already running on this host!"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 64276e8..7b559a5 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -33,10 +33,11 @@ module Propellor.Property.Docker (
 	restartOnFailure,
 	restartNever,
 	-- * Internal use
+	init,
 	chain,
 ) where
 
-import Propellor
+import Propellor hiding (init)
 import Propellor.Types.Info
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
@@ -48,7 +49,8 @@ import Utility.ThreadScheduler
 import Control.Concurrent.Async hiding (link)
 import System.Posix.Directory
 import System.Posix.Process
-import Data.List
+import Prelude hiding (init)
+import Data.List hiding (init)
 import Data.List.Utils
 import qualified Data.Set as S
 
@@ -391,7 +393,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 		liftIO $ writeFile (identFile cid) (show ident)
 		ensureProperty $ boolProperty "run" $ runContainer img
 			(runps ++ ["-i", "-d", "-t"])
-			[shim, "--continue", show (Docker (fromContainerId cid))]
+			[shim, "--continue", show (DockerInit (fromContainerId cid))]
 
 -- | Called when propellor is running inside a docker container.
 -- The string should be the container's ContainerId.
@@ -406,20 +408,20 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 -- again. So, to make the necessary services get started on boot, this needs
 -- to provision the container then. However, if the container is already
 -- being provisioned by the calling propellor, it would be redundant and
--- problimatic to also provisoon it here.
+-- problimatic to also provisoon it here, when not booting up.
 --
 -- The solution is a flag file. If the flag file exists, then the container
 -- was already provisioned. So, it must be a reboot, and time to provision
 -- again. If the flag file doesn't exist, don't provision here.
-chain :: String -> IO ()
-chain s = case toContainerId s of
+init :: String -> IO ()
+init s = case toContainerId s of
 	Nothing -> error $ "Invalid ContainerId: " ++ s
 	Just cid -> do
 		changeWorkingDirectory localdir
 		writeFile propellorIdent . show =<< readIdentFile cid
 		whenM (checkProvisionedFlag cid) $ do
 			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid)]) $
+			unlessM (boolSystem shim [Param "--continue", Param $ show $ DockerChain (containerHostName cid) (fromContainerId cid)]) $
 				warningMessage "Boot provision failed!"
 		void $ async $ job reapzombies
 		job $ do
@@ -437,7 +439,7 @@ chain s = case toContainerId s of
 provisionContainer :: ContainerId -> Property
 provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-	let params = ["--continue", show $ Chain (containerHostName cid)]
+	let params = ["--continue", show $ DockerChain (containerHostName cid) (fromContainerId cid)]
 	msgh <- mkMessageHandle
 	let p = inContainerProcess cid
 		[ if isConsole msgh then "-it" else "-i" ]
@@ -458,6 +460,13 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
 				hFlush stdout
 				processoutput (Just s) h
 
+chain :: String -> Host -> IO ()
+chain s h = case toContainerId s of
+	Just cid -> onlyProcess (provisioningLock cid) $ do
+		r <- runPropellor h $ ensureProperties $ hostProperties h
+		putStrLn $ "\n" ++ show r
+	Nothing -> error "bad container id"
+
 stopContainer :: ContainerId -> IO Bool
 stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
 
@@ -549,6 +558,9 @@ setProvisionedFlag cid = do
 checkProvisionedFlag :: ContainerId -> IO Bool
 checkProvisionedFlag = doesFileExist . provisionedFlag
 
+provisioningLock :: ContainerId -> FilePath
+provisioningLock cid = "docker" </> fromContainerId cid ++ ".lock"
+
 shimdir :: ContainerId -> FilePath
 shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
 
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 00da749..75b3c2a 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -145,8 +145,8 @@ data CmdLine
 	| ListFields
 	| AddKey String
 	| Continue CmdLine
-	| Chain HostName
 	| Update HostName
-	| Docker HostName
+	| DockerInit HostName
+	| DockerChain HostName String
 	| GitPush Fd Fd
 	deriving (Read, Show, Eq)

From 8e3d7dc49a140259742d68cf3498887aa3e18504 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:30:05 -0400
Subject: [PATCH 17/52] propellor spin


From 1872ee1ffcd757ea2a9e78b6392d14e9f1a8bc9b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:32:09 -0400
Subject: [PATCH 18/52] propellor spin

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

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 7b559a5..0fc7bee 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -462,9 +462,11 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
 
 chain :: String -> Host -> IO ()
 chain s h = case toContainerId s of
-	Just cid -> onlyProcess (provisioningLock cid) $ do
-		r <- runPropellor h $ ensureProperties $ hostProperties h
-		putStrLn $ "\n" ++ show r
+	Just cid -> do
+		changeWorkingDirectory localdir
+		onlyProcess (provisioningLock cid) $ do
+			r <- runPropellor h $ ensureProperties $ hostProperties h
+			putStrLn $ "\n" ++ show r
 	Nothing -> error "bad container id"
 
 stopContainer :: ContainerId -> IO Bool

From 624d8e84ebe71840ef6deefafa03fccd4e71658b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:32:51 -0400
Subject: [PATCH 19/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index a7f613d..98dac3e 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +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 hosts "simple-debian"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"

From 99234f016fcf93bd6b4de24abfe5c1471ca2c31d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:34:29 -0400
Subject: [PATCH 20/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index 98dac3e..a7f613d 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +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 hosts "simple-debian"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"

From f245ba6924d9a10ab1ab1b2bc95bde282b517cfc Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:35:17 -0400
Subject: [PATCH 21/52] propellor spin


From 3bfa43d03e7083a08736fd9580ec839365073604 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:36:10 -0400
Subject: [PATCH 22/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index a7f613d..98dac3e 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -53,7 +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 hosts "simple-debian"
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"

From 803e1407a086bca6014bbaeca238772364e859d6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:40:56 -0400
Subject: [PATCH 23/52] improve display

---
 src/Propellor/Property/Docker.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 0fc7bee..9640510 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -335,7 +335,7 @@ myContainerSuffix = ".propellor"
 containerDesc :: ContainerId -> Property -> Property
 containerDesc cid p = p `describe` desc
   where
-	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
+	desc = "container " ++ fromContainerId cid ++ " " ++ propertyDesc p
 
 runningContainer :: ContainerId -> Image -> [RunParam] -> Property
 runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do

From 409e20a69e91397d69be794367ddf3fc9be4ac57 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:41:50 -0400
Subject: [PATCH 24/52] big 1.0

---
 debian/changelog | 2 +-
 propellor.cabal  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index d29da29..e575ddd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-propellor (0.9.3) UNRELEASED; urgency=medium
+propellor (1.0.0) UNRELEASED; urgency=medium
 
   * propellor --spin can now be used to update remote hosts, without
     any central git repository needed. The central git repository is
diff --git a/propellor.cabal b/propellor.cabal
index d8a2ec4..9a1df40 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.9.3
+Version: 1.0.0
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <joey@kitenet.net>

From dd635e9fcd46b5d311c0e8f54ce56c9fbf47ecfe Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 01:58:35 -0400
Subject: [PATCH 25/52] update

---
 debian/changelog | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/debian/changelog b/debian/changelog
index e575ddd..0585246 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,7 +9,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium
   * Can be used to configure tor hidden services. Thanks, Félix Sipma.
   * When multiple gpg keys are added, ensure that the privdata file
     can be decrypted by all of them.
-  * Convert GpgKeyId to newtype.
+  * API: Convert GpgKeyId to newtype.
   * DigitalOcean.distroKernel property now reboots into the distribution
     kernel when necessary.
   * Avoid outputting color setting sequences when not run on a terminal.

From 5c34a575c835c061dc68025292e003786f60490e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 02:02:29 -0400
Subject: [PATCH 26/52] flag API changes

---
 debian/changelog | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 0585246..63adc6f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,7 +9,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium
   * Can be used to configure tor hidden services. Thanks, Félix Sipma.
   * When multiple gpg keys are added, ensure that the privdata file
     can be decrypted by all of them.
-  * API: Convert GpgKeyId to newtype.
+  * Convert GpgKeyId to newtype. (API change)
   * DigitalOcean.distroKernel property now reboots into the distribution
     kernel when necessary.
   * Avoid outputting color setting sequences when not run on a terminal.
@@ -33,7 +33,7 @@ propellor (0.9.1) unstable; urgency=medium
 
   * Docker: Add ability to control when containers restart.
   * Docker: Default to always restarting containers, so they come back 
-    up after reboots and docker daemon upgrades.
+    up after reboots and docker daemon upgrades. (API change)
   * Fix loop when a docker host that does not exist was docked.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 24 Oct 2014 09:57:31 -0400
@@ -46,7 +46,7 @@ propellor (0.9.0) unstable; urgency=medium
     Instead, the os property for a stable system includes the suite name
     to use, eg Stable "wheezy".
   * stdSourcesList uses the stable suite name, to avoid unwanted
-    immediate upgrades to the next stable release.
+    immediate upgrades to the next stable release. (API change)
   * debCdn switched from cdn.debian.net to http.debian.net, which seems to be
     better managed now.
   * Docker: Avoid committing container every time it's started up.
@@ -121,7 +121,7 @@ propellor (0.7.0) unstable; urgency=medium
   * combineProperties no longer stops when a property fails; now it continues
     trying to satisfy all properties on the list before propigating the
     failure.
-  * Attr is renamed to Info.
+  * Attr is renamed to Info. (API change)
   * Renamed wrapper to propellor to make cabal installation of propellor work.
   * When git gpg signature of a fetched git branch cannot be verified,
     propellor will now continue running, but without merging in that branch.
@@ -134,7 +134,7 @@ propellor (0.6.0) unstable; urgency=medium
     docked in. So if a docker container sets a DNS alias, every container
     it's docked in will automatically be added to a DNS round-robin,
     when propellor is used to manage DNS for the domain.
-  * Apt.stdSourcesList no longer needs a suite to be specified.
+  * Apt.stdSourcesList no longer needs a suite to be specified. (API change)
   * Added --dump to dump out a field of a host's privdata. Useful for editing
     it.
   * Propellor's output now includes the hostname being provisioned, or
@@ -177,7 +177,7 @@ propellor (0.5.1) unstable; urgency=medium
 propellor (0.5.0) unstable; urgency=medium
 
   * Removed root domain records from SOA. Instead, use RootDomain
-    when calling Dns.primary.
+    when calling Dns.primary. (API change)
   * Dns primary and secondary properties are now revertable.
   * When unattendedUpgrades is enabled on an Unstable or Testing system,
     configure it to allow the upgrades.
@@ -191,8 +191,9 @@ propellor (0.4.0) unstable; urgency=medium
     zone files, which is done by looking at the properties of hosts
     in a domain.
   * The `cname` property was renamed to `alias` as it does not always
-    generate CNAME in the DNS.
+    generate CNAME in the DNS. (API change)
   * Constructor of Property has changed (use `property` function instead).
+    (API change)
   * All Property combinators now combine together their Attr settings.
     So Attr settings can be made inside a propertyList, for example.
   * Run all cron jobs under chronic from moreutils to avoid unnecessary
@@ -228,7 +229,7 @@ propellor (0.3.0) unstable; urgency=medium
   * Include security updates in sources.list for stable and testing.
   * Use ssh connection caching, especially when bootstrapping.
   * Properties now run in a Propellor monad, which provides access to
-    attributes of the host.
+    attributes of the host. (API change)
 
  -- Joey Hess <joeyh@debian.org>  Fri, 11 Apr 2014 01:19:05 -0400
 

From 08242e29f6878cbf514bdf68a4a7276d514a6aba Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 18:57:58 -0400
Subject: [PATCH 27/52] add fallback combinator

---
 src/Propellor/Property.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 4b95731..9545979 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -89,6 +89,15 @@ check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
 	, return NoChange
 	)
 
+-- | Tries the first property, but if it fails to work, instead uses
+-- the second.
+fallback :: Property -> Property -> Property
+fallback p1 p2 = adjustProperty p1 $ \satisfy -> do
+	r <- satisfy
+	if r == FailedChange
+		then propertySatisfy p2
+		else return r
+
 -- | Marks a Property as trivial. It can only return FailedChange or
 -- NoChange. 
 --

From 4a9bbd1391b708d72a455cc00f698a80f1fd5fa5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 19:30:51 -0400
Subject: [PATCH 28/52] Added support for using debootstrap from propellor.

Most of the hard part was making it be able to install debootstrap from
source, for use on non-debian-derived systems.
---
 debian/changelog                      |   3 +-
 propellor.cabal                       |   1 +
 src/Propellor/Property.hs             |   4 +
 src/Propellor/Property/Debootstrap.hs | 218 ++++++++++++++++++++++++++
 4 files changed, 225 insertions(+), 1 deletion(-)
 create mode 100644 src/Propellor/Property/Debootstrap.hs

diff --git a/debian/changelog b/debian/changelog
index 63adc6f..0f4a06a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,8 +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.2.0.
+  * Added support for using debootstrap from propellor.
 
- -- Joey Hess <joeyh@debian.org>  Mon, 10 Nov 2014 11:15:27 -0400
+ -- Joey Hess <id@joeyh.name>  Mon, 10 Nov 2014 11:15:27 -0400
 
 propellor (0.9.2) unstable; urgency=medium
 
diff --git a/propellor.cabal b/propellor.cabal
index 9a1df40..161e477 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -75,6 +75,7 @@ Library
     Propellor.Property.Cmd
     Propellor.Property.Hostname
     Propellor.Property.Cron
+    Propellor.Property.Debootstrap
     Propellor.Property.Dns
     Propellor.Property.Docker
     Propellor.Property.File
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 9545979..7000b2a 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -131,6 +131,10 @@ boolProperty desc a = property desc $ ifM (liftIO a)
 revert :: RevertableProperty -> RevertableProperty
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 
+-- | Turns a revertable property into a regular property.
+unrevertable :: RevertableProperty -> Property
+unrevertable (RevertableProperty p1 _p2) = p1
+
 -- | Starts accumulating the properties of a Host.
 --
 -- > host "example.com"
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
new file mode 100644
index 0000000..8f93fe5
--- /dev/null
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -0,0 +1,218 @@
+module Propellor.Property.Debootstrap (
+	Url,
+	debootstrapped,
+	installed,
+	debootstrapPath,
+) where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import Utility.Path
+import Utility.SafeCommand
+import Utility.FileMode
+
+import Data.List
+import Data.Char
+import Control.Exception
+import System.Posix.Directory
+
+type Url = String
+
+-- | Builds a chroot in the given directory using debootstrap.
+--
+-- The System can be any OS and architecture that debootstrap
+-- and the kernel support.
+debootstrapped :: FilePath -> System -> [CommandParam] -> Property
+debootstrapped target system@(System _ arch) extraparams = 
+	check (unpopulated target) prop
+		`requires` unrevertable installed
+  where
+	unpopulated d = null <$> catchDefaultIO [] (dirContents d)
+
+	prop = property ("debootstrapped " ++ target) $ liftIO $ do
+		createDirectoryIfMissing True target
+		let suite = case extractSuite system of
+			Nothing -> error $ "don't know how to debootstrap " ++ show system
+			Just s -> s
+		let params = extraparams ++
+			[ Param suite
+			, Param target
+			, Param $ "--arch=" ++ arch
+			]
+		cmd <- fromMaybe "debootstrap" <$> debootstrapPath
+		ifM (boolSystem cmd params)
+			( do
+				fixForeignDev target
+				return MadeChange
+			, return FailedChange
+			)
+
+extractSuite :: System -> Maybe String
+extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
+extractSuite (System (Ubuntu r) _) = Just r
+
+-- | Ensures debootstrap is installed.
+--
+-- When necessary, falls back to installing debootstrap from source.
+-- Note that installation from source is done by downloading the tarball
+-- from a Debian mirror, with no cryptographic verification.
+installed :: RevertableProperty
+installed = RevertableProperty install remove
+  where
+	install = withOS "debootstrap installed" $ \o -> 
+		ifM (liftIO $ isJust <$> debootstrapPath)
+			( return NoChange
+			, ensureProperty (installon o)
+			)
+
+	installon (Just (System (Debian _) _)) = aptinstall
+	installon (Just (System (Ubuntu _) _)) = aptinstall
+	installon _ = sourceInstall
+
+	remove = withOS "debootstrap removed" $ ensureProperty . removefrom
+	removefrom (Just (System (Debian _) _)) = aptremove
+	removefrom (Just (System (Ubuntu _) _)) = aptremove
+	removefrom _ = sourceRemove
+			
+	aptinstall = Apt.installed ["debootstrap"]
+	aptremove = Apt.removed ["debootstrap"]
+
+sourceInstall :: Property
+sourceInstall = property "debootstrap installed from source"
+	(liftIO sourceInstall')
+
+sourceInstall' :: IO Result
+sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
+	let indexfile = tmpd </> "index.html"
+	unlessM (download baseurl indexfile) $
+		error $ "Failed to download " ++ baseurl
+	urls <- reverse . sort -- highest version first
+		. filter ("debootstrap_" `isInfixOf`)
+		. filter (".tar." `isInfixOf`)
+		. extractUrls baseurl <$>
+		readFileStrictAnyEncoding indexfile
+	nukeFile indexfile
+
+	tarfile <- case urls of
+		(tarurl:_) -> do
+			let f = tmpd </> takeFileName tarurl
+			unlessM (download tarurl f) $
+				error $ "Failed to download " ++ tarurl
+			return f
+		_ -> error $ "Failed to find any debootstrap tarballs listed on " ++ baseurl
+
+	createDirectoryIfMissing True localInstallDir
+	bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
+		changeWorkingDirectory localInstallDir
+		unlessM (boolSystem "tar" [Param "xf", File tarfile]) $
+			error "Failed to extract debootstrap tar file"
+		nukeFile tarfile
+		l <- dirContents "."
+		case l of
+			(subdir:[]) -> do
+				changeWorkingDirectory subdir
+				makeDevicesTarball
+				makeWrapperScript (localInstallDir </> subdir)
+				return MadeChange
+			_ -> error "debootstrap tar file did not contain exactly one dirctory"
+
+sourceRemove :: Property
+sourceRemove = property "debootstrap not installed from source" $ liftIO $
+	ifM (doesDirectoryExist sourceInstallDir)
+		( do
+			removeDirectoryRecursive sourceInstallDir
+			return MadeChange
+		, return NoChange
+		)
+
+sourceInstallDir :: FilePath
+sourceInstallDir = "/usr/local/propellor/debootstrap"
+
+wrapperScript :: FilePath
+wrapperScript = sourceInstallDir </> "debootstrap.wrapper"
+
+-- | Finds debootstrap in PATH, but fall back to looking for the
+-- wrapper script that is installed, outside the PATH, when debootstrap
+-- is installed from source.
+debootstrapPath :: IO (Maybe FilePath)
+debootstrapPath = getM searchPath
+	[ "debootstrap"
+	, wrapperScript
+	]
+
+makeWrapperScript :: FilePath -> IO ()
+makeWrapperScript dir = do
+	createDirectoryIfMissing True (takeDirectory wrapperScript)
+	writeFile wrapperScript $ unlines
+		[ "#!/bin/sh"
+		, "set -e"
+		, "DEBOOTSTRAP_DIR=" ++ dir
+		, "export DEBOOTSTRAP_DIR"
+		, dir </> "debootstrap" ++ " \"$@\""
+		]
+	modifyFileMode wrapperScript (addModes $ readModes ++ executeModes)
+
+-- Work around for http://bugs.debian.org/770217
+makeDevicesTarball :: IO ()
+makeDevicesTarball = do
+	-- TODO append to tarball; avoid writing to /dev
+	writeFile foreignDevFlag "1"
+	ok <- boolSystem "sh" [Param "-c", Param tarcmd]
+	nukeFile foreignDevFlag
+	unless ok $
+		error "Failed to tar up /dev to generate devices.tar.gz"
+  where
+	tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz"
+
+fixForeignDev :: FilePath -> IO ()
+fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ 
+	void $ boolSystem "chroot"
+		[ File target
+		, Param "sh"
+		, Param "-c"
+		, Param $ intercalate " && "
+			[ "rm -rf /dev"
+			, "mkdir /dev"
+			, "cd /dev"
+			, "/sbin/MAKEDEV std ptmx fd consoleonly"
+			]
+		]
+
+foreignDevFlag :: FilePath
+foreignDevFlag = "/dev/.propellor-foreign-dev"
+
+localInstallDir :: FilePath
+localInstallDir = "/usr/local/debootstrap"
+
+-- This http server directory listing is relied on to be fairly sane,
+-- which is one reason why it's using a specific server and not a
+-- round-robin address.
+baseurl :: Url
+baseurl = "http://ftp.debian.org/debian/pool/main/d/debootstrap/"
+
+download :: Url -> FilePath -> IO Bool
+download url dest = anyM id
+	[ boolSystem "curl" [Param "-o", File dest, Param url]
+	, boolSystem "wget" [Param "-O", File dest, Param url]
+	]
+
+-- Pretty hackish, but I don't want to pull in a whole html parser
+-- or parsec dependency just for this.
+--
+-- To simplify parsing, lower case everything. This is ok because
+-- the filenames are all lower-case anyway.
+extractUrls :: Url -> String -> [Url]
+extractUrls base = collect [] . map toLower
+  where
+	collect l [] = l
+	collect l ('h':'r':'e':'f':'=':r) = case r of
+		('"':r') -> findend l r'
+		_ -> findend l r
+	collect l (_:cs) = collect l cs
+
+	findend l s = 
+		let (u, r) = break (== '"') s
+		    u' = if "http" `isPrefixOf` u
+		    	then u
+			else base </> u
+		in collect (u':l) r

From caeed5492fa3c66668d750a79ea5886248c6bd07 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 20:35:33 -0400
Subject: [PATCH 29/52] allow debootstrapped to be reverted

---
 src/Propellor/Property/Debootstrap.hs | 33 +++++++++++++++++++++++----
 1 file changed, 28 insertions(+), 5 deletions(-)

diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 8f93fe5..876c12c 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -22,14 +22,24 @@ type Url = String
 --
 -- The System can be any OS and architecture that debootstrap
 -- and the kernel support.
-debootstrapped :: FilePath -> System -> [CommandParam] -> Property
-debootstrapped target system@(System _ arch) extraparams = 
-	check (unpopulated target) prop
-		`requires` unrevertable installed
+--
+-- Reverting this property deletes the chroot and all its contents.
+-- Anything mounted under the filesystem is first unmounted.
+--
+-- Note that reverting this property does not stop any processes
+-- currently running in the chroot.
+debootstrapped :: FilePath -> System -> [CommandParam] -> RevertableProperty
+debootstrapped target system@(System _ arch) extraparams =
+	RevertableProperty setup teardown
   where
+	setup = check (unpopulated target) setupprop
+		`requires` unrevertable installed
+	
+	teardown = check (not <$> unpopulated target) teardownprop
+	
 	unpopulated d = null <$> catchDefaultIO [] (dirContents d)
 
-	prop = property ("debootstrapped " ++ target) $ liftIO $ do
+	setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
 		createDirectoryIfMissing True target
 		let suite = case extractSuite system of
 			Nothing -> error $ "don't know how to debootstrap " ++ show system
@@ -47,6 +57,19 @@ debootstrapped target system@(System _ arch) extraparams =
 			, return FailedChange
 			)
 
+	teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do
+		submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
+			. filter (dirContains target)
+			<$> mountPoints
+		forM_ submnts $ \mnt ->
+			unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
+				error $ "failed unmounting " ++ mnt
+		removeDirectoryRecursive target
+		return MadeChange
+
+mountPoints :: IO [FilePath]
+mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
+
 extractSuite :: System -> Maybe String
 extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
 extractSuite (System (Ubuntu r) _) = Just r

From c186f9f4a858edfe0f2211e71da07715bd2e99b7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 20:41:35 -0400
Subject: [PATCH 30/52] propellor spin

---
 config-joey.hs                        |  3 +++
 src/Propellor/Property/Debootstrap.hs | 16 ++++++++--------
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index 98dac3e..fad37b0 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -24,6 +24,7 @@ import qualified Propellor.Property.Postfix as Postfix
 import qualified Propellor.Property.Grub as Grub
 import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Gpg as Gpg
+import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean
 import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost
 import qualified Propellor.Property.HostingProvider.Linode as Linode
@@ -79,6 +80,8 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	& alias "travelling.kitenet.net"
 	! Ssh.listenPort 80
 	! Ssh.listenPort 443
+
+	& Debootstrap.built "/tmp/chroot" (System (Debian Unstable) "amd64") []
 	
 orca :: Host
 orca = standardSystem "orca.kitenet.net" Unstable "amd64"
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 876c12c..70a0dd9 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,8 +1,8 @@
 module Propellor.Property.Debootstrap (
 	Url,
-	debootstrapped,
+	built,
 	installed,
-	debootstrapPath,
+	programPath,
 ) where
 
 import Propellor
@@ -28,8 +28,8 @@ type Url = String
 --
 -- Note that reverting this property does not stop any processes
 -- currently running in the chroot.
-debootstrapped :: FilePath -> System -> [CommandParam] -> RevertableProperty
-debootstrapped target system@(System _ arch) extraparams =
+built :: FilePath -> System -> [CommandParam] -> RevertableProperty
+built target system@(System _ arch) extraparams =
 	RevertableProperty setup teardown
   where
 	setup = check (unpopulated target) setupprop
@@ -49,7 +49,7 @@ debootstrapped target system@(System _ arch) extraparams =
 			, Param target
 			, Param $ "--arch=" ++ arch
 			]
-		cmd <- fromMaybe "debootstrap" <$> debootstrapPath
+		cmd <- fromMaybe "debootstrap" <$> programPath
 		ifM (boolSystem cmd params)
 			( do
 				fixForeignDev target
@@ -83,7 +83,7 @@ installed :: RevertableProperty
 installed = RevertableProperty install remove
   where
 	install = withOS "debootstrap installed" $ \o -> 
-		ifM (liftIO $ isJust <$> debootstrapPath)
+		ifM (liftIO $ isJust <$> programPath)
 			( return NoChange
 			, ensureProperty (installon o)
 			)
@@ -157,8 +157,8 @@ wrapperScript = sourceInstallDir </> "debootstrap.wrapper"
 -- | Finds debootstrap in PATH, but fall back to looking for the
 -- wrapper script that is installed, outside the PATH, when debootstrap
 -- is installed from source.
-debootstrapPath :: IO (Maybe FilePath)
-debootstrapPath = getM searchPath
+programPath :: IO (Maybe FilePath)
+programPath = getM searchPath
 	[ "debootstrap"
 	, wrapperScript
 	]

From 36d4938a19dc353cb3af9e5c73d3e2f6e176d185 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 20:48:36 -0400
Subject: [PATCH 31/52] remove excess verbosity from message

---
 src/Propellor/CmdLine.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index d9a95de..725bae4 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -176,7 +176,7 @@ spin hn hst = do
 
 	-- And now we can run it.
 	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
-		error $ "remote propellor failed (running: " ++ runcmd ++")"
+		error $ "remote propellor failed"
   where
 	user = "root@"++hn
 

From 2ceace6bd56c51edc0a534d3b692c78664b58b58 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 20:50:26 -0400
Subject: [PATCH 32/52] propellor spin


From 025c7c4b8e0b7aa3ba3ff8c077c5fbef3c8fa63d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:00:14 -0400
Subject: [PATCH 33/52] avoid double-build in --spin

It was fetching from the central repo, then building that, and then running
the client-to-client git update, and the building after that.

Remove the first build, as all that linking does take time.
---
 src/Propellor/CmdLine.hs | 40 +++++++++++++---------------------------
 src/Propellor/Git.hs     | 22 ++++++++++++++++++++++
 2 files changed, 35 insertions(+), 27 deletions(-)

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 725bae4..e42e240 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -87,6 +87,7 @@ defaultMain hostlist = do
 	go _ (DockerChain hn s) = withhost hn $ Docker.chain s
 	go _ (DockerInit hn) = Docker.init hn
 	go _ (GitPush fin fout) = gitPushHelper fin fout
+	go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update)
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
 	go False (Spin hn) = withhost hn $ spin hn
@@ -96,9 +97,6 @@ defaultMain hostlist = do
 		( onlyprocess $ withhost hn mainProperties
 		, go True (Spin hn)
 		)
-	go False (Update _) = do
-		forceConsole
-		onlyprocess update
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
 	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
@@ -127,35 +125,23 @@ buildFirst cmdline next = do
   where
 	getmtime = catchMaybeIO $ getModificationTime "propellor"
 
+fetchFirst :: IO () -> IO ()
+fetchFirst next = do
+	whenM hasOrigin $
+		void fetchOrigin
+	next
+
 updateFirst :: CmdLine -> IO () -> IO ()
 updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next)
 
 updateFirst' :: CmdLine -> IO () -> IO ()
-updateFirst' cmdline next = do
-	branchref <- getCurrentBranch
-	let originbranch = "origin" </> branchref
-
-	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
-	
-	oldsha <- getCurrentGitSha1 branchref
-	
-	whenM (doesFileExist keyring) $
-		ifM (verifyOriginBranch originbranch)
-			( do
-				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
-				hFlush stdout
-				void $ boolSystem "git" [Param "merge", Param originbranch]
-			, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
-			)
-	
-	newsha <- getCurrentGitSha1 branchref
-
-	if oldsha == newsha
-		then next
-		else ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
-			( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
+updateFirst' cmdline next = ifM fetchOrigin
+	( ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
+		( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
 			, errorMessage "Propellor build failed!" 
-			)
+		)
+	, next
+	)
 
 spin :: HostName -> Host -> IO ()
 spin hn hst = do
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 51ed3df..88d5c3a 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -62,3 +62,25 @@ verifyOriginBranch originbranch = do
 	nukeFile $ privDataDir </> "pubring.gpg"
 	nukeFile $ privDataDir </> "gpg.conf"
 	return (s == "U\n" || s == "G\n")
+
+-- Returns True if HEAD is changed by fetching and merging from origin.
+fetchOrigin :: IO Bool
+fetchOrigin = do
+	branchref <- getCurrentBranch
+	let originbranch = "origin" </> branchref
+
+	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
+	
+	oldsha <- getCurrentGitSha1 branchref
+	
+	whenM (doesFileExist keyring) $
+		ifM (verifyOriginBranch originbranch)
+			( do
+				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
+				hFlush stdout
+				void $ boolSystem "git" [Param "merge", Param originbranch]
+			, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
+			)
+	
+	newsha <- getCurrentGitSha1 branchref
+	return $ oldsha /= newsha

From 4de7d4295c91b07b1338db2114b9557b5353a978 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:03:06 -0400
Subject: [PATCH 34/52] propellor spin

---
 src/Propellor/Property/Debootstrap.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 70a0dd9..23dabcf 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -41,9 +41,9 @@ built target system@(System _ arch) extraparams =
 
 	setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
 		createDirectoryIfMissing True target
-		let suite = case extractSuite system of
-			Nothing -> error $ "don't know how to debootstrap " ++ show system
-			Just s -> s
+		suite <- case extractSuite system of
+			Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
+			Just s -> pure s
 		let params = extraparams ++
 			[ Param suite
 			, Param target
@@ -63,7 +63,7 @@ built target system@(System _ arch) extraparams =
 			<$> mountPoints
 		forM_ submnts $ \mnt ->
 			unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
-				error $ "failed unmounting " ++ mnt
+				errorMessage $ "failed unmounting " ++ mnt
 		removeDirectoryRecursive target
 		return MadeChange
 
@@ -108,7 +108,7 @@ sourceInstall' :: IO Result
 sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
 	let indexfile = tmpd </> "index.html"
 	unlessM (download baseurl indexfile) $
-		error $ "Failed to download " ++ baseurl
+		errorMessage $ "Failed to download " ++ baseurl
 	urls <- reverse . sort -- highest version first
 		. filter ("debootstrap_" `isInfixOf`)
 		. filter (".tar." `isInfixOf`)
@@ -120,15 +120,15 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
 		(tarurl:_) -> do
 			let f = tmpd </> takeFileName tarurl
 			unlessM (download tarurl f) $
-				error $ "Failed to download " ++ tarurl
+				errorMessage $ "Failed to download " ++ tarurl
 			return f
-		_ -> error $ "Failed to find any debootstrap tarballs listed on " ++ baseurl
+		_ -> errorMessage $ "Failed to find any debootstrap tarballs listed on " ++ baseurl
 
 	createDirectoryIfMissing True localInstallDir
 	bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
 		changeWorkingDirectory localInstallDir
 		unlessM (boolSystem "tar" [Param "xf", File tarfile]) $
-			error "Failed to extract debootstrap tar file"
+			errorMessage "Failed to extract debootstrap tar file"
 		nukeFile tarfile
 		l <- dirContents "."
 		case l of
@@ -137,7 +137,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
 				makeDevicesTarball
 				makeWrapperScript (localInstallDir </> subdir)
 				return MadeChange
-			_ -> error "debootstrap tar file did not contain exactly one dirctory"
+			_ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
 
 sourceRemove :: Property
 sourceRemove = property "debootstrap not installed from source" $ liftIO $
@@ -183,7 +183,7 @@ makeDevicesTarball = do
 	ok <- boolSystem "sh" [Param "-c", Param tarcmd]
 	nukeFile foreignDevFlag
 	unless ok $
-		error "Failed to tar up /dev to generate devices.tar.gz"
+		errorMessage "Failed to tar up /dev to generate devices.tar.gz"
   where
 	tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz"
 

From 205d1925598f986dd4ce679e17e487c089592ff3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:16:18 -0400
Subject: [PATCH 35/52] fix param order

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

diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 23dabcf..ed851d9 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -45,9 +45,9 @@ built target system@(System _ arch) extraparams =
 			Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
 			Just s -> pure s
 		let params = extraparams ++
-			[ Param suite
+			[ Param $ "--arch=" ++ arch
+			, Param suite
 			, Param target
-			, Param $ "--arch=" ++ arch
 			]
 		cmd <- fromMaybe "debootstrap" <$> programPath
 		ifM (boolSystem cmd params)

From b136609cb5adb48a994ec81df0b91d98e73c1be6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:20:19 -0400
Subject: [PATCH 36/52] unicode ahoy

---
 src/Propellor/Message.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index a1e510a..a5d4d2c 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -59,6 +59,7 @@ actionMessage' mhn desc a = do
 	liftIO $ do
 		whenConsole h $
 			setTitle "propellor: running"
+		putStr propellorSigel
 		showhn h mhn
 		putStr $ desc ++ " ... "
 		let (msg, intensity, color) = getActionResult r
@@ -78,12 +79,12 @@ actionMessage' mhn desc a = do
 warningMessage :: MonadIO m => String -> m ()
 warningMessage s = liftIO $ do
 	h <- mkMessageHandle
-	colorLine h Vivid Magenta $ "** warning: " ++ s
+	colorLine h Vivid Magenta $ propellorSigel ++ "** warning: " ++ s
 
 errorMessage :: MonadIO m => String -> m a
 errorMessage s = liftIO $ do
 	h <- mkMessageHandle
-	colorLine h Vivid Red $ "** error: " ++ s
+	colorLine h Vivid Red $ propellorSigel ++ "** error: " ++ s
 	error "Cannot continue!"
 
 colorLine :: MessageHandle -> ColorIntensity -> Color -> String -> IO ()
@@ -112,3 +113,7 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 		updateGlobalLogger rootLoggerName $ 
 			setLevel DEBUG .  setHandlers [f]
 	go _ = noop
+
+-- Unicode propellor.
+propellorSigel :: String
+propellorSigel = "ꕤ "

From 3343b220a8381fb356926c458e66874bc540abcd Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:21:20 -0400
Subject: [PATCH 37/52] propellor spin

---
 src/Propellor/Property/Debootstrap.hs | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index ed851d9..4e7bc74 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -32,7 +32,7 @@ built :: FilePath -> System -> [CommandParam] -> RevertableProperty
 built target system@(System _ arch) extraparams =
 	RevertableProperty setup teardown
   where
-	setup = check (unpopulated target) setupprop
+	setup = check (unpopulated target <||> ispartial) setupprop
 		`requires` unrevertable installed
 	
 	teardown = check (not <$> unpopulated target) teardownprop
@@ -58,6 +58,10 @@ built target system@(System _ arch) extraparams =
 			)
 
 	teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do
+		removetarget
+		return MadeChange
+
+	removetarget = do
 		submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
 			. filter (dirContains target)
 			<$> mountPoints
@@ -65,7 +69,15 @@ built target system@(System _ arch) extraparams =
 			unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
 				errorMessage $ "failed unmounting " ++ mnt
 		removeDirectoryRecursive target
-		return MadeChange
+
+	-- A failed debootstrap run will leave a debootstrap directory;
+	-- recover by deleting it and trying again.
+	ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
+		( do
+			removetarget
+			return True
+		, return False
+		)
 
 mountPoints :: IO [FilePath]
 mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]

From 41b10a956a8706724ab6503e43c8dddb5821ba9d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:25:55 -0400
Subject: [PATCH 38/52] correct version

---
 debian/changelog | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/debian/changelog b/debian/changelog
index 0f4a06a..83958a1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,7 +14,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium
     kernel when necessary.
   * 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.2.0.
+  * Docker code simplified by using `docker exec`; needs docker 1.3.1.
   * Added support for using debootstrap from propellor.
 
  -- Joey Hess <id@joeyh.name>  Mon, 10 Nov 2014 11:15:27 -0400

From c181ece029b9ea8813ac649daca5003694a37fed Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:28:30 -0400
Subject: [PATCH 39/52] propellor spin

---
 config-joey.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config-joey.hs b/config-joey.hs
index fad37b0..2866e79 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -81,7 +81,7 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64"
 	! Ssh.listenPort 80
 	! Ssh.listenPort 443
 
-	& Debootstrap.built "/tmp/chroot" (System (Debian Unstable) "amd64") []
+	! Debootstrap.built "/tmp/chroot" (System (Debian Unstable) "amd64") []
 	
 orca :: Host
 orca = standardSystem "orca.kitenet.net" Unstable "amd64"

From d38037682584313fff39650bd8e8004c713be66b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:34:11 -0400
Subject: [PATCH 40/52] propellor spin


From d130e7e628568be9593474fbe5601239c6ce8a2e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:48:48 -0400
Subject: [PATCH 41/52] propellor spin

---
 src/Propellor/Git.hs     |  3 ++-
 src/Propellor/Message.hs | 11 +++++++----
 src/Propellor/Server.hs  |  2 +-
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 88d5c3a..73de1de 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -69,7 +69,8 @@ fetchOrigin = do
 	branchref <- getCurrentBranch
 	let originbranch = "origin" </> branchref
 
-	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
+	void $ actionMessage "Pull from central git repository" $
+		boolSystem "git" [Param "fetch"]
 	
 	oldsha <- getCurrentGitSha1 branchref
 	
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index a5d4d2c..244913e 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -15,16 +15,19 @@ import Control.Applicative
 import Propellor.Types
 import Utility.Monad
 import Utility.Env
+import Utility.FileSystemEncoding
 
 data MessageHandle
 	= ConsoleMessageHandle
 	| TextMessageHandle
 
 mkMessageHandle :: IO MessageHandle
-mkMessageHandle = ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "PROPELLOR_CONSOLE"))
-	( return ConsoleMessageHandle
-	, return TextMessageHandle
-	)
+mkMessageHandle = do
+	fileEncoding stdout
+	ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "PROPELLOR_CONSOLE"))
+		( return ConsoleMessageHandle
+		, return TextMessageHandle
+		)
 
 forceConsole :: IO ()
 forceConsole = void $ setEnv "PROPELLOR_CONSOLE" "1" True
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index 182cc2b..513a81f 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -20,7 +20,7 @@ import Utility.FileMode
 import Utility.SafeCommand
 
 -- Update the privdata, repo url, and git repo over the ssh
--- connection, talking the the user's local propellor instance which is
+-- connection, talking to the user's local propellor instance which is
 -- running the updateServer
 update :: IO ()
 update = do

From 7c11d6801865a75af98dff0209b09a642d813411 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:50:49 -0400
Subject: [PATCH 42/52] propellor spin

---
 src/Propellor/Message.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 244913e..7e38654 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -15,7 +15,6 @@ import Control.Applicative
 import Propellor.Types
 import Utility.Monad
 import Utility.Env
-import Utility.FileSystemEncoding
 
 data MessageHandle
 	= ConsoleMessageHandle
@@ -23,7 +22,6 @@ data MessageHandle
 
 mkMessageHandle :: IO MessageHandle
 mkMessageHandle = do
-	fileEncoding stdout
 	ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "PROPELLOR_CONSOLE"))
 		( return ConsoleMessageHandle
 		, return TextMessageHandle
@@ -117,6 +115,5 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 			setLevel DEBUG .  setHandlers [f]
 	go _ = noop
 
--- Unicode propellor.
 propellorSigel :: String
-propellorSigel = "ꕤ "
+propellorSigel = "* "

From b7d78e679ab94a93732f48f4446c1b55bf3dae32 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 21:51:52 -0400
Subject: [PATCH 43/52] sigel didn't work out

Unicode output failed in docker, due to no locales, and would be generally
shakey from haskell in all the environments propellor needs to run in.
---
 src/Propellor/Message.hs | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index 7e38654..09a9253 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -60,7 +60,6 @@ actionMessage' mhn desc a = do
 	liftIO $ do
 		whenConsole h $
 			setTitle "propellor: running"
-		putStr propellorSigel
 		showhn h mhn
 		putStr $ desc ++ " ... "
 		let (msg, intensity, color) = getActionResult r
@@ -80,12 +79,12 @@ actionMessage' mhn desc a = do
 warningMessage :: MonadIO m => String -> m ()
 warningMessage s = liftIO $ do
 	h <- mkMessageHandle
-	colorLine h Vivid Magenta $ propellorSigel ++ "** warning: " ++ s
+	colorLine h Vivid Magenta $ "** warning: " ++ s
 
 errorMessage :: MonadIO m => String -> m a
 errorMessage s = liftIO $ do
 	h <- mkMessageHandle
-	colorLine h Vivid Red $ propellorSigel ++ "** error: " ++ s
+	colorLine h Vivid Red $ "** error: " ++ s
 	error "Cannot continue!"
 
 colorLine :: MessageHandle -> ColorIntensity -> Color -> String -> IO ()
@@ -114,6 +113,3 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 		updateGlobalLogger rootLoggerName $ 
 			setLevel DEBUG .  setHandlers [f]
 	go _ = noop
-
-propellorSigel :: String
-propellorSigel = "* "

From d49d2518979c7b985af8f00741f2a91bcd511024 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 23:11:34 -0400
Subject: [PATCH 44/52] separate docker container type

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)
---
 config-joey.hs                                | 103 ++++++++----------
 config-simple.hs                              |  19 ++--
 debian/changelog                              |   3 +
 src/Propellor/Property.hs                     |  31 +++---
 src/Propellor/Property/Docker.hs              |  63 +++++------
 .../Property/SiteSpecific/GitAnnexBuilder.hs  |  10 +-
 src/Propellor/Types/Info.hs                   |  14 +--
 7 files changed, 112 insertions(+), 131 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index 2866e79..d6f174d 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"
+-- 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.
-	, standardStableContainer "openid-provider"
-		& alias "openid.kitenet.net"
-		& Docker.publish "8081:80"
-		& OpenId.providerFor ["joey", "liw"]
-			"openid.kitenet.net:8081"
+-- 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.
-	, 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
+-- 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")
 
-	, Docker.container "simple-debian" "debian"
-		& "/hello" `File.containsLine` "hello"
-		& Docker.publish "8081:80"
+oldusenetShellBox :: Docker.Container
+oldusenetShellBox = standardStableContainer "oldusenet-shellbox"
+	& alias "shell.olduse.net"
+	& Docker.publish "4200:4200"
+	& JoeySites.oldUseNetShellBox
 
-	-- 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)
-	]
+-- 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 dcdc51a..fb02e27 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 83958a1..155d512 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 7000b2a..bf69ff6 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)
+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
 
-infixl 1 &
+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 9640510..ce9fb7d 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 901eba2..0208dea 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 de072aa..6aba1f9 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))
 		]

From e1505b05b61c4d12b194411b9af13021d5e06f12 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 23:11:53 -0400
Subject: [PATCH 45/52] propellor spin


From 9d6bc4a7bf54a57755a6fbbd29879d82b99ba952 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Nov 2014 23:26:53 -0400
Subject: [PATCH 46/52] foo


From 5e4c57652cef29d9729dce22da3f98dc909b3ff2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:21:40 -0400
Subject: [PATCH 47/52] fix docker container provisioning

Since the containers are no longer on the host list, they were not found
while provisioning, oops.

To fix, had to add to a host's info a map of the containers docked to it.

Unfortunately, that required Propellor.Types.Info be glommed into
Propellor.Types, since it needed to refer to Host.
---
 propellor.cabal                  |  1 -
 src/Propellor/CmdLine.hs         |  2 +-
 src/Propellor/Info.hs            |  1 -
 src/Propellor/PrivData.hs        |  1 -
 src/Propellor/Property/Dns.hs    |  1 -
 src/Propellor/Property/Docker.hs | 54 +++++++++++++-----------
 src/Propellor/Types.hs           | 71 +++++++++++++++++++++++++++++++-
 src/Propellor/Types/Info.hs      | 66 -----------------------------
 8 files changed, 101 insertions(+), 96 deletions(-)
 delete mode 100644 src/Propellor/Types/Info.hs

diff --git a/propellor.cabal b/propellor.cabal
index 161e477..38e3da2 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -113,7 +113,6 @@ Library
     Propellor.Types.Dns
     Propellor.Types.PrivData
   Other-Modules:
-    Propellor.Types.Info
     Propellor.Git
     Propellor.Gpg
     Propellor.Server
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index e42e240..8b958a7 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -84,7 +84,7 @@ defaultMain hostlist = do
 	go _ (Edit field context) = editPrivData field context
 	go _ ListFields = listPrivDataFields hostlist
 	go _ (AddKey keyid) = addKey keyid
-	go _ (DockerChain hn s) = withhost hn $ Docker.chain s
+	go _ (DockerChain hn cid) = Docker.chain hostlist hn cid
 	go _ (DockerInit hn) = Docker.init hn
 	go _ (GitPush fin fout) = gitPushHelper fin fout
 	go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update)
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index f44d1de..a91f69c 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -3,7 +3,6 @@
 module Propellor.Info where
 
 import Propellor.Types
-import Propellor.Types.Info
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index a515043..c5f489e 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -15,7 +15,6 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 
 import Propellor.Types
-import Propellor.Types.Info
 import Propellor.Message
 import Propellor.Info
 import Propellor.Gpg
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 135c765..f351804 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -15,7 +15,6 @@ module Propellor.Property.Dns (
 import Propellor
 import Propellor.Types.Dns
 import Propellor.Property.File
-import Propellor.Types.Info
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 import Utility.Applicative
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index ce9fb7d..676d323 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -39,7 +39,6 @@ module Propellor.Property.Docker (
 ) where
 
 import Propellor hiding (init)
-import Propellor.Types.Info
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Docker.Shim as Shim
@@ -54,6 +53,7 @@ import Prelude hiding (init)
 import Data.List hiding (init)
 import Data.List.Utils
 import qualified Data.Set as S
+import qualified Data.Map as M
 
 installed :: Property
 installed = Apt.installed ["docker.io"]
@@ -86,13 +86,9 @@ instance Hostlike Container where
 -- >    & Apt.installed {"apache2"]
 -- >    & ...
 container :: ContainerName -> Image -> Container
-container cn image = Container image (Host hn [] info)
+container cn image = Container image (Host cn [] info)
   where
 	info = dockerInfo mempty
-	hn = cn2hn cn
-
-cn2hn :: ContainerName -> HostName
-cn2hn cn = cn ++ ".docker"
 
 -- | Ensures that a docker container is set up and running.
 -- 
@@ -108,7 +104,7 @@ docked
 	:: Container
 	-> RevertableProperty
 docked ctr@(Container _ h) = RevertableProperty
-	(propigateInfo h (go "docked" setup))
+	(propigateInfo ctr (go "docked" setup))
 	(go "undocked" teardown)
   where
 	cn = hostName h
@@ -135,10 +131,12 @@ docked ctr@(Container _ h) = RevertableProperty
 					]
 			]
 
-propigateInfo :: Host -> Property -> Property
-propigateInfo (Host _ _ containerinfo) p =
-	combineProperties (propertyDesc p) $ p : dnsprops ++ privprops
+propigateInfo :: Container -> Property -> Property
+propigateInfo (Container _ h@(Host hn _ containerinfo)) p =
+	combineProperties (propertyDesc p) $ p' : dnsprops ++ privprops
   where
+	p' = p { propertyInfo = propertyInfo p <> dockerinfo }
+	dockerinfo = dockerInfo $ mempty { _dockerContainers = M.singleton hn h }
 	dnsprops = map addDNS (S.toList $ _dns containerinfo)
 	privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
 
@@ -146,7 +144,8 @@ mkContainerInfo :: ContainerId -> Container -> ContainerInfo
 mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = 
 	ContainerInfo img runparams
   where
-	runparams = map (\mkparam -> mkparam hn) (_dockerRunParams info)
+	runparams = map (\(DockerRunParam mkparam) -> mkparam hn)
+		(_dockerRunParams info)
 	info = _dockerinfo $ hostInfo h'
 	h' = h
 		-- Restart by default so container comes up on
@@ -294,7 +293,10 @@ restartNever = runProp "restart" "no"
 
 -- | A container is identified by its name, and the host
 -- on which it's deployed.
-data ContainerId = ContainerId HostName ContainerName
+data ContainerId = ContainerId 
+	{ containerHostName :: HostName
+	, containerName :: ContainerName
+	}
 	deriving (Eq, Read, Show)
 
 -- | Two containers with the same ContainerIdent were started from
@@ -317,9 +319,6 @@ toContainerId s
 fromContainerId :: ContainerId -> String
 fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
 
-containerHostName :: ContainerId -> HostName
-containerHostName (ContainerId _ cn) = cn2hn cn
-
 myContainerSuffix :: String
 myContainerSuffix = ".propellor"
 
@@ -412,7 +411,7 @@ init s = case toContainerId s of
 		writeFile propellorIdent . show =<< readIdentFile cid
 		whenM (checkProvisionedFlag cid) $ do
 			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-			unlessM (boolSystem shim [Param "--continue", Param $ show $ DockerChain (containerHostName cid) (fromContainerId cid)]) $
+			unlessM (boolSystem shim [Param "--continue", Param $ show $ toChain cid]) $
 				warningMessage "Boot provision failed!"
 		void $ async $ job reapzombies
 		job $ do
@@ -430,7 +429,7 @@ init s = case toContainerId s of
 provisionContainer :: ContainerId -> Property
 provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-	let params = ["--continue", show $ DockerChain (containerHostName cid) (fromContainerId cid)]
+	let params = ["--continue", show $ toChain cid]
 	msgh <- mkMessageHandle
 	let p = inContainerProcess cid
 		[ if isConsole msgh then "-it" else "-i" ]
@@ -451,14 +450,23 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
 				hFlush stdout
 				processoutput (Just s) h
 
-chain :: String -> Host -> IO ()
-chain s h = case toContainerId s of
-	Just cid -> do
+toChain :: ContainerId -> CmdLine
+toChain cid = DockerChain (containerHostName cid) (fromContainerId cid)
+
+chain :: [Host] -> HostName -> String -> IO ()
+chain hostlist hn s = case toContainerId s of
+	Nothing -> errorMessage "bad container id"
+	Just cid -> case findHostNoAlias hostlist hn of
+		Nothing -> errorMessage ("cannot find host " ++ hn)
+		Just parenthost -> case M.lookup (containerName cid) (_dockerContainers $ _dockerinfo $ hostInfo parenthost) of
+			Nothing -> errorMessage ("cannot find container " ++ containerName cid ++ " docked on host " ++ hn)
+			Just h -> go cid h
+  where
+	go cid h = do
 		changeWorkingDirectory localdir
 		onlyProcess (provisioningLock cid) $ do
 			r <- runPropellor h $ ensureProperties $ hostProperties h
 			putStrLn $ "\n" ++ show r
-	Nothing -> error "bad container id"
 
 stopContainer :: ContainerId -> IO Bool
 stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
@@ -520,13 +528,13 @@ listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
 runProp :: String -> RunParam -> Property
 runProp field val = pureInfoProperty (param) $ dockerInfo $
-	mempty { _dockerRunParams = [\_ -> "--"++param] }
+	mempty { _dockerRunParams = [DockerRunParam (\_ -> "--"++param)] }
   where
 	param = field++"="++val
 
 genProp :: String -> (HostName -> RunParam) -> Property
 genProp field mkval = pureInfoProperty field $ dockerInfo $
-	mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
+	mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] }
 
 dockerInfo :: DockerInfo -> Info
 dockerInfo i = mempty { _dockerinfo = i }
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 75b3c2a..90c08e6 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -3,7 +3,7 @@
 
 module Propellor.Types
 	( Host(..)
-	, Info
+	, Info(..)
 	, getInfo
 	, Propellor(..)
 	, Property(..)
@@ -21,6 +21,10 @@ module Propellor.Types
 	, Context(..)
 	, anyContext
 	, SshKeyType(..)
+	, Val(..)
+	, fromVal
+	, DockerInfo(..)
+	, DockerRunParam(..)
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
 	) where
@@ -31,8 +35,10 @@ import System.Console.ANSI
 import System.Posix.Types
 import "mtl" Control.Monad.Reader
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Propellor.Types.Dns as Dns
 
-import Propellor.Types.Info
 import Propellor.Types.OS
 import Propellor.Types.Dns
 import Propellor.Types.PrivData
@@ -150,3 +156,64 @@ data CmdLine
 	| DockerChain HostName String
 	| GitPush Fd Fd
 	deriving (Read, Show, Eq)
+
+-- | Information about a host.
+data Info = Info
+	{ _os :: Val System
+	, _privDataFields :: S.Set (PrivDataField, Context)
+	, _sshPubKey :: Val String
+	, _aliases :: S.Set HostName
+	, _dns :: S.Set Dns.Record
+	, _namedconf :: Dns.NamedConfMap
+	, _dockerinfo :: DockerInfo
+	}
+	deriving (Eq, Show)
+
+instance Monoid Info where
+	mempty = Info mempty mempty mempty mempty mempty mempty mempty
+	mappend old new = Info
+		{ _os = _os old <> _os new
+		, _privDataFields = _privDataFields old <> _privDataFields new
+		, _sshPubKey = _sshPubKey old <> _sshPubKey new
+		, _aliases = _aliases old <> _aliases new
+		, _dns = _dns old <> _dns new
+		, _namedconf = _namedconf old <> _namedconf new
+		, _dockerinfo = _dockerinfo old <> _dockerinfo new
+		}
+
+data Val a = Val a | NoVal
+	deriving (Eq, Show)
+
+instance Monoid (Val a) where
+	mempty = NoVal
+	mappend old new = case new of
+		NoVal -> old
+		_ -> new
+
+fromVal :: Val a -> Maybe a
+fromVal (Val a) = Just a
+fromVal NoVal = Nothing
+
+data DockerInfo = DockerInfo
+	{ _dockerRunParams :: [DockerRunParam]
+	, _dockerContainers :: M.Map String Host
+	}
+	deriving (Show)
+
+instance Monoid DockerInfo where
+	mempty = DockerInfo mempty mempty
+	mappend old new = DockerInfo
+		{ _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
+		, _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new)
+		}
+
+instance Eq DockerInfo where
+	x == y = and
+		[ let simpl v = map (\(DockerRunParam a) -> a "") (_dockerRunParams v)
+		  in simpl x == simpl y
+		]
+
+newtype DockerRunParam = DockerRunParam (HostName -> String)
+
+instance Show DockerRunParam where
+	show (DockerRunParam a) = a ""
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
deleted file mode 100644
index 6aba1f9..0000000
--- a/src/Propellor/Types/Info.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-module Propellor.Types.Info where
-
-import Propellor.Types.OS
-import Propellor.Types.PrivData
-import qualified Propellor.Types.Dns as Dns
-
-import qualified Data.Set as S
-import Data.Monoid
-
--- | Information about a host.
-data Info = Info
-	{ _os :: Val System
-	, _privDataFields :: S.Set (PrivDataField, Context)
-	, _sshPubKey :: Val String
-	, _aliases :: S.Set HostName
-	, _dns :: S.Set Dns.Record
-	, _namedconf :: Dns.NamedConfMap
-	, _dockerinfo :: DockerInfo
-	}
-	deriving (Eq, Show)
-
-instance Monoid Info where
-	mempty = Info mempty mempty mempty mempty mempty mempty mempty
-	mappend old new = Info
-		{ _os = _os old <> _os new
-		, _privDataFields = _privDataFields old <> _privDataFields new
-		, _sshPubKey = _sshPubKey old <> _sshPubKey new
-		, _aliases = _aliases old <> _aliases new
-		, _dns = _dns old <> _dns new
-		, _namedconf = _namedconf old <> _namedconf new
-		, _dockerinfo = _dockerinfo old <> _dockerinfo new
-		}
-
-data Val a = Val a | NoVal
-	deriving (Eq, Show)
-
-instance Monoid (Val a) where
-	mempty = NoVal
-	mappend old new = case new of
-		NoVal -> old
-		_ -> new
-
-fromVal :: Val a -> Maybe a
-fromVal (Val a) = Just a
-fromVal NoVal = Nothing
-
-data DockerInfo = DockerInfo
-	{ _dockerRunParams :: [HostName -> String]
-	}
-
-instance Eq DockerInfo where
-	x == y = and
-		[ let simpl v = map (\a -> a "") (_dockerRunParams v)
-		  in simpl x == simpl y
-		]
-
-instance Monoid DockerInfo where
-	mempty = DockerInfo mempty
-	mappend old new = DockerInfo
-		{ _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
-		}
-
-instance Show DockerInfo where
-	show a = unlines
-		[ "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
-		]

From 0cab7a605e1237e7415108d417eee81dd7ff5aa2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:34:09 -0400
Subject: [PATCH 48/52] propellor spin


From e0c9b80370cdf42e3535bfce0ca08217d88fa66b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:35:21 -0400
Subject: [PATCH 49/52] propellor spin


From e534205282cc0794c905755bebdfc2b122aa07cb Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:38:07 -0400
Subject: [PATCH 50/52] propellor spin


From 80e465185fe03af09e51b1c4c61757d925a9c0a7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:54:28 -0400
Subject: [PATCH 51/52] propellor spin


From 0d4dd37ee769a6ef1bc80507c8ee8a4b9e882856 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 20 Nov 2014 00:55:28 -0400
Subject: [PATCH 52/52] git commit may or may not be signed

---
 src/Propellor/CmdLine.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 8b958a7..061c970 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -145,7 +145,7 @@ updateFirst' cmdline next = ifM fetchOrigin
 
 spin :: HostName -> Host -> IO ()
 spin hn hst = do
-	void $ actionMessage "Git commit (signed)" $
+	void $ actionMessage "Git commit" $
 		gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	-- Push to central origin repo first, if possible.
 	-- The remote propellor will pull from there, which avoids