From 745f42c1499749345c32736342959584587c9b57 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 20 Oct 2015 23:33:19 -0400
Subject: simplify privdata propigation to spin from controller

---
 src/Propellor/Spin.hs | 77 +++++++++++++++++++++++----------------------------
 1 file changed, 34 insertions(+), 43 deletions(-)

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

diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 587a7f76..3cdd8c98 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -1,7 +1,7 @@
 module Propellor.Spin (
 	commitSpin,
-	SpinMode(..),
 	spin,
+	spin',
 	update,
 	gitPushHelper,
 	mergeSpin,
@@ -41,41 +41,35 @@ commitSpin = do
 		void $ actionMessage "Push to central git repository" $
 			boolSystem "git" [Param "push"]
 
-data SpinMode
-	= RegularSpin
-	| RelaySpin HostName
-	| ControllingSpin
-	deriving (Eq)
+spin :: Maybe HostName -> HostName -> Host -> IO ()
+spin = spin' Nothing
 
-spin :: SpinMode -> HostName -> Host -> IO ()
-spin spinmode target hst = do
+spin' :: Maybe PrivMap -> Maybe HostName -> HostName -> Host -> IO ()
+spin' mprivdata relay target hst = do
 	cacheparams <- if viarelay
 		then pure ["-A"]
 		else toCommand <$> sshCachingParams hn
 	when viarelay $
 		void $ boolSystem "ssh-add" []
 
-	sshtarget <- ("root@" ++) <$> case spinmode of
-		RelaySpin r -> pure r
-		_ -> getSshTarget target hst
+	sshtarget <- ("root@" ++) <$> case relay of
+		Just r -> pure r
+		Nothing -> getSshTarget target hst
 
 	-- Install, or update the remote propellor.
-	updateServer target spinmode hst
+	updateServer target relay hst
 		(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd])
 		(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd])
+		getprivdata
 
 	-- And now we can run it.
 	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
 		error "remote propellor failed"
   where
-	hn = case spinmode of
-		RelaySpin h -> h
-		_ -> target
+	hn = fromMaybe target relay
 
-	relaying = spinmode == RelaySpin target
-	viarelay = not relaying && case spinmode of
-		RelaySpin _ -> True
-		_ -> False
+	relaying = relay == Just target
+	viarelay = isJust relay && not relaying
 
 	probecmd = intercalate " ; "
 		[ "if [ ! -d " ++ localdir ++ "/.git ]"
@@ -101,6 +95,17 @@ spin spinmode target hst = do
 	cmd = if viarelay
 		then "--serialized " ++ shellEscape (show (Spin [target] (Just target)))
 		else "--continue " ++ shellEscape (show (SimpleRun target))
+	
+	getprivdata = case mprivdata of
+		Nothing
+			| relaying -> do
+				let f = privDataRelay hn
+				d <- readFileStrictAnyEncoding f
+				nukeFile f
+				return (readPrivData d)
+			| otherwise -> 
+				filterPrivData hst <$> decryptPrivData
+		Just pd -> pure pd
 
 -- Check if the Host contains an IP address that matches one of the IPs
 -- in the DNS for the HostName. If so, the HostName is used as-is, 
@@ -180,22 +185,20 @@ update forhost = do
 
 updateServer
 	:: HostName
-	-> SpinMode
+	-> Maybe HostName
 	-> Host
 	-> CreateProcess
 	-> CreateProcess
+	-> IO PrivMap
 	-> IO ()
-updateServer target spinmode hst connect haveprecompiled =
+updateServer target relay hst connect haveprecompiled getprivdata =
 	withIOHandles createProcessSuccess connect go
   where
-	hn = case spinmode of
-		RelaySpin h -> h
-		_ -> target
-	relaying = spinmode == RelaySpin target
+	hn = fromMaybe target relay
 
 	go (toh, fromh) = do
 		let loop = go (toh, fromh)
-		let restart = updateServer hn spinmode hst connect haveprecompiled
+		let restart = updateServer hn relay hst connect haveprecompiled getprivdata
 		let done = return ()
 		v <- maybe Nothing readish <$> getMarked fromh statusMarker
 		case v of
@@ -214,36 +217,24 @@ updateServer target spinmode hst connect haveprecompiled =
 				hClose toh
 				hClose fromh
 				sendPrecompiled hn
-				updateServer hn spinmode hst haveprecompiled (error "loop")
+				updateServer hn relay hst haveprecompiled (error "loop") getprivdata
 			(Just NeedGitPush) -> do
 				sendGitUpdate hn fromh toh
 				hClose fromh
 				hClose toh
 				done
 			Nothing -> done
-	getprivdata
-		| relaying = do
-			let f = privDataRelay hn
-			d <- readFileStrictAnyEncoding f
-			nukeFile f
-			return d
-		| otherwise = case spinmode of
-			-- When one host is controlling another,
-			-- the controlling host's privdata includes the
-			-- privdata of the controlled host.
-			ControllingSpin -> show . filterPrivData hst . readPrivData
-				<$> readFileStrictAnyEncoding privDataLocal
-			_ -> show . filterPrivData hst <$> decryptPrivData
 
 sendRepoUrl :: Handle -> IO ()
 sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)
 
