From fd3335e40e3c938f1fbf53287e37aaf76b8c69df Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 12:57:07 -0400
Subject: --via implemented

---
 src/Propellor/CmdLine.hs | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ec2ca7ed..c681a08d 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -24,7 +24,7 @@ usage h = hPutStrLn h $ unlines
 	[ "Usage:"
 	, "  propellor"
 	, "  propellor hostname"
-	, "  propellor --spin hostname"
+	, "  propellor --spin targethost [--via relayhost]"
 	, "  propellor --add-key keyid"
 	, "  propellor --set field context"
 	, "  propellor --dump field context"
@@ -41,7 +41,8 @@ processCmdLine :: IO CmdLine
 processCmdLine = go =<< getArgs
   where
 	go ("--run":h:[]) = return $ Run h
-	go ("--spin":h:[]) = return $ Spin h
+	go ("--spin":h:[]) = return $ Spin h Nothing
+	go ("--spin":h:"--via":r:[]) = return $ Spin h (Just r)
 	go ("--add-key":k:[]) = return $ AddKey k
 	go ("--set":f:c:[]) = withprivfield f c Set
 	go ("--dump":f:c:[]) = withprivfield f c Dump
@@ -50,8 +51,8 @@ processCmdLine = go =<< getArgs
 	go ("--help":_) = do	
 		usage stdout
 		exitFailure
-	go ("--update":h:[]) = return $ Update h
-	go ("--boot":h:[]) = return $ Update h -- for back-compat
+	go ("--update":_:[]) = return $ Update Nothing
+	go ("--boot":_:[]) = return $ Update Nothing -- for back-compat
 	go ("--continue":s:[]) = case readish s of
 		Just cmdline -> return $ Continue cmdline
 		Nothing -> errorMessage $ "--continue serialization failure (" ++ s ++ ")"
@@ -89,15 +90,16 @@ defaultMain hostlist = do
 	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)
-	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
+	go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing))
+	go _ (Update (Just h)) = forceConsole >> fetchFirst (update (Just h))
+	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
+	go False (Spin hn r) = withhost hn $ spin hn r
 	go False cmdline@(SimpleRun hn) = buildFirst cmdline $
 		go False (Run hn)
 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
 		( onlyprocess $ withhost hn mainProperties
-		, go True (Spin hn)
+		, go True (Spin hn Nothing)
 		)
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
@@ -148,8 +150,8 @@ updateFirst' cmdline next = ifM fetchOrigin
 	, next
 	)
 
-spin :: HostName -> Host -> IO ()
-spin hn hst = do
+spin :: HostName -> Maybe HostName -> Host -> IO ()
+spin target relay hst = do
 	void $ actionMessage "Git commit" $
 		gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	-- Push to central origin repo first, if possible.
@@ -160,15 +162,18 @@ spin hn hst = do
 			boolSystem "git" [Param "push"]
 	
 	cacheparams <- toCommand <$> sshCachingParams hn
+	when (isJust relay) $
+		void $ boolSystem "ssh-add" []
 
 	-- Install, or update the remote propellor.
-	updateServer hn hst $ withBothHandles createProcessSuccess
+	updateServer target relay 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"
   where
+	hn = fromMaybe target relay
 	user = "root@"++hn
 
 	mkcmd = shellWrap . intercalate " ; "
@@ -183,10 +188,17 @@ spin hn hst = do
 		, "else " ++ intercalate " && "
 			[ "cd " ++ localdir
 			, "if ! test -x ./propellor; then make deps build; fi"
-			, "./propellor --boot " ++ hn
+			, if isNothing relay
+				-- Still using --boot for back-compat...
+				then "./propellor --boot " ++ target
+				else "./propellor --continue " ++
+					shellEscape (show (Update (Just target)))
 			]
 		, "fi"
 		]
 
-	runcmd = mkcmd
-		[ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show (SimpleRun hn)) ]
+	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
+	cmd = if isNothing relay
+		then "--continue " ++ shellEscape (show (SimpleRun target))
+		else "--spin " ++ shellEscape target
+
-- 
cgit v1.3-2-g0d8e


