From 84413dd508f20e4f62293b4c925962b8dfe2987e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 21 Oct 2015 15:08:41 -0400 Subject: Rewrote Propellor.Property.ControlHeir one more time, renaming it to Propellor.Property.Conductor. Wow, really.. So, this gets back to having properties that are added to hosts to say what they conduct. I think that conducts webservers `before` conducts dnsserver is an important thing to be able to express. Untested except for eyeballing the resulting Host data. --- debian/changelog | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index f8bd5ad5..32f6e310 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +propellor (2.11.0) UNRELEASED; urgency=medium + + * Rewrote Propellor.Property.ControlHeir one more time, renaming it to + Propellor.Property.Conductor. + + -- Joey Hess Wed, 21 Oct 2015 15:06:26 -0400 + propellor (2.10.0) unstable; urgency=medium * The Propellor.Property.Spin added in the last release is replaced -- cgit v1.2.3 From a35c50d2cdc0bc6fe6f7cc49103d6e94ea406839 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 21 Oct 2015 19:43:59 -0400 Subject: 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. --- debian/changelog | 1 + src/Propellor/Property/Conductor.hs | 49 +++++++++++++------ src/Propellor/Property/File.hs | 3 ++ src/Propellor/Property/Ssh.hs | 98 +++++++++++++++++++++++++++++-------- 4 files changed, 116 insertions(+), 35 deletions(-) (limited to 'debian') 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 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) -- cgit v1.2.3