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: broke out Server module

---
 src/Propellor/CmdLine.hs | 137 ++++-------------------------------------------
 1 file changed, 9 insertions(+), 128 deletions(-)

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ee563012..0ae79ac3 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
-- 
cgit v1.3-2-g0d8e


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: clean up Propellr.CmdLine exports

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

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/propellor.cabal b/propellor.cabal
index c0b8624e..82880d1e 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 0ae79ac3..9006d903 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
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/config-joey.hs b/config-joey.hs
index 7d48aee3..abd20e55 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 9006d903..e41ab39d 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 491955dd..2b4faf7b 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 a1d25b4f..00da7495 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
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index e41ab39d..d9a95de2 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 a3fc0f30..3fa9ffc0 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 64276e87..7b559a50 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 00da7495..75b3c2ab 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)
-- 
cgit v1.3-2-g0d8e


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: remove excess verbosity from message

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

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index d9a95de2..725bae43 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
 
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 725bae43..e42e2408 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 51ed3df2..88d5c3ab 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
-- 
cgit v1.3-2-g0d8e


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: 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

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/propellor.cabal b/propellor.cabal
index 161e4779..38e3da21 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 e42e2408..8b958a7e 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 f44d1de3..a91f69c8 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 a5150432..c5f489e5 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 135c765d..f351804c 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 ce9fb7d7..676d323a 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 75b3c2ab..90c08e64 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 6aba1f9f..00000000
--- 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))
-		]
-- 
cgit v1.3-2-g0d8e


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: git commit may or may not be signed

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

(limited to 'src/Propellor/CmdLine.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 8b958a7e..061c9700 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
-- 
cgit v1.3-2-g0d8e