summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Conductor.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-21 19:43:59 -0400
committerJoey Hess2015-10-21 19:43:59 -0400
commita35c50d2cdc0bc6fe6f7cc49103d6e94ea406839 (patch)
treef00066791521167a026b3ea10c30c3088dbe5ffe /src/Propellor/Property/Conductor.hs
parent84413dd508f20e4f62293b4c925962b8dfe2987e (diff)
Added Ssh properties to remove authorized_keys and known_hosts lines.
And use when reverting conductor property. Note that I didn't convert existing ssh properties to RevertablePropery because the API change was too annoying to work through.
Diffstat (limited to 'src/Propellor/Property/Conductor.hs')
-rw-r--r--src/Propellor/Property/Conductor.hs49
1 files changed, 35 insertions, 14 deletions
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 7c85858b..ca69abb5 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -213,17 +213,26 @@ extractOrchestras = filter fullOrchestra . go [] . map mkOrchestra
orchestrate :: [Host] -> [Host]
orchestrate hs = map go hs
where
- os = extractOrchestras hs
go h
| isOrchestrated (getInfo (hostInfo h)) = h
- | otherwise = foldl orchestrate' h (map (deloop h) os)
+ | 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
+ | any (sameHost h) (map topHost l) = cont $ h & conductedBy c
| otherwise = cont h
where
cont h' = foldl orchestrate' h' l
@@ -233,7 +242,7 @@ orchestrate' h (Conductor c l)
-- to have any effect.
conductorFor :: Host -> Property HasInfo
conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
- `requires` Ssh.knownHost [h] (hostName h) (User "root")
+ `requires` toProp (conductorKnownHost h)
`requires` Ssh.installed
where
desc = cdesc (hostName h)
@@ -252,6 +261,21 @@ conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) []
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.
--
@@ -265,17 +289,14 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i }
`addInfo` Orchestrated (Any True)
privinfo h = forceHostContext (hostName h) $ getInfo (hostInfo h)
--- Reverts conductorFor.
-notConductorFor :: Host -> Property HasInfo
-notConductorFor h = pureInfoProperty desc (NotConductorFor [h])
- where
- desc = "not " ++ cdesc (hostName h)
-
-- Use this property to let the specified conductor ssh in and run propellor.
-conductedBy :: Host -> Property NoInfo
-conductedBy h = User "root" `Ssh.authorizedKeysFrom` (User "root", h)
+conductedBy :: Host -> RevertableProperty
+conductedBy h = (setup <!> teardown)
`describe` ("conducted by " ++ hostName h)
- `requires` Ssh.installed
+ 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