From 8cbf4c96bdb77350a233c6f0934458b8486ce11e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 17:47:21 -0400 Subject: more porting Conductor WIP --- src/Propellor/Property/Conductor.hs | 26 ++++++++++++----------- src/Propellor/Property/SiteSpecific/Branchable.hs | 2 +- src/Propellor/Property/SiteSpecific/IABak.hs | 13 ++++++------ 3 files changed, 22 insertions(+), 19 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs index 0d275b91..d97d0a72 100644 --- a/src/Propellor/Property/Conductor.hs +++ b/src/Propellor/Property/Conductor.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-} -- | This module adds conductors to propellor. A conductor is a Host that -- is responsible for running propellor on other hosts @@ -83,7 +83,7 @@ import qualified Data.Set as S -- | Class of things that can be conducted. class Conductable c where - conducts :: c -> RevertableProperty HasInfo + conducts :: c -> RevertableProperty (HasInfo + UnixLike) (HasInfo + UnixLike) instance Conductable Host where -- | Conduct the specified host. @@ -94,9 +94,9 @@ instance Conductable Host where -- will be propagated as an overall failure of the property. instance Conductable [Host] where conducts hs = - propertyList desc (map (toProp . conducts) hs) + propertyList desc (toProps $ map (setupRevertableProperty . conducts) hs) - propertyList desc (map (toProp . revert . conducts) hs) + propertyList desc (toProps $ map (undoRevertableProperty . conducts) hs) where desc = cdesc $ unwords $ map hostName hs @@ -240,9 +240,10 @@ orchestrate' h (Conductor c 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` toProp (conductorKnownHost h) +conductorFor :: Host -> Property (HasInfo + UnixLike) +conductorFor h = property desc go + `addInfoProperty` (toInfo (ConductorFor [h])) + `requires` setupRevertableProperty (conductorKnownHost h) `requires` Ssh.installed where desc = cdesc (hostName h) @@ -262,13 +263,14 @@ conductorFor h = infoProperty desc go (addInfo mempty (ConductorFor [h])) [] ) -- Reverts conductorFor. -notConductorFor :: Host -> Property HasInfo -notConductorFor h = infoProperty desc (return NoChange) (addInfo mempty (NotConductorFor [h])) [] - `requires` toProp (revert (conductorKnownHost h)) +notConductorFor :: Host -> Property (HasInfo + UnixLike) +notConductorFor h = property desc (return NoChange) + `addInfoProperty` (toInfo (NotConductorFor [h])) + `requires` undoRevertableProperty (conductorKnownHost h) where desc = "not " ++ cdesc (hostName h) -conductorKnownHost :: Host -> RevertableProperty NoInfo +conductorKnownHost :: Host -> RevertableProperty UnixLike UnixLike conductorKnownHost h = mk Ssh.knownHost @@ -290,7 +292,7 @@ addConductorPrivData h hs = h { hostInfo = hostInfo h <> i } privinfo h' = forceHostContext (hostName h') $ getInfo (hostInfo h') -- Use this property to let the specified conductor ssh in and run propellor. -conductedBy :: Host -> RevertableProperty NoInfo +conductedBy :: Host -> RevertableProperty DebianLike UnixLike conductedBy h = (setup teardown) `describe` ("conducted by " ++ hostName h) where diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs index 5c85610b..239bcbeb 100644 --- a/src/Propellor/Property/SiteSpecific/Branchable.hs +++ b/src/Propellor/Property/SiteSpecific/Branchable.hs @@ -9,7 +9,7 @@ import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Sudo as Sudo -server :: [Host] -> Property HasInfo +server :: [Host] -> Property (HasInfo + DebianLike) server hosts = propertyList "branchable server" $ props & "/etc/timezone" `File.hasContent` ["Etc/UTC"] & "/etc/locale.gen" `File.containsLines` diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index bb62fba7..b245e444 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -15,14 +15,14 @@ repo = "https://github.com/ArchiveTeam/IA.BAK/" userrepo :: String userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git" -publicFace :: Property HasInfo +publicFace :: Property DebianLike publicFace = propertyList "iabak public face" $ props & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server") & Apt.serviceInstalledRunning "apache2" & Cron.niceJob "graph-gen" (Cron.Times "*/10 * * * *") (User "root") "/" "/usr/local/IA.BAK/web/graph-gen.sh" -gitServer :: [Host] -> Property HasInfo +gitServer :: [Host] -> Property (HasInfo + DebianLike) gitServer knownhosts = propertyList "iabak git server" $ props & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server") & Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master") @@ -42,7 +42,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props "/usr/local/IA.BAK" "./expireemailer" -registrationServer :: [Host] -> Property HasInfo +registrationServer :: [Host] -> Property (HasInfo + DebianLike) registrationServer knownhosts = propertyList "iabak registration server" $ props & User.accountFor (User "registrar") & Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys @@ -66,7 +66,7 @@ sshKeys = [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5") ] -graphiteServer :: Property HasInfo +graphiteServer :: Property (HasInfo + DebianLike) graphiteServer = propertyList "iabak graphite server" $ props & Apt.serviceInstalledRunning "apache2" & Apt.installed ["libapache2-mod-wsgi", "graphite-carbon", "graphite-web"] @@ -114,7 +114,8 @@ graphiteServer = propertyList "iabak graphite server" $ props , "" ] where + graphiteCSRF :: Property (HasInfo + DebianLike) graphiteCSRF = withPrivData (Password "csrf-token") (Context "iabak.archiveteam.org") $ - \gettoken -> property "graphite-web CSRF token" $ - gettoken $ \token -> ensureProperty $ File.containsLine + \gettoken -> property' "graphite-web CSRF token" $ \w -> + gettoken $ \token -> ensureProperty w $ File.containsLine "/etc/graphite/local_settings.py" ("SECRET_KEY = '"++ privDataVal token ++"'") -- cgit v1.2.3