From 8e5551c925828fe1f5133c3c9e86d13722c09f89 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 13:44:25 -0400
Subject: avoid unncessary apt-get upgrade

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

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index c681a08d..aa294fb5 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -181,8 +181,7 @@ spin target relay hst = do
 	updatecmd = mkcmd
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then (" ++ intercalate " && "
-			[ "apt-get update"
-			, "apt-get --no-install-recommends --no-upgrade -y install git make"
+			[ "if ! git --version || ! make --version; the apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
 			] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
 		, "else " ++ intercalate " && "
-- 
cgit v1.3-2-g0d8e


From fdde4d91c7dda15dcc4eee5fc91859c0e1a45b9b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 13:48:16 -0400
Subject: propellor spin

---
 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 aa294fb5..3e64f035 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -181,7 +181,7 @@ spin target relay hst = do
 	updatecmd = mkcmd
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then (" ++ intercalate " && "
-			[ "if ! git --version || ! make --version; the apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
+			[ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
 			] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
 		, "else " ++ intercalate " && "
-- 
cgit v1.3-2-g0d8e


From 151aadd4e20c49d18eedadb08272fccd114de7c8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 15:11:24 -0400
Subject: propellor spin

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

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 3e64f035..bb9b470e 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -170,7 +170,7 @@ spin target relay hst = do
 		(proc "ssh" $ cacheparams ++ [user, updatecmd])
 
 	-- And now we can run it.
-	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
+	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ runparams)) $
 		error $ "remote propellor failed"
   where
 	hn = fromMaybe target relay
@@ -200,4 +200,9 @@ spin target relay hst = do
 	cmd = if isNothing relay
 		then "--continue " ++ shellEscape (show (SimpleRun target))
 		else "--spin " ++ shellEscape target
-
+	runparams = catMaybes
+		[ if isJust relay then Just "-A" else Nothing
+		, Just "-t"
+		, Just user
+		, Just runcmd
+		]
-- 
cgit v1.3-2-g0d8e


From 395f311e1e07e0da31b48dc1bd0c1f5882fc3627 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 15:48:17 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs |  6 +++---
 src/Propellor/Server.hs  | 31 +++++++++++++++++--------------
 2 files changed, 20 insertions(+), 17 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index bb9b470e..7a4fdd7c 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -196,10 +196,10 @@ spin target relay hst = do
 		, "fi"
 		]
 
-	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
+	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show cmd) ]
 	cmd = if isNothing relay
-		then "--continue " ++ shellEscape (show (SimpleRun target))
-		else "--spin " ++ shellEscape target
+		then SimpleRun target
+		else Spin target relay
 	runparams = catMaybes
 		[ if isJust relay then Just "-A" else Nothing
 		, Just "-t"
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index fe90a456..be2eb1d3 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -66,51 +66,54 @@ updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO (
 updateServer target relay hst connect = connect go
   where
 	hn = fromMaybe target relay
+	relaying = relay == Just target
+
 	go (toh, fromh) = do
 		let loop = go (toh, fromh)
+		let restart = updateServer hn relay hst connect
+		let done = return ()
 		v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
 		case v of
 			(Just NeedRepoUrl) -> do
 				sendRepoUrl toh
 				loop
 			(Just NeedPrivData) -> do
-				sendPrivData hn hst toh relay
+				sendPrivData hn hst toh relaying
 				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 relay hst connect
+				restart
 			(Just NeedPrecompiled) -> do
 				hClose toh
 				hClose fromh
 				sendPrecompiled hn
-				updateServer hn relay hst connect
-			Nothing -> return ()
+				restart
+			(Just NeedGitPush) -> do
+				sendGitUpdate hn fromh toh
+				hClose fromh
+				hClose toh
+				done
+			Nothing -> done
 
 sendRepoUrl :: Handle -> IO ()
 sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
 
-sendPrivData :: HostName -> Host -> Handle -> Maybe HostName -> IO ()
-sendPrivData hn hst toh target = do
+sendPrivData :: HostName -> Host -> Handle -> Bool -> IO ()
+sendPrivData hn hst toh relaying = do
 	privdata <- getdata
 	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
 		sendMarked toh privDataMarker privdata
 		return True
   where
 	getdata
-		| isNothing target =
-			show . filterPrivData hst <$> decryptPrivData
-		| otherwise = do
+		| relaying = do
 			let f = privDataRelay hn
 			d <- readFileStrictAnyEncoding f
 			nukeFile f
 			return d
+		| otherwise = show . filterPrivData hst <$> decryptPrivData
 
 sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
 sendGitUpdate hn fromh toh =
-- 
cgit v1.3-2-g0d8e


From 97931fe6700be054e6e5e26da9a9f47e88ba6a2a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 15:50:14 -0400
Subject: propellor spin

---
 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 7a4fdd7c..2bd07614 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -199,7 +199,7 @@ spin target relay hst = do
 	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show cmd) ]
 	cmd = if isNothing relay
 		then SimpleRun target
-		else Spin target relay
+		else Spin target (Just target)
 	runparams = catMaybes
 		[ if isJust relay then Just "-A" else Nothing
 		, Just "-t"
-- 
cgit v1.3-2-g0d8e


From 40339a7fd830503a09b54138372a159c8bc342d7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 15:54:31 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs | 16 ++++++++++------
 src/Propellor/Types.hs   |  1 +
 2 files changed, 11 insertions(+), 6 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 2bd07614..ea6cabff 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -53,9 +53,8 @@ processCmdLine = go =<< getArgs
 		exitFailure
 	go ("--update":_:[]) = return $ Update Nothing
 	go ("--boot":_:[]) = return $ Update Nothing -- for back-compat
-	go ("--continue":s:[]) = case readish s of
-		Just cmdline -> return $ Continue cmdline
-		Nothing -> errorMessage $ "--continue serialization failure (" ++ s ++ ")"
+	go ("--serialized":s:[]) = serialized Serialized s
+	go ("--continue":s:[]) = serialized Continue s
 	go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout)
 	go (h:[])
 		| "--" `isPrefixOf` h = usageError [h]
