propellor spin

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
+	cacheparams <- toCommand <$> sshCachingParams hn viarelay
-	when (isJust relay) $
+	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
+			, if viarelay
-				-- Still using --boot for back-compat...
+				then "./propellor --continue " ++
-				then "./propellor --boot " ++ target
-				else "./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
+	cmd = if viarelay
-		then "--continue " ++ shellEscape (show (SimpleRun target))
+		then "--serialized " ++ shellEscape (show (Spin target (Just target)))
-		else "--serialized " ++ shellEscape (show (Spin target (Just target)))
+		else "--continue " ++ shellEscape (show (SimpleRun target))
-	runparams = catMaybes
-		[ if isJust relay then Just "-A" else Nothing
-		, Just "-t"
-		, Just user
-		, Just runcmd
-		]

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)

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 :: HostName -> Bool -> IO [CommandParam]
-sshCachingParams hn = do
+sshCachingParams hn viarelay = do
 	home <- myHomeDir
 	let cachedir = home </> ".ssh" </> "propellor"
 	createDirectoryIfMissing False cachedir
 	let socketfile = cachedir </> hn ++ ".sock"
-	let ps = 
+	let ps = catMaybes
-		[ Param "-o", Param ("ControlPath=" ++ socketfile)
+		[ if viarelay then Just (Param "-A") else Nothing
-		, Params "-o ControlMaster=auto -o ControlPersist=yes"
+		, Just $ Param "-o"
+		, Just $ Param ("ControlPath=" ++ socketfile)
+		, Just $ Params "-o ControlMaster=auto -o ControlPersist=yes"
 		]
 
 	maybe noop (expireold ps socketfile)