summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Spin.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Spin.hs')
-rw-r--r--src/Propellor/Property/Spin.hs160
1 files changed, 0 insertions, 160 deletions
diff --git a/src/Propellor/Property/Spin.hs b/src/Propellor/Property/Spin.hs
deleted file mode 100644
index 144f8197..00000000
--- a/src/Propellor/Property/Spin.hs
+++ /dev/null
@@ -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