diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,24 @@ +propellor (2.16.0) unstable; urgency=medium + + * Obnam: Only let one backup job run at a time when a host has multiple + different backup properties, to avoid concurrent jobs fighting over + scarce resources (particularly memory). Other jobs block on a lock + file. + * Removed references to a Debian derivative from code and documentation + because of an unfortunate trademark use policy. + http://joeyh.name/blog/entry/trademark_nonsense/ + * That included changing a data constructor to "Buntish", an API change. + * Firewall.rule: Now takes a Table parameter. (API change) + * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules, + add CustomTarget, and more improvements. + Thanks, Félix Sipma. + * Ssh.authorizedKey: Fix bug preventing it from working when the + authorized_keys file does not yet exist. + * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable. + (API change) + + -- Joey Hess Sat, 27 Feb 2016 13:31:57 -0400 + propellor (2.15.4) unstable; urgency=medium * Build /usr/src/propellor/propellor.git reproducibly, diff --git a/config-joey.hs b/config-joey.hs --- a/config-joey.hs +++ b/config-joey.hs @@ -261,23 +261,32 @@ & Ssh.passwordAuthentication True -- Since ssh password authentication is allowed: & Fail2Ban.installed + & Apt.serviceInstalledRunning "ntp" + & "/etc/timezone" `File.hasContent` ["US/Eastern"] + & Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite.obnam" + [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam" , "--client-name=kitenet.net" + , "--exclude=/home" , "--exclude=/var/cache" , "--exclude=/var/tmp" - , "--exclude=/home/joey/lib" + , "--exclude=/srv/git" + , "--exclude=/var/spool/oldusenet" , "--exclude=.*/tmp/" , "--one-file-system" , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6] ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487") - `requires` Ssh.userKeys (User "root") - (Context "kite.kitenet.net") - [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite") - ] + `requires` rootsshkey `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") - & Apt.serviceInstalledRunning "ntp" - & "/etc/timezone" `File.hasContent` ["US/Eastern"] + & Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *") + [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam" + , "--client-name=kitenet.net" + , "--exclude=/home/joey/lib" + , "--one-file-system" + , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6] + ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487") + `requires` rootsshkey + `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") & alias "smtp.kitenet.net" & alias "imap.kitenet.net" @@ -337,6 +346,11 @@ & Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html" (LetsEncrypt.AgreeTOS (Just "id@joeyh.name")) & alias "letsencrypt.joeyh.name" + where + rootsshkey = Ssh.userKeys (User "root") + (Context "kite.kitenet.net") + [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite") + ] elephant :: Host elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" @@ -583,7 +597,7 @@ monsters :: [Host] -- Systems I don't manage with propellor, monsters = -- but do want to track their public keys etc. [ host "usw-s002.rsync.net" - & Ssh.hostPubKey SshEd25519 "ssh-ed25519 SHA256:DBW4gxagH9Q3Avnus+dxaoOS5L/Q/tZlT42bcoMp+4Y" + & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd" , host "github.com" & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" , host "gitlab.com" diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,24 @@ +propellor (2.16.0) unstable; urgency=medium + + * Obnam: Only let one backup job run at a time when a host has multiple + different backup properties, to avoid concurrent jobs fighting over + scarce resources (particularly memory). Other jobs block on a lock + file. + * Removed references to a Debian derivative from code and documentation + because of an unfortunate trademark use policy. + http://joeyh.name/blog/entry/trademark_nonsense/ + * That included changing a data constructor to "Buntish", an API change. + * Firewall.rule: Now takes a Table parameter. (API change) + * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules, + add CustomTarget, and more improvements. + Thanks, Félix Sipma. + * Ssh.authorizedKey: Fix bug preventing it from working when the + authorized_keys file does not yet exist. + * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable. + (API change) + + -- Joey Hess Sat, 27 Feb 2016 13:31:57 -0400 + propellor (2.15.4) unstable; urgency=medium * Build /usr/src/propellor/propellor.git reproducibly, diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.15.4 +Version: 2.16.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -255,7 +255,7 @@ -- -- > myproperty = withOS "foo installed" $ \o -> case o of -- > (Just (System (Debian suite) arch)) -> ... --- > (Just (System (Ubuntu release) arch)) -> ... +-- > (Just (System (Buntish release) arch)) -> ... -- > Nothing -> ... withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo withOS desc a = property desc $ a =<< getOS diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -90,7 +90,7 @@ instance ChrootBootstrapper Debootstrapped where buildchroot (Debootstrapped cf) system loc = case system of (Just s@(System (Debian _) _)) -> Right $ debootstrap s - (Just s@(System (Ubuntu _) _)) -> Right $ debootstrap s + (Just s@(System (Buntish _) _)) -> Right $ debootstrap s Nothing -> Left "Cannot debootstrap; `os` property not specified" where debootstrap s = Debootstrap.built loc s cf diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -91,7 +91,7 @@ extractSuite :: System -> Maybe String extractSuite (System (Debian s) _) = Just $ Apt.showSuite s -extractSuite (System (Ubuntu r) _) = Just r +extractSuite (System (Buntish r) _) = Just r -- | Ensures debootstrap is installed. -- @@ -108,12 +108,12 @@ ) installon (Just (System (Debian _) _)) = aptinstall - installon (Just (System (Ubuntu _) _)) = aptinstall + installon (Just (System (Buntish _) _)) = aptinstall installon _ = sourceInstall remove = withOS "debootstrap removed" $ ensureProperty . removefrom removefrom (Just (System (Debian _) _)) = aptremove - removefrom (Just (System (Ubuntu _) _)) = aptremove + removefrom (Just (System (Buntish _) _)) = aptremove removefrom _ = sourceRemove aptinstall = Apt.installed ["debootstrap"] diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -1,15 +1,22 @@ -- | Maintainer: Arnaud Bailly --- +-- -- Properties for configuring firewall (iptables) rules module Propellor.Property.Firewall ( rule, installed, Chain(..), - Target(..), + Table(..), + TargetFilter(..), + TargetNat(..), + TargetMangle(..), + TargetRaw(..), + TargetSecurity(..), Proto(..), Rules(..), - ConnectionState(..) + ConnectionState(..), + IPWithMask(..), + fromIPWithMask ) where import Data.Monoid @@ -23,7 +30,7 @@ installed :: Property NoInfo installed = Apt.installed ["iptables"] -rule :: Chain -> Target -> Rules -> Property NoInfo +rule :: Chain -> Table -> Rules -> Property NoInfo rule c t rs = property ("firewall rule: " <> show r) addIpTable where r = Rule c t rs @@ -33,13 +40,13 @@ if exist then return NoChange else toResult <$> boolSystem "iptables" (add args) - add params = (Param "-A") : params - chk params = (Param "-C") : params + add params = Param "-A" : params + chk params = Param "-C" : params toIpTable :: Rule -> [CommandParam] toIpTable r = map Param $ - (show $ ruleChain r) : - (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ] + show (ruleChain r) : + toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r) toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] @@ -47,26 +54,105 @@ toIpTableArg (DPort (Port port)) = ["--dport", show port] toIpTableArg (DPortRange (Port f, Port t)) = ["--dport", show f ++ ":" ++ show t] -toIpTableArg (IFace iface) = ["-i", iface] +toIpTableArg (InIFace iface) = ["-i", iface] +toIpTableArg (OutIFace iface) = ["-o", iface] toIpTableArg (Ctstate states) = [ "-m" , "conntrack" - , "--ctstate", concat $ intersperse "," (map show states) + , "--ctstate", intercalate "," (map show states) ] +toIpTableArg (Source ipwm) = + [ "-s" + , intercalate "," (map fromIPWithMask ipwm) + ] +toIpTableArg (Destination ipwm) = + [ "-d" + , intercalate "," (map fromIPWithMask ipwm) + ] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' +data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int + deriving (Eq, Show) + +fromIPWithMask :: IPWithMask -> String +fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip +fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm +fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m + data Rule = Rule { ruleChain :: Chain - , ruleTarget :: Target + , ruleTable :: Table , ruleRules :: Rules } deriving (Eq, Show) +data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity + deriving (Eq, Show) + +toIpTableTable :: Table -> [String] +toIpTableTable f = ["-t", table, "-j", target] + where + (table, target) = toIpTableTable' f + +toIpTableTable' :: Table -> (String, String) +toIpTableTable' (Filter target) = ("filter", fromTarget target) +toIpTableTable' (Nat target) = ("nat", fromTarget target) +toIpTableTable' (Mangle target) = ("mangle", fromTarget target) +toIpTableTable' (Raw target) = ("raw", fromTarget target) +toIpTableTable' (Security target) = ("security", fromTarget target) + data Chain = INPUT | OUTPUT | FORWARD deriving (Eq, Show) -data Target = ACCEPT | REJECT | DROP | LOG +data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String deriving (Eq, Show) +class FromTarget a where + fromTarget :: a -> String + +instance FromTarget TargetFilter where + fromTarget ACCEPT = "ACCEPT" + fromTarget REJECT = "REJECT" + fromTarget DROP = "DROP" + fromTarget LOG = "LOG" + fromTarget (FilterCustom f) = f + +data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String + deriving (Eq, Show) + +instance FromTarget TargetNat where + fromTarget NatPREROUTING = "PREROUTING" + fromTarget NatOUTPUT = "OUTPUT" + fromTarget NatPOSTROUTING = "POSTROUTING" + fromTarget (NatCustom f) = f + +data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String + deriving (Eq, Show) + +instance FromTarget TargetMangle where + fromTarget ManglePREROUTING = "PREROUTING" + fromTarget MangleOUTPUT = "OUTPUT" + fromTarget MangleINPUT = "INPUT" + fromTarget MangleFORWARD = "FORWARD" + fromTarget ManglePOSTROUTING = "POSTROUTING" + fromTarget (MangleCustom f) = f + +data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String + deriving (Eq, Show) + +instance FromTarget TargetRaw where + fromTarget RawPREROUTING = "PREROUTING" + fromTarget RawOUTPUT = "OUTPUT" + fromTarget (RawCustom f) = f + +data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String + deriving (Eq, Show) + +instance FromTarget TargetSecurity where + fromTarget SecurityINPUT = "INPUT" + fromTarget SecurityOUTPUT = "OUTPUT" + fromTarget SecurityFORWARD = "FORWARD" + fromTarget (SecurityCustom f) = f + data Proto = TCP | UDP | ICMP deriving (Eq, Show) @@ -80,8 +166,11 @@ -- data type with proto + ports | DPort Port | DPortRange (Port,Port) - | IFace Network.Interface + | InIFace Network.Interface + | OutIFace Network.Interface | Ctstate [ ConnectionState ] + | Source [ IPWithMask ] + | Destination [ IPWithMask ] | Rules :- Rules -- ^Combine two rules deriving (Eq, Show) diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -85,8 +85,8 @@ osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of (Just d@(System (Debian _) _)) -> debootstrap d - (Just u@(System (Ubuntu _) _)) -> debootstrap u - _ -> error "os is not declared to be Debian or Ubuntu" + (Just u@(System (Buntish _) _)) -> debootstrap u + _ -> error "os is not declared to be Debian or *buntu" debootstrap targetos = ensureProperty $ -- Ignore the os setting, and install debootstrap from @@ -221,7 +221,7 @@ preserveRootSshAuthorized = check (fileExist oldloc) $ property (newloc ++ " copied from old OS") $ do ks <- liftIO $ lines <$> readFile oldloc - ensureProperties (map (Ssh.authorizedKey (User "root")) ks) + ensureProperties (map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks) where newloc = "/root/.ssh/authorized_keys" oldloc = oldOSDir ++ newloc diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -36,6 +36,10 @@ -- -- Note that this property does not make obnam encrypt the backup -- repository. +-- +-- Since obnam uses a fair amount of system resources, only one obnam +-- backup job will be run at a time. Other jobs will wait their turns to +-- run. backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo backup dir crontimes params numclients = backup' dir crontimes params numclients @@ -59,16 +63,18 @@ where desc = dir ++ " backed up by obnam" cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes (User "root") "/" $ - unwords $ catMaybes - [ if numclients == OnlyClient - -- forcelock fails if repo does not exist yet - then Just $ forcelockcmd ++ " 2>/dev/null ;" - else Nothing - , Just backupcmd - , if any isKeepParam params - then Just $ "&& " ++ forgetcmd - else Nothing - ] + "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape cmdline + lockfile = "/var/lock/propellor-obnam.lock" + cmdline = unwords $ catMaybes + [ if numclients == OnlyClient + -- forcelock fails if repo does not exist yet + then Just $ forcelockcmd ++ " 2>/dev/null ;" + else Nothing + , Just backupcmd + , if any isKeepParam params + then Just $ "&& " ++ forgetcmd + else Nothing + ] forcelockcmd = unwords $ [ "obnam" , "force-lock" diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -30,7 +30,6 @@ unauthorizedKeysFrom, authorizedKeys, authorizedKey, - unauthorizedKey, hasAuthorizedKeys, getUserPubKeys, ) where @@ -372,7 +371,7 @@ go [] = return NoChange go ls = ensureProperty $ combineProperties desc $ - map (unauthorizedKey localuser) ls + map (revert . authorizedKey localuser) ls authorizedKeyLines :: User -> Host -> Propellor [File.Line] authorizedKeyLines remoteuser remotehost = @@ -395,28 +394,23 @@ -- | Ensures that a user's authorized_keys contains a line. -- Any other lines in the file are preserved as-is. -authorizedKey :: User -> String -> Property NoInfo -authorizedKey user@(User u) l = property desc $ do - f <- liftIO $ dotFile "authorized_keys" user - modAuthorizedKey f user $ - f `File.containsLine` l - `requires` File.dirExists (takeDirectory f) - where - desc = u ++ " has authorized_keys" - --- | Reverts `authorizedKey` -unauthorizedKey :: User -> String -> Property NoInfo -unauthorizedKey user@(User u) l = property desc $ do - f <- liftIO $ dotFile "authorized_keys" user - ifM (liftIO $ doesFileExist f) - ( modAuthorizedKey f user $ f `File.lacksLine` l - , return NoChange - ) +authorizedKey :: User -> String -> RevertableProperty NoInfo +authorizedKey user@(User u) l = add remove where - desc = u ++ " lacks authorized_keys" + add = property (u ++ " has authorized_keys") $ do + f <- liftIO $ dotFile "authorized_keys" user + modAuthorizedKey f user $ + f `File.containsLine` l + `requires` File.dirExists (takeDirectory f) + remove = property (u ++ " lacks authorized_keys") $ do + f <- liftIO $ dotFile "authorized_keys" user + ifM (liftIO $ doesFileExist f) + ( modAuthorizedKey f user $ f `File.lacksLine` l + , return NoChange + ) modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result modAuthorizedKey f user p = ensureProperty $ p - `requires` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) - `requires` File.ownerGroup f user (userGroup user) - `requires` File.ownerGroup (takeDirectory f) user (userGroup user) + `before` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) + `before` File.ownerGroup f user (userGroup user) + `before` File.ownerGroup (takeDirectory f) user (userGroup user) diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -24,7 +24,7 @@ data Distribution = Debian DebianSuite - | Ubuntu Release + | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per ) deriving (Show, Eq) -- | Debian has several rolling suites, and a number of stable releases,