summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-07-06 15:56:56 -0400
committerJoey Hess2014-07-06 15:56:56 -0400
commit58f79c12aad3511b70f2233226d3f0afc5214b10 (patch)
tree3ec92668278f03d9e99c1008d386b6270694a92d /src/Propellor/Property
parent9f781db6daaff6f6cbc8d50d57bea0c188d3a0fa (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Docker.hs7
-rw-r--r--src/Propellor/Property/File.hs13
-rw-r--r--src/Propellor/Property/Gpg.hs17
-rw-r--r--src/Propellor/Property/OpenId.hs5
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs38
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs28
-rw-r--r--src/Propellor/Property/Ssh.hs45
-rw-r--r--src/Propellor/Property/User.hs23
8 files changed, 91 insertions, 85 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 1521eb65..4d443986 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -55,10 +55,11 @@ installed = Apt.installed ["docker.io"]
-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io. Optional.
configured :: Property
-configured = property "docker configured" go `requires` installed
+configured = prop `requires` installed
where
- go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $
- "/root/.dockercfg" `File.hasContent` (lines cfg)
+ prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
+ property "docker configured" $ getcfg $ \cfg -> ensureProperty $
+ "/root/.dockercfg" `File.hasContent` (lines cfg)
-- | A short descriptive name for a container.
-- Should not contain whitespace or other unusual characters,
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 0b060177..0e738f25 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -17,16 +17,17 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
--
-- The file's permissions are preserved if the file already existed.
-- Otherwise, they're set to 600.
-hasPrivContent :: FilePath -> Property
-hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent ->
- ensureProperty $ fileProperty' writeFileProtected desc
- (\_oldcontent -> lines privcontent) f
+hasPrivContent :: FilePath -> Context -> Property
+hasPrivContent f context = withPrivData (PrivFile f) context $ \getcontent ->
+ property desc $ getcontent $ \privcontent ->
+ ensureProperty $ fileProperty' writeFileProtected desc
+ (\_oldcontent -> lines privcontent) f
where
desc = "privcontent " ++ f
-- | Leaves the file world-readable.
-hasPrivContentExposed :: FilePath -> Property
-hasPrivContentExposed f = hasPrivContent f `onChange`
+hasPrivContentExposed :: FilePath -> Context -> Property
+hasPrivContentExposed f context = hasPrivContent f context `onChange`
mode f (combineModes (ownerWriteMode:readModes))
-- | Ensures that a line is present in a file, adding it to the end if not.
diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs
index 64ea9fea..b4698663 100644
--- a/src/Propellor/Property/Gpg.hs
+++ b/src/Propellor/Property/Gpg.hs
@@ -9,6 +9,8 @@ import System.PosixCompat
installed :: Property
installed = Apt.installed ["gnupg"]
+type GpgKeyId = String
+
-- | Sets up a user with a gpg key from the privdata.
--
-- Note that if a secret key is exported using gpg -a --export-secret-key,
@@ -21,19 +23,20 @@ installed = Apt.installed ["gnupg"]
-- The GpgKeyId does not have to be a numeric id; it can just as easily
-- be a description of the key.
keyImported :: GpgKeyId -> UserName -> Property
-keyImported keyid user = flagFile' (property desc go) genflag
+keyImported keyid user = flagFile' prop genflag
`requires` installed
where
desc = user ++ " has gpg key " ++ show keyid
genflag = do
d <- dotDir user
return $ d </> ".propellor-imported-keyid-" ++ keyid
- go = withPrivData (GpgKey keyid) $ \key -> makeChange $
- withHandle StdinHandle createProcessSuccess
- (proc "su" ["-c", "gpg --import", user]) $ \h -> do
- fileEncoding h
- hPutStr h key
- hClose h
+ prop = withPrivData GpgKey (Context keyid) $ \getkey ->
+ property desc $ getkey $ \key -> makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "su" ["-c", "gpg --import", user]) $ \h -> do
+ fileEncoding h
+ hPutStr h key
+ hClose h
dotDir :: UserName -> IO FilePath
dotDir user = do
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index 051d6425..39cb6ff0 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -25,5 +25,6 @@ providerFor users baseurl = propertyList desc $
-- the identitites directory controls access, so open up
-- file mode
- identfile u = File.hasPrivContentExposed $
- concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
+ identfile u = File.hasPrivContentExposed
+ (concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
+ (Context baseurl)
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 85584e43..4cb26a50 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -23,29 +23,25 @@ builddir = gitbuilderdir </> "build"
type TimeOut = String -- eg, 5h
-autobuilder :: CronTimes -> TimeOut -> Bool -> Property
-autobuilder crontimes timeout rsyncupload = combineProperties "gitannexbuilder"
+autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
+autobuilder arch crontimes timeout = combineProperties "gitannexbuilder"
[ Apt.serviceInstalledRunning "cron"
, Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $
"git pull ; timeout " ++ timeout ++ " ./autobuild"
-- The builduser account does not have a password set,
-- instead use the password privdata to hold the rsync server
-- password used to upload the built image.
- , property "rsync password" $ do
- let f = homedir </> "rsyncpassword"
- if rsyncupload
- then withPrivData (Password builduser) $ \p -> do
- oldp <- liftIO $ catchDefaultIO "" $
- readFileStrict f
- if p /= oldp
- then makeChange $ writeFile f p
- else noChange
- else do
- ifM (liftIO $ doesFileExist f)
- ( noChange
- , makeChange $ writeFile f "no password configured"
- )
+ , withPrivData (Password builduser) context $ \getpw ->
+ property "rsync password" $ getpw $ \pw -> do
+ oldpw <- liftIO $ catchDefaultIO "" $
+ readFileStrict pwfile
+ if pw /= oldpw
+ then makeChange $ writeFile pwfile pw
+ else noChange
]
+ where
+ context = Context ("gitannexbuilder " ++ arch)
+ pwfile = homedir </> "rsyncpassword"
tree :: Architecture -> Property
tree buildarch = combineProperties "gitannexbuilder tree"
@@ -101,13 +97,13 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta
& User.accountFor builduser
& tree arch
& buildDepsApt
- & autobuilder (show buildminute ++ " * * * *") timeout True
+ & autobuilder arch (show buildminute ++ " * * * *") timeout
androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
androidAutoBuilderContainer dockerImage crontimes timeout =
androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
& Apt.unattendedUpgrades
- & autobuilder crontimes timeout True
+ & autobuilder "android" crontimes timeout
-- Android is cross-built in a Debian i386 container, using the Android NDK.
androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
@@ -154,7 +150,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
-- The armel builder can ssh to this companion.
& Docker.expose "22"
& Apt.serviceInstalledRunning "ssh"
- & Ssh.authorizedKeys builduser
+ & Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
@@ -172,9 +168,9 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme
-- git-annex/standalone/linux/install-haskell-packages
-- which is not fully automated.)
& buildDepsNoHaskellLibs
- & autobuilder crontimes timeout True
+ & autobuilder "armel" crontimes timeout
`requires` tree "armel"
- & Ssh.keyImported SshRsa builduser
+ & Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder")
& trivial writecompanionaddress
where
writecompanionaddress = scriptProperty
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 57023cb5..bffc8a30 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -29,7 +29,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
, "--client-name=spool"
] Obnam.OnlyClient
- `requires` Ssh.keyImported SshRsa "root"
+ `requires` Ssh.keyImported SshRsa "root" (Context "olduse.net")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
property "olduse.net spool in place" $ makeChange $ do
@@ -97,7 +97,7 @@ kgbServer = withOS desc $ \o -> case o of
(Just (System (Debian Unstable) _)) ->
ensureProperty $ propertyList desc
[ Apt.serviceInstalledRunning "kgb-bot"
- , File.hasPrivContent "/etc/kgb-bot/kgb.conf"
+ , File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
`onChange` Service.restarted "kgb-bot"
, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
`describe` "kgb bot enabled"
@@ -108,17 +108,19 @@ kgbServer = withOS desc $ \o -> case o of
desc = "kgb.kitenet.net setup"
mumbleServer :: [Host] -> Property
-mumbleServer hosts = combineProperties "mumble.debian.net"
+mumbleServer hosts = combineProperties hn
[ Apt.serviceInstalledRunning "mumble-server"
, Obnam.latestVersion
, Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
- [ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/mumble.debian.net.obnam"
+ [ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
, "--client-name=mumble"
] Obnam.OnlyClient
- `requires` Ssh.keyImported SshRsa "root"
+ `requires` Ssh.keyImported SshRsa "root" (Context hn)
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
, trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
]
+ where
+ hn = "mumble.debian.net"
obnamLowMem :: Property
obnamLowMem = combineProperties "obnam tuned for low memory use"
@@ -141,16 +143,16 @@ gitServer hosts = propertyList "git.kitenet.net setup"
, "--client-name=wren"
] Obnam.OnlyClient
`requires` Gpg.keyImported "1B169BE1" "root"
- `requires` Ssh.keyImported SshRsa "root"
+ `requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
- `requires` Ssh.authorizedKeys "family"
+ `requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net")
`requires` User.accountFor "family"
, Apt.installed ["git", "rsync", "gitweb"]
-- backport avoids channel flooding on branch merge
, Apt.installedBackport ["kgb-client"]
-- backport supports ssh event notification
, Apt.installedBackport ["git-annex"]
- , File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf"
+ , File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
, toProp $ Git.daemonRunning "/srv/git"
, "/etc/gitweb.conf" `File.containsLines`
[ "$projectroot = '/srv/git';"
@@ -202,7 +204,7 @@ annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using g
dir = "/srv/web/" ++ hn
postupdatehook = dir </> ".git/hooks/post-update"
setup = userScriptProperty "joey" setupscript
- `requires` Ssh.keyImported SshRsa "joey"
+ `requires` Ssh.keyImported SshRsa "joey" (Context hn)
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
setupscript =
[ "cd " ++ shellEscape dir
@@ -270,9 +272,9 @@ mainhttpscert True =
gitAnnexDistributor :: Property
gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
[ Apt.installed ["rsync"]
- , File.hasPrivContent "/etc/rsyncd.conf"
+ , File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
`onChange` Service.restarted "rsync"
- , File.hasPrivContent "/etc/rsyncd.secrets"
+ , File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
`onChange` Service.restarted "rsync"
, "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
`onChange` Service.running "rsync"
@@ -315,7 +317,7 @@ ircBouncer = propertyList "IRC bouncer"
[ Apt.installed ["znc"]
, User.accountFor "znc"
, File.dirExists (parentDir conf)
- , File.hasPrivContent conf
+ , File.hasPrivContent conf anyContext
, File.ownerGroup conf "znc" "znc"
, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
-- ensure running if it was not already
@@ -341,7 +343,7 @@ githubBackup :: Property
githubBackup = propertyList "github-backup box"
[ Apt.installed ["github-backup", "moreutils"]
, let f = "/home/joey/.github-keys"
- in File.hasPrivContent f
+ in File.hasPrivContent f anyContext
`onChange` File.ownerGroup f "joey" "joey"
]
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index bc0e7cab..6785ede6 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -75,42 +75,43 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
ensureProperty $ scriptProperty
[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
--- | Sets ssh host keys from the site's PrivData.
---
--- (Uses a null username for host keys.)
-hostKey :: SshKeyType -> Property
-hostKey keytype = combineProperties desc
- [ property desc (install writeFile (SshPubKey keytype "") ".pub")
- , property desc (install writeFileProtected (SshPrivKey keytype "") "")
+-- | Sets ssh host keys.
+hostKey :: SshKeyType -> Context -> Property
+hostKey keytype context = combineProperties desc
+ [ installkey (SshPubKey keytype "") (install writeFile ".pub")
+ , installkey (SshPrivKey keytype "") (install writeFileProtected "")
]
`onChange` restartSshd
where
desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
- install writer p ext = withPrivData p $ \key -> do
+ installkey p a = withPrivData p context $ \getkey ->
+ property desc $ getkey a
+ install writer ext key = do
let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
s <- liftIO $ readFileStrict f
if s == key
then noChange
else makeChange $ writer f key
--- | Sets up a user with a ssh private key and public key pair
--- from the site's PrivData.
-keyImported :: SshKeyType -> UserName -> Property
-keyImported keytype user = combineProperties desc
- [ property desc (install writeFile (SshPubKey keytype user) ".pub")
- , property desc (install writeFileProtected (SshPrivKey keytype user) "")
+-- | Sets up a user with a ssh private key and public key pair from the
+-- PrivData.
+keyImported :: SshKeyType -> UserName -> Context -> Property
+keyImported keytype user context = combineProperties desc
+ [ installkey (SshPubKey keytype user) (install writeFile ".pub")
+ , installkey (SshPrivKey keytype user) (install writeFileProtected "")
]
where
desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
- install writer p ext = do
+ installkey p a = withPrivData p context $ \getkey ->
+ property desc $ getkey a
+ install writer ext key = do
f <- liftIO $ keyfile ext
ifM (liftIO $ doesFileExist f)
( noChange
, ensureProperties
- [ property desc $
- withPrivData p $ \key -> makeChange $ do
- createDirectoryIfMissing True (takeDirectory f)
- writer f key
+ [ property desc $ makeChange $ do
+ createDirectoryIfMissing True (takeDirectory f)
+ writer f key
, File.ownerGroup f user user
, File.ownerGroup (takeDirectory f) user user
]
@@ -143,9 +144,9 @@ knownHost hosts hn user = property desc $
return FailedChange
-- | Makes a user have authorized_keys from the PrivData
-authorizedKeys :: UserName -> Property
-authorizedKeys user = property (user ++ " has authorized_keys") $
- withPrivData (SshAuthorizedKeys user) $ \v -> do
+authorizedKeys :: UserName -> Context -> Property
+authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
+ property (user ++ " has authorized_keys") $ get $ \v -> do
f <- liftIO $ dotFile "authorized_keys" user
liftIO $ do
createDirectoryIfMissing True (takeDirectory f)
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index eef2a57e..f9c400a8 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -24,17 +24,18 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use
-- | Only ensures that the user has some password set. It may or may
-- not be the password from the PrivData.
-hasSomePassword :: UserName -> Property
-hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
- hasPassword user
-
-hasPassword :: UserName -> Property
-hasPassword user = property (user ++ " has password") $
- withPrivData (Password user) $ \password -> makeChange $
- withHandle StdinHandle createProcessSuccess
- (proc "chpasswd" []) $ \h -> do
- hPutStrLn h $ user ++ ":" ++ password
- hClose h
+hasSomePassword :: UserName -> Context -> Property
+hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
+ hasPassword user context
+
+hasPassword :: UserName -> Context -> Property
+hasPassword user context = withPrivData (Password user) context $ \getpassword ->
+ property (user ++ " has password") $
+ getpassword $ \password -> makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "chpasswd" []) $ \h -> do
+ hPutStrLn h $ user ++ ":" ++ password
+ hClose h
lockedPassword :: UserName -> Property
lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"