propellor 2.9.0 → 2.10.0

raw patch · 5 files changed

+225/−162 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• debian/changelog +7/−0
• propellor.cabal +2/−2
• src/Propellor/Property/ControlHeir.hs +209/−0
• src/Propellor/Property/Spin.hs +0/−160

@@ -1,3 +1,10 @@+propellor (2.10.0) unstable; urgency=medium++  * The Propellor.Property.Spin added in the last release is replaced+    with a very different Propellor.Property.ControlHeir.++ -- Joey Hess <id@joeyh.name>  Tue, 20 Oct 2015 21:29:12 -0400+ propellor (2.9.0) unstable; urgency=medium    * Added basic Uwsgi module, maintained by Félix Sipma.

@@ -1,3 +1,10 @@+propellor (2.10.0) unstable; urgency=medium++  * The Propellor.Property.Spin added in the last release is replaced+    with a very different Propellor.Property.ControlHeir.++ -- Joey Hess <id@joeyh.name>  Tue, 20 Oct 2015 21:29:12 -0400+ propellor (2.9.0) unstable; urgency=medium    * Added basic Uwsgi module, maintained by Félix Sipma.

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.9.0+Version: 2.10.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -76,6 +76,7 @@     Propellor.Property.Apache     Propellor.Property.Apt     Propellor.Property.Cmd+    Propellor.Property.ControlHeir     Propellor.Property.Hostname     Propellor.Property.Chroot     Propellor.Property.ConfFile@@ -109,7 +110,6 @@     Propellor.Property.Prosody     Propellor.Property.Reboot     Propellor.Property.Rsync-    Propellor.Property.Spin     Propellor.Property.Scheduled     Propellor.Property.Service     Propellor.Property.Ssh

@@ -0,0 +1,209 @@+{-# 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

@@ -1,160 +0,0 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}--module Propellor.Property.Spin (-	Spinnable(..),-	controllerFor,-	controllerKeys,-	controlledBy,-) where--import Propellor.Base-import Propellor.Spin (spin, SpinMode(..))-import Propellor.Types.Info-import qualified Propellor.Property.Ssh as Ssh--import qualified Data.Set as S---- | A class of things that can be spinned.-class Spinnable t where-	toSpin :: t -> Property HasInfo--instance Spinnable Host where-	toSpin h = infoProperty desc go (mkControllingInfo h <> privinfo) []-		`requires` Ssh.knownHost [h] (hostName h) (User "root")-	  where-		desc = cdesc (hostName h)-		go = do-			thishost <- ask-			if isControllerLoop thishost h-				then errorMessage $ unwords-					[ "controller loop detected involving"-					, hostName thishost-					, "and"-					, hostName h-					]-				else 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)---- | Each Host in the list is spinned in turn. Does not stop on spin--- failure; does propagate overall success/failure.-instance Spinnable [Host] where-	toSpin l = propertyList (cdesc $ unwords $ map hostName l) (map toSpin l)---- | The Host that has this Property is in control of running propellor on--- some other Hosts.------ Making a host a controller 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 the controlled Hosts.------ The controller needs to be able to ssh to the hosts it controls,--- and run propellor, as root. The controller is automatically configured--- with `Propellor.Property.Ssh.knownHost` to know the host keys of the --- hosts that it will ssh to. It's up to you to use `controllerKeys`--- and `controlledBy` to set up the ssh keys that will let the controller--- log into the hosts it controls.------ For example, if you have some webservers and a dnsserver,--- and want a master that runs propellor on all of them:------ > import Propellor--- > import qualified Propellor.Property.Spin as Spin--- > import qualified Propellor.Property.Ssh as Ssh--- > import qualified Propellor.Property.Cron as Cron--- > --- > main = defaultMain hosts--- >--- > hosts =--- > 	[ master--- >	, dnsserver--- >	] ++ webservers--- > --- > dnsserver = host "dns.example.com"--- >	& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]--- >    & Spin.controlledBy master--- >	& ...--- > --- > webservers =--- >    [ host "www1.example.com"--- >		& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]--- > 		& Spin.controlledBy master--- >		& ...--- >	, ...--- >	]--- >--- > master = host "master.example.com"--- >	& Spin.controllerKeys [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]--- > 	-- Only update dnsserver once all webservers are successfully updated.--- >	& Spin.controllerFor dnsserver--- >		`requires` Spin.controllerFor webservers--- >	& Cron.runPropellor------ Multiple controllers can control the same hosts. However, when--- propellor is already running on a host, a controller will fail--- to run it. So, if two controllers both try to control the same--- host at the same time, one will fail.------ Chains of controllers are supported; host A can control host B which--- controls host C. Loops of controllers are automatically prevented.------ Note that a controller can see all PrivInfo of the hosts it controls.-controllerFor :: Spinnable h => h -> Property HasInfo-controllerFor h = toSpin h-	`requires` Ssh.installed---- | Uses `Propellor.Property.Ssh.keysImported` to set up the ssh keys--- for the root user on a controller. ------ (The corresponding private keys come from the privdata.)-controllerKeys :: [(SshKeyType, Ssh.PubKeyText)] -> Property HasInfo-controllerKeys ks = Ssh.userKeys (User "root") hostContext ks-	`requires` Ssh.installed---- | 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---- To detect loops of controlled hosts, each Host's info contains a list--- of the hosts it's controlling.-newtype Controlling = Controlled [Host]-	deriving (Typeable, Monoid, Show)--isControlledBy :: Host -> Controlling -> Bool-h `isControlledBy` (Controlled hs) = any (== hostName h) (map hostName hs)--instance IsInfo Controlling where-	propagateInfo _ = True--mkControllingInfo :: Host -> Info-mkControllingInfo controlled = addInfo mempty (Controlled [controlled])--getControlledBy :: Host -> Controlling-getControlledBy = getInfo . hostInfo--isControllerLoop :: Host -> Host -> Bool-isControllerLoop controller controlled = go S.empty controlled-  where-	go checked h-		| controller `isControlledBy` c = True-		-- avoid checking loops that have been checked before-		| hostName h `S.member` checked = False-		| otherwise = any (go (S.insert (hostName h) checked)) l-	  where-		c@(Controlled l) = getControlledBy h