From f35ef9d6975710f2d77c2ea708c66500861d92d1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 22 Apr 2015 13:04:39 -0400 Subject: API change: Added User and Group newtypes, and Properties that used to use the type UserName = String were changed to use them. Note that UserName is kept and PrivData still uses it in its sum type. This is to avoid breaking PrivData serialization. --- src/Propellor/Property/Cmd.hs | 4 +- src/Propellor/Property/Cron.hs | 14 ++-- src/Propellor/Property/File.hs | 4 +- src/Propellor/Property/Git.hs | 10 +-- src/Propellor/Property/Gpg.hs | 14 ++-- src/Propellor/Property/Group.hs | 4 +- .../Property/HostingProvider/CloudAtCost.hs | 2 +- src/Propellor/Property/OS.hs | 2 +- src/Propellor/Property/Obnam.hs | 4 +- src/Propellor/Property/OpenId.hs | 4 +- src/Propellor/Property/Postfix.hs | 2 +- .../Property/SiteSpecific/GitAnnexBuilder.hs | 26 +++---- src/Propellor/Property/SiteSpecific/GitHome.hs | 8 +-- src/Propellor/Property/SiteSpecific/IABak.hs | 26 +++---- src/Propellor/Property/SiteSpecific/JoeySites.hs | 80 +++++++++++----------- src/Propellor/Property/Ssh.hs | 54 +++++++-------- src/Propellor/Property/Sudo.hs | 8 +-- src/Propellor/Property/Tor.hs | 10 +-- src/Propellor/Property/User.hs | 66 +++++++++--------- src/Propellor/Types/OS.hs | 19 +++-- src/Propellor/Types/PrivData.hs | 4 +- 21 files changed, 186 insertions(+), 179 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index ae8238f5..e2b91db1 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -39,7 +39,7 @@ scriptProperty script = cmdProperty "sh" ["-c", shellcmd] -- | A property that can satisfied by running a series of shell commands, -- as user (cd'd to their home directory). -userScriptProperty :: UserName -> [String] -> Property NoInfo -userScriptProperty user script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] +userScriptProperty :: User -> [String] -> Property NoInfo +userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] where shellcmd = intercalate " ; " ("set -e" : "cd" : script) diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs index 222f3849..d2feaf3c 100644 --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -28,8 +28,8 @@ data Times -- job file. -- -- The cron job's output will only be emailed if it exits nonzero. -job :: Desc -> Times -> UserName -> FilePath -> String -> Property NoInfo -job desc times user cddir command = combineProperties ("cronned " ++ desc) +job :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo +job desc times (User u) cddir command = combineProperties ("cronned " ++ desc) [ cronjobfile `File.hasContent` [ case times of Times _ -> "" @@ -40,10 +40,10 @@ job desc times user cddir command = combineProperties ("cronned " ++ desc) , "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin" , "" , case times of - Times t -> t ++ "\t" ++ user ++ "\tchronic " ++ shellEscape scriptfile - _ -> case user of + Times t -> t ++ "\t" ++ u ++ "\tchronic " ++ shellEscape scriptfile + _ -> case u of "root" -> "chronic " ++ shellEscape scriptfile - _ -> "chronic su " ++ user ++ " -c " ++ shellEscape scriptfile + _ -> "chronic su " ++ u ++ " -c " ++ shellEscape scriptfile ] , case times of Times _ -> doNothing @@ -76,11 +76,11 @@ job desc times user cddir command = combineProperties ("cronned " ++ desc) | otherwise = '_' -- | Installs a cron job, and runs it niced and ioniced. -niceJob :: Desc -> Times -> UserName -> FilePath -> String -> Property NoInfo +niceJob :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo niceJob desc times user cddir command = job desc times user cddir ("nice ionice -c 3 sh -c " ++ shellEscape command) -- | Installs a cron job to run propellor. runPropellor :: Times -> Property NoInfo -runPropellor times = niceJob "propellor" times "root" localdir +runPropellor times = niceJob "propellor" times (User "root") localdir (bootstrapPropellorCommand ++ "; ./propellor") diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 12d9202f..46704746 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -91,8 +91,8 @@ dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $ makeChange $ createDirectoryIfMissing True d -- | Ensures that a file/dir has the specified owner and group. -ownerGroup :: FilePath -> UserName -> GroupName -> Property NoInfo -ownerGroup f owner group = property (f ++ " owner " ++ og) $ do +ownerGroup :: FilePath -> User -> Group -> Property NoInfo +ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do r <- ensureProperty $ cmdProperty "chown" [og, f] if r == FailedChange then return r diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs index 91f1e3ed..0ac8eb84 100644 --- a/src/Propellor/Property/Git.hs +++ b/src/Propellor/Property/Git.hs @@ -62,7 +62,7 @@ type Branch = String -- it will be recursively deleted first. -- -- A branch can be specified, to check out. -cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo +cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo cloned owner url dir mbranch = check originurl (property desc checkout) `requires` installed where @@ -96,17 +96,17 @@ cloned owner url dir mbranch = check originurl (property desc checkout) isGitDir :: FilePath -> IO Bool isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir]) -data GitShared = Shared GroupName | SharedAll | NotShared +data GitShared = Shared Group | SharedAll | NotShared -bareRepo :: FilePath -> UserName -> GitShared -> Property NoInfo +bareRepo :: FilePath -> User -> GitShared -> Property NoInfo bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ dirExists repo : case gitshared of NotShared -> - [ ownerGroup repo user user + [ ownerGroup repo user (userGroup user) , userScriptProperty user ["git", "init", "--bare", "--shared=false", repo] ] SharedAll -> - [ ownerGroup repo user user + [ ownerGroup repo user (userGroup user) , userScriptProperty user ["git", "init", "--bare", "--shared=all", repo] ] Shared group' -> diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs index dfb9d429..0f68f8fe 100644 --- a/src/Propellor/Property/Gpg.hs +++ b/src/Propellor/Property/Gpg.hs @@ -20,24 +20,24 @@ newtype GpgKeyId = GpgKeyId { getGpgKeyId :: String } -- -- Recommend only using this for low-value dedicated role keys. -- No attempt has been made to scrub the key out of memory once it's used. -keyImported :: GpgKeyId -> UserName -> Property HasInfo -keyImported (GpgKeyId keyid) user = flagFile' prop genflag +keyImported :: GpgKeyId -> User -> Property HasInfo +keyImported (GpgKeyId keyid) user@(User u) = flagFile' prop genflag `requires` installed where - desc = user ++ " has gpg key " ++ show keyid + desc = u ++ " has gpg key " ++ show keyid genflag = do d <- dotDir user return $ d ".propellor-imported-keyid-" ++ keyid prop = withPrivData src (Context keyid) $ \getkey -> property desc $ getkey $ \key -> makeChange $ withHandle StdinHandle createProcessSuccess - (proc "su" ["-c", "gpg --import", user]) $ \h -> do + (proc "su" ["-c", "gpg --import", u]) $ \h -> do fileEncoding h hPutStr h key hClose h src = PrivDataSource GpgKey "Either a gpg public key, exported with gpg --export -a, or a gpg private key, exported with gpg --export-secret-key -a" -dotDir :: UserName -> IO FilePath -dotDir user = do - home <- homeDirectory <$> getUserEntryForName user +dotDir :: User -> IO FilePath +dotDir (User u) = do + home <- homeDirectory <$> getUserEntryForName u return $ home ".gnupg" diff --git a/src/Propellor/Property/Group.hs b/src/Propellor/Property/Group.hs index 15524eb4..d4dc0fb2 100644 --- a/src/Propellor/Property/Group.hs +++ b/src/Propellor/Property/Group.hs @@ -4,8 +4,8 @@ import Propellor type GID = Int -exists :: GroupName -> Maybe GID -> Property NoInfo -exists group' mgid = check test (cmdProperty "addgroup" $ args mgid) +exists :: Group -> Maybe GID -> Property NoInfo +exists (Group group') mgid = check test (cmdProperty "addgroup" $ args mgid) `describe` unwords ["group", group'] where groupFile = "/etc/group" diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs index 2cfdb951..bc53635c 100644 --- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs +++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs @@ -17,7 +17,7 @@ decruft = propertyList "cloudatcost cleanup" [ File.notPresent "/etc/rc.local" , File.notPresent "/etc/init.d/S97-setup.sh" , File.notPresent "/zang-debian.sh" - , User.nuked "user" User.YesReallyDeleteHome + , User.nuked (User "user") User.YesReallyDeleteHome ] ] diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 7a6857fb..11fa6c82 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -222,7 +222,7 @@ preserveRootSshAuthorized :: Property NoInfo preserveRootSshAuthorized = check (fileExist oldloc) $ property (newloc ++ " copied from old OS") $ do ks <- liftIO $ lines <$> readFile oldloc - ensureProperties (map (Ssh.authorizedKey "root") ks) + ensureProperties (map (Ssh.authorizedKey (User "root")) ks) where newloc = "/root/.ssh/authorized_keys" oldloc = oldOSDir ++ newloc diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index c066d9f7..99e87e4c 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -49,7 +49,7 @@ backup dir crontimes params numclients = backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo backupEncrypted dir crontimes params numclients keyid = backup dir crontimes params' numclients - `requires` Gpg.keyImported keyid "root" + `requires` Gpg.keyImported keyid (User "root") where params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params @@ -58,7 +58,7 @@ backup' :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoIn backup' dir crontimes params numclients = cronjob `describe` desc where desc = dir ++ " backed up by obnam" - cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $ + cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes (User "root") "/" $ intercalate ";" $ catMaybes [ if numclients == OnlyClient then Just $ unwords $ diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs index 7ecf345f..1f6f2559 100644 --- a/src/Propellor/Property/OpenId.hs +++ b/src/Propellor/Property/OpenId.hs @@ -7,7 +7,7 @@ import qualified Propellor.Property.Service as Service import Data.List -providerFor :: [UserName] -> String -> Property HasInfo +providerFor :: [User] -> String -> Property HasInfo providerFor users baseurl = propertyList desc $ map toProp [ Apt.serviceInstalledRunning "apache2" , Apt.installed ["simpleid"] @@ -25,6 +25,6 @@ providerFor users baseurl = propertyList desc $ map toProp -- the identities directory controls access, so open up -- file mode - identfile u = File.hasPrivContentExposed + identfile (User u) = File.hasPrivContentExposed (concat [ "/var/lib/simpleid/identities/", u, ".identity" ]) (Context baseurl) diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs index 8557f083..073d5dc8 100644 --- a/src/Propellor/Property/Postfix.hs +++ b/src/Propellor/Property/Postfix.hs @@ -153,6 +153,6 @@ saslAuthdInstalled = setupdaemon dirperm = check (not <$> doesDirectoryExist dir) $ cmdProperty "dpkg-statoverride" [ "--add", "root", "sasl", "710", dir ] - postfixgroup = "postfix" `User.hasGroup` "sasl" + postfixgroup = (User "postfix") `User.hasGroup` (Group "sasl") `onChange` restarted dir = "/var/spool/postfix/var/run/saslauthd" diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 102e6a1d..384b2724 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -28,7 +28,7 @@ type TimeOut = String -- eg, 5h autobuilder :: Architecture -> Times -> TimeOut -> Property HasInfo autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props & Apt.serviceInstalledRunning "cron" - & Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir + & Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir ("git pull ; timeout " ++ timeout ++ " ./autobuild") & rsyncpassword where @@ -51,18 +51,18 @@ tree buildarch = combineProperties "gitannexbuilder tree" $ props -- gitbuilderdir directory already exists when docker volume is used, -- but with wrong owner. & File.dirExists gitbuilderdir - & File.ownerGroup gitbuilderdir builduser builduser + & File.ownerGroup gitbuilderdir (User builduser) (Group builduser) & gitannexbuildercloned & builddircloned where gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir ".git"))) $ - userScriptProperty builduser + userScriptProperty (User builduser) [ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir , "cd " ++ gitbuilderdir , "git checkout " ++ buildarch ] `describe` "gitbuilder setup" - builddircloned = check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser + builddircloned = check (not <$> doesDirectoryExist builddir) $ userScriptProperty (User builduser) [ "git clone git://git-annex.branchable.com/ " ++ builddir ] @@ -89,7 +89,7 @@ buildDepsNoHaskellLibs = Apt.installed cabalDeps :: Property NoInfo cabalDeps = flagFile go cabalupdated where - go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"] + go = userScriptProperty (User builduser) ["cabal update && cabal install git-annex --only-dependencies || true"] cabalupdated = homedir ".cabal" "packages" "hackage.haskell.org" "00-index.cache" standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Docker.Container @@ -99,7 +99,7 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta & Apt.stdSourcesList & Apt.installed ["systemd"] & Apt.unattendedUpgrades - & User.accountFor builduser + & User.accountFor (User builduser) & tree arch & buildDepsApt & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout @@ -125,9 +125,9 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe & Apt.stdSourcesList & Apt.installed ["systemd"] & Docker.tweaked - & User.accountFor builduser + & User.accountFor (User builduser) & File.dirExists gitbuilderdir - & File.ownerGroup homedir builduser builduser + & File.ownerGroup homedir (User builduser) (Group builduser) & buildDepsApt & flagFile chrootsetup ("/chrootsetup") `requires` setupgitannexdir @@ -139,7 +139,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe chrootsetup = scriptProperty [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" ] - haskellpkgsinstalled = userScriptProperty "builder" + haskellpkgsinstalled = userScriptProperty (User builduser) [ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages" ] osver = System (Debian Testing) "i386" -- once jessie is released, use: (Stable "jessie") @@ -155,7 +155,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder- & Apt.installed ["systemd"] -- This volume is shared with the armel builder. & Docker.volume gitbuilderdir - & User.accountFor builduser + & User.accountFor (User builduser) -- Install current versions of build deps from cabal. & tree "armel" & buildDepsNoHaskellLibs @@ -163,7 +163,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 (Context "armel-git-annex-builder") + & Ssh.authorizedKeys (User builduser) (Context "armel-git-annex-builder") & Docker.tweaked armelAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container @@ -175,7 +175,7 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme & Apt.installed ["openssh-client"] & Docker.link "armel-git-annex-builder-companion" "companion" & Docker.volumes_from "armel-git-annex-builder-companion" - & User.accountFor builduser + & User.accountFor (User builduser) -- TODO: automate installing haskell libs -- (Currently have to run -- git-annex/standalone/linux/install-haskell-packages @@ -183,7 +183,7 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme & buildDepsNoHaskellLibs & autobuilder "armel" crontimes timeout `requires` tree "armel" - & Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder") + & Ssh.keyImported SshRsa (User builduser) (Context "armel-git-annex-builder") & trivial writecompanionaddress & Docker.tweaked where diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs index 59e62d80..d6dce7c0 100644 --- a/src/Propellor/Property/SiteSpecific/GitHome.hs +++ b/src/Propellor/Property/SiteSpecific/GitHome.hs @@ -6,9 +6,9 @@ import Propellor.Property.User import Utility.SafeCommand -- | Clones Joey Hess's git home directory, and runs its fixups script. -installedFor :: UserName -> Property NoInfo -installedFor user = check (not <$> hasGitDir user) $ - property ("githome " ++ user) (go =<< liftIO (homedir user)) +installedFor :: User -> Property NoInfo +installedFor user@(User u) = check (not <$> hasGitDir user) $ + property ("githome " ++ u) (go =<< liftIO (homedir user)) `requires` Apt.installed ["git"] where go home = do @@ -28,7 +28,7 @@ installedFor user = check (not <$> hasGitDir user) $ url :: String url = "git://git.kitenet.net/joey/home" -hasGitDir :: UserName -> IO Bool +hasGitDir :: User -> IO Bool hasGitDir user = go =<< homedir user where go home = doesDirectoryExist (home ".git") diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index d89e85fb..f50482ff 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -17,26 +17,26 @@ userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git" gitServer :: [Host] -> Property HasInfo gitServer knownhosts = propertyList "iabak git server" $ props - & Git.cloned "root" repo "/usr/local/IA.BAK" (Just "server") - & Git.cloned "root" repo "/usr/local/IA.BAK/client" (Just "master") - & Ssh.keyImported SshRsa "root" (Context "IA.bak.users.git") - & Ssh.knownHost knownhosts "gitlab.com" "root" - & Git.cloned "root" userrepo "/usr/local/IA.BAK/pubkeys" (Just "master") + & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server") + & Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master") + & Ssh.keyImported SshRsa (User "root") (Context "IA.bak.users.git") + & Ssh.knownHost knownhosts "gitlab.com" (User "root") + & Git.cloned (User "root") userrepo "/usr/local/IA.BAK/pubkeys" (Just "master") & Apt.serviceInstalledRunning "apache2" & cmdProperty "ln" ["-sf", "/usr/local/IA.BAK/pushme.cgi", "/usr/lib/cgi-bin/pushme.cgi"] & File.containsLine "/etc/sudoers" "www-data ALL=NOPASSWD:/usr/local/IA.BAK/pushed.sh" - & Cron.niceJob "shardstats" (Cron.Times "*/30 * * * *") "root" "/" + & Cron.niceJob "shardstats" (Cron.Times "*/30 * * * *") (User "root") "/" "/usr/local/IA.BAK/shardstats-all" - & Cron.niceJob "shardmaint" Cron.Daily "root" "/" + & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/" "/usr/local/IA.BAK/shardmaint" registrationServer :: [Host] -> Property HasInfo registrationServer knownhosts = propertyList "iabak registration server" $ props - & User.accountFor "registrar" - & Ssh.keyImported SshRsa "registrar" (Context "IA.bak.users.git") - & Ssh.knownHost knownhosts "gitlab.com" "registrar" - & Git.cloned "registrar" repo "/home/registrar/IA.BAK" (Just "server") - & Git.cloned "registrar" userrepo "/home/registrar/users" (Just "master") + & User.accountFor (User "registrar") + & Ssh.keyImported SshRsa (User "registrar") (Context "IA.bak.users.git") + & Ssh.knownHost knownhosts "gitlab.com" (User "registrar") + & Git.cloned (User "registrar") repo "/home/registrar/IA.BAK" (Just "server") + & Git.cloned (User "registrar") userrepo "/home/registrar/users" (Just "master") & Apt.serviceInstalledRunning "apache2" & Apt.installed ["perl", "perl-modules"] & cmdProperty "ln" ["-sf", "/home/registrar/IA.BAK/registrar/register.cgi", link] @@ -67,7 +67,7 @@ graphiteServer = propertyList "iabak graphite server" $ props & cmdProperty "graphite-manage" ["createsuperuser", "--noinput", "--username=db48x", "--email=db48x@localhost"] `flagFile` "/etc/flagFiles/graphite-user-db48x" `flagFile` "/etc/graphite-superuser-db48x" -- TODO: deal with passwords somehow - & File.ownerGroup "/var/lib/graphite/graphite.db" "_graphite" "_graphite" + & File.ownerGroup "/var/lib/graphite/graphite.db" (User "_graphite") (Group "_graphite") & "/etc/apache2/ports.conf" `File.containsLine` "Listen 8080" `onChange` Apache.restarted & Apache.siteEnabled "iabak-graphite-web" diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 1a3099f4..e317c3d1 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -24,15 +24,15 @@ import Data.String.Utils scrollBox :: Property HasInfo scrollBox = propertyList "scroll server" $ props - & User.accountFor "scroll" - & Git.cloned "scroll" "git://git.kitenet.net/scroll" (d "scroll") Nothing + & User.accountFor (User "scroll") + & Git.cloned (User "scroll") "git://git.kitenet.net/scroll" (d "scroll") Nothing & Apt.installed ["ghc", "make", "cabal-install", "libghc-vector-dev", "libghc-bytestring-dev", "libghc-mtl-dev", "libghc-ncurses-dev", "libghc-random-dev", "libghc-monad-loops-dev", "libghc-text-dev", "libghc-ifelse-dev", "libghc-case-insensitive-dev", "libghc-transformers-dev", "libghc-data-default-dev", "libghc-optparse-applicative-dev"] - & userScriptProperty "scroll" + & userScriptProperty (User "scroll") [ "cd " ++ d "scroll" , "git pull" , "cabal configure" @@ -76,7 +76,7 @@ scrollBox = propertyList "scroll server" $ props & Ssh.sshdConfig `File.containsLine` ("DenyUsers scroll") `onChange` Ssh.restarted & cmdProperty "chsh" ["scroll", "-s", s] - & User.hasPassword "scroll" + & User.hasPassword (User "scroll") & Apt.serviceInstalledRunning "telnetd" & Apt.installed ["shellinabox"] & File.hasContent "/etc/default/shellinabox" @@ -115,8 +115,8 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props & Apt.serviceInstalledRunning "openbsd-inetd" & File.notPresent "/etc/cron.daily/leafnode" & File.notPresent "/etc/cron.d/leafnode" - & Cron.niceJob "oldusenet-expire" (Cron.Times "11 1 * * *") "news" newsspool expirecommand - & Cron.niceJob "oldusenet-uucp" (Cron.Times "*/5 * * * *") "news" "/" uucpcommand + & Cron.niceJob "oldusenet-expire" (Cron.Times "11 1 * * *") (User "news") newsspool expirecommand + & Cron.niceJob "oldusenet-uucp" (Cron.Times "*/5 * * * *") (User "news") "/" uucpcommand & Apache.siteEnabled "nntp.olduse.net" nntpcfg where newsspool = "/var/spool/news" @@ -140,8 +140,8 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props , "--client-name=spool" , "--ssh-key=" ++ keyfile ] Obnam.OnlyClient - `requires` Ssh.keyImported' (Just keyfile) SshRsa "root" (Context "olduse.net") - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" + `requires` Ssh.keyImported' (Just keyfile) SshRsa (User "root") (Context "olduse.net") + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") keyfile = "/root/.ssh/olduse.net.key" oldUseNetShellBox :: Property HasInfo @@ -189,8 +189,8 @@ mumbleServer hosts = combineProperties hn $ props [ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam" , "--client-name=mumble" ] Obnam.OnlyClient - `requires` Ssh.keyImported SshRsa "root" (Context hn) - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" + `requires` Ssh.keyImported SshRsa (User "root") (Context hn) + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") & trivial (cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]) where hn = "mumble.debian.net" @@ -204,10 +204,10 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props , "--ssh-key=" ++ sshkey , "--client-name=wren" -- historical ] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1") - `requires` Ssh.keyImported' (Just sshkey) SshRsa "root" (Context "git.kitenet.net") - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" - `requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net") - `requires` User.accountFor "family" + `requires` Ssh.keyImported' (Just sshkey) SshRsa (User "root") (Context "git.kitenet.net") + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") + `requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net") + `requires` User.accountFor (User "family") & Apt.installed ["git", "rsync", "gitweb"] & Apt.installed ["git-annex"] & Apt.installed ["kgb-client"] @@ -222,9 +222,9 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props ] `describe` "gitweb configured" -- Repos push on to github. - & Ssh.knownHost hosts "github.com" "joey" + & Ssh.knownHost hosts "github.com" (User "joey") -- I keep the website used for gitweb checked into git.. - & Git.cloned "root" "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing + & Git.cloned (User "root") "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing & website "git.kitenet.net" & website "git.joeyh.name" & Apache.modEnabled "cgi" @@ -252,7 +252,7 @@ type AnnexUUID = String -- | A website, with files coming from a git-annex repository. annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property HasInfo annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") $ props - & Git.cloned "joey" origin dir Nothing + & Git.cloned (User "joey") origin dir Nothing `onChange` setup & alias hn & postupdatehook `File.hasContent` @@ -264,7 +264,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann where dir = "/srv/web/" ++ hn postupdatehook = dir ".git/hooks/post-update" - setup = userScriptProperty "joey" setupscript + setup = userScriptProperty (User "joey") setupscript setupscript = [ "cd " ++ shellEscape dir , "git annex reinit " ++ shellEscape uuid @@ -344,11 +344,11 @@ gitAnnexDistributor = combineProperties "git-annex distributor, including rsync & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-yosemite" & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows" -- git-annex distribution signing key - & Gpg.keyImported (Gpg.GpgKeyId "89C809CB") "joey" + & Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey") where endpoint d = combineProperties ("endpoint " ++ d) [ File.dirExists d - , File.ownerGroup d "joey" "joey" + , File.ownerGroup d (User "joey") (Group "joey") ] downloads :: [Host] -> Property HasInfo @@ -356,7 +356,7 @@ downloads hosts = annexWebSite "/srv/git/downloads.git" "downloads.kitenet.net" "840760dc-08f0-11e2-8c61-576b7e66acfd" [("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")] - `requires` Ssh.knownHost hosts "eubackup.kitenet.net" "joey" + `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey") tmp :: Property HasInfo tmp = propertyList "tmp.kitenet.net" $ props @@ -370,16 +370,16 @@ tmp = propertyList "tmp.kitenet.net" $ props -- Twitter, you kill us. twitRss :: Property HasInfo twitRss = combineProperties "twitter rss" $ props - & Git.cloned "joey" "git://git.kitenet.net/twitrss.git" dir Nothing + & Git.cloned (User "joey") "git://git.kitenet.net/twitrss.git" dir Nothing & check (not <$> doesFileExist (dir "twitRss")) compiled & feed "http://twitter.com/search/realtime?q=git-annex" "git-annex-twitter" & feed "http://twitter.com/search/realtime?q=olduse+OR+git-annex+OR+debhelper+OR+etckeeper+OR+ikiwiki+-ashley_ikiwiki" "twittergrep" where dir = "/srv/web/tmp.kitenet.net/twitrss" crontime = Cron.Times "15 * * * *" - feed url desc = Cron.job desc crontime "joey" dir $ + feed url desc = Cron.job desc crontime (User "joey") dir $ "./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss") - compiled = userScriptProperty "joey" + compiled = userScriptProperty (User "joey") [ "cd " ++ dir , "ghc --make twitRss" ] @@ -391,19 +391,19 @@ twitRss = combineProperties "twitter rss" $ props -- Work around for expired ssl cert. pumpRss :: Property NoInfo -pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") "joey" "/srv/web/tmp.kitenet.net/" +pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/" "wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom" ircBouncer :: Property HasInfo ircBouncer = propertyList "IRC bouncer" $ props & Apt.installed ["znc"] - & User.accountFor "znc" + & User.accountFor (User "znc") & File.dirExists (takeDirectory conf) & File.hasPrivContent conf anyContext - & File.ownerGroup conf "znc" "znc" - & Cron.job "znconboot" (Cron.Times "@reboot") "znc" "~" "znc" + & File.ownerGroup conf (User "znc") (Group "znc") + & Cron.job "znconboot" (Cron.Times "@reboot") (User "znc") "~" "znc" -- ensure running if it was not already - & trivial (userScriptProperty "znc" ["znc || true"]) + & trivial (userScriptProperty (User "znc") ["znc || true"]) `describe` "znc running" where conf = "/home/znc/.znc/configs/znc.conf" @@ -425,9 +425,9 @@ githubBackup :: Property HasInfo githubBackup = propertyList "github-backup box" $ props & Apt.installed ["github-backup", "moreutils"] & githubKeys - & Cron.niceJob "github-backup run" (Cron.Times "30 4 * * *") "joey" + & Cron.niceJob "github-backup run" (Cron.Times "30 4 * * *") (User "joey") "/home/joey/lib/backup" backupcmd - & Cron.niceJob "gitriddance" (Cron.Times "30 4 * * *") "joey" + & Cron.niceJob "gitriddance" (Cron.Times "30 4 * * *") (User "joey") "/home/joey/lib/backup" gitriddancecmd where backupcmd = intercalate "&&" $ @@ -446,7 +446,7 @@ githubKeys :: Property HasInfo githubKeys = let f = "/home/joey/.github-keys" in File.hasPrivContent f anyContext - `onChange` File.ownerGroup f "joey" "joey" + `onChange` File.ownerGroup f (User "joey") (Group "joey") -- these repos are only mirrored on github, I don't want @@ -464,13 +464,13 @@ githubMirrors = rsyncNetBackup :: [Host] -> Property NoInfo rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *") - "joey" "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net" - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "joey" + (User "joey") "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net" + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "joey") backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property NoInfo backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc - (Cron.Times "@reboot") "joey" "/" cmd - `requires` Ssh.knownHost hosts srchost "joey" + (Cron.Times "@reboot") (User "joey") "/" cmd + `requires` Ssh.knownHost hosts srchost (User "joey") where desc = "backups copied from " ++ srchost ++ " on boot" cmd = "rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir srchost @@ -483,11 +483,11 @@ obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) `requires` mkdir "/home/joey/lib" mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam") mkdir d = File.dirExists d - `before` File.ownerGroup d "joey" "joey" + `before` File.ownerGroup d (User "joey") (Group "joey") podcatcher :: Property NoInfo podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *") - "joey" "/home/joey/lib/sound/podcasts" + (User "joey") "/home/joey/lib/sound/podcasts" "xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update" `requires` Apt.installed ["git-annex", "myrepos"] @@ -645,7 +645,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props & File.hasPrivContent dovecotusers ctx `onChange` (dovecotusers `File.mode` combineModes [ownerReadMode, groupReadMode]) - & File.ownerGroup dovecotusers "root" "dovecot" + & File.ownerGroup dovecotusers (User "root") (Group "dovecot") & Apt.installed ["mutt", "bsd-mailx", "alpine"] @@ -713,7 +713,7 @@ dkimInstalled = go `onChange` Service.restarted "opendkim" & Apt.serviceInstalledRunning "opendkim" & File.dirExists "/etc/mail" & File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net") - & File.ownerGroup "/etc/mail/dkim.key" "opendkim" "opendkim" + & File.ownerGroup "/etc/mail/dkim.key" (User "opendkim") (Group "opendkim") & "/etc/default/opendkim" `File.containsLine` "SOCKET=\"inet:8891@localhost\"" & "/etc/opendkim.conf" `File.containsLines` diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 1fbf92ec..236016ff 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -54,17 +54,17 @@ permitRootLogin = setSshdConfig "PermitRootLogin" passwordAuthentication :: Bool -> Property NoInfo passwordAuthentication = setSshdConfig "PasswordAuthentication" -dotDir :: UserName -> IO FilePath +dotDir :: User -> IO FilePath dotDir user = do h <- homedir user return $ h ".ssh" -dotFile :: FilePath -> UserName -> IO FilePath +dotFile :: FilePath -> User -> IO FilePath dotFile f user = do d <- dotDir user return $ d f -hasAuthorizedKeys :: UserName -> IO Bool +hasAuthorizedKeys :: User -> IO Bool hasAuthorizedKeys = go <=< dotFile "authorized_keys" where go f = not . null <$> catchDefaultIO "" (readFile f) @@ -151,19 +151,19 @@ getPubKey = asks (_sshPubKey . hostInfo) -- PrivData. -- -- If the user already has a private/public key, it is left unchanged. -keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property HasInfo +keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo keyImported = keyImported' Nothing -- | A file can be speficied to write the key to somewhere other than -- usual. Allows a user to have multiple keys for different roles. -keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> UserName -> c -> Property HasInfo -keyImported' dest keytype user context = combineProperties desc - [ installkey (SshPubKey keytype user) (install writeFile ".pub") - , installkey (SshPrivKey keytype user) (install writeFileProtected "") +keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo +keyImported' dest keytype user@(User u) context = combineProperties desc + [ installkey (SshPubKey keytype u) (install writeFile ".pub") + , installkey (SshPrivKey keytype u) (install writeFileProtected "") ] where desc = unwords $ catMaybes - [ Just user + [ Just u , Just "has ssh key" , dest , Just $ "(" ++ fromKeyType keytype ++ ")" @@ -178,13 +178,13 @@ keyImported' dest keytype user context = combineProperties desc [ property desc $ makeChange $ do createDirectoryIfMissing True (takeDirectory f) writer f key - , File.ownerGroup f user user - , File.ownerGroup (takeDirectory f) user user + , File.ownerGroup f user (userGroup user) + , File.ownerGroup (takeDirectory f) user (userGroup user) ] ) keyfile ext = case dest of Nothing -> do - home <- homeDirectory <$> getUserEntryForName user + home <- homeDirectory <$> getUserEntryForName u return $ home ".ssh" "id_" ++ fromKeyType keytype ++ ext Just f -> return $ f ++ ext @@ -196,19 +196,19 @@ fromKeyType SshEd25519 = "ed25519" -- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey' -- into the known_hosts file for a user. -knownHost :: [Host] -> HostName -> UserName -> Property NoInfo -knownHost hosts hn user = property desc $ +knownHost :: [Host] -> HostName -> User -> Property NoInfo +knownHost hosts hn user@(User u) = property desc $ go =<< fromHost hosts hn getPubKey where - desc = user ++ " knows ssh key for " ++ hn + desc = u ++ " knows ssh key for " ++ hn go (Just m) | not (M.null m) = do f <- liftIO $ dotFile "known_hosts" user ensureProperty $ combineProperties desc [ File.dirExists (takeDirectory f) , f `File.containsLines` (map (\k -> hn ++ " " ++ k) (M.elems m)) - , File.ownerGroup f user user - , File.ownerGroup (takeDirectory f) user user + , File.ownerGroup f user (userGroup user) + , File.ownerGroup (takeDirectory f) user (userGroup user) ] go _ = do warningMessage $ "no configred pubKey for " ++ hn @@ -217,32 +217,32 @@ knownHost hosts hn user = property desc $ -- | Makes a user have authorized_keys from the PrivData -- -- This removes any other lines from the file. -authorizedKeys :: IsContext c => UserName -> c -> Property HasInfo -authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get -> - property (user ++ " has authorized_keys") $ get $ \v -> do +authorizedKeys :: IsContext c => User -> c -> Property HasInfo +authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get -> + property (u ++ " has authorized_keys") $ get $ \v -> do f <- liftIO $ dotFile "authorized_keys" user liftIO $ do createDirectoryIfMissing True (takeDirectory f) writeFileProtected f v ensureProperties - [ File.ownerGroup f user user - , File.ownerGroup (takeDirectory f) user user + [ File.ownerGroup f user (userGroup user) + , File.ownerGroup (takeDirectory f) user (userGroup user) ] -- | Ensures that a user's authorized_keys contains a line. -- Any other lines in the file are preserved as-is. -authorizedKey :: UserName -> String -> Property NoInfo -authorizedKey user l = property desc $ do +authorizedKey :: User -> String -> Property NoInfo +authorizedKey user@(User u) l = property desc $ do f <- liftIO $ dotFile "authorized_keys" user ensureProperty $ combineProperties desc [ f `File.containsLine` l `requires` File.dirExists (takeDirectory f) `onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) - , File.ownerGroup f user user - , File.ownerGroup (takeDirectory f) user user + , File.ownerGroup f user (userGroup user) + , File.ownerGroup (takeDirectory f) user (userGroup user) ] where - desc = user ++ " has autorized_keys" + desc = u ++ " has autorized_keys" -- | Makes the ssh server listen on a given port, in addition to any other -- ports it is configured to listen on. diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs index c183a8a3..0257f3f1 100644 --- a/src/Propellor/Property/Sudo.hs +++ b/src/Propellor/Property/Sudo.hs @@ -9,8 +9,8 @@ import Propellor.Property.User -- | Allows a user to sudo. If the user has a password, sudo is configured -- to require it. If not, NOPASSWORD is enabled for the user. -enabledFor :: UserName -> Property NoInfo -enabledFor user = property desc go `requires` Apt.installed ["sudo"] +enabledFor :: User -> Property NoInfo +enabledFor user@(User u) = property desc go `requires` Apt.installed ["sudo"] where go = do locked <- liftIO $ isLockedPassword user @@ -18,8 +18,8 @@ enabledFor user = property desc go `requires` Apt.installed ["sudo"] fileProperty desc (modify locked . filter (wanted locked)) "/etc/sudoers" - desc = user ++ " is sudoer" - sudobaseline = user ++ " ALL=(ALL:ALL)" + desc = u ++ " is sudoer" + sudobaseline = u ++ " ALL=(ALL:ALL)" sudoline True = sudobaseline ++ " NOPASSWD:ALL" sudoline False = sudobaseline ++ " ALL" wanted locked l diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 7a490824..3af4a70c 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -52,7 +52,7 @@ named n = configured [("Nickname", n')] torPrivKey :: Context -> Property HasInfo torPrivKey context = f `File.hasPrivContent` context - `onChange` File.ownerGroup f user user + `onChange` File.ownerGroup f user (userGroup user) -- install tor first, so the directory exists with right perms `requires` Apt.installed ["tor"] where @@ -140,8 +140,8 @@ hiddenServiceData hn context = combineProperties desc writeFileProtected f content , File.mode (takeDirectory f) $ combineModes [ownerReadMode, ownerWriteMode, ownerExecuteMode] - , File.ownerGroup (takeDirectory f) user user - , File.ownerGroup f user user + , File.ownerGroup (takeDirectory f) user (userGroup user) + , File.ownerGroup f user (userGroup user) ] ) @@ -157,8 +157,8 @@ varLib = "/var/lib/tor" varRun :: FilePath varRun = "/var/run/tor" -user :: UserName -user = "debian-tor" +user :: User +user = User "debian-tor" type NickName = String diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index 557875fb..add3ae52 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -7,31 +7,31 @@ import qualified Propellor.Property.File as File data Eep = YesReallyDeleteHome -accountFor :: UserName -> Property NoInfo -accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser" +accountFor :: User -> Property NoInfo +accountFor user@(User u) = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser" [ "--disabled-password" , "--gecos", "" - , user + , u ] - `describe` ("account for " ++ user) + `describe` ("account for " ++ u) -- | Removes user home directory!! Use with caution. -nuked :: UserName -> Eep -> Property NoInfo -nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel" +nuked :: User -> Eep -> Property NoInfo +nuked user@(User u) _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel" [ "-r" - , user + , u ] - `describe` ("nuked user " ++ user) + `describe` ("nuked user " ++ u) -- | Only ensures that the user has some password set. It may or may -- not be a password from the PrivData. -hasSomePassword :: UserName -> Property HasInfo +hasSomePassword :: User -> Property HasInfo hasSomePassword user = hasSomePassword' user hostContext -- | While hasSomePassword uses the name of the host as context, -- this allows specifying a different context. This is useful when -- you want to use the same password on multiple hosts, for example. -hasSomePassword' :: IsContext c => UserName -> c -> Property HasInfo +hasSomePassword' :: IsContext c => User -> c -> Property HasInfo hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword' user context @@ -41,18 +41,18 @@ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus us -- A user's password can be stored in the PrivData in either of two forms; -- the full cleartext or a hash. The latter -- is obviously more secure. -hasPassword :: UserName -> Property HasInfo +hasPassword :: User -> Property HasInfo hasPassword user = hasPassword' user hostContext -hasPassword' :: IsContext c => UserName -> c -> Property HasInfo -hasPassword' user context = go `requires` shadowConfig True +hasPassword' :: IsContext c => User -> c -> Property HasInfo +hasPassword' (User u) context = go `requires` shadowConfig True where go = withSomePrivData srcs context $ - property (user ++ " has password") . setPassword + property (u ++ " has password") . setPassword srcs = - [ PrivDataSource (CryptPassword user) + [ PrivDataSource (CryptPassword u) "a crypt(3)ed password, which can be generated by, for example: perl -e 'print crypt(shift, q{$6$}.shift)' 'somepassword' 'somesalt'" - , PrivDataSource (Password user) ("a password for " ++ user) + , PrivDataSource (Password u) ("a password for " ++ u) ] setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result @@ -67,32 +67,32 @@ setPassword getpassword = getpassword $ go hPutStrLn h $ user ++ ":" ++ v hClose h -lockedPassword :: UserName -> Property NoInfo -lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd" +lockedPassword :: User -> Property NoInfo +lockedPassword user@(User u) = check (not <$> isLockedPassword user) $ cmdProperty "passwd" [ "--lock" - , user + , u ] - `describe` ("locked " ++ user ++ " password") + `describe` ("locked " ++ u ++ " password") data PasswordStatus = NoPassword | LockedPassword | HasPassword deriving (Eq) -getPasswordStatus :: UserName -> IO PasswordStatus -getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user] +getPasswordStatus :: User -> IO PasswordStatus +getPasswordStatus (User u) = parse . words <$> readProcess "passwd" ["-S", u] where parse (_:"L":_) = LockedPassword parse (_:"NP":_) = NoPassword parse (_:"P":_) = HasPassword parse _ = NoPassword -isLockedPassword :: UserName -> IO Bool +isLockedPassword :: User -> IO Bool isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user -homedir :: UserName -> IO FilePath -homedir user = homeDirectory <$> getUserEntryForName user +homedir :: User -> IO FilePath +homedir (User user) = homeDirectory <$> getUserEntryForName user -hasGroup :: UserName -> GroupName -> Property NoInfo -hasGroup user group' = check test $ cmdProperty "adduser" +hasGroup :: User -> Group -> Property NoInfo +hasGroup (User user) (Group group') = check test $ cmdProperty "adduser" [ user , group' ] @@ -114,16 +114,16 @@ shadowExists = doesFileExist "/etc/shadow" -- | Ensures that a user has a specified login shell, and that the shell -- is enabled in /etc/shells. -hasLoginShell :: UserName -> FilePath -> Property NoInfo +hasLoginShell :: User -> FilePath -> Property NoInfo hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell -shellSetTo :: UserName -> FilePath -> Property NoInfo -shellSetTo user loginshell = check needchangeshell $ - cmdProperty "chsh" ["--shell", loginshell, user] - `describe` (user ++ " has login shell " ++ loginshell) +shellSetTo :: User -> FilePath -> Property NoInfo +shellSetTo (User u) loginshell = check needchangeshell $ + cmdProperty "chsh" ["--shell", loginshell, u] + `describe` (u ++ " has login shell " ++ loginshell) where needchangeshell = do - currshell <- userShell <$> getUserEntryForName user + currshell <- userShell <$> getUserEntryForName u return (currshell /= loginshell) -- | Ensures that /etc/shells contains a shell. diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 2bb41446..58bd809a 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -1,20 +1,19 @@ module Propellor.Types.OS ( - HostName, - UserName, - GroupName, System(..), Distribution(..), DebianSuite(..), isStable, Release, Architecture, + HostName, + UserName, + User(..), + Group(..), + userGroup, ) where import Network.BSD (HostName) -type UserName = String -type GroupName = String - -- | High level description of a operating system. data System = System Distribution Architecture deriving (Show, Eq) @@ -35,3 +34,11 @@ isStable _ = False type Release = String type Architecture = String + +type UserName = String +newtype User = User UserName +newtype Group = Group String + +-- | Makes a Group with the same name as the User. +userGroup :: User -> Group +userGroup (User u) = Group u diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs index 6b3c35a2..d713c7cf 100644 --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -2,8 +2,8 @@ module Propellor.Types.PrivData where import Propellor.Types.OS --- | Note that removing or changing constructors will break the --- serialized privdata files, so don't do that! +-- | Note that removing or changing constructors or changing types will +-- break the serialized privdata files, so don't do that! -- It's fine to add new constructors. data PrivDataField = DockerAuthentication -- cgit v1.2.3