summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-04-22 13:04:39 -0400
committerJoey Hess2015-04-22 13:04:39 -0400
commitf35ef9d6975710f2d77c2ea708c66500861d92d1 (patch)
treece00d88d1f67109b62dcdec56262e63471fba412 /src/Propellor
parentd3dbdb1f4d47142c20a498dc9279e480900b86c5 (diff)
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.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/Cmd.hs4
-rw-r--r--src/Propellor/Property/Cron.hs14
-rw-r--r--src/Propellor/Property/File.hs4
-rw-r--r--src/Propellor/Property/Git.hs10
-rw-r--r--src/Propellor/Property/Gpg.hs14
-rw-r--r--src/Propellor/Property/Group.hs4
-rw-r--r--src/Propellor/Property/HostingProvider/CloudAtCost.hs2
-rw-r--r--src/Propellor/Property/OS.hs2
-rw-r--r--src/Propellor/Property/Obnam.hs4
-rw-r--r--src/Propellor/Property/OpenId.hs4
-rw-r--r--src/Propellor/Property/Postfix.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs26
-rw-r--r--src/Propellor/Property/SiteSpecific/GitHome.hs8
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs26
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs80
-rw-r--r--src/Propellor/Property/Ssh.hs54
-rw-r--r--src/Propellor/Property/Sudo.hs8
-rw-r--r--src/Propellor/Property/Tor.hs10
-rw-r--r--src/Propellor/Property/User.hs66
-rw-r--r--src/Propellor/Types/OS.hs19
-rw-r--r--src/Propellor/Types/PrivData.hs4
21 files changed, 186 insertions, 179 deletions
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 <Password> or a <CryptPassword> 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