@@ -71,6 +70,10 @@ processCmdLine = go =<< getArgs
 		Just pf -> return $ f pf (Context c)
 		Nothing -> errorMessage $ "Unknown privdata field " ++ s
 
+	serialized mk s = case readish s of
+		Just cmdline -> return $ mk cmdline
+		Nothing -> errorMessage $ "serialization failure (" ++ s ++ ")"
+
 -- | Runs propellor on hosts, as controlled by command-line options.
 defaultMain :: [Host] -> IO ()
 defaultMain hostlist = do
@@ -80,6 +83,7 @@ defaultMain hostlist = do
 	debug ["command line: ", show cmdline]
 	go True cmdline
   where
+	go _ (Serialized cmdline) = go True cmdline
 	go _ (Continue cmdline) = go False cmdline
 	go _ (Set field context) = setPrivData field context
 	go _ (Dump field context) = dumpPrivData field context
@@ -196,10 +200,10 @@ spin target relay hst = do
 		, "fi"
 		]
 
-	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor --continue " ++ shellEscape (show cmd) ]
+	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
 	cmd = if isNothing relay
-		then SimpleRun target
-		else Spin target (Just target)
+		then "--continue " ++ shellEscape (show (SimpleRun target))
+		else "--serialized " ++ shellEscape (show (Spin target (Just target)))
 	runparams = catMaybes
 		[ if isJust relay then Just "-A" else Nothing
 		, Just "-t"
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index e4cbf981..949ce4b7 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -149,6 +149,7 @@ data CmdLine
 	| Edit PrivDataField Context
 	| ListFields
 	| AddKey String
+	| Serialized CmdLine
 	| Continue CmdLine
 	| Update (Maybe HostName)
 	| DockerInit HostName
-- 
cgit v1.3-2-g0d8e


From 6d13790afa236b958eec9e8a0ea1e75125d90351 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 15:58:09 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ea6cabff..e719e149 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -156,14 +156,15 @@ updateFirst' cmdline next = ifM fetchOrigin
 
 spin :: HostName -> Maybe HostName -> Host -> IO ()
 spin target relay hst = do
-	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
-	-- us needing to send stuff directly to the remote host.
-	whenM hasOrigin $
-		void $ actionMessage "Push to central git repository" $
-			boolSystem "git" [Param "push"]
+	unless relaying $ do
+		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
+		-- us needing to send stuff directly to the remote host.
+		whenM hasOrigin $
+			void $ actionMessage "Push to central git repository" $
+				boolSystem "git" [Param "push"]
 	
 	cacheparams <- toCommand <$> sshCachingParams hn
 	when (isJust relay) $
@@ -179,6 +180,7 @@ spin target relay hst = do
   where
 	hn = fromMaybe target relay
 	user = "root@"++hn
+	relaying = relay == Just target
 
 	mkcmd = shellWrap . intercalate " ; "
 
-- 
cgit v1.3-2-g0d8e


From 392a0d3c1cc175161cd0c6d82b098e92d6adf9e6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:06:44 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs | 28 ++++++++++++----------------
 src/Propellor/Server.hs  |  4 ++--
 src/Propellor/Ssh.hs     | 12 +++++++-----
 3 files changed, 21 insertions(+), 23 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index e719e149..b44cbc28 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,8 +166,8 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- toCommand <$> sshCachingParams hn
-	when (isJust relay) $
+	cacheparams <- toCommand <$> sshCachingParams hn viarelay
+	when viarelay $
 		void $ boolSystem "ssh-add" []
 
 	-- Install, or update the remote propellor.
@@ -175,12 +175,14 @@ spin target relay hst = do
 		(proc "ssh" $ cacheparams ++ [user, updatecmd])
 
 	-- And now we can run it.
-	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ runparams)) $
+	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $
 		error $ "remote propellor failed"
   where
 	hn = fromMaybe target relay
 	user = "root@"++hn
+
 	relaying = relay == Just target
+	viarelay = isJust relay && not relaying
 
 	mkcmd = shellWrap . intercalate " ; "
 
@@ -193,22 +195,16 @@ spin target relay hst = do
 		, "else " ++ intercalate " && "
 			[ "cd " ++ localdir
 			, "if ! test -x ./propellor; then make deps build; fi"
-			, if isNothing relay
-				-- Still using --boot for back-compat...
-				then "./propellor --boot " ++ target
-				else "./propellor --continue " ++
+			, if viarelay
+				then "./propellor --continue " ++
 					shellEscape (show (Update (Just target)))
+				-- Still using --boot for back-compat...
+				else "./propellor --boot " ++ target
 			]
 		, "fi"
 		]
 
 	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
