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. --- src/Propellor/Property/Conductor.hs | 307 ++++++++++++++++++++++++++++++++++++ 1 file changed, 307 insertions(+) create mode 100644 src/Propellor/Property/Conductor.hs (limited to 'src/Propellor/Property/Conductor.hs') diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs new file mode 100644 index 00000000..7c85858b --- /dev/null +++ b/src/Propellor/Property/Conductor.hs @@ -0,0 +1,307 @@ +{-# 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 +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) os') + where + combineos os o = case mapMaybe (`combineOrchestras` o) os of + [] -> [o] + os' -> os' +combineOrchestras' a@(Conductor h os) (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 c@(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 + os = extractOrchestras hs + go h + | isOrchestrated (getInfo (hostInfo h)) = h + | otherwise = foldl orchestrate' h (map (deloop h) os) + +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` Ssh.knownHost [h] (hostName h) (User "root") + `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 + ) + +-- 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) + +-- 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) + `describe` ("conducted by " ++ hostName h) + `requires` Ssh.installed + +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 -- cgit v1.3-2-g0d8e 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 'src/Propellor/Property/Conductor.hs') 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.3-2-g0d8e From 85f08ee913a77c16ba4d264581b1240468c4ebb2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 21 Oct 2015 19:47:00 -0400 Subject: fix build warnings --- src/Propellor/Property/Conductor.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property/Conductor.hs') diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs index ca69abb5..ed46601d 100644 --- a/src/Propellor/Property/Conductor.hs +++ b/src/Propellor/Property/Conductor.hs @@ -73,7 +73,7 @@ module Propellor.Property.Conductor ( Conductable(..), ) where -import Propellor.Base +import Propellor.Base hiding (os) import Propellor.Spin (spin') import Propellor.PrivData.Paths import Propellor.Types.Info @@ -142,12 +142,12 @@ 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) os') + | sameHost h h' = Just $ Conductor h (concatMap combineos os') where - combineos os o = case mapMaybe (`combineOrchestras` o) os of + combineos o = case mapMaybe (`combineOrchestras` o) os of [] -> [o] - os' -> os' -combineOrchestras' a@(Conductor h os) (Conducted h') + os'' -> os'' +combineOrchestras' a@(Conductor h _) (Conducted h') | sameHost h h' = Just a combineOrchestras' (Conductor h os) b | null (catMaybes (map snd osgrafts)) = Nothing @@ -164,7 +164,7 @@ sameHost a b = hostName a == hostName b -- one seen. deloop :: Host -> Orchestra -> Orchestra deloop _ (Conducted h) = Conducted h -deloop thehost c@(Conductor htop ostop) = Conductor htop $ +deloop thehost (Conductor htop ostop) = Conductor htop $ fst $ seekh [] ostop (sameHost htop thehost) where seekh l [] seen = (l, seen) @@ -287,7 +287,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i } i = mempty `addInfo` mconcat (map privinfo hs) `addInfo` Orchestrated (Any True) - privinfo h = forceHostContext (hostName h) $ getInfo (hostInfo h) + privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h') -- Use this property to let the specified conductor ssh in and run propellor. conductedBy :: Host -> RevertableProperty -- cgit v1.3-2-g0d8e