From 58f79c12aad3511b70f2233226d3f0afc5214b10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Jul 2014 15:56:56 -0400 Subject: propellor spin --- src/Propellor/Property/Docker.hs | 7 ++-- src/Propellor/Property/File.hs | 13 ++++--- src/Propellor/Property/Gpg.hs | 17 ++++---- src/Propellor/Property/OpenId.hs | 5 ++- .../Property/SiteSpecific/GitAnnexBuilder.hs | 38 ++++++++---------- src/Propellor/Property/SiteSpecific/JoeySites.hs | 28 +++++++------- src/Propellor/Property/Ssh.hs | 45 +++++++++++----------- src/Propellor/Property/User.hs | 23 +++++------ 8 files changed, 91 insertions(+), 85 deletions(-) (limited to 'src/Propellor/Property') 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" -- cgit v1.2.3