-	cmd = if isNothing relay
-		then "--continue " ++ shellEscape (show (SimpleRun target))
-		else "--serialized " ++ shellEscape (show (Spin target (Just target)))
-	runparams = catMaybes
-		[ if isJust relay then Just "-A" else Nothing
-		, Just "-t"
-		, Just user
-		, Just runcmd
-		]
+	cmd = if viarelay
+		then "--serialized " ++ shellEscape (show (Spin target (Just target)))
+		else "--continue " ++ shellEscape (show (SimpleRun target))
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index be2eb1d3..38325003 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -131,7 +131,7 @@ sendGitUpdate hn fromh toh =
 sendGitClone :: HostName -> IO ()
 sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
 	branch <- getCurrentBranch
-	cacheparams <- sshCachingParams hn
+	cacheparams <- sshCachingParams hn False
 	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)]
@@ -156,7 +156,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor
 		withTmpDir "propellor" go
   where
 	go tmpdir = do
-		cacheparams <- sshCachingParams hn
+		cacheparams <- sshCachingParams hn False
 		let shimdir = takeFileName localdir
 		createDirectoryIfMissing True (tmpdir </> shimdir)
 		changeWorkingDirectory (tmpdir </> shimdir)
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
index 969517a8..ecdb54d2 100644
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@@ -14,15 +14,17 @@ import Data.Time.Clock.POSIX
 -- minutes, and if so stop that ssh process, in order to not try to
 -- use an old stale connection. (atime would be nicer, but there's
 -- a good chance a laptop uses noatime)
-sshCachingParams :: HostName -> IO [CommandParam]
-sshCachingParams hn = do
+sshCachingParams :: HostName -> Bool -> IO [CommandParam]
+sshCachingParams hn viarelay = do
 	home <- myHomeDir
 	let cachedir = home </> ".ssh" </> "propellor"
 	createDirectoryIfMissing False cachedir
 	let socketfile = cachedir </> hn ++ ".sock"
-	let ps = 
-		[ Param "-o", Param ("ControlPath=" ++ socketfile)
-		, Params "-o ControlMaster=auto -o ControlPersist=yes"
+	let ps = catMaybes
+		[ if viarelay then Just (Param "-A") else Nothing
+		, Just $ Param "-o"
+		, Just $ Param ("ControlPath=" ++ socketfile)
+		, Just $ Params "-o ControlMaster=auto -o ControlPersist=yes"
 		]
 
 	maybe noop (expireold ps socketfile)
-- 
cgit v1.3-2-g0d8e


From 6be56755eedc4a8c259c0be7f912a3fde1da245a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:10:46 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index b44cbc28..fb4b8eed 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,7 +166,9 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- toCommand <$> sshCachingParams hn viarelay
+	cacheparams <- if relaying
+		then pure []
+		else toCommand <$> sshCachingParams hn viarelay
 	when viarelay $
 		void $ boolSystem "ssh-add" []
 
-- 
cgit v1.3-2-g0d8e


From 7ed9f70504d902f48e88e7701f6398e769072bd7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:12:53 -0400
Subject: propellor spin

---
 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 fb4b8eed..51ee592d 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,7 +166,7 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- if relaying
+	cacheparams <- if relaying || viarelay
 		then pure []
 		else toCommand <$> sshCachingParams hn viarelay
 	when viarelay $
-- 
cgit v1.3-2-g0d8e


From cb94e7484e5c0c966f3f9624e910ae2521b259a3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:14:20 -0400
Subject: propellor spin

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

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 51ee592d..5827409c 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,9 +166,11 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- if relaying || viarelay
+	cacheparams <- if relaying
 		then pure []
-		else toCommand <$> sshCachingParams hn viarelay
+		else if viarelay
+			then pure ["-A"]
+			else toCommand <$> sshCachingParams hn viarelay
 	when viarelay $
 		void $ boolSystem "ssh-add" []
 
-- 
cgit v1.3-2-g0d8e


From 02e0fac6839572f8823369730b0f73f2374d5574 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:17:39 -0400
Subject: propellor spin

---
 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 5827409c..7002a3f6 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,7 +166,7 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- if relaying
+	cacheparams <- if False
 		then pure []
 		else if viarelay
 			then pure ["-A"]
-- 
cgit v1.3-2-g0d8e


From a4edc404f0d91db54e13dace7be265a2611de5d6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 16:20:02 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs |  8 +++-----
 src/Propellor/Server.hs  |  4 ++--
 src/Propellor/Ssh.hs     | 13 ++++++-------
 3 files changed, 11 insertions(+), 14 deletions(-)

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

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 7002a3f6..11193ab3 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -166,11 +166,9 @@ spin target relay hst = do
 			void $ actionMessage "Push to central git repository" $
 				boolSystem "git" [Param "push"]
 	
-	cacheparams <- if False
-		then pure []
-		else if viarelay
-			then pure ["-A"]
-			else toCommand <$> sshCachingParams hn viarelay
+	cacheparams <- if viarelay
+		then pure ["-A"]
+		else toCommand <$> sshCachingParams hn
 	when viarelay $
 		void $ boolSystem "ssh-add" []
 
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
index 38325003..be2eb1d3 100644
--- a/src/Propellor/Server.hs
+++ b/src/Propellor/Server.hs
@@ -131,7 +131,7 @@ sendGitUpdate hn fromh toh =
 sendGitClone :: HostName -> IO ()
 sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
 	branch <- getCurrentBranch
-	cacheparams <- sshCachingParams hn False
+	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)]
@@ -156,7 +156,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor
 		withTmpDir "propellor" go
   where
 	go tmpdir = do
