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.
This commit is contained in:
Joey Hess 2015-04-22 13:04:39 -04:00
parent d3dbdb1f4d
commit f35ef9d697
25 changed files with 212 additions and 203 deletions

View File

@ -65,7 +65,7 @@ testvm = host "testvm.kitenet.net"
& Hostname.searchDomain & Hostname.searchDomain
& Apt.installed ["linux-image-amd64"] & Apt.installed ["linux-image-amd64"]
& Apt.installed ["ssh"] & Apt.installed ["ssh"]
& User.hasPassword "root" & User.hasPassword (User "root")
darkstar :: Host darkstar :: Host
darkstar = host "darkstar.kitenet.net" darkstar = host "darkstar.kitenet.net"
@ -174,9 +174,9 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
, "--exclude=.*/tmp/" , "--exclude=.*/tmp/"
, "--one-file-system" , "--one-file-system"
] Obnam.OnlyClient (Gpg.GpgKeyId "98147487") ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")
`requires` Ssh.keyImported SshRsa "root" `requires` Ssh.keyImported SshRsa (User "root")
(Context "kite.kitenet.net") (Context "kite.kitenet.net")
`requires` Ssh.knownHost hosts "eubackup.kitenet.net" "root" `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")
& Apt.serviceInstalledRunning "ntp" & Apt.serviceInstalledRunning "ntp"
& "/etc/timezone" `File.hasContent` ["US/Eastern"] & "/etc/timezone" `File.hasContent` ["US/Eastern"]
@ -188,7 +188,7 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
& JoeySites.kitenetHttps & JoeySites.kitenetHttps
& JoeySites.legacyWebSites & JoeySites.legacyWebSites
& File.ownerGroup "/srv/web" "joey" "joey" & File.ownerGroup "/srv/web" (User "joey") (Group "joey")
& Apt.installed ["analog"] & Apt.installed ["analog"]
& alias "git.kitenet.net" & alias "git.kitenet.net"
@ -255,7 +255,7 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
& Apt.unattendedUpgrades & Apt.unattendedUpgrades
& Systemd.installed & Systemd.installed
& Systemd.persistentJournal & Systemd.persistentJournal
& Ssh.keyImported SshRsa "joey" hostContext & Ssh.keyImported SshRsa (User "joey") hostContext
& Apt.serviceInstalledRunning "swapspace" & Apt.serviceInstalledRunning "swapspace"
& alias "eubackup.kitenet.net" & alias "eubackup.kitenet.net"
@ -308,7 +308,7 @@ beaver = host "beaver.kitenet.net"
& alias "usbackup.kitenet.net" & alias "usbackup.kitenet.net"
& JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup" & JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup"
& Apt.serviceInstalledRunning "anacron" & Apt.serviceInstalledRunning "anacron"
& Cron.niceJob "system disk backed up" Cron.Weekly "root" "/" & Cron.niceJob "system disk backed up" Cron.Weekly (User "root") "/"
"rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/" "rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/"
iabak :: Host iabak :: Host
@ -327,18 +327,18 @@ iabak = host "iabak.archiveteam.org"
] ]
& Apt.installed ["etckeeper", "sudo"] & Apt.installed ["etckeeper", "sudo"]
& Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"] & Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]
& User.hasSomePassword "root" & User.hasSomePassword (User "root")
& propertyList "admin accounts" & propertyList "admin accounts"
(map User.accountFor admins ++ map Sudo.enabledFor admins) (map User.accountFor admins ++ map Sudo.enabledFor admins)
& User.hasSomePassword "joey" & User.hasSomePassword (User "joey")
& GitHome.installedFor "joey" & GitHome.installedFor (User "joey")
& Ssh.authorizedKey "db48x" "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel" & Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"
& Apt.installed ["sudo"] & Apt.installed ["sudo"]
& IABak.gitServer monsters & IABak.gitServer monsters
& IABak.registrationServer monsters & IABak.registrationServer monsters
& IABak.graphiteServer & IABak.graphiteServer
where where
admins = ["joey", "db48x"] admins = map User ["joey", "db48x"]
--' __|II| ,. --' __|II| ,.
---- __|II|II|__ ( \_,/\ ---- __|II|II|__ ( \_,/\
@ -361,7 +361,7 @@ openidProvider :: Docker.Container
openidProvider = standardStableContainer "openid-provider" openidProvider = standardStableContainer "openid-provider"
& alias "openid.kitenet.net" & alias "openid.kitenet.net"
& Docker.publish "8081:80" & Docker.publish "8081:80"
& OpenId.providerFor ["joey", "liw"] & OpenId.providerFor [User "joey", User "liw"]
"openid.kitenet.net:8081" "openid.kitenet.net:8081"
-- Exhibit: kite's 90's website. -- Exhibit: kite's 90's website.
@ -370,7 +370,7 @@ ancientKitenet = standardStableContainer "ancient-kitenet"
& alias "ancient.kitenet.net" & alias "ancient.kitenet.net"
& Docker.publish "1994:80" & Docker.publish "1994:80"
& Apt.serviceInstalledRunning "apache2" & Apt.serviceInstalledRunning "apache2"
& Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www" & Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www"
(Just "remotes/origin/old-kitenet.net") (Just "remotes/origin/old-kitenet.net")
oldusenetShellBox :: Docker.Container oldusenetShellBox :: Docker.Container
@ -392,7 +392,7 @@ jerryPlay = standardContainer "jerryplay" Unstable "amd64"
& Docker.publish "2202:22" & Docker.publish "2202:22"
& Docker.publish "8001:80" & Docker.publish "8001:80"
& Apt.installed ["ssh"] & Apt.installed ["ssh"]
& User.hasSomePassword "root" & User.hasSomePassword (User "root")
& Ssh.permitRootLogin True & Ssh.permitRootLogin True
kiteShellBox :: Docker.Container kiteShellBox :: Docker.Container
@ -407,7 +407,7 @@ standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host
standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd
-- Harden the system, but only once root's authorized_keys -- Harden the system, but only once root's authorized_keys
-- is safely in place. -- is safely in place.
& check (Ssh.hasAuthorizedKeys "root") & check (Ssh.hasAuthorizedKeys (User "root"))
(Ssh.passwordAuthentication False) (Ssh.passwordAuthentication False)
standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host
@ -420,12 +420,12 @@ standardSystemUnhardened hn suite arch motd = host hn
& Apt.cacheCleaned & Apt.cacheCleaned
& Apt.installed ["etckeeper"] & Apt.installed ["etckeeper"]
& Apt.installed ["ssh"] & Apt.installed ["ssh"]
& GitHome.installedFor "root" & GitHome.installedFor (User "root")
& User.hasSomePassword "root" & User.hasSomePassword (User "root")
& User.accountFor "joey" & User.accountFor (User "joey")
& User.hasSomePassword "joey" & User.hasSomePassword (User "joey")
& Sudo.enabledFor "joey" & Sudo.enabledFor (User "joey")
& GitHome.installedFor "joey" & GitHome.installedFor (User "joey")
& Apt.installed ["vim", "screen", "less"] & Apt.installed ["vim", "screen", "less"]
& Cron.runPropellor (Cron.Times "30 * * * *") & Cron.runPropellor (Cron.Times "30 * * * *")
-- I use postfix, or no MTA. -- I use postfix, or no MTA.

View File

@ -28,7 +28,7 @@ hosts =
& Apt.unattendedUpgrades & Apt.unattendedUpgrades
& Apt.installed ["etckeeper"] & Apt.installed ["etckeeper"]
& Apt.installed ["ssh"] & Apt.installed ["ssh"]
& User.hasSomePassword "root" & User.hasSomePassword (User "root")
& Network.ipv6to4 & Network.ipv6to4
& File.dirExists "/var/www" & File.dirExists "/var/www"
& Docker.docked webserverContainer & Docker.docked webserverContainer

4
debian/changelog vendored
View File

@ -1,4 +1,4 @@
propellor (2.2.2) UNRELEASED; urgency=medium propellor (2.3.0) UNRELEASED; urgency=medium
* Make propellor resistent to changes to shared libraries, such as libffi, * Make propellor resistent to changes to shared libraries, such as libffi,
which might render the propellor binary unable to run. This is dealt with which might render the propellor binary unable to run. This is dealt with
@ -9,6 +9,8 @@ propellor (2.2.2) UNRELEASED; urgency=medium
* Added hasLoginShell and shellEnabled. * Added hasLoginShell and shellEnabled.
* debCdn changed to new httpredir.debian.org official replacement for * debCdn changed to new httpredir.debian.org official replacement for
http.debian.net. http.debian.net.
* API change: Added User and Group newtypes, and Properties that
used to use the type UserName = String were changed to use them.
-- Joey Hess <id@joeyh.name> Thu, 02 Apr 2015 10:09:46 -0400 -- Joey Hess <id@joeyh.name> Thu, 02 Apr 2015 10:09:46 -0400

View File

@ -64,7 +64,7 @@ Some other properties you may find in your config.hs, or want to add:
[[!format haskell """ [[!format haskell """
& Apt.unattendedUpgrades & Apt.unattendedUpgrades
& User.hasSomePassword "root" & User.hasSomePassword (User "root")
& "/etc/default/foodaemon" `File.containsLine` "ENABLED=yes" & "/etc/default/foodaemon" `File.containsLine` "ENABLED=yes"
& Cron.runPropellor (Cron.Times "30 * * * *") & Cron.runPropellor (Cron.Times "30 * * * *")
"""]] """]]

View File

@ -39,7 +39,7 @@ scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
-- | A property that can satisfied by running a series of shell commands, -- | A property that can satisfied by running a series of shell commands,
-- as user (cd'd to their home directory). -- as user (cd'd to their home directory).
userScriptProperty :: UserName -> [String] -> Property NoInfo userScriptProperty :: User -> [String] -> Property NoInfo
userScriptProperty user script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user]
where where
shellcmd = intercalate " ; " ("set -e" : "cd" : script) shellcmd = intercalate " ; " ("set -e" : "cd" : script)

View File

@ -28,8 +28,8 @@ data Times
-- job file. -- job file.
-- --
-- The cron job's output will only be emailed if it exits nonzero. -- 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 -> FilePath -> String -> Property NoInfo
job desc times user cddir command = combineProperties ("cronned " ++ desc) job desc times (User u) cddir command = combineProperties ("cronned " ++ desc)
[ cronjobfile `File.hasContent` [ cronjobfile `File.hasContent`
[ case times of [ case times of
Times _ -> "" 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" , "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
, "" , ""
, case times of , case times of
Times t -> t ++ "\t" ++ user ++ "\tchronic " ++ shellEscape scriptfile Times t -> t ++ "\t" ++ u ++ "\tchronic " ++ shellEscape scriptfile
_ -> case user of _ -> case u of
"root" -> "chronic " ++ shellEscape scriptfile "root" -> "chronic " ++ shellEscape scriptfile
_ -> "chronic su " ++ user ++ " -c " ++ shellEscape scriptfile _ -> "chronic su " ++ u ++ " -c " ++ shellEscape scriptfile
] ]
, case times of , case times of
Times _ -> doNothing Times _ -> doNothing
@ -76,11 +76,11 @@ job desc times user cddir command = combineProperties ("cronned " ++ desc)
| otherwise = '_' | otherwise = '_'
-- | Installs a cron job, and runs it niced and ioniced. -- | 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 niceJob desc times user cddir command = job desc times user cddir
("nice ionice -c 3 sh -c " ++ shellEscape command) ("nice ionice -c 3 sh -c " ++ shellEscape command)
-- | Installs a cron job to run propellor. -- | Installs a cron job to run propellor.
runPropellor :: Times -> Property NoInfo runPropellor :: Times -> Property NoInfo
runPropellor times = niceJob "propellor" times "root" localdir runPropellor times = niceJob "propellor" times (User "root") localdir
(bootstrapPropellorCommand ++ "; ./propellor") (bootstrapPropellorCommand ++ "; ./propellor")

View File

@ -91,8 +91,8 @@ dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
makeChange $ createDirectoryIfMissing True d makeChange $ createDirectoryIfMissing True d
-- | Ensures that a file/dir has the specified owner and group. -- | Ensures that a file/dir has the specified owner and group.
ownerGroup :: FilePath -> UserName -> GroupName -> Property NoInfo ownerGroup :: FilePath -> User -> Group -> Property NoInfo
ownerGroup f owner group = property (f ++ " owner " ++ og) $ do ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do
r <- ensureProperty $ cmdProperty "chown" [og, f] r <- ensureProperty $ cmdProperty "chown" [og, f]
if r == FailedChange if r == FailedChange
then return r then return r

View File

@ -62,7 +62,7 @@ type Branch = String
-- it will be recursively deleted first. -- it will be recursively deleted first.
-- --
-- A branch can be specified, to check out. -- 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) cloned owner url dir mbranch = check originurl (property desc checkout)
`requires` installed `requires` installed
where where
@ -96,17 +96,17 @@ cloned owner url dir mbranch = check originurl (property desc checkout)
isGitDir :: FilePath -> IO Bool isGitDir :: FilePath -> IO Bool
isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir]) 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) $ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $
dirExists repo : case gitshared of dirExists repo : case gitshared of
NotShared -> NotShared ->
[ ownerGroup repo user user [ ownerGroup repo user (userGroup user)
, userScriptProperty user ["git", "init", "--bare", "--shared=false", repo] , userScriptProperty user ["git", "init", "--bare", "--shared=false", repo]
] ]
SharedAll -> SharedAll ->
[ ownerGroup repo user user [ ownerGroup repo user (userGroup user)
, userScriptProperty user ["git", "init", "--bare", "--shared=all", repo] , userScriptProperty user ["git", "init", "--bare", "--shared=all", repo]
] ]
Shared group' -> Shared group' ->

View File

@ -20,24 +20,24 @@ newtype GpgKeyId = GpgKeyId { getGpgKeyId :: String }
-- --
-- Recommend only using this for low-value dedicated role keys. -- 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. -- No attempt has been made to scrub the key out of memory once it's used.
keyImported :: GpgKeyId -> UserName -> Property HasInfo keyImported :: GpgKeyId -> User -> Property HasInfo
keyImported (GpgKeyId keyid) user = flagFile' prop genflag keyImported (GpgKeyId keyid) user@(User u) = flagFile' prop genflag
`requires` installed `requires` installed
where where
desc = user ++ " has gpg key " ++ show keyid desc = u ++ " has gpg key " ++ show keyid
genflag = do genflag = do
d <- dotDir user d <- dotDir user
return $ d </> ".propellor-imported-keyid-" ++ keyid return $ d </> ".propellor-imported-keyid-" ++ keyid
prop = withPrivData src (Context keyid) $ \getkey -> prop = withPrivData src (Context keyid) $ \getkey ->
property desc $ getkey $ \key -> makeChange $ property desc $ getkey $ \key -> makeChange $
withHandle StdinHandle createProcessSuccess withHandle StdinHandle createProcessSuccess
(proc "su" ["-c", "gpg --import", user]) $ \h -> do (proc "su" ["-c", "gpg --import", u]) $ \h -> do
fileEncoding h fileEncoding h
hPutStr h key hPutStr h key
hClose h 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" 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 -> IO FilePath
dotDir user = do dotDir (User u) = do
home <- homeDirectory <$> getUserEntryForName user home <- homeDirectory <$> getUserEntryForName u
return $ home </> ".gnupg" return $ home </> ".gnupg"

View File

@ -4,8 +4,8 @@ import Propellor
type GID = Int type GID = Int
exists :: GroupName -> Maybe GID -> Property NoInfo exists :: Group -> Maybe GID -> Property NoInfo
exists group' mgid = check test (cmdProperty "addgroup" $ args mgid) exists (Group group') mgid = check test (cmdProperty "addgroup" $ args mgid)
`describe` unwords ["group", group'] `describe` unwords ["group", group']
where where
groupFile = "/etc/group" groupFile = "/etc/group"

View File

@ -17,7 +17,7 @@ decruft = propertyList "cloudatcost cleanup"
[ File.notPresent "/etc/rc.local" [ File.notPresent "/etc/rc.local"
, File.notPresent "/etc/init.d/S97-setup.sh" , File.notPresent "/etc/init.d/S97-setup.sh"
, File.notPresent "/zang-debian.sh" , File.notPresent "/zang-debian.sh"
, User.nuked "user" User.YesReallyDeleteHome , User.nuked (User "user") User.YesReallyDeleteHome
] ]
] ]

View File

@ -222,7 +222,7 @@ preserveRootSshAuthorized :: Property NoInfo
preserveRootSshAuthorized = check (fileExist oldloc) $ preserveRootSshAuthorized = check (fileExist oldloc) $
property (newloc ++ " copied from old OS") $ do property (newloc ++ " copied from old OS") $ do
ks <- liftIO $ lines <$> readFile oldloc ks <- liftIO $ lines <$> readFile oldloc
ensureProperties (map (Ssh.authorizedKey "root") ks) ensureProperties (map (Ssh.authorizedKey (User "root")) ks)
where where
newloc = "/root/.ssh/authorized_keys" newloc = "/root/.ssh/authorized_keys"
oldloc = oldOSDir ++ newloc oldloc = oldOSDir ++ newloc

View File

@ -49,7 +49,7 @@ backup dir crontimes params numclients =
backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo backupEncrypted :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Gpg.GpgKeyId -> Property HasInfo
backupEncrypted dir crontimes params numclients keyid = backupEncrypted dir crontimes params numclients keyid =
backup dir crontimes params' numclients backup dir crontimes params' numclients
`requires` Gpg.keyImported keyid "root" `requires` Gpg.keyImported keyid (User "root")
where where
params' = ("--encrypt-with=" ++ Gpg.getGpgKeyId keyid) : params 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 backup' dir crontimes params numclients = cronjob `describe` desc
where where
desc = dir ++ " backed up by obnam" 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 intercalate ";" $ catMaybes
[ if numclients == OnlyClient [ if numclients == OnlyClient
then Just $ unwords $ then Just $ unwords $

View File

@ -7,7 +7,7 @@ import qualified Propellor.Property.Service as Service
import Data.List import Data.List
providerFor :: [UserName] -> String -> Property HasInfo providerFor :: [User] -> String -> Property HasInfo
providerFor users baseurl = propertyList desc $ map toProp providerFor users baseurl = propertyList desc $ map toProp
[ Apt.serviceInstalledRunning "apache2" [ Apt.serviceInstalledRunning "apache2"
, Apt.installed ["simpleid"] , Apt.installed ["simpleid"]
@ -25,6 +25,6 @@ providerFor users baseurl = propertyList desc $ map toProp
-- the identities directory controls access, so open up -- the identities directory controls access, so open up
-- file mode -- file mode
identfile u = File.hasPrivContentExposed identfile (User u) = File.hasPrivContentExposed
(concat [ "/var/lib/simpleid/identities/", u, ".identity" ]) (concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
(Context baseurl) (Context baseurl)

View File

@ -153,6 +153,6 @@ saslAuthdInstalled = setupdaemon
dirperm = check (not <$> doesDirectoryExist dir) $ dirperm = check (not <$> doesDirectoryExist dir) $
cmdProperty "dpkg-statoverride" cmdProperty "dpkg-statoverride"
[ "--add", "root", "sasl", "710", dir ] [ "--add", "root", "sasl", "710", dir ]
postfixgroup = "postfix" `User.hasGroup` "sasl" postfixgroup = (User "postfix") `User.hasGroup` (Group "sasl")
`onChange` restarted `onChange` restarted
dir = "/var/spool/postfix/var/run/saslauthd" dir = "/var/spool/postfix/var/run/saslauthd"

View File

@ -28,7 +28,7 @@ type TimeOut = String -- eg, 5h
autobuilder :: Architecture -> Times -> TimeOut -> Property HasInfo autobuilder :: Architecture -> Times -> TimeOut -> Property HasInfo
autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
& Apt.serviceInstalledRunning "cron" & Apt.serviceInstalledRunning "cron"
& Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir & Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir
("git pull ; timeout " ++ timeout ++ " ./autobuild") ("git pull ; timeout " ++ timeout ++ " ./autobuild")
& rsyncpassword & rsyncpassword
where where
@ -51,18 +51,18 @@ tree buildarch = combineProperties "gitannexbuilder tree" $ props
-- gitbuilderdir directory already exists when docker volume is used, -- gitbuilderdir directory already exists when docker volume is used,
-- but with wrong owner. -- but with wrong owner.
& File.dirExists gitbuilderdir & File.dirExists gitbuilderdir
& File.ownerGroup gitbuilderdir builduser builduser & File.ownerGroup gitbuilderdir (User builduser) (Group builduser)
& gitannexbuildercloned & gitannexbuildercloned
& builddircloned & builddircloned
where where
gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $ gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
userScriptProperty builduser userScriptProperty (User builduser)
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir [ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
, "cd " ++ gitbuilderdir , "cd " ++ gitbuilderdir
, "git checkout " ++ buildarch , "git checkout " ++ buildarch
] ]
`describe` "gitbuilder setup" `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 [ "git clone git://git-annex.branchable.com/ " ++ builddir
] ]
@ -89,7 +89,7 @@ buildDepsNoHaskellLibs = Apt.installed
cabalDeps :: Property NoInfo cabalDeps :: Property NoInfo
cabalDeps = flagFile go cabalupdated cabalDeps = flagFile go cabalupdated
where 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" cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"
standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Docker.Container standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Docker.Container
@ -99,7 +99,7 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta
& Apt.stdSourcesList & Apt.stdSourcesList
& Apt.installed ["systemd"] & Apt.installed ["systemd"]
& Apt.unattendedUpgrades & Apt.unattendedUpgrades
& User.accountFor builduser & User.accountFor (User builduser)
& tree arch & tree arch
& buildDepsApt & buildDepsApt
& autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout
@ -125,9 +125,9 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe
& Apt.stdSourcesList & Apt.stdSourcesList
& Apt.installed ["systemd"] & Apt.installed ["systemd"]
& Docker.tweaked & Docker.tweaked
& User.accountFor builduser & User.accountFor (User builduser)
& File.dirExists gitbuilderdir & File.dirExists gitbuilderdir
& File.ownerGroup homedir builduser builduser & File.ownerGroup homedir (User builduser) (Group builduser)
& buildDepsApt & buildDepsApt
& flagFile chrootsetup ("/chrootsetup") & flagFile chrootsetup ("/chrootsetup")
`requires` setupgitannexdir `requires` setupgitannexdir
@ -139,7 +139,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe
chrootsetup = scriptProperty chrootsetup = scriptProperty
[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
] ]
haskellpkgsinstalled = userScriptProperty "builder" haskellpkgsinstalled = userScriptProperty (User builduser)
[ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages" [ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages"
] ]
osver = System (Debian Testing) "i386" -- once jessie is released, use: (Stable "jessie") 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"] & Apt.installed ["systemd"]
-- This volume is shared with the armel builder. -- This volume is shared with the armel builder.
& Docker.volume gitbuilderdir & Docker.volume gitbuilderdir
& User.accountFor builduser & User.accountFor (User builduser)
-- Install current versions of build deps from cabal. -- Install current versions of build deps from cabal.
& tree "armel" & tree "armel"
& buildDepsNoHaskellLibs & buildDepsNoHaskellLibs
@ -163,7 +163,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-
-- The armel builder can ssh to this companion. -- The armel builder can ssh to this companion.
& Docker.expose "22" & Docker.expose "22"
& Apt.serviceInstalledRunning "ssh" & Apt.serviceInstalledRunning "ssh"
& Ssh.authorizedKeys builduser (Context "armel-git-annex-builder") & Ssh.authorizedKeys (User builduser) (Context "armel-git-annex-builder")
& Docker.tweaked & Docker.tweaked
armelAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container armelAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container
@ -175,7 +175,7 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme
& Apt.installed ["openssh-client"] & Apt.installed ["openssh-client"]
& Docker.link "armel-git-annex-builder-companion" "companion" & Docker.link "armel-git-annex-builder-companion" "companion"
& Docker.volumes_from "armel-git-annex-builder-companion" & Docker.volumes_from "armel-git-annex-builder-companion"
& User.accountFor builduser & User.accountFor (User builduser)
-- TODO: automate installing haskell libs -- TODO: automate installing haskell libs
-- (Currently have to run -- (Currently have to run
-- git-annex/standalone/linux/install-haskell-packages -- git-annex/standalone/linux/install-haskell-packages
@ -183,7 +183,7 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme
& buildDepsNoHaskellLibs & buildDepsNoHaskellLibs
& autobuilder "armel" crontimes timeout & autobuilder "armel" crontimes timeout
`requires` tree "armel" `requires` tree "armel"
& Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder") & Ssh.keyImported SshRsa (User builduser) (Context "armel-git-annex-builder")
& trivial writecompanionaddress & trivial writecompanionaddress
& Docker.tweaked & Docker.tweaked
where where

View File

@ -6,9 +6,9 @@ import Propellor.Property.User
import Utility.SafeCommand import Utility.SafeCommand
-- | Clones Joey Hess's git home directory, and runs its fixups script. -- | Clones Joey Hess's git home directory, and runs its fixups script.
installedFor :: UserName -> Property NoInfo installedFor :: User -> Property NoInfo
installedFor user = check (not <$> hasGitDir user) $ installedFor user@(User u) = check (not <$> hasGitDir user) $
property ("githome " ++ user) (go =<< liftIO (homedir user)) property ("githome " ++ u) (go =<< liftIO (homedir user))
`requires` Apt.installed ["git"] `requires` Apt.installed ["git"]
where where
go home = do go home = do
@ -28,7 +28,7 @@ installedFor user = check (not <$> hasGitDir user) $
url :: String url :: String
url = "git://git.kitenet.net/joey/home" url = "git://git.kitenet.net/joey/home"
hasGitDir :: UserName -> IO Bool hasGitDir :: User -> IO Bool
hasGitDir user = go =<< homedir user hasGitDir user = go =<< homedir user
where where
go home = doesDirectoryExist (home </> ".git") go home = doesDirectoryExist (home </> ".git")

View File

@ -17,26 +17,26 @@ userrepo = "git@gitlab.com:archiveteam/IA.bak.users.git"
gitServer :: [Host] -> Property HasInfo gitServer :: [Host] -> Property HasInfo
gitServer knownhosts = propertyList "iabak git server" $ props gitServer knownhosts = propertyList "iabak git server" $ props
& Git.cloned "root" repo "/usr/local/IA.BAK" (Just "server") & Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
& Git.cloned "root" repo "/usr/local/IA.BAK/client" (Just "master") & Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")
& Ssh.keyImported SshRsa "root" (Context "IA.bak.users.git") & Ssh.keyImported SshRsa (User "root") (Context "IA.bak.users.git")
& Ssh.knownHost knownhosts "gitlab.com" "root" & Ssh.knownHost knownhosts "gitlab.com" (User "root")
& Git.cloned "root" userrepo "/usr/local/IA.BAK/pubkeys" (Just "master") & Git.cloned (User "root") userrepo "/usr/local/IA.BAK/pubkeys" (Just "master")
& Apt.serviceInstalledRunning "apache2" & Apt.serviceInstalledRunning "apache2"
& cmdProperty "ln" ["-sf", "/usr/local/IA.BAK/pushme.cgi", "/usr/lib/cgi-bin/pushme.cgi"] & 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" & 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" "/usr/local/IA.BAK/shardstats-all"
& Cron.niceJob "shardmaint" Cron.Daily "root" "/" & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/"
"/usr/local/IA.BAK/shardmaint" "/usr/local/IA.BAK/shardmaint"
registrationServer :: [Host] -> Property HasInfo registrationServer :: [Host] -> Property HasInfo
registrationServer knownhosts = propertyList "iabak registration server" $ props registrationServer knownhosts = propertyList "iabak registration server" $ props
& User.accountFor "registrar" & User.accountFor (User "registrar")
& Ssh.keyImported SshRsa "registrar" (Context "IA.bak.users.git") & Ssh.keyImported SshRsa (User "registrar") (Context "IA.bak.users.git")
& Ssh.knownHost knownhosts "gitlab.com" "registrar" & Ssh.knownHost knownhosts "gitlab.com" (User "registrar")
& Git.cloned "registrar" repo "/home/registrar/IA.BAK" (Just "server") & Git.cloned (User "registrar") repo "/home/registrar/IA.BAK" (Just "server")
& Git.cloned "registrar" userrepo "/home/registrar/users" (Just "master") & Git.cloned (User "registrar") userrepo "/home/registrar/users" (Just "master")
& Apt.serviceInstalledRunning "apache2" & Apt.serviceInstalledRunning "apache2"
& Apt.installed ["perl", "perl-modules"] & Apt.installed ["perl", "perl-modules"]
& cmdProperty "ln" ["-sf", "/home/registrar/IA.BAK/registrar/register.cgi", link] & 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" & cmdProperty "graphite-manage" ["createsuperuser", "--noinput", "--username=db48x", "--email=db48x@localhost"] `flagFile` "/etc/flagFiles/graphite-user-db48x"
`flagFile` "/etc/graphite-superuser-db48x" `flagFile` "/etc/graphite-superuser-db48x"
-- TODO: deal with passwords somehow -- 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" & "/etc/apache2/ports.conf" `File.containsLine` "Listen 8080"
`onChange` Apache.restarted `onChange` Apache.restarted
& Apache.siteEnabled "iabak-graphite-web" & Apache.siteEnabled "iabak-graphite-web"

View File

@ -24,15 +24,15 @@ import Data.String.Utils
scrollBox :: Property HasInfo scrollBox :: Property HasInfo
scrollBox = propertyList "scroll server" $ props scrollBox = propertyList "scroll server" $ props
& User.accountFor "scroll" & User.accountFor (User "scroll")
& Git.cloned "scroll" "git://git.kitenet.net/scroll" (d </> "scroll") Nothing & Git.cloned (User "scroll") "git://git.kitenet.net/scroll" (d </> "scroll") Nothing
& Apt.installed ["ghc", "make", "cabal-install", "libghc-vector-dev", & Apt.installed ["ghc", "make", "cabal-install", "libghc-vector-dev",
"libghc-bytestring-dev", "libghc-mtl-dev", "libghc-ncurses-dev", "libghc-bytestring-dev", "libghc-mtl-dev", "libghc-ncurses-dev",
"libghc-random-dev", "libghc-monad-loops-dev", "libghc-text-dev", "libghc-random-dev", "libghc-monad-loops-dev", "libghc-text-dev",
"libghc-ifelse-dev", "libghc-case-insensitive-dev", "libghc-ifelse-dev", "libghc-case-insensitive-dev",
"libghc-transformers-dev", "libghc-transformers-dev",
"libghc-data-default-dev", "libghc-optparse-applicative-dev"] "libghc-data-default-dev", "libghc-optparse-applicative-dev"]
& userScriptProperty "scroll" & userScriptProperty (User "scroll")
[ "cd " ++ d </> "scroll" [ "cd " ++ d </> "scroll"
, "git pull" , "git pull"
, "cabal configure" , "cabal configure"
@ -76,7 +76,7 @@ scrollBox = propertyList "scroll server" $ props
& Ssh.sshdConfig `File.containsLine` ("DenyUsers scroll") & Ssh.sshdConfig `File.containsLine` ("DenyUsers scroll")
`onChange` Ssh.restarted `onChange` Ssh.restarted
& cmdProperty "chsh" ["scroll", "-s", s] & cmdProperty "chsh" ["scroll", "-s", s]
& User.hasPassword "scroll" & User.hasPassword (User "scroll")
& Apt.serviceInstalledRunning "telnetd" & Apt.serviceInstalledRunning "telnetd"
& Apt.installed ["shellinabox"] & Apt.installed ["shellinabox"]
& File.hasContent "/etc/default/shellinabox" & File.hasContent "/etc/default/shellinabox"
@ -115,8 +115,8 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
& Apt.serviceInstalledRunning "openbsd-inetd" & Apt.serviceInstalledRunning "openbsd-inetd"
& File.notPresent "/etc/cron.daily/leafnode" & File.notPresent "/etc/cron.daily/leafnode"
& File.notPresent "/etc/cron.d/leafnode" & File.notPresent "/etc/cron.d/leafnode"
& Cron.niceJob "oldusenet-expire" (Cron.Times "11 1 * * *") "news" newsspool expirecommand & Cron.niceJob "oldusenet-expire" (Cron.Times "11 1 * * *") (User "news") newsspool expirecommand
& Cron.niceJob "oldusenet-uucp" (Cron.Times "*/5 * * * *") "news" "/" uucpcommand & Cron.niceJob "oldusenet-uucp" (Cron.Times "*/5 * * * *") (User "news") "/" uucpcommand
& Apache.siteEnabled "nntp.olduse.net" nntpcfg & Apache.siteEnabled "nntp.olduse.net" nntpcfg
where where
newsspool = "/var/spool/news" newsspool = "/var/spool/news"
@ -140,8 +140,8 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
, "--client-name=spool" , "--client-name=spool"
, "--ssh-key=" ++ keyfile , "--ssh-key=" ++ keyfile
] Obnam.OnlyClient ] Obnam.OnlyClient
`requires` Ssh.keyImported' (Just keyfile) SshRsa "root" (Context "olduse.net") `requires` Ssh.keyImported' (Just keyfile) SshRsa (User "root") (Context "olduse.net")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
keyfile = "/root/.ssh/olduse.net.key" keyfile = "/root/.ssh/olduse.net.key"
oldUseNetShellBox :: Property HasInfo oldUseNetShellBox :: Property HasInfo
@ -189,8 +189,8 @@ mumbleServer hosts = combineProperties hn $ props
[ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam" [ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam"
, "--client-name=mumble" , "--client-name=mumble"
] Obnam.OnlyClient ] Obnam.OnlyClient
`requires` Ssh.keyImported SshRsa "root" (Context hn) `requires` Ssh.keyImported SshRsa (User "root") (Context hn)
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
& trivial (cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]) & trivial (cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"])
where where
hn = "mumble.debian.net" hn = "mumble.debian.net"
@ -204,10 +204,10 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
, "--ssh-key=" ++ sshkey , "--ssh-key=" ++ sshkey
, "--client-name=wren" -- historical , "--client-name=wren" -- historical
] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1") ] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1")
`requires` Ssh.keyImported' (Just sshkey) SshRsa "root" (Context "git.kitenet.net") `requires` Ssh.keyImported' (Just sshkey) SshRsa (User "root") (Context "git.kitenet.net")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
`requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net") `requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net")
`requires` User.accountFor "family" `requires` User.accountFor (User "family")
& Apt.installed ["git", "rsync", "gitweb"] & Apt.installed ["git", "rsync", "gitweb"]
& Apt.installed ["git-annex"] & Apt.installed ["git-annex"]
& Apt.installed ["kgb-client"] & Apt.installed ["kgb-client"]
@ -222,9 +222,9 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
] ]
`describe` "gitweb configured" `describe` "gitweb configured"
-- Repos push on to github. -- 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.. -- 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.kitenet.net"
& website "git.joeyh.name" & website "git.joeyh.name"
& Apache.modEnabled "cgi" & Apache.modEnabled "cgi"
@ -252,7 +252,7 @@ type AnnexUUID = String
-- | A website, with files coming from a git-annex repository. -- | A website, with files coming from a git-annex repository.
annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property HasInfo annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property HasInfo
annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") $ props 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 `onChange` setup
& alias hn & alias hn
& postupdatehook `File.hasContent` & postupdatehook `File.hasContent`
@ -264,7 +264,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
where where
dir = "/srv/web/" ++ hn dir = "/srv/web/" ++ hn
postupdatehook = dir </> ".git/hooks/post-update" postupdatehook = dir </> ".git/hooks/post-update"
setup = userScriptProperty "joey" setupscript setup = userScriptProperty (User "joey") setupscript
setupscript = setupscript =
[ "cd " ++ shellEscape dir [ "cd " ++ shellEscape dir
, "git annex reinit " ++ shellEscape uuid , "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/x86_64-apple-yosemite"
& endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows" & endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows"
-- git-annex distribution signing key -- git-annex distribution signing key
& Gpg.keyImported (Gpg.GpgKeyId "89C809CB") "joey" & Gpg.keyImported (Gpg.GpgKeyId "89C809CB") (User "joey")
where where
endpoint d = combineProperties ("endpoint " ++ d) endpoint d = combineProperties ("endpoint " ++ d)
[ File.dirExists d [ File.dirExists d
, File.ownerGroup d "joey" "joey" , File.ownerGroup d (User "joey") (Group "joey")
] ]
downloads :: [Host] -> Property HasInfo downloads :: [Host] -> Property HasInfo
@ -356,7 +356,7 @@ downloads hosts = annexWebSite "/srv/git/downloads.git"
"downloads.kitenet.net" "downloads.kitenet.net"
"840760dc-08f0-11e2-8c61-576b7e66acfd" "840760dc-08f0-11e2-8c61-576b7e66acfd"
[("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")] [("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 :: Property HasInfo
tmp = propertyList "tmp.kitenet.net" $ props tmp = propertyList "tmp.kitenet.net" $ props
@ -370,16 +370,16 @@ tmp = propertyList "tmp.kitenet.net" $ props
-- Twitter, you kill us. -- Twitter, you kill us.
twitRss :: Property HasInfo twitRss :: Property HasInfo
twitRss = combineProperties "twitter rss" $ props 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 & 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=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" & feed "http://twitter.com/search/realtime?q=olduse+OR+git-annex+OR+debhelper+OR+etckeeper+OR+ikiwiki+-ashley_ikiwiki" "twittergrep"
where where
dir = "/srv/web/tmp.kitenet.net/twitrss" dir = "/srv/web/tmp.kitenet.net/twitrss"
crontime = Cron.Times "15 * * * *" 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") "./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss")
compiled = userScriptProperty "joey" compiled = userScriptProperty (User "joey")
[ "cd " ++ dir [ "cd " ++ dir
, "ghc --make twitRss" , "ghc --make twitRss"
] ]
@ -391,19 +391,19 @@ twitRss = combineProperties "twitter rss" $ props
-- Work around for expired ssl cert. -- Work around for expired ssl cert.
pumpRss :: Property NoInfo 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" "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 :: Property HasInfo
ircBouncer = propertyList "IRC bouncer" $ props ircBouncer = propertyList "IRC bouncer" $ props
& Apt.installed ["znc"] & Apt.installed ["znc"]
& User.accountFor "znc" & User.accountFor (User "znc")
& File.dirExists (takeDirectory conf) & File.dirExists (takeDirectory conf)
& File.hasPrivContent conf anyContext & File.hasPrivContent conf anyContext
& File.ownerGroup conf "znc" "znc" & File.ownerGroup conf (User "znc") (Group "znc")
& Cron.job "znconboot" (Cron.Times "@reboot") "znc" "~" "znc" & Cron.job "znconboot" (Cron.Times "@reboot") (User "znc") "~" "znc"
-- ensure running if it was not already -- ensure running if it was not already
& trivial (userScriptProperty "znc" ["znc || true"]) & trivial (userScriptProperty (User "znc") ["znc || true"])
`describe` "znc running" `describe` "znc running"
where where
conf = "/home/znc/.znc/configs/znc.conf" conf = "/home/znc/.znc/configs/znc.conf"
@ -425,9 +425,9 @@ githubBackup :: Property HasInfo
githubBackup = propertyList "github-backup box" $ props githubBackup = propertyList "github-backup box" $ props
& Apt.installed ["github-backup", "moreutils"] & Apt.installed ["github-backup", "moreutils"]
& githubKeys & 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 "/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 "/home/joey/lib/backup" gitriddancecmd
where where
backupcmd = intercalate "&&" $ backupcmd = intercalate "&&" $
@ -446,7 +446,7 @@ githubKeys :: Property HasInfo
githubKeys = githubKeys =
let f = "/home/joey/.github-keys" let f = "/home/joey/.github-keys"
in File.hasPrivContent f anyContext 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 -- these repos are only mirrored on github, I don't want
@ -464,13 +464,13 @@ githubMirrors =
rsyncNetBackup :: [Host] -> Property NoInfo rsyncNetBackup :: [Host] -> Property NoInfo
rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" (Cron.Times "30 5 * * *") 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" (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" "joey" `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "joey")
backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property NoInfo backupsBackedupFrom :: [Host] -> HostName -> FilePath -> Property NoInfo
backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc backupsBackedupFrom hosts srchost destdir = Cron.niceJob desc
(Cron.Times "@reboot") "joey" "/" cmd (Cron.Times "@reboot") (User "joey") "/" cmd
`requires` Ssh.knownHost hosts srchost "joey" `requires` Ssh.knownHost hosts srchost (User "joey")
where where
desc = "backups copied from " ++ srchost ++ " on boot" desc = "backups copied from " ++ srchost ++ " on boot"
cmd = "rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir </> srchost 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" `requires` mkdir "/home/joey/lib"
mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam") mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam")
mkdir d = File.dirExists d mkdir d = File.dirExists d
`before` File.ownerGroup d "joey" "joey" `before` File.ownerGroup d (User "joey") (Group "joey")
podcatcher :: Property NoInfo podcatcher :: Property NoInfo
podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *") 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" "xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
`requires` Apt.installed ["git-annex", "myrepos"] `requires` Apt.installed ["git-annex", "myrepos"]
@ -645,7 +645,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
& File.hasPrivContent dovecotusers ctx & File.hasPrivContent dovecotusers ctx
`onChange` (dovecotusers `File.mode` `onChange` (dovecotusers `File.mode`
combineModes [ownerReadMode, groupReadMode]) combineModes [ownerReadMode, groupReadMode])
& File.ownerGroup dovecotusers "root" "dovecot" & File.ownerGroup dovecotusers (User "root") (Group "dovecot")
& Apt.installed ["mutt", "bsd-mailx", "alpine"] & Apt.installed ["mutt", "bsd-mailx", "alpine"]
@ -713,7 +713,7 @@ dkimInstalled = go `onChange` Service.restarted "opendkim"
& Apt.serviceInstalledRunning "opendkim" & Apt.serviceInstalledRunning "opendkim"
& File.dirExists "/etc/mail" & File.dirExists "/etc/mail"
& File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net") & 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` & "/etc/default/opendkim" `File.containsLine`
"SOCKET=\"inet:8891@localhost\"" "SOCKET=\"inet:8891@localhost\""
& "/etc/opendkim.conf" `File.containsLines` & "/etc/opendkim.conf" `File.containsLines`

View File

@ -54,17 +54,17 @@ permitRootLogin = setSshdConfig "PermitRootLogin"
passwordAuthentication :: Bool -> Property NoInfo passwordAuthentication :: Bool -> Property NoInfo
passwordAuthentication = setSshdConfig "PasswordAuthentication" passwordAuthentication = setSshdConfig "PasswordAuthentication"
dotDir :: UserName -> IO FilePath dotDir :: User -> IO FilePath
dotDir user = do dotDir user = do
h <- homedir user h <- homedir user
return $ h </> ".ssh" return $ h </> ".ssh"
dotFile :: FilePath -> UserName -> IO FilePath dotFile :: FilePath -> User -> IO FilePath
dotFile f user = do dotFile f user = do
d <- dotDir user d <- dotDir user
return $ d </> f return $ d </> f
hasAuthorizedKeys :: UserName -> IO Bool hasAuthorizedKeys :: User -> IO Bool
hasAuthorizedKeys = go <=< dotFile "authorized_keys" hasAuthorizedKeys = go <=< dotFile "authorized_keys"
where where
go f = not . null <$> catchDefaultIO "" (readFile f) go f = not . null <$> catchDefaultIO "" (readFile f)
@ -151,19 +151,19 @@ getPubKey = asks (_sshPubKey . hostInfo)
-- PrivData. -- PrivData.
-- --
-- If the user already has a private/public key, it is left unchanged. -- 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 keyImported = keyImported' Nothing
-- | A file can be speficied to write the key to somewhere other than -- | A file can be speficied to write the key to somewhere other than
-- usual. Allows a user to have multiple keys for different roles. -- usual. Allows a user to have multiple keys for different roles.
keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> UserName -> c -> Property HasInfo keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo
keyImported' dest keytype user context = combineProperties desc keyImported' dest keytype user@(User u) context = combineProperties desc
[ installkey (SshPubKey keytype user) (install writeFile ".pub") [ installkey (SshPubKey keytype u) (install writeFile ".pub")
, installkey (SshPrivKey keytype user) (install writeFileProtected "") , installkey (SshPrivKey keytype u) (install writeFileProtected "")
] ]
where where
desc = unwords $ catMaybes desc = unwords $ catMaybes
[ Just user [ Just u
, Just "has ssh key" , Just "has ssh key"
, dest , dest
, Just $ "(" ++ fromKeyType keytype ++ ")" , Just $ "(" ++ fromKeyType keytype ++ ")"
@ -178,13 +178,13 @@ keyImported' dest keytype user context = combineProperties desc
[ property desc $ makeChange $ do [ property desc $ makeChange $ do
createDirectoryIfMissing True (takeDirectory f) createDirectoryIfMissing True (takeDirectory f)
writer f key writer f key
, File.ownerGroup f user user , File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user user , File.ownerGroup (takeDirectory f) user (userGroup user)
] ]
) )
keyfile ext = case dest of keyfile ext = case dest of
Nothing -> do Nothing -> do
home <- homeDirectory <$> getUserEntryForName user home <- homeDirectory <$> getUserEntryForName u
return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
Just f -> return $ f ++ 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' -- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey'
-- into the known_hosts file for a user. -- into the known_hosts file for a user.
knownHost :: [Host] -> HostName -> UserName -> Property NoInfo knownHost :: [Host] -> HostName -> User -> Property NoInfo
knownHost hosts hn user = property desc $ knownHost hosts hn user@(User u) = property desc $
go =<< fromHost hosts hn getPubKey go =<< fromHost hosts hn getPubKey
where where
desc = user ++ " knows ssh key for " ++ hn desc = u ++ " knows ssh key for " ++ hn
go (Just m) | not (M.null m) = do go (Just m) | not (M.null m) = do
f <- liftIO $ dotFile "known_hosts" user f <- liftIO $ dotFile "known_hosts" user
ensureProperty $ combineProperties desc ensureProperty $ combineProperties desc
[ File.dirExists (takeDirectory f) [ File.dirExists (takeDirectory f)
, f `File.containsLines` , f `File.containsLines`
(map (\k -> hn ++ " " ++ k) (M.elems m)) (map (\k -> hn ++ " " ++ k) (M.elems m))
, File.ownerGroup f user user , File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user user , File.ownerGroup (takeDirectory f) user (userGroup user)
] ]
go _ = do go _ = do
warningMessage $ "no configred pubKey for " ++ hn 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 -- | Makes a user have authorized_keys from the PrivData
-- --
-- This removes any other lines from the file. -- This removes any other lines from the file.
authorizedKeys :: IsContext c => UserName -> c -> Property HasInfo authorizedKeys :: IsContext c => User -> c -> Property HasInfo
authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get -> authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->
property (user ++ " has authorized_keys") $ get $ \v -> do property (u ++ " has authorized_keys") $ get $ \v -> do
f <- liftIO $ dotFile "authorized_keys" user f <- liftIO $ dotFile "authorized_keys" user
liftIO $ do liftIO $ do
createDirectoryIfMissing True (takeDirectory f) createDirectoryIfMissing True (takeDirectory f)
writeFileProtected f v writeFileProtected f v
ensureProperties ensureProperties
[ File.ownerGroup f user user [ File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user user , File.ownerGroup (takeDirectory f) user (userGroup user)
] ]
-- | Ensures that a user's authorized_keys contains a line. -- | Ensures that a user's authorized_keys contains a line.
-- Any other lines in the file are preserved as-is. -- Any other lines in the file are preserved as-is.
authorizedKey :: UserName -> String -> Property NoInfo authorizedKey :: User -> String -> Property NoInfo
authorizedKey user l = property desc $ do authorizedKey user@(User u) l = property desc $ do
f <- liftIO $ dotFile "authorized_keys" user f <- liftIO $ dotFile "authorized_keys" user
ensureProperty $ combineProperties desc ensureProperty $ combineProperties desc
[ f `File.containsLine` l [ f `File.containsLine` l
`requires` File.dirExists (takeDirectory f) `requires` File.dirExists (takeDirectory f)
`onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) `onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
, File.ownerGroup f user user , File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user user , File.ownerGroup (takeDirectory f) user (userGroup user)
] ]
where 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 -- | Makes the ssh server listen on a given port, in addition to any other
-- ports it is configured to listen on. -- ports it is configured to listen on.

View File

@ -9,8 +9,8 @@ import Propellor.Property.User
-- | Allows a user to sudo. If the user has a password, sudo is configured -- | 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. -- to require it. If not, NOPASSWORD is enabled for the user.
enabledFor :: UserName -> Property NoInfo enabledFor :: User -> Property NoInfo
enabledFor user = property desc go `requires` Apt.installed ["sudo"] enabledFor user@(User u) = property desc go `requires` Apt.installed ["sudo"]
where where
go = do go = do
locked <- liftIO $ isLockedPassword user locked <- liftIO $ isLockedPassword user
@ -18,8 +18,8 @@ enabledFor user = property desc go `requires` Apt.installed ["sudo"]
fileProperty desc fileProperty desc
(modify locked . filter (wanted locked)) (modify locked . filter (wanted locked))
"/etc/sudoers" "/etc/sudoers"
desc = user ++ " is sudoer" desc = u ++ " is sudoer"
sudobaseline = user ++ " ALL=(ALL:ALL)" sudobaseline = u ++ " ALL=(ALL:ALL)"
sudoline True = sudobaseline ++ " NOPASSWD:ALL" sudoline True = sudobaseline ++ " NOPASSWD:ALL"
sudoline False = sudobaseline ++ " ALL" sudoline False = sudobaseline ++ " ALL"
wanted locked l wanted locked l

View File

@ -52,7 +52,7 @@ named n = configured [("Nickname", n')]
torPrivKey :: Context -> Property HasInfo torPrivKey :: Context -> Property HasInfo
torPrivKey context = f `File.hasPrivContent` context 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 -- install tor first, so the directory exists with right perms
`requires` Apt.installed ["tor"] `requires` Apt.installed ["tor"]
where where
@ -140,8 +140,8 @@ hiddenServiceData hn context = combineProperties desc
writeFileProtected f content writeFileProtected f content
, File.mode (takeDirectory f) $ combineModes , File.mode (takeDirectory f) $ combineModes
[ownerReadMode, ownerWriteMode, ownerExecuteMode] [ownerReadMode, ownerWriteMode, ownerExecuteMode]
, File.ownerGroup (takeDirectory f) user user , File.ownerGroup (takeDirectory f) user (userGroup user)
, File.ownerGroup f user user , File.ownerGroup f user (userGroup user)
] ]
) )
@ -157,8 +157,8 @@ varLib = "/var/lib/tor"
varRun :: FilePath varRun :: FilePath
varRun = "/var/run/tor" varRun = "/var/run/tor"
user :: UserName user :: User
user = "debian-tor" user = User "debian-tor"
type NickName = String type NickName = String

View File

@ -7,31 +7,31 @@ import qualified Propellor.Property.File as File
data Eep = YesReallyDeleteHome data Eep = YesReallyDeleteHome
accountFor :: UserName -> Property NoInfo accountFor :: User -> Property NoInfo
accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser" accountFor user@(User u) = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser"
[ "--disabled-password" [ "--disabled-password"
, "--gecos", "" , "--gecos", ""
, user , u
] ]
`describe` ("account for " ++ user) `describe` ("account for " ++ u)
-- | Removes user home directory!! Use with caution. -- | Removes user home directory!! Use with caution.
nuked :: UserName -> Eep -> Property NoInfo nuked :: User -> Eep -> Property NoInfo
nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel" nuked user@(User u) _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel"
[ "-r" [ "-r"
, user , u
] ]
`describe` ("nuked user " ++ user) `describe` ("nuked user " ++ u)
-- | Only ensures that the user has some password set. It may or may -- | Only ensures that the user has some password set. It may or may
-- not be a password from the PrivData. -- not be a password from the PrivData.
hasSomePassword :: UserName -> Property HasInfo hasSomePassword :: User -> Property HasInfo
hasSomePassword user = hasSomePassword' user hostContext hasSomePassword user = hasSomePassword' user hostContext
-- | While hasSomePassword uses the name of the host as context, -- | While hasSomePassword uses the name of the host as context,
-- this allows specifying a different context. This is useful when -- this allows specifying a different context. This is useful when
-- you want to use the same password on multiple hosts, for example. -- 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) $ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
hasPassword' user context 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; -- 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 -- the full cleartext <Password> or a <CryptPassword> hash. The latter
-- is obviously more secure. -- is obviously more secure.
hasPassword :: UserName -> Property HasInfo hasPassword :: User -> Property HasInfo
hasPassword user = hasPassword' user hostContext hasPassword user = hasPassword' user hostContext
hasPassword' :: IsContext c => UserName -> c -> Property HasInfo hasPassword' :: IsContext c => User -> c -> Property HasInfo
hasPassword' user context = go `requires` shadowConfig True hasPassword' (User u) context = go `requires` shadowConfig True
where where
go = withSomePrivData srcs context $ go = withSomePrivData srcs context $
property (user ++ " has password") . setPassword property (u ++ " has password") . setPassword
srcs = 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'" "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 setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
@ -67,32 +67,32 @@ setPassword getpassword = getpassword $ go
hPutStrLn h $ user ++ ":" ++ v hPutStrLn h $ user ++ ":" ++ v
hClose h hClose h
lockedPassword :: UserName -> Property NoInfo lockedPassword :: User -> Property NoInfo
lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd" lockedPassword user@(User u) = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
[ "--lock" [ "--lock"
, user , u
] ]
`describe` ("locked " ++ user ++ " password") `describe` ("locked " ++ u ++ " password")
data PasswordStatus = NoPassword | LockedPassword | HasPassword data PasswordStatus = NoPassword | LockedPassword | HasPassword
deriving (Eq) deriving (Eq)
getPasswordStatus :: UserName -> IO PasswordStatus getPasswordStatus :: User -> IO PasswordStatus
getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user] getPasswordStatus (User u) = parse . words <$> readProcess "passwd" ["-S", u]
where where
parse (_:"L":_) = LockedPassword parse (_:"L":_) = LockedPassword
parse (_:"NP":_) = NoPassword parse (_:"NP":_) = NoPassword
parse (_:"P":_) = HasPassword parse (_:"P":_) = HasPassword
parse _ = NoPassword parse _ = NoPassword
isLockedPassword :: UserName -> IO Bool isLockedPassword :: User -> IO Bool
isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
homedir :: UserName -> IO FilePath homedir :: User -> IO FilePath
homedir user = homeDirectory <$> getUserEntryForName user homedir (User user) = homeDirectory <$> getUserEntryForName user
hasGroup :: UserName -> GroupName -> Property NoInfo hasGroup :: User -> Group -> Property NoInfo
hasGroup user group' = check test $ cmdProperty "adduser" hasGroup (User user) (Group group') = check test $ cmdProperty "adduser"
[ user [ user
, group' , group'
] ]
@ -114,16 +114,16 @@ shadowExists = doesFileExist "/etc/shadow"
-- | Ensures that a user has a specified login shell, and that the shell -- | Ensures that a user has a specified login shell, and that the shell
-- is enabled in /etc/shells. -- is enabled in /etc/shells.
hasLoginShell :: UserName -> FilePath -> Property NoInfo hasLoginShell :: User -> FilePath -> Property NoInfo
hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell
shellSetTo :: UserName -> FilePath -> Property NoInfo shellSetTo :: User -> FilePath -> Property NoInfo
shellSetTo user loginshell = check needchangeshell $ shellSetTo (User u) loginshell = check needchangeshell $
cmdProperty "chsh" ["--shell", loginshell, user] cmdProperty "chsh" ["--shell", loginshell, u]
`describe` (user ++ " has login shell " ++ loginshell) `describe` (u ++ " has login shell " ++ loginshell)
where where
needchangeshell = do needchangeshell = do
currshell <- userShell <$> getUserEntryForName user currshell <- userShell <$> getUserEntryForName u
return (currshell /= loginshell) return (currshell /= loginshell)
-- | Ensures that /etc/shells contains a shell. -- | Ensures that /etc/shells contains a shell.

View File

@ -1,20 +1,19 @@
module Propellor.Types.OS ( module Propellor.Types.OS (
HostName,
UserName,
GroupName,
System(..), System(..),
Distribution(..), Distribution(..),
DebianSuite(..), DebianSuite(..),
isStable, isStable,
Release, Release,
Architecture, Architecture,
HostName,
UserName,
User(..),
Group(..),
userGroup,
) where ) where
import Network.BSD (HostName) import Network.BSD (HostName)
type UserName = String
type GroupName = String
-- | High level description of a operating system. -- | High level description of a operating system.
data System = System Distribution Architecture data System = System Distribution Architecture
deriving (Show, Eq) deriving (Show, Eq)
@ -35,3 +34,11 @@ isStable _ = False
type Release = String type Release = String
type Architecture = 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

View File

@ -2,8 +2,8 @@ module Propellor.Types.PrivData where
import Propellor.Types.OS import Propellor.Types.OS
-- | Note that removing or changing constructors will break the -- | Note that removing or changing constructors or changing types will
-- serialized privdata files, so don't do that! -- break the serialized privdata files, so don't do that!
-- It's fine to add new constructors. -- It's fine to add new constructors.
data PrivDataField data PrivDataField
= DockerAuthentication = DockerAuthentication