Merge branch 'joeyconfig'

7 files changed, 447 insertions, 275 deletions

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index a0be167e..9f798166 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -119,8 +119,7 @@ defaultMain hostlist = do
 	go True cmdline = updateFirst cmdline $ go False cmdline
 	go False (Spin hs mrelay) = do
 		commitSpin
-		forM_ hs $ \hn -> withhost hn $
-			spin (maybe RegularSpin RelaySpin mrelay) hn
+		forM_ hs $ \hn -> withhost hn $ spin mrelay hn
 	go False cmdline@(SimpleRun hn) = buildFirst cmdline $
 		go False (Run hn)
 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
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/Conductor.hs b/src/Propellor/Property/Conductor.hs
new file mode 100644
index 00000000..ed46601d
--- /dev/null
+++ b/src/Propellor/Property/Conductor.hs
@@ -0,0 +1,328 @@
+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
+-- | This module adds conductors to propellor. A conductor is a Host that
+-- is responsible for running propellor on other hosts
+--
+-- This eliminates the need to manually run propellor --spin to
+-- update the conducted hosts, and can be used to orchestrate updates
+-- to hosts.
+--
+-- The conductor needs to be able to ssh to the hosts it conducts,
+-- and run propellor, as root. To this end, 
+-- the `Propellor.Property.Ssh.knownHost` property is automatically
+-- added to the conductor, so it knows the host keys of the relevant hosts.
+-- Also, each conducted host is configured to let its conductor
+-- ssh in as root, by automatically adding the
+-- `Propellor.Property.Ssh.authorizedKeysFrom` property.
+--
+-- It's left up to you to use `Propellor.Property.Ssh.userKeys` to
+-- configure the ssh keys for the root user on conductor hosts,
+-- and to use `Ssh.hostKeys` to configure the host keys for the 
+-- conducted hosts.
+--
+-- For example, if you have some webservers and a dnsserver,
+-- and want the master host to conduct all of them:
+--
+-- > import Propellor
+-- > import Propellor.Property.Conductor
+-- > import qualified Propellor.Property.Ssh as Ssh
+-- > import qualified Propellor.Property.Cron as Cron
+-- > 
+-- > main = defaultMain (orchestrate hosts)
+-- >
+-- > hosts =
+-- > 	[ master
+-- >	, dnsserver
+-- >	] ++ webservers
+-- > 
+-- > dnsserver = host "dns.example.com"
+-- >	& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]
+-- >	& ...
+-- > 
+-- > webservers =
+-- >    [ host "www1.example.com"
+-- >		& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]
+-- >		& ...
+-- >	, ...
+-- >	]
+-- >
+-- > master = host "master.example.com"
+-- >	& Ssh.userKeys (User "root") [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]
+-- >	& conducts webservers
+-- >		`before` conducts dnsserver
+-- >	& Cron.runPropellor
+--
+-- Notice that, in the above example, the the webservers are conducted
+-- first. Only once the webservers have successfully been set up is the
+-- dnsserver updated. This way, when adding a new web server, the dns
+-- won't list it until it's ready.
+--
+-- There can be multiple conductors, and conductors can conduct other
+-- conductors if you need such a hierarchy. (Loops in the hierarchy, such
+-- as a host conducting itself, are detected and automatically broken.)
+--
+-- While it's allowed for a single host to be conducted by
+-- multiple conductors, the results can be discordent.
+-- Since only one propellor process can be run on a host at a time,
+-- one of the conductors will fail to communicate with it.
+--
+-- Note that a conductor can see all PrivData of the hosts it conducts.
+
+module Propellor.Property.Conductor (
+	orchestrate,
+	Conductable(..),
+) where
+
+import Propellor.Base hiding (os)
+import Propellor.Spin (spin')
+import Propellor.PrivData.Paths
+import Propellor.Types.Info
+import qualified Propellor.Property.Ssh as Ssh
+
+import qualified Data.Set as S
+
+-- | Class of things that can be conducted.
+class Conductable c where
+	conducts :: c -> RevertableProperty
+
+instance Conductable Host where
+	-- | Conduct the specified host.
+	conducts h = conductorFor h <!> notConductorFor h
+
+-- | Each host in the list will be conducted in turn. Failure to conduct
+-- one host does not prevent conducting subsequent hosts in the list, but
+-- will be propagated as an overall failure of the property.
+instance Conductable [Host] where
+	conducts hs = 
+		propertyList desc (map (toProp . conducts) hs)
+			<!>
+		propertyList desc (map (toProp . revert . conducts) hs)
+	  where
+		desc = cdesc $ unwords $ map hostName hs
+
+data Orchestra
+	= Conductor Host [Orchestra]
+	| Conducted Host
+
+instance Show Orchestra where
+	show (Conductor h l) = "Conductor " ++ hostName h ++ " (" ++ show l ++ ")"
+	show (Conducted h) = "Conducted " ++ hostName h
+
+fullOrchestra :: Orchestra -> Bool
+fullOrchestra (Conductor _ _) = True
+fullOrchestra (Conducted _) = False
+
+topHost :: Orchestra -> Host
+topHost (Conducted h) = h
+topHost (Conductor h _) = h
+
+allHosts :: Orchestra -> [Host]
+allHosts (Conducted h) = [h]
+allHosts (Conductor h l) = h : concatMap allHosts l
+
+-- Makes an Orchestra for the host, and any hosts it's conducting.
+mkOrchestra :: Host -> Orchestra
+mkOrchestra = fromJust . go S.empty
+  where
+	go seen h
+		| S.member (hostName h) seen = Nothing -- break loop
+		| otherwise = Just $ case getInfo (hostInfo h) of
+			ConductorFor [] -> Conducted h
+			ConductorFor l -> 
+				let seen' = S.insert (hostName h) seen
+				in Conductor h (mapMaybe (go seen') l)
+
+-- Combines the two orchestras, if there's a place, or places where they
+-- can be grafted together.
+combineOrchestras :: Orchestra -> Orchestra -> Maybe Orchestra
+combineOrchestras a b = combineOrchestras' a b <|> combineOrchestras' b a
+
+combineOrchestras' :: Orchestra -> Orchestra -> Maybe Orchestra
+combineOrchestras' (Conducted h) b
+	| sameHost h (topHost b) = Just b
+	| otherwise = Nothing
+combineOrchestras' (Conductor h os) (Conductor h' os')
+	| sameHost h h' = Just $ Conductor h (concatMap combineos os')
+  where
+	combineos o = case mapMaybe (`combineOrchestras` o) os of
+		[] -> [o]
+		os'' -> os''
+combineOrchestras' a@(Conductor h _) (Conducted h')
+	| sameHost h h' = Just a
+combineOrchestras' (Conductor h os) b
+	| null (catMaybes (map snd osgrafts)) = Nothing
+	| otherwise = Just $ Conductor h (map (uncurry fromMaybe) osgrafts)
+  where
+	osgrafts = zip os (map (`combineOrchestras` b) os)
+
+sameHost :: Host -> Host -> Bool
+sameHost a b = hostName a == hostName b
+
+-- Removes any loops that may be present in the Orchestra involving
+-- the passed Host. This is a matter of traversing the Orchestra
+-- top-down, and removing all occurrances of the host after the first
+-- one seen.
+deloop :: Host -> Orchestra -> Orchestra
+deloop _ (Conducted h) = Conducted h
+deloop thehost (Conductor htop ostop) = Conductor htop $
+	fst $ seekh [] ostop (sameHost htop thehost)
+  where
+	seekh l [] seen = (l, seen)
+	seekh l ((Conducted h) : rest) seen
+		| sameHost h thehost = 
+			if seen
+				then seekh l rest seen
+				else seekh (Conducted h : l) rest True
+		| otherwise = seekh (Conducted h:l) rest seen
+	seekh l ((Conductor h os) : rest) seen
+		| sameHost h thehost =
+			if seen
+				then seekh l rest seen
+				else 
+					let (os', _seen') = seekh [] os True
+					in seekh (Conductor h os' : l) rest True
+		| otherwise = 
+			let (os', seen') = seekh [] os seen
+			in seekh (Conductor h os' : l) rest seen'
+
+-- Extracts the Orchestras from a list of hosts.
+--
+-- Method: For each host that is a conductor, check the
+-- list of orchesteras to see if any already contain that host, or
+-- any of the hosts it conducts. If so, add the host to that
+-- orchestra. If not, start a new orchestra.
+--
+-- The result is a set of orchestras, which are each fully disconnected
+-- from the other. Some may contain loops.
+extractOrchestras :: [Host] -> [Orchestra]
+extractOrchestras = filter fullOrchestra . go [] . map mkOrchestra
+  where
+	go os [] = os
+	go os (o:rest) = 
+		let os' = zip os (map (combineOrchestras o) os)
+		in case catMaybes (map snd os') of
+			[] -> go (o:os) rest
+			[_] -> go (map (uncurry fromMaybe) os') rest
+			_ -> error "Bug: Host somehow ended up in multiple Orchestras!"
+
+-- | Pass this a list of all your hosts; it will finish setting up
+-- orchestration as configured by the `conducts` properties you add to
+-- hosts.
+--
+-- > main = defaultMain $ orchestrate hosts
+orchestrate :: [Host] -> [Host]
+orchestrate hs = map go hs
+  where
+	go h
+		| isOrchestrated (getInfo (hostInfo h)) = h
+		| otherwise = foldl orchestrate' (removeold h) (map (deloop h) os)
+	os = extractOrchestras hs
+
+	removeold h = foldl removeold' h (oldconductorsof h)
+	removeold' h oldconductor = h & revert (conductedBy oldconductor)
+
+	oldconductors = zip hs (map (getInfo . hostInfo) hs)
+	oldconductorsof h = flip mapMaybe oldconductors $ 
+		\(oldconductor, NotConductorFor l) ->
+			if any (sameHost h) l
+				then Just oldconductor
+				else Nothing
+
+orchestrate' :: Host -> Orchestra -> Host
+orchestrate' h (Conducted _) = h
+orchestrate' h (Conductor c l)
+	| sameHost h c = cont $ addConductorPrivData h (concatMap allHosts l)
+	| any (sameHost h) (map topHost l) = cont $ h & conductedBy c
+	| otherwise = cont h
+  where
+	cont h' = foldl orchestrate' h' l
+
+-- The host this property is added to becomes the conductor for the
+-- specified Host. Note that `orchestrate` must be used for this property
+-- to have any effect.
+conductorFor :: Host -> Property HasInfo
+conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
+	`requires` toProp (conductorKnownHost h)
+	`requires` Ssh.installed
+  where
+	desc = cdesc (hostName h)
+
+	go = ifM (isOrchestrated <$> askInfo)
+		( do
+			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,
+			-- the local host was not changed.
+			noChange
+		, do
+			warningMessage "Can't conduct; either orchestrate has not been used, or there is a conductor loop."
+			return FailedChange
+		)
+
+-- Reverts conductorFor.
+notConductorFor :: Host -> Property HasInfo
+notConductorFor h = infoProperty desc (return NoChange) (addInfo mempty (NotConductorFor [h])) []
+	`requires` toProp (revert (conductorKnownHost h))
+  where
+	desc = "not " ++ cdesc (hostName h)
+
+conductorKnownHost :: Host -> RevertableProperty
+conductorKnownHost h = 
+	mk Ssh.knownHost
+		<!>
+	mk Ssh.unknownHost
+  where
+	mk p = p [h] (hostName h) (User "root")
+
+-- Gives a conductor access to all the PrivData of the specified hosts.
+-- This allows it to send it on the the hosts when conducting it.
+--
+-- This is not done in conductorFor, so that it can be added
+-- at the orchestration stage, and so is not added when there's a loop.
+addConductorPrivData :: Host -> [Host] -> Host
+addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
+  where
+	i = mempty 
+		`addInfo` mconcat (map privinfo hs)
+		`addInfo` Orchestrated (Any True)
+	privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h')
+
+-- Use this property to let the specified conductor ssh in and run propellor.
+conductedBy :: Host -> RevertableProperty
+conductedBy h = (setup <!> teardown)
+	`describe` ("conducted by " ++ hostName h)
+  where
+	setup = User "root" `Ssh.authorizedKeysFrom` (User "root", h)
+		`requires` Ssh.installed
+	teardown = User "root" `Ssh.unauthorizedKeysFrom` (User "root", h)
+
+cdesc :: String -> Desc
+cdesc n = "conducting " ++ n
+
+-- A Host's Info indicates when it's a conductor for hosts, and when it's
+-- stopped being a conductor.
+newtype ConductorFor = ConductorFor [Host]
+	deriving (Typeable, Monoid)
+newtype NotConductorFor = NotConductorFor [Host]
+	deriving (Typeable, Monoid)
+
+instance Show ConductorFor where
+	show (ConductorFor l) = "ConductorFor " ++ show (map hostName l)
+instance Show NotConductorFor where
+	show (NotConductorFor l) = "NotConductorFor " ++ show (map hostName l)
+
+instance IsInfo ConductorFor where
+	propagateInfo _ = False
+instance IsInfo NotConductorFor where
+	propagateInfo _ = False
+
+-- Added to Info when a host has been orchestrated.
+newtype Orchestrated = Orchestrated Any
+	deriving (Typeable, Monoid, Show)
+instance IsInfo Orchestrated where
+	propagateInfo _ = False
+
+isOrchestrated :: Orchestrated -> Bool
+isOrchestrated (Orchestrated v) = getAny v
diff --git a/src/Propellor/Property/ControlHeir.hs b/src/Propellor/Property/ControlHeir.hs
deleted file mode 100644
index 531f884a..00000000
--- a/src/Propellor/Property/ControlHeir.hs
+++ /dev/null
@@ -1,209 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
-module Propellor.Property.ControlHeir (
-	ControlHeir(..),
-	ControlList(..),
-	addControlHeir,
-	ControllerOf(..),
-) where
-
-import Propellor.Base
-import Propellor.Spin (spin, SpinMode(..))
-import Propellor.Types.Info
-import qualified Propellor.Property.Ssh as Ssh
-
--- | A hierarchy of control. When propellor is run on a host that
--- is a Controller, it in turn spins each of the hosts in its control
--- list.
---
--- There can be multiple levels of controllers in the hierarchy.
---
--- Multiple controllers can control the same hosts. However, when
--- propellor is already running on a host, a controller will fail
--- to spin it. So, if two controllers both try to control the same
--- host at the same time, one will fail.
--- 
--- (Loops in the hierarchy, such as a host controlling itself,
--- are detected and automatically broken.)
-data ControlHeir
-	= Controller Host ControlList
-	| Controlled Host
-
-instance Show ControlHeir where
-	show (Controller h l) = "Controller " ++ hostName h ++ " (" ++ show l ++ ")"
-	show (Controlled h) = "Controlled " ++ hostName h
-
-data ControlList
-	-- | A list of hosts to control. Failure to spin one host does not
-	-- prevent spinning later hosts in the list.
-	= ControlList [ControlHeir]
-	-- | Requires the first host to be successfully spinned before
-	-- proceeding to spin the hosts in the ControlList.
-	| ControlReq ControlHeir ControlList
-	deriving (Show)
-
-listHeir :: ControlList -> [ControlHeir]
-listHeir (ControlList l) = l
-listHeir (ControlReq h l) = h : listHeir l
-
-class DirectlyControlled a where
-	directlyControlled :: a -> [Host]
-
-instance DirectlyControlled ControlHeir where
-	directlyControlled (Controlled h) = [h]
-	directlyControlled (Controller h _) = [h]
-
-instance DirectlyControlled ControlList where
-	directlyControlled = concatMap directlyControlled . listHeir
-
--- Removes any loops that may be present in the ControlHeir involving
--- the passed Host. This is a simple matter of removing the Host from any
--- sub-hierarchies.
-deloop :: Host -> ControlHeir -> ControlHeir
-deloop _ (Controlled h) = Controlled h
-deloop thehost (Controller h cl) = Controller h (removeh cl)
-  where
-	removeh (ControlList l) = ControlList (mapMaybe removeh' l)
-	removeh (ControlReq ch cl') = case removeh' ch of
-		Just ch' -> ControlReq ch' (removeh cl')
-		Nothing -> removeh cl'
-	removeh' (Controlled h')
-		| hostName h' == hostName thehost = Nothing
-		| otherwise = Just (Controlled h')
-	removeh' (Controller h' cl')
-		| hostName h' == hostName thehost = Nothing
-		| otherwise = Just (Controller h' (removeh cl'))
-
--- | Applies a ControlHeir to a list of hosts.
---
--- This eliminates the need to manually run propellor --spin to
--- update the controlled hosts. Each time propellor is run
--- on the controller host, it will in turn run propellor
--- on each of the controlled Hosts.
---
--- The controller needs to be able to ssh to the hosts it controls,
--- and run propellor, as root. To this end, 
--- the `Propellor.Property.Ssh.knownHost` property is added to the
--- controller, so it knows the host keys of the hosts it controlls.
---
--- Each controlled host is configured to let its controller
--- ssh in as root. This is done by adding the 
--- `Propellor.Property.Ssh.authorizedKeysFrom` property, with
--- `User "root"`.
---
--- It's left up to you to use `Propellor.Property.Ssh.userKeys` to
--- configure the ssh keys for the root user on controller hosts,
--- and to use `Ssh.hostKeys` to configure the host keys for the controlled
--- hosts.
---
--- For example, if you have some webservers and a dnsserver,
--- and want a master that runs propellor on all of them:
---
--- > import Propellor
--- > import Propellor.Property.ControlHeir
--- > import qualified Propellor.Property.Ssh as Ssh
--- > import qualified Propellor.Property.Cron as Cron
--- > 
--- > main = defaultMain (hosts `addControlHeir` control)
--- >
--- > hosts =
--- > 	[ master
--- >	, dnsserver
--- >	] ++ webservers
--- > 
--- > control = Controller master (ControlList (map Controlled (dnsserver:webservers)))
--- >
--- > dnsserver = host "dns.example.com"
--- >	& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]
--- >	& ...
--- > 
--- > webservers =
--- >    [ host "www1.example.com"
--- >		& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]
--- >		& ...
--- >	, ...
--- >	]
--- >
--- > master = host "master.example.com"
--- >	& Ssh.userKeys (User "root") [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]
--- >	& Cron.runPropellor
---
--- Note that a controller can see all PrivData of the hosts below it in
--- the ControlHeir.
-addControlHeir :: [Host] -> ControlHeir -> [Host]
-addControlHeir hs (Controlled _) = hs
-addControlHeir hs c@(Controller _ _)
-	| any isController hs = error "Detected repeated applications of addControlHeir. Since loop prevention only works within a single application, repeated application is unsafe and not allowed."
-	| otherwise = map (\h -> addControlHeir' h (deloop h c)) hs
-
--- Walk through the ControlHeir, and add properties to the Host
--- depending on where it appears in the ControlHeir.
--- (Loops are already removed before this point.)
-addControlHeir' :: Host -> ControlHeir -> Host
-addControlHeir' h (Controlled _) = h
-addControlHeir' h (Controller controller l)
-	| hn == hostName controller = cont $
-		h & mkcontroller l
-	| hn `elem` map hostName (directlyControlled l) = cont $
-		h & controlledBy controller
-	| otherwise = cont h
-  where
-	hn = hostName h
-
-	cont h' = foldl addControlHeir' h' (listHeir l)
-	
-	mkcontroller (ControlList l') =
-		mkcontroller' (concatMap directlyControlled l')
-	mkcontroller (ControlReq h' l') =
-		mkcontroller' (directlyControlled h')
-			`before` mkcontroller l' 
-	mkcontroller' l' = propertyList
-		(cdesc $ unwords $ map hostName l')
-		(map controllerFor l')
-
--- | The host this property is added to becomes the controller for the
--- specified Host.
-controllerFor :: Host -> Property HasInfo
-controllerFor h = infoProperty desc go (mkControllingInfo h <> privinfo) []
-	`requires` Ssh.knownHost [h] (hostName h) (User "root")
-	`requires` Ssh.installed
-  where
-	desc = cdesc (hostName h)
-
-	go = do
-		liftIO $ spin ControllingSpin (hostName h) h
-		-- Don't know if the spin made a change to
-		-- the remote host or not, but in any case,
-		-- the local host was not changed.
-		noChange
-
-	-- Make the controlling host have all the remote host's
-	-- PrivData, so it can send it on to the remote host
-	-- when spinning it.
-	privinfo = addInfo mempty $
-		forceHostContext (hostName h) $
-			getInfo (hostInfo h)
-
--- | Use this property to let the specified controller Host ssh in
--- and run propellor.
-controlledBy :: Host -> Property NoInfo
-controlledBy h = User "root" `Ssh.authorizedKeysFrom` (User "root", h)
-	`requires` Ssh.installed
-
-cdesc :: String -> Desc
-cdesc n = "controller for " ++ n
-
--- | Each Host's info contains a list of the names of hosts it's controlling.
-newtype ControllerOf = ControllerOf [HostName]
-	deriving (Typeable, Monoid, Show)
-
-instance IsInfo ControllerOf where
-	propagateInfo _ = True
-
-mkControllingInfo :: Host -> Info
-mkControllingInfo controlled = addInfo mempty (ControllerOf [hostName controlled])
-
-isController :: Host -> Bool
-isController h = case getInfo (hostInfo h) of
-	ControllerOf [] -> False
-	_ -> True
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 08fdc780..7e421cb7 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -67,6 +67,9 @@ f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
 lacksLine :: FilePath -> Line -> Property NoInfo
 f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
 
+lacksLines :: FilePath -> [Line] -> Property NoInfo
+f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
+
 -- | Removes a file. Does not remove symlinks or non-plain-files.
 notPresent :: FilePath -> Property NoInfo
 notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ 
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index fa07c6f8..5ba069e3 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -24,9 +24,12 @@ module Propellor.Property.Ssh (
 	userKeys,
 	userKeyAt,
 	knownHost,
+	unknownHost,
 	authorizedKeysFrom,
+	unauthorizedKeysFrom,
 	authorizedKeys,
 	authorizedKey,
+	unauthorizedKey,
 	hasAuthorizedKeys,
 	getUserPubKeys,
 ) where
@@ -300,23 +303,46 @@ fromKeyType SshEd25519 = "ed25519"
 -- or `hostKey` into the known_hosts file for a user.
 knownHost :: [Host] -> HostName -> User -> Property NoInfo
 knownHost hosts hn user@(User u) = property desc $
-	go =<< fromHost hosts hn getHostPubKey
+	go =<< knownHostLines hosts hn
   where
 	desc = u ++ " knows ssh key for " ++ hn
-	go (Just m) | not (M.null m) = do
-		f <- liftIO $ dotFile "known_hosts" user
-		ensureProperty $ combineProperties desc
-			[ File.dirExists (takeDirectory f)
-			, f `File.containsLines`
-				(map (\k -> hn ++ " " ++ k) (M.elems m))
-			, File.ownerGroup f user (userGroup user)
-			, File.ownerGroup (takeDirectory f) user (userGroup user)
-			]
-	go _ = do
+
+	go [] = do
 		warningMessage $ "no configured ssh host keys for " ++ hn
 		return FailedChange
+	go ls = do
+		f <- liftIO $ dotFile "known_hosts" user
+		modKnownHost user f $
+			f `File.containsLines` ls
+				`requires` File.dirExists (takeDirectory f)
+
+-- | Reverts `knownHost`
+unknownHost :: [Host] -> HostName -> User -> Property NoInfo
+unknownHost hosts hn user@(User u) = property desc $
+	go =<< knownHostLines hosts hn
+  where
+	desc = u ++ " does not know ssh key for " ++ hn
 
--- | Ensures that a local user's authorized keys contains a line allowing
+	go [] = return NoChange
+	go ls = do
+		f <- liftIO $ dotFile "known_hosts" user
+		ifM (liftIO $ doesFileExist f)
+			( modKnownHost user f $ f `File.lacksLines` ls
+			, return NoChange
+			)
+
+knownHostLines :: [Host] -> HostName -> Propellor [File.Line]
+knownHostLines hosts hn = keylines <$> fromHost hosts hn getHostPubKey
+  where
+	keylines (Just m) = map (\k -> hn ++ " " ++ k) (M.elems m)
+	keylines Nothing = []
+
+modKnownHost :: User -> FilePath -> Property NoInfo -> Propellor Result
+modKnownHost user f p = ensureProperty $ p
+	`requires` File.ownerGroup f user (userGroup user)
+	`requires` File.ownerGroup (takeDirectory f) user (userGroup user)
+
+-- | Ensures that a local user's authorized_keys contains lines allowing
 -- logins from a remote user on the specified Host.
 --
 -- The ssh keys of the remote user can be set using `keysImported`
@@ -324,15 +350,32 @@ knownHost hosts hn user@(User u) = property desc $
 -- Any other lines in the authorized_keys file are preserved as-is.
 authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
 localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = 
-	property desc $ go =<< fromHost' remotehost (getUserPubKeys remoteuser)
+	property desc (go =<< authorizedKeyLines remoteuser remotehost)
   where
 	remote = rn ++ "@" ++ hostName remotehost
 	desc = ln ++ " authorized_keys from " ++ remote
+
 	go [] = do
 		warningMessage $ "no configured ssh user keys for " ++ remote
 		return FailedChange
-	go ks = ensureProperty $ combineProperties desc $
-		map (authorizedKey localuser . snd) ks
+	go ls = ensureProperty $ combineProperties desc $
+		map (authorizedKey localuser) ls
+
+-- | Reverts `authorizedKeysFrom`
+unauthorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
+localuser@(User ln) `unauthorizedKeysFrom` (remoteuser@(User rn), remotehost) =
+	property desc (go =<< authorizedKeyLines remoteuser remotehost)
+  where
+	remote = rn ++ "@" ++ hostName remotehost
+	desc = ln ++ " unauthorized_keys from " ++ remote
+
+	go [] = return NoChange
+	go ls = ensureProperty $ combineProperties desc $
+		map (unauthorizedKey localuser) ls
+	
+authorizedKeyLines :: User -> Host -> Propellor [File.Line]
+authorizedKeyLines remoteuser remotehost = 
+	map snd <$> fromHost' remotehost (getUserPubKeys remoteuser)
 
 -- | Makes a user have authorized_keys from the PrivData
 --
@@ -354,12 +397,25 @@ authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) contex
 authorizedKey :: User -> String -> Property NoInfo
 authorizedKey user@(User u) l = property desc $ do
 	f <- liftIO $ dotFile "authorized_keys" user
-	ensureProperty $ combineProperties desc
-		[ f `File.containsLine` l
+	modAuthorizedKey f user $
+		f `File.containsLine` l
 			`requires` File.dirExists (takeDirectory f)
-			`onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
-		, File.ownerGroup f user (userGroup user)
-		, File.ownerGroup (takeDirectory f) user (userGroup user)
-		]
   where
 	desc = u ++ " has authorized_keys"
+
+-- | Reverts `authorizedKey`
+unauthorizedKey :: User -> String -> Property NoInfo
+unauthorizedKey user@(User u) l = property desc $ do
+	f <- liftIO $ dotFile "authorized_keys" user
+	ifM (liftIO $ doesFileExist f) 
+		( modAuthorizedKey f user $ f `File.lacksLine` l
+		, return NoChange
+		)
+  where
+	desc = u ++ " lacks authorized_keys"
+
+modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result
+modAuthorizedKey f user p = ensureProperty $ p
+	`requires` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
+	`requires` File.ownerGroup f user (userGroup user)
+	`requires` File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 587a7f76..0c457705 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 <- readPrivDataFile f
+				nukeFile f
+				return 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 =