-		cacheparams <- sshCachingParams hn False
+		cacheparams <- sshCachingParams hn
 		let shimdir = takeFileName localdir
 		createDirectoryIfMissing True (tmpdir </> shimdir)
 		changeWorkingDirectory (tmpdir </> shimdir)
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
index ecdb54d2..97c3eb6d 100644
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@@ -14,17 +14,16 @@ import Data.Time.Clock.POSIX
 -- minutes, and if so stop that ssh process, in order to not try to
 -- use an old stale connection. (atime would be nicer, but there's
 -- a good chance a laptop uses noatime)
-sshCachingParams :: HostName -> Bool -> IO [CommandParam]
-sshCachingParams hn viarelay = do
+sshCachingParams :: HostName -> IO [CommandParam]
+sshCachingParams hn = do
 	home <- myHomeDir
 	let cachedir = home </> ".ssh" </> "propellor"
 	createDirectoryIfMissing False cachedir
 	let socketfile = cachedir </> hn ++ ".sock"
-	let ps = catMaybes
-		[ if viarelay then Just (Param "-A") else Nothing
-		, Just $ Param "-o"
-		, Just $ Param ("ControlPath=" ++ socketfile)
-		, Just $ Params "-o ControlMaster=auto -o ControlPersist=yes"
+	let ps =
+		[ Param "-o"
+		, Param ("ControlPath=" ++ socketfile)
+		, Params "-o ControlMaster=auto -o ControlPersist=yes"
 		]
 
 	maybe noop (expireold ps socketfile)
-- 
cgit v1.3-2-g0d8e


From 9a8fcf80bb026c390ad56da9b70d153fd978d6cf Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 19:58:35 -0400
Subject: Hostname parameters not containing dots are looked up in the DNS to
 find the full hostname.

---
 debian/changelog          |  2 ++
 src/Propellor/CmdLine.hs  | 16 ++++++++++++----
 src/Propellor/Types/OS.hs | 15 +++++++++++++--
 3 files changed, 27 insertions(+), 6 deletions(-)

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

diff --git a/debian/changelog b/debian/changelog
index f82270e2..32b504fd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,8 @@ propellor (1.0.1) UNRELEASED; urgency=medium
   * --spin target --via relay causes propellor to bounce through an
     intermediate relay host, which handles any necessary uploads
     when provisioning the target host.
+  * Hostname parameters not containing dots are looked up in the DNS to
+    find the full hostname.
 
  -- Joey Hess <joeyh@debian.org>  Sat, 22 Nov 2014 00:12:35 -0400
 
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 11193ab3..e808395b 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -7,6 +7,7 @@ import System.Environment (getArgs)
 import Data.List
 import System.Exit
 import System.PosixCompat
+import qualified Network.BSD
 
 import Propellor
 import Propellor.Protocol
@@ -40,9 +41,8 @@ usageError ps = do
 processCmdLine :: IO CmdLine
 processCmdLine = go =<< getArgs
   where
-	go ("--run":h:[]) = return $ Run h
-	go ("--spin":h:[]) = return $ Spin h Nothing
-	go ("--spin":h:"--via":r:[]) = return $ Spin h (Just r)
+	go ("--spin":h:[]) = Spin <$> hostname h <*> pure Nothing
+	go ("--spin":h:"--via":r:[]) = Spin <$> hostname h <*> pure (Just r)
 	go ("--add-key":k:[]) = return $ AddKey k
 	go ("--set":f:c:[]) = withprivfield f c Set
 	go ("--dump":f:c:[]) = withprivfield f c Dump
@@ -56,9 +56,10 @@ processCmdLine = go =<< getArgs
 	go ("--serialized":s:[]) = serialized Serialized s
 	go ("--continue":s:[]) = serialized Continue s
 	go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout)
+	go ("--run":h:[]) = go [h]
 	go (h:[])
 		| "--" `isPrefixOf` h = usageError [h]
-		| otherwise = return $ Run h
+		| otherwise = Run <$> hostname h
 	go [] = do
 		s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
 		if null s
@@ -210,3 +211,10 @@ spin target relay hst = do
 	cmd = if viarelay
 		then "--serialized " ++ shellEscape (show (Spin target (Just target)))
 		else "--continue " ++ shellEscape (show (SimpleRun target))
+
+hostname :: String -> IO HostName
+hostname s
+	| "." `isInfixOf` s = pure s
+	| otherwise = do
+		h <- Network.BSD.getHostByName s
+		return (Network.BSD.hostName h)
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 2529e7d8..72e3d764 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -1,6 +1,17 @@
-module Propellor.Types.OS where
+module Propellor.Types.OS (
+	HostName,
+	UserName,
+	GroupName,
+	System(..),
+	Distribution(..),
+	DebianSuite(..),
+	isStable,
+	Release,
+	Architecture,
+) where
+
+import Network.BSD (HostName)
 
