summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-21 19:43:59 -0400
committerJoey Hess2015-10-21 19:43:59 -0400
commita35c50d2cdc0bc6fe6f7cc49103d6e94ea406839 (patch)
treef00066791521167a026b3ea10c30c3088dbe5ffe
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.
-rw-r--r--debian/changelog1
-rw-r--r--src/Propellor/Property/Conductor.hs49
-rw-r--r--src/Propellor/Property/File.hs3
-rw-r--r--src/Propellor/Property/Ssh.hs98
4 files changed, 116 insertions, 35 deletions
diff --git a/debian/changelog b/debian/changelog
index 32f6e310..b4819dd7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,7 @@ propellor (2.11.0) UNRELEASED; urgency=medium
* Rewrote Propellor.Property.ControlHeir one more time, renaming it to
Propellor.Property.Conductor.
+ * Added Ssh properties to remove authorized_keys and known_hosts lines.
-- Joey Hess <id@joeyh.name> Wed, 21 Oct 2015 15:06:26 -0400
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
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
+
+ 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 a line allowing
+-- | 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)