propellor 2.2.1 → 2.3.0
raw patch · 33 files changed
+322/−207 lines, 33 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Propellor.Types.OS: type GroupName = String
+ Propellor.Property.User: hasLoginShell :: User -> FilePath -> Property NoInfo
+ Propellor.Property.User: shellEnabled :: FilePath -> Property NoInfo
+ Propellor.Property.User: shellSetTo :: User -> FilePath -> Property NoInfo
+ Propellor.Types.CmdLine: Check :: CmdLine
+ Propellor.Types.OS: Group :: String -> Group
+ Propellor.Types.OS: User :: UserName -> User
+ Propellor.Types.OS: newtype Group
+ Propellor.Types.OS: newtype User
+ Propellor.Types.OS: userGroup :: User -> Group
- Propellor.Property.Cmd: userScriptProperty :: UserName -> [String] -> Property NoInfo
+ Propellor.Property.Cmd: userScriptProperty :: User -> [String] -> Property NoInfo
- Propellor.Property.Cron: job :: Desc -> Times -> UserName -> FilePath -> String -> Property NoInfo
+ Propellor.Property.Cron: job :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo
- Propellor.Property.Cron: niceJob :: Desc -> Times -> UserName -> FilePath -> String -> Property NoInfo
+ Propellor.Property.Cron: niceJob :: Desc -> Times -> User -> FilePath -> String -> Property NoInfo
- Propellor.Property.File: ownerGroup :: FilePath -> UserName -> GroupName -> Property NoInfo
+ Propellor.Property.File: ownerGroup :: FilePath -> User -> Group -> Property NoInfo
- Propellor.Property.Git: Shared :: GroupName -> GitShared
+ Propellor.Property.Git: Shared :: Group -> GitShared
- Propellor.Property.Git: bareRepo :: FilePath -> UserName -> GitShared -> Property NoInfo
+ Propellor.Property.Git: bareRepo :: FilePath -> User -> GitShared -> Property NoInfo
- Propellor.Property.Git: cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo
+ Propellor.Property.Git: cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo
- Propellor.Property.Gpg: dotDir :: UserName -> IO FilePath
+ Propellor.Property.Gpg: dotDir :: User -> IO FilePath
- Propellor.Property.Gpg: keyImported :: GpgKeyId -> UserName -> Property HasInfo
+ Propellor.Property.Gpg: keyImported :: GpgKeyId -> User -> Property HasInfo
- Propellor.Property.Group: exists :: GroupName -> Maybe GID -> Property NoInfo
+ Propellor.Property.Group: exists :: Group -> Maybe GID -> Property NoInfo
- Propellor.Property.OpenId: providerFor :: [UserName] -> String -> Property HasInfo
+ Propellor.Property.OpenId: providerFor :: [User] -> String -> Property HasInfo
- Propellor.Property.SiteSpecific.GitHome: hasGitDir :: UserName -> IO Bool
+ Propellor.Property.SiteSpecific.GitHome: hasGitDir :: User -> IO Bool
- Propellor.Property.SiteSpecific.GitHome: installedFor :: UserName -> Property NoInfo
+ Propellor.Property.SiteSpecific.GitHome: installedFor :: User -> Property NoInfo
- Propellor.Property.Ssh: authorizedKey :: UserName -> String -> Property NoInfo
+ Propellor.Property.Ssh: authorizedKey :: User -> String -> Property NoInfo
- Propellor.Property.Ssh: authorizedKeys :: IsContext c => UserName -> c -> Property HasInfo
+ Propellor.Property.Ssh: authorizedKeys :: IsContext c => User -> c -> Property HasInfo
- Propellor.Property.Ssh: hasAuthorizedKeys :: UserName -> IO Bool
+ Propellor.Property.Ssh: hasAuthorizedKeys :: User -> IO Bool
- Propellor.Property.Ssh: keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property HasInfo
+ Propellor.Property.Ssh: keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo
- Propellor.Property.Ssh: keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> UserName -> c -> Property HasInfo
+ Propellor.Property.Ssh: keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo
- Propellor.Property.Ssh: knownHost :: [Host] -> HostName -> UserName -> Property NoInfo
+ Propellor.Property.Ssh: knownHost :: [Host] -> HostName -> User -> Property NoInfo
- Propellor.Property.Sudo: enabledFor :: UserName -> Property NoInfo
+ Propellor.Property.Sudo: enabledFor :: User -> Property NoInfo
- Propellor.Property.Tor: user :: UserName
+ Propellor.Property.Tor: user :: User
- Propellor.Property.User: accountFor :: UserName -> Property NoInfo
+ Propellor.Property.User: accountFor :: User -> Property NoInfo
- Propellor.Property.User: getPasswordStatus :: UserName -> IO PasswordStatus
+ Propellor.Property.User: getPasswordStatus :: User -> IO PasswordStatus
- Propellor.Property.User: hasGroup :: UserName -> GroupName -> Property NoInfo
+ Propellor.Property.User: hasGroup :: User -> Group -> Property NoInfo
- Propellor.Property.User: hasPassword :: UserName -> Property HasInfo
+ Propellor.Property.User: hasPassword :: User -> Property HasInfo
- Propellor.Property.User: hasPassword' :: IsContext c => UserName -> c -> Property HasInfo
+ Propellor.Property.User: hasPassword' :: IsContext c => User -> c -> Property HasInfo
- Propellor.Property.User: hasSomePassword :: UserName -> Property HasInfo
+ Propellor.Property.User: hasSomePassword :: User -> Property HasInfo
- Propellor.Property.User: hasSomePassword' :: IsContext c => UserName -> c -> Property HasInfo
+ Propellor.Property.User: hasSomePassword' :: IsContext c => User -> c -> Property HasInfo
- Propellor.Property.User: homedir :: UserName -> IO FilePath
+ Propellor.Property.User: homedir :: User -> IO FilePath
- Propellor.Property.User: isLockedPassword :: UserName -> IO Bool
+ Propellor.Property.User: isLockedPassword :: User -> IO Bool
- Propellor.Property.User: lockedPassword :: UserName -> Property NoInfo
+ Propellor.Property.User: lockedPassword :: User -> Property NoInfo
- Propellor.Property.User: nuked :: UserName -> Eep -> Property NoInfo
+ Propellor.Property.User: nuked :: User -> Eep -> Property NoInfo
Files
- CHANGELOG +16/−0
- config-joey.hs +58/−18
- config-simple.hs +3/−3
- config.hs +3/−3
- debian/changelog +16/−0
- debian/rules +0/−4
- propellor.cabal +1/−1
- src/Propellor/Bootstrap.hs +16/−5
- src/Propellor/CmdLine.hs +3/−0
- src/Propellor/Property/Apt.hs +1/−1
- src/Propellor/Property/Cmd.hs +2/−2
- src/Propellor/Property/Cron.hs +9/−7
- src/Propellor/Property/File.hs +2/−2
- src/Propellor/Property/Git.hs +5/−5
- src/Propellor/Property/Gpg.hs +7/−7
- src/Propellor/Property/Group.hs +2/−2
- src/Propellor/Property/HostingProvider/CloudAtCost.hs +1/−1
- src/Propellor/Property/OS.hs +1/−1
- src/Propellor/Property/Obnam.hs +2/−2
- src/Propellor/Property/OpenId.hs +2/−2
- src/Propellor/Property/Postfix.hs +1/−1
- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +13/−13
- src/Propellor/Property/SiteSpecific/GitHome.hs +4/−4
- src/Propellor/Property/SiteSpecific/JoeySites.hs +51/−47
- src/Propellor/Property/Ssh.hs +27/−27
- src/Propellor/Property/Sudo.hs +4/−4
- src/Propellor/Property/Tor.hs +5/−5
- src/Propellor/Property/User.hs +46/−27
- src/Propellor/Types/CmdLine.hs +1/−0
- src/Propellor/Types/OS.hs +14/−7
- src/Propellor/Types/PrivData.hs +2/−2
- src/config.hs +3/−3
- src/wrapper.hs +1/−1
CHANGELOG view
@@ -1,3 +1,19 @@+propellor (2.3.0) unstable; urgency=medium++ * Make propellor resistent to changes to shared libraries, such as libffi,+ which might render the propellor binary unable to run. This is dealt with+ by checking the binary both when running propellor on a remote host,+ and by Cron.runPropellor. If the binary doesn't work, it will be rebuilt.+ * Note that since a new switch had to be added to allow testing the binary,+ upgrading to this version will cause a rebuild from scratch of propellor.+ * Added hasLoginShell and shellEnabled.+ * debCdn changed to new httpredir.debian.org official replacement for+ 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> Wed, 22 Apr 2015 13:46:24 -0400+ propellor (2.2.1) unstable; urgency=medium * userScriptProperty now passes --shell /bin/sh, so it can be used
config-joey.hs view
@@ -30,6 +30,7 @@ import qualified Propellor.Property.HostingProvider.Linode as Linode import qualified Propellor.Property.SiteSpecific.GitHome as GitHome import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder+import qualified Propellor.Property.SiteSpecific.IABak as IABak import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites @@ -40,11 +41,13 @@ hosts :: [Host] -- * \ | | '--------' hosts = -- (o) ` [ darkstar+ , gnu , clam , orca , kite , elephant , beaver+ , iabak ] ++ monsters testvm :: Host@@ -62,7 +65,7 @@ & Hostname.searchDomain & Apt.installed ["linux-image-amd64"] & Apt.installed ["ssh"]- & User.hasPassword "root"+ & User.hasPassword (User "root") darkstar :: Host darkstar = host "darkstar.kitenet.net"@@ -75,6 +78,14 @@ & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net") & JoeySites.dkimMilter +gnu :: Host+gnu = host "gnu.kitenet.net"+ & Apt.buildDep ["git-annex"] `period` Daily+ & Docker.configured++ & JoeySites.postfixClientRelay (Context "gnu.kitenet.net")+ & JoeySites.dkimMilter+ clam :: Host clam = standardSystem "clam.kitenet.net" Unstable "amd64" [ "Unreliable server. Anything here may be lost at any time!" ]@@ -163,9 +174,9 @@ , "--exclude=.*/tmp/" , "--one-file-system" ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")- `requires` Ssh.keyImported SshRsa "root"+ `requires` Ssh.keyImported SshRsa (User "root") (Context "kite.kitenet.net")- `requires` Ssh.knownHost hosts "eubackup.kitenet.net" "root"+ `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") & Apt.serviceInstalledRunning "ntp" & "/etc/timezone" `File.hasContent` ["US/Eastern"] @@ -177,7 +188,7 @@ & JoeySites.kitenetHttps & JoeySites.legacyWebSites- & File.ownerGroup "/srv/web" "joey" "joey"+ & File.ownerGroup "/srv/web" (User "joey") (Group "joey") & Apt.installed ["analog"] & alias "git.kitenet.net"@@ -211,7 +222,6 @@ & Docker.configured & Docker.garbageCollected `period` Daily- ! Docker.docked oldusenetShellBox & alias "nntp.olduse.net" & JoeySites.oldUseNetServer hosts@@ -245,12 +255,12 @@ & Apt.unattendedUpgrades & Systemd.installed & Systemd.persistentJournal- & Ssh.keyImported SshRsa "joey" hostContext+ & Ssh.keyImported SshRsa (User "joey") hostContext & Apt.serviceInstalledRunning "swapspace" & alias "eubackup.kitenet.net" & Apt.installed ["obnam", "sshfs", "rsync"]- & JoeySites.obnamRepos ["wren", "pell", "kite"]+ & JoeySites.obnamRepos ["pell", "kite"] & JoeySites.githubBackup & JoeySites.rsyncNetBackup hosts @@ -298,9 +308,37 @@ & alias "usbackup.kitenet.net" & JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup" & 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/" +iabak :: Host+iabak = host "iabak.archiveteam.org"+ & ipv4 "124.6.40.227"+ & Hostname.sane+ & os (System (Debian Testing) "amd64")+ & Systemd.persistentJournal+ & Cron.runPropellor (Cron.Times "30 * * * *")+ & Apt.stdSourcesList `onChange` Apt.upgrade+ & Apt.installed ["git", "ssh"]+ & Ssh.hostKeys (Context "iabak.archiveteam.org")+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAMhuYTshLxavWCpfyJxg3j/GWyIRlL3VTharsfUTzMOqyMSWantZjflfJX21z2KzFDtPEA711GYztsgMVXMrsPQInaOKNISe/R9cfgnEktKTxeppWTfw0GTNcpCeeecddU0FCPVW3a6yDoT6+Rv0jPvkQoDGmhQ40MhauMrO0mJ9AAAAFQDpCbXG8o/3Sg7wrsp5abizJoQ0yQAAAIEAxxyHo/ZhDPP+EWtDS05s5dwiDMUsxIllk1NeleAOQIyLtFkaifOeskDJybIPWYPGX1trjcPoGuXJ5GBYrRaPiu6FBvYdYMFRLr4uNBsaSHHqlHhBPkP3RzCrdUyau4XyjdE4iA0EQlO+u11A+o3f7aTuJSveM0YRfbqvaatG89EAAACAWd0h0SkRLnGjBzkou0SQfYujFY9ilhWXPWV/oOs+bieDSpvfmnaEfLSinVFRrJPvQp/dtpxPLEm+StrK3w6dmwTZVUM5JEoB1mRjBkVs6gPC9PVVg9qLpzC2/x+r5cTfrffjyRrlPdkwLKpO6oiPxTIxAyCW8ixjafkxe2hAeJo=")+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDP13oPRLRY0V9ZDWojb8TgHbUdE30Nq3b541TwPmlLMbYPAhldxGHkuXGlX8g9/FYP/1AgkPcxs2Uc61ZV+1Ss7q7t52f4R0bO4WHqxfdXHd9FlLzMLWxMU3aMr693pGlhnUp3/xH6O6/+bNEIo3VGGgv9XDr2cAxypS9J7X9ibHZcZ3BGvoCR+nnFJ00ERG2tREKZBPDWKk76lhCiM21fG/CSmcApXaA45FHDaM9/2Clj1sXvoS72f0hEKpl1m08sUx+F0GPzQESnKqNFl+xXdYPPbfhdrgCnDmx9tL5NnXsJU2beFiuxpICOeB1HV6DJsdlO18WqwXYhOg/2A1H3")+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHb0kXcrF5ThwS8wB0Hez404Zp9bz78ZxEGSqnwuF4d/N3+bymg7/HAj7l/SzRoEXKHsJ7P5320oMxBHeM16Y+k=")+ ]+ & Apt.installed ["etckeeper", "sudo"]+ & Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]+ & User.hasSomePassword (User "root")+ & propertyList "admin accounts"+ (map User.accountFor admins ++ map Sudo.enabledFor admins)+ & User.hasSomePassword (User "joey")+ & GitHome.installedFor (User "joey")+ & 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"]+ & IABak.gitServer monsters+ & IABak.registrationServer monsters+ & IABak.graphiteServer+ where+ admins = map User ["joey", "db48x"] --' __|II| ,. ---- __|II|II|__ ( \_,/\@@ -323,7 +361,7 @@ openidProvider = standardStableContainer "openid-provider" & alias "openid.kitenet.net" & Docker.publish "8081:80"- & OpenId.providerFor ["joey", "liw"]+ & OpenId.providerFor [User "joey", User "liw"] "openid.kitenet.net:8081" -- Exhibit: kite's 90's website.@@ -332,7 +370,7 @@ & alias "ancient.kitenet.net" & Docker.publish "1994:80" & 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") oldusenetShellBox :: Docker.Container@@ -354,7 +392,7 @@ & Docker.publish "2202:22" & Docker.publish "8001:80" & Apt.installed ["ssh"]- & User.hasSomePassword "root"+ & User.hasSomePassword (User "root") & Ssh.permitRootLogin True kiteShellBox :: Docker.Container@@ -369,7 +407,7 @@ standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd -- Harden the system, but only once root's authorized_keys -- is safely in place.- & check (Ssh.hasAuthorizedKeys "root")+ & check (Ssh.hasAuthorizedKeys (User "root")) (Ssh.passwordAuthentication False) standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host@@ -382,12 +420,12 @@ & Apt.cacheCleaned & Apt.installed ["etckeeper"] & Apt.installed ["ssh"]- & GitHome.installedFor "root"- & User.hasSomePassword "root"- & User.accountFor "joey"- & User.hasSomePassword "joey"- & Sudo.enabledFor "joey"- & GitHome.installedFor "joey"+ & GitHome.installedFor (User "root")+ & User.hasSomePassword (User "root")+ & User.accountFor (User "joey")+ & User.hasSomePassword (User "joey")+ & Sudo.enabledFor (User "joey")+ & GitHome.installedFor (User "joey") & Apt.installed ["vim", "screen", "less"] & Cron.runPropellor (Cron.Times "30 * * * *") -- I use postfix, or no MTA.@@ -446,6 +484,8 @@ & Ssh.pubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ==" , host "github.com" & Ssh.pubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="+ , host "gitlab.com"+ & Ssh.pubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" , host "ns6.gandi.net" & ipv4 "217.70.177.40" , host "turtle.kitenet.net"
config-simple.hs view
@@ -28,7 +28,7 @@ & Apt.unattendedUpgrades & Apt.installed ["etckeeper"] & Apt.installed ["ssh"]- & User.hasSomePassword "root"+ & User.hasSomePassword (User "root") & Network.ipv6to4 & File.dirExists "/var/www" & Docker.docked webserverContainer@@ -41,8 +41,8 @@ -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "joeyh/debian-stable"- & os (System (Debian (Stable "wheezy")) "amd64")+webserverContainer = Docker.container "webserver" "debian"+ & os (System (Debian (Stable "jessie")) "amd64") & Apt.stdSourcesList & Docker.publish "80:80" & Docker.volume "/var/www:/var/www"
config.hs view
@@ -28,7 +28,7 @@ & Apt.unattendedUpgrades & Apt.installed ["etckeeper"] & Apt.installed ["ssh"]- & User.hasSomePassword "root"+ & User.hasSomePassword (User "root") & Network.ipv6to4 & File.dirExists "/var/www" & Docker.docked webserverContainer@@ -41,8 +41,8 @@ -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "joeyh/debian-stable"- & os (System (Debian (Stable "wheezy")) "amd64")+webserverContainer = Docker.container "webserver" "debian"+ & os (System (Debian (Stable "jessie")) "amd64") & Apt.stdSourcesList & Docker.publish "80:80" & Docker.volume "/var/www:/var/www"
debian/changelog view
@@ -1,3 +1,19 @@+propellor (2.3.0) unstable; urgency=medium++ * Make propellor resistent to changes to shared libraries, such as libffi,+ which might render the propellor binary unable to run. This is dealt with+ by checking the binary both when running propellor on a remote host,+ and by Cron.runPropellor. If the binary doesn't work, it will be rebuilt.+ * Note that since a new switch had to be added to allow testing the binary,+ upgrading to this version will cause a rebuild from scratch of propellor.+ * Added hasLoginShell and shellEnabled.+ * debCdn changed to new httpredir.debian.org official replacement for+ 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> Wed, 22 Apr 2015 13:46:24 -0400+ propellor (2.2.1) unstable; urgency=medium * userScriptProperty now passes --shell /bin/sh, so it can be used
debian/rules view
@@ -12,7 +12,3 @@ dh_installdocs doc/README.mdwn override_dh_installman: dh_installman propellor.1--# Not intended for use by anyone except the author.-announcedir:- @echo ${HOME}/src/propellor/doc/news
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 2.2.1+Version: 2.3.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>
src/Propellor/Bootstrap.hs view
@@ -1,5 +1,6 @@ module Propellor.Bootstrap ( bootstrapPropellorCommand,+ checkBinaryCommand, installGitCommand, buildPropellor, ) where@@ -12,14 +13,24 @@ type ShellCommand = String --- Shell command line to build propellor, used when bootstrapping on a new--- host. Should be run inside the propellor config dir, and will install--- all necessary build dependencies.+-- Shell command line to ensure propellor is bootstrapped and ready to run.+-- Should be run inside the propellor config dir, and will install+-- all necessary build dependencies and build propellor. bootstrapPropellorCommand :: ShellCommand-bootstrapPropellorCommand = "if ! test -x ./propellor; then " ++ go ++ "; fi"+bootstrapPropellorCommand = "if ! test -x ./propellor; then " ++ go ++ "; fi;" ++ checkBinaryCommand where- go = intercalate " && "+ go = intercalate " && " [ depsCommand+ , buildCommand+ ]++-- Use propellor --check to detect if the local propellor binary has+-- stopped working (eg due to library changes), and must be rebuilt.+checkBinaryCommand :: ShellCommand+checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check 2>/dev/null; then " ++ go ++ "; fi"+ where+ go = intercalate " && "+ [ "cabal clean" , buildCommand ]
src/Propellor/CmdLine.hs view
@@ -33,6 +33,7 @@ , " propellor --list-fields" , " propellor --merge" , " propellor --build"+ , " propellor --check" ] usageError :: [String] -> IO a@@ -43,6 +44,7 @@ processCmdLine :: IO CmdLine processCmdLine = go =<< getArgs where+ go ("--check":_) = return Check go ("--spin":ps) = case reverse ps of (r:"--via":hs) -> Spin <$> mapM hostname (reverse hs) @@ -91,6 +93,7 @@ where go _ (Serialized cmdline) = go True cmdline go _ (Continue cmdline) = go False cmdline+ go _ Check = return () go _ (Set field context) = setPrivData field context go _ (Dump field context) = dumpPrivData field context go _ (Edit field context) = editPrivData field context
src/Propellor/Property/Apt.hs view
@@ -61,7 +61,7 @@ return $ debLine bs url stdSections debCdn :: SourcesGenerator-debCdn = binandsrc "http://http.debian.net/debian"+debCdn = binandsrc "http://httpredir.debian.org/debian" kernelOrg :: SourcesGenerator kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
src/Propellor/Property/Cmd.hs view
@@ -39,7 +39,7 @@ -- | 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)
src/Propellor/Property/Cron.hs view
@@ -3,6 +3,7 @@ import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt+import Propellor.Bootstrap import Utility.SafeCommand import Utility.FileMode @@ -27,8 +28,8 @@ -- 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 _ -> ""@@ -39,10 +40,10 @@ , "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@@ -75,10 +76,11 @@ | 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 "./propellor"+runPropellor times = niceJob "propellor" times (User "root") localdir+ (bootstrapPropellorCommand ++ "; ./propellor")
src/Propellor/Property/File.hs view
@@ -91,8 +91,8 @@ 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
src/Propellor/Property/Git.hs view
@@ -62,7 +62,7 @@ -- 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 @@ 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' ->
src/Propellor/Property/Gpg.hs view
@@ -20,24 +20,24 @@ -- -- 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"
src/Propellor/Property/Group.hs view
@@ -4,8 +4,8 @@ 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"
src/Propellor/Property/HostingProvider/CloudAtCost.hs view
@@ -17,7 +17,7 @@ [ 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 ] ]
src/Propellor/Property/OS.hs view
@@ -222,7 +222,7 @@ 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
src/Propellor/Property/Obnam.hs view
@@ -49,7 +49,7 @@ 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' 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 $
src/Propellor/Property/OpenId.hs view
@@ -7,7 +7,7 @@ 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 @@ -- 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)
src/Propellor/Property/Postfix.hs view
@@ -153,6 +153,6 @@ 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"
src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs view
@@ -28,7 +28,7 @@ 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 @@ -- 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 @@ 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 @@ & 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 @@ & 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 @@ 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 @@ & 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 @@ -- 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 @@ & 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 @@ & 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
src/Propellor/Property/SiteSpecific/GitHome.hs view
@@ -6,9 +6,9 @@ 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 @@ 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")
src/Propellor/Property/SiteSpecific/JoeySites.hs view
@@ -24,14 +24,15 @@ 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-random-dev", "libghc-monad-loops-dev", "libghc-text-dev", "libghc-ifelse-dev", "libghc-case-insensitive-dev",- "libghc-data-default-dev"]- & userScriptProperty "scroll"+ "libghc-transformers-dev",+ "libghc-data-default-dev", "libghc-optparse-applicative-dev"]+ & userScriptProperty (User "scroll") [ "cd " ++ d </> "scroll" , "git pull" , "cabal configure"@@ -49,13 +50,16 @@ , "mkdir \"$t\"" , "cd \"$t\"" , "echo"+ , "echo Note that games on this server are time-limited to 2 hours"+ , "echo 'Need more time? Run scroll locally instead!'"+ , "echo" , "echo Press Enter to start the game." , "read me" , "SHELL=/bin/sh script --timing=timing -c " ++ g ] `onChange` (s `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes))) & g `File.hasContent` [ "#!/bin/sh"- , "if ! ../../scroll/scroll; then"+ , "if ! timeout --kill-after 1m --foreground 2h ../../scroll/scroll; then" , "echo Scroll seems to have ended unexpectedly. Possibly a bug.." , "else" , "echo Thanks for playing scroll! https://joeyh.name/code/scroll/"@@ -65,14 +69,14 @@ , "echo 'or, type comments below (finish with a dot on its own line)'" , "echo" , "echo Your comments:"- , "mail -s \"scroll test $t\" joey@kitenet.net"+ , "timeout --kill-after 1m --foreground 2h mail -E -s \"scroll test $t\" joey@kitenet.net" ] `onChange` (g `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes))) & Apt.installed ["bsd-mailx"] -- prevent port forwarding etc by not letting scroll log in via ssh & Ssh.sshdConfig `File.containsLine` ("DenyUsers scroll") `onChange` Ssh.restarted- & cmdProperty "chsh" ["scroll", "-s", s]- & User.hasPassword "scroll"+ & User.shellSetTo (User "scroll") s+ & User.hasPassword (User "scroll") & Apt.serviceInstalledRunning "telnetd" & Apt.installed ["shellinabox"] & File.hasContent "/etc/default/shellinabox"@@ -111,8 +115,8 @@ & 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"@@ -136,8 +140,8 @@ , "--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@@ -185,8 +189,8 @@ [ "--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"@@ -200,10 +204,10 @@ , "--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"]@@ -218,9 +222,9 @@ ] `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"@@ -248,7 +252,7 @@ -- | 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`@@ -260,7 +264,7 @@ 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@@ -340,11 +344,11 @@ & 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@@ -352,7 +356,7 @@ "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@@ -366,16 +370,16 @@ -- 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" ]@@ -387,26 +391,26 @@ -- 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" kiteShellBox :: Property NoInfo kiteShellBox = propertyList "kitenet.net shellinabox"- [ Apt.installed ["shellinabox"]+ [ Apt.installed ["openssl", "shellinabox"] , File.hasContent "/etc/default/shellinabox" [ "# Deployed by propellor" , "SHELLINABOX_DAEMON_START=1"@@ -421,9 +425,9 @@ 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 "&&" $@@ -442,7 +446,7 @@ 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@@ -456,17 +460,17 @@ , ("etckeeper", plzuseurl "http://etckeeper.branchable.com/todo/") ] where- plzuseurl u = "please submit changes to " ++ u ++ " instead of using github pull requests"+ plzuseurl u = "Please submit changes to " ++ u ++ " instead of using github pull requests, which are not part of my workflow. -- A robot acting on behalf of Joey Hess" 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@@ -479,11 +483,11 @@ `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"] @@ -641,7 +645,7 @@ & 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"] @@ -709,7 +713,7 @@ & 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`
src/Propellor/Property/Ssh.hs view
@@ -54,17 +54,17 @@ 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 @@ -- 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 @@ [ 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 @@ -- | 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 @@ -- | 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 line " ++ l+ 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.
src/Propellor/Property/Sudo.hs view
@@ -9,8 +9,8 @@ -- | 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 @@ 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
src/Propellor/Property/Tor.hs view
@@ -52,7 +52,7 @@ 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 @@ 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 @@ varRun :: FilePath varRun = "/var/run/tor" -user :: UserName-user = "debian-tor"+user :: User+user = User "debian-tor" type NickName = String
src/Propellor/Property/User.hs view
@@ -3,34 +3,35 @@ import System.Posix import Propellor+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 @@ -40,18 +41,18 @@ -- 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@@ -66,32 +67,32 @@ 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' ]@@ -110,3 +111,21 @@ shadowExists :: IO Bool shadowExists = doesFileExist "/etc/shadow"++-- | Ensures that a user has a specified login shell, and that the shell+-- is enabled in /etc/shells.+hasLoginShell :: User -> FilePath -> Property NoInfo+hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled 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 u+ return (currshell /= loginshell)++-- | Ensures that /etc/shells contains a shell.+shellEnabled :: FilePath -> Property NoInfo+shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell
src/Propellor/Types/CmdLine.hs view
@@ -23,5 +23,6 @@ | DockerChain HostName String | ChrootChain HostName FilePath Bool Bool | GitPush Fd Fd+ | Check deriving (Read, Show, Eq)
src/Propellor/Types/OS.hs view
@@ -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)@@ -25,7 +24,7 @@ deriving (Show, Eq) -- | Debian has several rolling suites, and a number of stable releases,--- such as Stable "wheezy".+-- such as Stable "jessie". data DebianSuite = Experimental | Unstable | Testing | Stable Release deriving (Show, Eq) @@ -35,3 +34,11 @@ 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
src/Propellor/Types/PrivData.hs view
@@ -2,8 +2,8 @@ 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
src/config.hs view
@@ -28,7 +28,7 @@ & Apt.unattendedUpgrades & Apt.installed ["etckeeper"] & Apt.installed ["ssh"]- & User.hasSomePassword "root"+ & User.hasSomePassword (User "root") & Network.ipv6to4 & File.dirExists "/var/www" & Docker.docked webserverContainer@@ -41,8 +41,8 @@ -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "joeyh/debian-stable"- & os (System (Debian (Stable "wheezy")) "amd64")+webserverContainer = Docker.container "webserver" "debian"+ & os (System (Debian (Stable "jessie")) "amd64") & Apt.stdSourcesList & Docker.publish "80:80" & Docker.volume "/var/www:/var/www"
src/wrapper.hs view
@@ -77,7 +77,7 @@ , void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir] ) - checkRepo = whenM (doesFileExist disthead) $ do+ checkRepo = whenM (doesFileExist disthead <&&> doesFileExist (propellordir </> "propellor.cabal")) $ do headrev <- takeWhile (/= '\n') <$> readFile disthead changeWorkingDirectory propellordir headknown <- catchMaybeIO $