-type HostName = String
 type UserName = String
 type GroupName = String
 
-- 
cgit v1.3-2-g0d8e


From eb946f109bb895545dd41c7328d900648e2eb71a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 20:02:44 -0400
Subject: look for /usr/local/propellor/.git to know if it's fully deployed

When propellor is deployed by uploading the binary, there's no git repo, so
each spin needs to re-upload it to get any config changes. This should be
rare since this is only intended to be used when taking over a host and
getting it properly set up from source, but it still needs to be supported.
---
 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 e808395b..5c051d1c 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -190,7 +190,7 @@ spin target relay hst = do
 	mkcmd = shellWrap . intercalate " ; "
 
 	updatecmd = mkcmd
-		[ "if [ ! -d " ++ localdir ++ " ]"
+		[ "if [ ! -d " ++ localdir ++ "/.git ]"
 		, "then (" ++ intercalate " && "
 			[ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
-- 
cgit v1.3-2-g0d8e


From 239581c75901c3305eaa9298cf41de28a57bd099 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 22 Nov 2014 20:17:46 -0400
Subject: reorg

---
 propellor.cabal          |   2 +-
 src/Propellor/CmdLine.hs |  61 +----------
 src/Propellor/Server.hs  | 207 -------------------------------------
 src/Propellor/Spin.hs    | 262 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 264 insertions(+), 268 deletions(-)
 delete mode 100644 src/Propellor/Server.hs
 create mode 100644 src/Propellor/Spin.hs

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

diff --git a/propellor.cabal b/propellor.cabal
index 9fe7a26f..20aba22e 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -121,7 +121,7 @@ Library
   Other-Modules:
     Propellor.Git
     Propellor.Gpg
-    Propellor.Server
+    Propellor.Spin
     Propellor.Ssh
     Propellor.PrivData.Paths
     Propellor.Protocol
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 5c051d1c..f5cfc783 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -10,11 +10,9 @@ import System.PosixCompat
 import qualified Network.BSD
 
 import Propellor
-import Propellor.Protocol
 import Propellor.Gpg
 import Propellor.Git
-import Propellor.Ssh
-import Propellor.Server
+import Propellor.Spin
 import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Shim as Shim
@@ -155,63 +153,6 @@ updateFirst' cmdline next = ifM fetchOrigin
 	, next
 	)
 
-spin :: HostName -> Maybe HostName -> Host -> IO ()
-spin target relay hst = do
-	unless relaying $ do
-		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
-		-- us needing to send stuff directly to the remote host.
-		whenM hasOrigin $
-			void $ actionMessage "Push to central git repository" $
-				boolSystem "git" [Param "push"]
-	
-	cacheparams <- if viarelay
-		then pure ["-A"]
-		else toCommand <$> sshCachingParams hn
-	when viarelay $
-		void $ boolSystem "ssh-add" []
-
-	-- Install, or update the remote propellor.
-	updateServer target relay 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"
-  where
-	hn = fromMaybe target relay
-	user = "root@"++hn
-
-	relaying = relay == Just target
-	viarelay = isJust relay && not relaying
-
-	mkcmd = shellWrap . intercalate " ; "
-
-	updatecmd = mkcmd
-		[ "if [ ! -d " ++ localdir ++ "/.git ]"
-		, "then (" ++ intercalate " && "
-			[ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
-			, "echo " ++ toMarked statusMarker (show NeedGitClone)
-			] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
-		, "else " ++ intercalate " && "
-			[ "cd " ++ localdir
-			, "if ! test -x ./propellor; then make deps build; fi"
-			, if viarelay
-				then "./propellor --continue " ++
-					shellEscape (show (Update (Just target)))
-				-- Still using --boot for back-compat...
-				else "./propellor --boot " ++ target
-			]
-		, "fi"
-		]
-
-	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
-	cmd = if viarelay
-		then "--serialized " ++ shellEscape (show (Spin target (Just target)))
-		else "--continue " ++ shellEscape (show (SimpleRun target))
-
 hostname :: String -> IO HostName
 hostname s
 	| "." `isInfixOf` s = pure s
diff --git a/src/Propellor/Server.hs b/src/Propellor/Server.hs
deleted file mode 100644
index 77f72085..00000000
--- a/src/Propellor/Server.hs
+++ /dev/null
@@ -1,207 +0,0 @@
--- When propellor --spin is running, the local host acts as a server,
--- which connects to the remote host's propellor and responds to its
--- requests.
-
-module Propellor.Server (
-	update,
-	updateServer,
-	gitPushHelper
-) where
-
-import Data.List
-import System.Exit
-import System.PosixCompat
-import System.Posix.IO
-import System.Posix.Directory
-import Control.Concurrent.Async
-import Control.Exception (bracket)
-import qualified Data.ByteString as B
-
-import Propellor
-import Propellor.Protocol
-import Propellor.PrivData.Paths
-import Propellor.Git
-import Propellor.Ssh
-import qualified Propellor.Shim as Shim
-import Utility.FileMode
-import Utility.SafeCommand
-
--- Update the privdata, repo url, and git repo over the ssh
--- connection, talking to the user's local propellor instance which is
--- running the updateServer
-update :: Maybe HostName -> IO ()
-update forhost = do
-	whenM hasGitRepo $
-		req NeedRepoUrl repoUrlMarker setRepoUrl
-
-	makePrivDataDir
-	createDirectoryIfMissing True (takeDirectory privfile)
-	req NeedPrivData privDataMarker $
-		writeFileProtected privfile
-
-	whenM hasGitRepo $
-		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 "."
-		]
-	
-	-- When --spin --relay is run, get a privdata file
-	-- to be relayed to the target host.
-	privfile = maybe privDataLocal privDataRelay forhost
-
--- The connect action should ssh to the remote host and run the provided
--- calback action.
-updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
-updateServer target relay hst connect = connect go
-  where
-	hn = fromMaybe target relay
-	relaying = relay == Just target
-
-	go (toh, fromh) = do
-		let loop = go (toh, fromh)
-		let restart = updateServer hn relay hst connect
-		let done = return ()
-		v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
-		case v of
-			(Just NeedRepoUrl) -> do
-				sendRepoUrl toh
-				loop
-			(Just NeedPrivData) -> do
-				sendPrivData hn hst toh relaying
-				loop
-			(Just NeedGitClone) -> do
-				hClose toh
-				hClose fromh
-				sendGitClone hn
-				restart
-			(Just NeedPrecompiled) -> do
-				hClose toh
-				hClose fromh
-				sendPrecompiled hn
-				restart
-			(Just NeedGitPush) -> do
-				sendGitUpdate hn fromh toh
-				hClose fromh
-				hClose toh
-				done
-			Nothing -> done
-
-sendRepoUrl :: Handle -> IO ()
-sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
-
-sendPrivData :: HostName -> Host -> Handle -> Bool -> IO ()
-sendPrivData hn hst toh relaying = do
-	privdata <- getdata
-	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
-		sendMarked toh privDataMarker privdata
-		return True
-  where
-	getdata
-		| relaying = do
-			let f = privDataRelay hn
-			d <- readFileStrictAnyEncoding f
-			nukeFile f
-			return d
-		| otherwise = show . filterPrivData hst <$> decryptPrivData
-
-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
-		]
-
--- Send a tarball containing the precompiled propellor, and libraries.
--- This should be reasonably portable, as long as the remote host has the
--- same architecture as the build host.
-sendPrecompiled :: HostName -> IO ()
-sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do
-	bracket getWorkingDirectory changeWorkingDirectory $ \_ ->
-		withTmpDir "propellor" go
-  where
-	go tmpdir = do
-		cacheparams <- sshCachingParams hn
-		let shimdir = takeFileName localdir
-		createDirectoryIfMissing True (tmpdir </> shimdir)
-		changeWorkingDirectory (tmpdir </> shimdir)
-		me <- readSymbolicLink "/proc/self/exe"
-		createDirectoryIfMissing True "bin"
-		unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $
-			errorMessage "failed copying in propellor"
-		void $ Shim.setup "bin/propellor" "."
-		changeWorkingDirectory tmpdir
-		withTmpFile "propellor.tar." $ \tarball _ -> allM id
-			[ boolSystem "strip" [File me]
-			, boolSystem "tar" [Param "czf", File tarball, File shimdir]
-			, boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
-			, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
-			]
-
-	remotetarball = "/usr/local/propellor.tar"
-
-	unpackcmd = shellWrap $ intercalate " && "
-		[ "cd " ++ takeDirectory remotetarball
-		, "tar xzf " ++ remotetarball
-		, "rm -f " ++ remotetarball
-		]
-
--- 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
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
new file mode 100644
index 00000000..8baf4fd9
--- /dev/null
+++ b/src/Propellor/Spin.hs
@@ -0,0 +1,262 @@
+module Propellor.Spin (
+	spin,
+	update,
+	gitPushHelper
+) where
+
+import Data.List
+import System.Exit
+import System.PosixCompat
+import System.Posix.IO
+import System.Posix.Directory
+import Control.Concurrent.Async
+import Control.Exception (bracket)
+import qualified Data.ByteString as B
+
+import Propellor
+import Propellor.Protocol
+import Propellor.PrivData.Paths
+import Propellor.Git
+import Propellor.Ssh
+import Propellor.Gpg
+import qualified Propellor.Shim as Shim
+import Utility.FileMode
+import Utility.SafeCommand
+
+spin :: HostName -> Maybe HostName -> Host -> IO ()
+spin target relay hst = do
+	unless relaying $ do
+		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
+		-- us needing to send stuff directly to the remote host.
+		whenM hasOrigin $
+			void $ actionMessage "Push to central git repository" $
+				boolSystem "git" [Param "push"]
+	
+	cacheparams <- if viarelay
+		then pure ["-A"]
+		else toCommand <$> sshCachingParams hn
+	when viarelay $
+		void $ boolSystem "ssh-add" []
+
+	-- Install, or update the remote propellor.
+	updateServer target relay 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"
+  where
+	hn = fromMaybe target relay
+	user = "root@"++hn
+
+	relaying = relay == Just target
+	viarelay = isJust relay && not relaying
+
+	mkcmd = shellWrap . intercalate " ; "
+
+	updatecmd = mkcmd
+		[ "if [ ! -d " ++ localdir ++ "/.git ]"
+		, "then (" ++ intercalate " && "
+			[ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi"
+			, "echo " ++ toMarked statusMarker (show NeedGitClone)
+			] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
+		, "else " ++ intercalate " && "
+			[ "cd " ++ localdir
+			, "if ! test -x ./propellor; then make deps build; fi"
+			, if viarelay
+				then "./propellor --continue " ++
+					shellEscape (show (Update (Just target)))
+				-- Still using --boot for back-compat...
+				else "./propellor --boot " ++ target
+			]
+		, "fi"
+		]
+
+	runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ]
+	cmd = if viarelay
+		then "--serialized " ++ shellEscape (show (Spin target (Just target)))
+		else "--continue " ++ shellEscape (show (SimpleRun target))
+
+-- Update the privdata, repo url, and git repo over the ssh
+-- connection, talking to the user's local propellor instance which is
+-- running the updateServer
+update :: Maybe HostName -> IO ()
+update forhost = do
+	whenM hasGitRepo $
+		req NeedRepoUrl repoUrlMarker setRepoUrl
+
+	makePrivDataDir
+	createDirectoryIfMissing True (takeDirectory privfile)
+	req NeedPrivData privDataMarker $
+		writeFileProtected privfile
+
+	whenM hasGitRepo $
+		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 "."
+		]
+	
+	-- When --spin --relay is run, get a privdata file
+	-- to be relayed to the target host.
+	privfile = maybe privDataLocal privDataRelay forhost
+
+-- The connect action should ssh to the remote host and run the provided
+-- calback action.
+updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO ()
+updateServer target relay hst connect = connect go
+  where
+	hn = fromMaybe target relay
+	relaying = relay == Just target
+
+	go (toh, fromh) = do
+		let loop = go (toh, fromh)
+		let restart = updateServer hn relay hst connect
+		let done = return ()
+		v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
+		case v of
+			(Just NeedRepoUrl) -> do
+				sendRepoUrl toh
+				loop
+			(Just NeedPrivData) -> do
+				sendPrivData hn hst toh relaying
+				loop
+			(Just NeedGitClone) -> do
+				hClose toh
+				hClose fromh
+				sendGitClone hn
+				restart
+			(Just NeedPrecompiled) -> do
+				hClose toh
+				hClose fromh
+				sendPrecompiled hn
+				restart
+			(Just NeedGitPush) -> do
+				sendGitUpdate hn fromh toh
+				hClose fromh
+				hClose toh
+				done
+			Nothing -> done
+
+sendRepoUrl :: Handle -> IO ()
+sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
+
+sendPrivData :: HostName -> Host -> Handle -> Bool -> IO ()
+sendPrivData hn hst toh relaying = do
+	privdata <- getdata
+	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
+		sendMarked toh privDataMarker privdata
+		return True
+  where
+	getdata
+		| relaying = do
+			let f = privDataRelay hn
+			d <- readFileStrictAnyEncoding f
+			nukeFile f
+			return d
+		| otherwise = show . filterPrivData hst <$> decryptPrivData
+
+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
+		]
+
+-- Send a tarball containing the precompiled propellor, and libraries.
+-- This should be reasonably portable, as long as the remote host has the
+-- same architecture as the build host.
+sendPrecompiled :: HostName -> IO ()
+sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do
+	bracket getWorkingDirectory changeWorkingDirectory $ \_ ->
+		withTmpDir "propellor" go
+  where
+	go tmpdir = do
+		cacheparams <- sshCachingParams hn
+		let shimdir = takeFileName localdir
+		createDirectoryIfMissing True (tmpdir </> shimdir)
+		changeWorkingDirectory (tmpdir </> shimdir)
+		me <- readSymbolicLink "/proc/self/exe"
+		createDirectoryIfMissing True "bin"
+		unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $
+			errorMessage "failed copying in propellor"
+		void $ Shim.setup "bin/propellor" "."
+		changeWorkingDirectory tmpdir
+		withTmpFile "propellor.tar." $ \tarball _ -> allM id
+			[ boolSystem "strip" [File me]
+			, boolSystem "tar" [Param "czf", File tarball, File shimdir]
+			, boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
+			, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+			]
+
+	remotetarball = "/usr/local/propellor.tar"
+
+	unpackcmd = shellWrap $ intercalate " && "
+		[ "cd " ++ takeDirectory remotetarball
+		, "rm -rf " ++ localdir
+		, "tar xzf " ++ remotetarball
+		, "rm -f " ++ remotetarball
+		]
+
+-- 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
-- 
cgit v1.3-2-g0d8e