-sendPrivData :: HostName -> Handle -> String -> IO ()
+sendPrivData :: HostName -> Handle -> PrivMap -> IO ()
 sendPrivData hn toh privdata = void $ actionMessage msg $ do
-	sendMarked toh privDataMarker privdata
+	sendMarked toh privDataMarker d
 	return True
   where
-	msg = "Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn
+	msg = "Sending privdata (" ++ show (length d) ++ " bytes) to " ++ hn
+	d = show privdata
 
 sendGitUpdate :: HostName -> Handle -> Handle -> IO ()
 sendGitUpdate hn fromh toh =
-- 
cgit v1.3-2-g0d8e


From 0e39d53352b982022747e451676bc6a66e3d9acc Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 20 Oct 2015 23:37:21 -0400
Subject: refactor

---
 src/Propellor/PrivData.hs             | 4 ++++
 src/Propellor/Property/ControlHeir.hs | 4 ++--
 src/Propellor/Spin.hs                 | 4 ++--
 3 files changed, 8 insertions(+), 4 deletions(-)

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

diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 070070f0..aac37d14 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -17,6 +17,7 @@ module Propellor.PrivData (
 	makePrivDataDir,
 	decryptPrivData,
 	readPrivData,
+	readPrivDataFile,
 	PrivMap,
 	PrivInfo,
 	forceHostContext,
@@ -254,6 +255,9 @@ decryptPrivData = readPrivData <$> gpgDecrypt privDataFile
 readPrivData :: String -> PrivMap
 readPrivData = fromMaybe M.empty . readish
 
+readPrivDataFile :: FilePath -> IO PrivMap
+readPrivDataFile f = readPrivData <$> readFileStrictAnyEncoding f
+
 makePrivDataDir :: IO ()
 makePrivDataDir = createDirectoryIfMissing False privDataDir
 
diff --git a/src/Propellor/Property/ControlHeir.hs b/src/Propellor/Property/ControlHeir.hs
index 9fd2ce43..ce993a02 100644
--- a/src/Propellor/Property/ControlHeir.hs
+++ b/src/Propellor/Property/ControlHeir.hs
@@ -179,8 +179,8 @@ controllerFor h = infoProperty desc go (mkControllingInfo h <> privinfo) []
 			getInfo (hostInfo h)
 
 	go = do
-		pm <- liftIO $ filterPrivData h . readPrivData
-			<$> readFileStrictAnyEncoding privDataLocal
+		pm <- liftIO $ filterPrivData h
+			<$> readPrivDataFile privDataLocal
 		liftIO $ spin' (Just pm) Nothing (hostName h) h
 		-- Don't know if the spin made a change to
 		-- the remote host or not, but in any case,
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 3cdd8c98..0c457705 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -100,9 +100,9 @@ spin' mprivdata relay target hst = do
 		Nothing
 			| relaying -> do
 				let f = privDataRelay hn
-				d <- readFileStrictAnyEncoding f
+				d <- readPrivDataFile f
 				nukeFile f
-				return (readPrivData d)
+				return d
 			| otherwise -> 
 				filterPrivData hst <$> decryptPrivData
 		Just pd -> pure pd
-- 
cgit v1.3-2-g0d8e