summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2016-03-26 17:47:21 -0400
committerJoey Hess2016-03-26 17:47:21 -0400
commit8cbf4c96bdb77350a233c6f0934458b8486ce11e (patch)
treea5021cd1d1ffb4e0dc63c3ae7846af9c6ff96318 /src/Propellor
parentc85c462c617fe31c3fe8c97d85db4bcae838a8b2 (diff)
more porting
Conductor WIP
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/Conductor.hs26
-rw-r--r--src/Propellor/Property/SiteSpecific/Branchable.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs13
3 files changed, 22 insertions, 19 deletions
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
, "</VirtualHost>"
]
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 ++"'")