diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,19 @@ +propellor (2.8.1) unstable; urgency=medium + + * Guard against power loss etc when building propellor, by updating + the executable atomically. + * Added Logcheck module, contributed by Jelmer Vernooij. + * Added Kerberos module, contributed by Jelmer Vernooij. + * Privdata that uses HostContext inside a container will now have the + name of the container as its context, rather than the name of + the host(s) where the container is used. This allows eg, having different + passwords for a user in different containers. Note that previously, + propellor would prompt using the container name as the context, but + not actually use privdata using that context; so this is a bug fix. + * Fix --add-key to not fail committing when no privdata file exists yet. + + -- Joey Hess Sun, 04 Oct 2015 13:54:59 -0400 + propellor (2.8.0) unstable; urgency=medium * Added Propellor.Property.Rsync. diff --git a/config-joey.hs b/config-joey.hs --- a/config-joey.hs +++ b/config-joey.hs @@ -455,7 +455,7 @@ & Docker.publish "2202:22" & Docker.publish "8001:80" & Apt.installed ["ssh"] - & User.hasSomePassword (User "root") + & User.hasPassword (User "root") & Ssh.permitRootLogin (Ssh.RootLogin True) kiteShellBox :: Systemd.Container diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,19 @@ +propellor (2.8.1) unstable; urgency=medium + + * Guard against power loss etc when building propellor, by updating + the executable atomically. + * Added Logcheck module, contributed by Jelmer Vernooij. + * Added Kerberos module, contributed by Jelmer Vernooij. + * Privdata that uses HostContext inside a container will now have the + name of the container as its context, rather than the name of + the host(s) where the container is used. This allows eg, having different + passwords for a user in different containers. Note that previously, + propellor would prompt using the container name as the context, but + not actually use privdata using that context; so this is a bug fix. + * Fix --add-key to not fail committing when no privdata file exists yet. + + -- Joey Hess Sun, 04 Oct 2015 13:54:59 -0400 + propellor (2.8.0) unstable; urgency=medium * Added Propellor.Property.Rsync. diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.8.0 +Version: 2.8.1 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess @@ -91,6 +91,7 @@ Propellor.Property.Group Propellor.Property.Grub Propellor.Property.Journald + Propellor.Property.Kerberos Propellor.Property.Mount Propellor.Property.Network Propellor.Property.Nginx @@ -105,6 +106,7 @@ Propellor.Property.Rsync Propellor.Property.List Propellor.Property.LightDM + Propellor.Property.Logcheck Propellor.Property.Scheduled Propellor.Property.Service Propellor.Property.Ssh diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -104,9 +104,24 @@ void $ cabal ["configure"] unlessM (cabal ["build"]) $ error "cabal build failed" - nukeFile "propellor" - createSymbolicLink "dist/build/propellor-config/propellor-config" "propellor" + -- For safety against eg power loss in the middle of the build, + -- make a copy of the binary, and move it into place atomically. + -- This ensures that the propellor symlink only ever points at + -- a binary that is fully built. Also, avoid ever removing + -- or breaking the symlink. + -- + -- Need cp -a to make build timestamp checking work. + unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $ + error "cp of binary failed" + rename (tmpfor safetycopy) safetycopy + createSymbolicLink safetycopy (tmpfor dest) + rename (tmpfor dest) dest return True + where + dest = "propellor" + cabalbuiltbin = "dist/build/propellor-config/propellor-config" + safetycopy = cabalbuiltbin ++ ".built" + tmpfor f = f ++ ".propellortmp" make :: FilePath -> [FilePath] -> IO Bool -> IO () make dest srcs builder = do diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs --- a/src/Propellor/Gpg.hs +++ b/src/Propellor/Gpg.hs @@ -6,6 +6,7 @@ import System.Directory import Data.Maybe import Data.List.Utils +import Control.Monad import Propellor.PrivData.Paths import Propellor.Message @@ -106,12 +107,14 @@ ] gitCommitKeyRing :: String -> IO Bool -gitCommitKeyRing action = gitCommit - [ File keyring - , File privDataFile - , Param "-m" - , Param ("propellor " ++ action) - ] +gitCommitKeyRing action = do + -- Commit explicitly the keyring and privdata files, as other + -- changes may be staged by the user and shouldn't be committed. + tocommit <- filterM doesFileExist [ privDataFile, keyring] + gitCommit $ (map File tocommit) ++ + [ Param "-m" + , Param ("propellor " ++ action) + ] -- Adds --gpg-sign if there's a keyring. gpgSignParams :: [CommandParam] -> IO [CommandParam] diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -17,6 +17,7 @@ decryptPrivData, PrivMap, PrivInfo, + forceHostContext, ) where import Control.Applicative @@ -236,3 +237,10 @@ -- hosts need it. instance IsInfo PrivInfo where propigateInfo _ = True + +-- | Sets the context of any privdata that uses HostContext to the +-- provided name. +forceHostContext :: String -> PrivInfo -> PrivInfo +forceHostContext name i = PrivInfo $ S.map go (fromPrivInfo i) + where + go (f, d, HostContext ctx) = (f, d, HostContext (const $ ctx name)) diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -14,6 +14,7 @@ import Propellor.Types import Propellor.Property import Propellor.Types.Info +import Propellor.PrivData -- | Starts accumulating the properties of a Host. -- @@ -72,12 +73,16 @@ -- -- The Info of the propertyChildren is adjusted to only include -- info that should be propigated out to the Property. +-- +-- Any PrivInfo that uses HostContext is adjusted to use the name +-- of the container as its context. propigateContainer :: (PropAccum container) - => container + => String + -> container -> Property HasInfo -> Property HasInfo -propigateContainer c prop = infoProperty +propigateContainer containername c prop = infoProperty (propertyDesc prop) (propertySatisfy prop) (propertyInfo prop) @@ -85,6 +90,7 @@ where hostprops = map go $ getProperties c go p = - let i = propigatableInfo (propertyInfo p) + let i = mapInfo (forceHostContext containername) + (propigatableInfo (propertyInfo p)) cs = map go (propertyChildren p) in infoProperty (propertyDesc p) (propertySatisfy p) i cs diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -1,3 +1,5 @@ +-- | Maintainer: Jelmer Vernooij + module Propellor.Property.Aiccu ( installed, restarted, @@ -46,5 +48,5 @@ property "aiccu configured" . writeConfig writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result writeConfig getpassword = getpassword $ ensureProperty . go - go (Password _, p) = confPath `File.hasContentProtected` config u t p + go (Password u', p) = confPath `File.hasContentProtected` config u' t p go (f, _) = error $ "Unexpected type of privdata: " ++ show f 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 @@ -83,7 +83,7 @@ teardown = toProp (revert built) propigateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo -propigateChrootInfo c p = propigateContainer c p' +propigateChrootInfo c@(Chroot location _ _ _) p = propigateContainer location c p' where p' = infoProperty (propertyDesc p) diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs --- a/src/Propellor/Property/DebianMirror.hs +++ b/src/Propellor/Property/DebianMirror.hs @@ -1,3 +1,5 @@ +-- | Maintainer: Félix Sipma + module Propellor.Property.DebianMirror ( DebianPriority(..) , showPriority diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -19,7 +19,7 @@ Image(..), latestImage, ContainerName, - Container, + Container(..), HasImage(..), -- * Container configuration dns, @@ -171,7 +171,7 @@ image = getImageName ctr propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo -propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p' +propigateContainerInfo ctr@(Container _ h) p = propigateContainer cn ctr p' where p' = infoProperty (propertyDesc p) @@ -179,7 +179,8 @@ (propertyInfo p <> dockerinfo) (propertyChildren p) dockerinfo = dockerInfo $ - mempty { _dockerContainers = M.singleton (hostName h) h } + mempty { _dockerContainers = M.singleton cn h } + cn = hostName h mkContainerInfo :: ContainerId -> Container -> ContainerInfo mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = 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,7 +1,7 @@ --- |Properties for configuring firewall (iptables) rules --- --- Copyright 2014 Arnaud Bailly --- License: BSD-2-Clause +-- | Maintainer: Arnaud Bailly +-- +-- Properties for configuring firewall (iptables) rules + module Propellor.Property.Firewall ( rule, installed, diff --git a/src/Propellor/Property/Kerberos.hs b/src/Propellor/Property/Kerberos.hs new file mode 100644 --- /dev/null +++ b/src/Propellor/Property/Kerberos.hs @@ -0,0 +1,94 @@ +-- | Maintainer: Jelmer Vernooij + +module Propellor.Property.Kerberos where + +import Utility.Process + +import Propellor +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.File as File +import Propellor.Property.User + +type Realm = String +type Principal = String +type Kvno = Integer + +-- Standard paths in MIT Kerberos + +defaultKeyTab :: FilePath +defaultKeyTab = "/etc/krb5.keytab" + +kadmAclPath :: FilePath +kadmAclPath = "/etc/krb5kdc/kadm5.acl" + +kpropdAclPath :: FilePath +kpropdAclPath = "/etc/krb5kdc/kpropd.acl" + +kdcConfPath :: FilePath +kdcConfPath = "/etc/krb5kdc/kdc.conf" + +keyTabPath :: Maybe FilePath -> FilePath +keyTabPath = maybe defaultKeyTab id + +-- | Create a principal from a primary, instance and realm +principal :: String -> Maybe String -> Maybe Realm -> Principal +principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r + +installed :: Property NoInfo +installed = Apt.installed ["krb5-user"] + +kdcInstalled :: Property NoInfo +kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc" + +adminServerInstalled :: Property NoInfo +adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server" + +kpropServerInstalled :: Property HasInfo +kpropServerInstalled = propertyList "kprop server installed" $ props + & kdcInstalled + & Apt.installed ["openbsd-inetd"] + & "/etc/inetd.conf" `File.containsLines` + [ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd" + , "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd" + ] + +kpropAcls :: [String] -> Property NoInfo +kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs" + +k5srvutil :: (Maybe FilePath) -> [String] -> IO String +k5srvutil kt cmd = readProcess "k5srvutil" (maybe [] (\x -> ["-f", x]) kt ++ cmd) + +-- Keytab management +keytabEntries :: Maybe FilePath -> IO [(Kvno, Principal)] +keytabEntries p = do + c <- k5srvutil p ["list"] + return $ map parseLine (drop 3 $ lines c) + where + parseLine l = (Prelude.read x, y) where (x, y) = splitAt 5 l + +checkKeyTabEntry' :: Maybe FilePath -> (Kvno, Principal) -> IO Bool +checkKeyTabEntry' path entry = do + entries <- keytabEntries path + return $ entry `elem` entries + +checkKeyTabEntry :: Maybe FilePath -> Principal -> IO Bool +checkKeyTabEntry path princ = do + entries <- keytabEntries path + return $ princ `elem` (map snd entries) + +-- k5login files +k5loginPath :: User -> IO FilePath +k5loginPath user = do + h <- homedir user + return $ h ".k5login" + +k5login :: User -> [Principal] -> Property NoInfo +k5login user@(User u) ps = property (u ++ " has k5login") $ do + f <- liftIO $ k5loginPath user + liftIO $ do + createDirectoryIfMissing True (takeDirectory f) + writeFile f (unlines ps) + ensureProperties + [ File.ownerGroup f user (userGroup user) + , File.ownerGroup (takeDirectory f) user (userGroup user) + ] diff --git a/src/Propellor/Property/LightDM.hs b/src/Propellor/Property/LightDM.hs --- a/src/Propellor/Property/LightDM.hs +++ b/src/Propellor/Property/LightDM.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Maintainer: Sean Whitton + module Propellor.Property.LightDM where import Propellor diff --git a/src/Propellor/Property/Logcheck.hs b/src/Propellor/Property/Logcheck.hs new file mode 100644 --- /dev/null +++ b/src/Propellor/Property/Logcheck.hs @@ -0,0 +1,36 @@ +-- | Maintainer: Jelmer Vernooij + +module Propellor.Property.Logcheck ( + ReportLevel (Workstation, Server, Paranoid), + Service, + defaultPrefix, + ignoreFilePath, + ignoreLines, + installed, +) where + +import Propellor +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.File as File + +data ReportLevel = Workstation | Server | Paranoid +type Service = String + +instance Show ReportLevel where + show Workstation = "workstation" + show Server = "server" + show Paranoid = "paranoid" + +-- The common prefix used by default in syslog lines. +defaultPrefix :: String +defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ " + +ignoreFilePath :: ReportLevel -> Service -> FilePath +ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) n + +ignoreLines :: ReportLevel -> Service -> [String] -> Property NoInfo +ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls + `describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")") + +installed :: Property NoInfo +installed = Apt.installed ["logcheck"] diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs --- a/src/Propellor/Property/Nginx.hs +++ b/src/Propellor/Property/Nginx.hs @@ -1,3 +1,5 @@ +-- | Maintainer: Félix Sipma + module Propellor.Property.Nginx where import Propellor diff --git a/src/Propellor/Property/Prosody.hs b/src/Propellor/Property/Prosody.hs --- a/src/Propellor/Property/Prosody.hs +++ b/src/Propellor/Property/Prosody.hs @@ -1,3 +1,5 @@ +-- | Maintainer: Félix Sipma + module Propellor.Property.Prosody where import Propellor diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -37,6 +37,10 @@ & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/" "/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardmaint" & Apt.installed ["git-annex"] + & Apt.installed ["libmail-sendmail-perl"] + & Cron.niceJob "expireemailer" Cron.Daily (User "root") + "/usr/local/IA.BAK" + "./expireemailer" registrationServer :: [Host] -> Property HasInfo registrationServer knownhosts = propertyList "iabak registration server" $ props diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -1,9 +1,19 @@ --- | Properties for the Unbound caching DNS server +-- | Maintainer: Félix Sipma +-- +-- Properties for the Unbound caching DNS server module Propellor.Property.Unbound ( installed , restarted , reloaded + , UnboundSection + , UnboundZone + , UnboundHost + , UnboundSetting + , UnboundValue + , UnboundKey + , ConfSection + , ZoneType , cachingDnsServer ) where diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs --- a/src/Propellor/Types/Info.hs +++ b/src/Propellor/Types/Info.hs @@ -5,6 +5,7 @@ IsInfo(..), addInfo, getInfo, + mapInfo, propigatableInfo, InfoVal(..), fromInfoVal, @@ -16,8 +17,6 @@ import Data.Maybe -- | Information about a Host, which can be provided by its properties. --- --- Any value in the `IsInfo` type class can be added to an Info. data Info = Info [(Dynamic, Bool)] instance Show Info where @@ -37,11 +36,21 @@ -- container to its Host? propigateInfo :: v -> Bool +-- | Any value in the `IsInfo` type class can be added to an Info. addInfo :: IsInfo v => Info -> v -> Info addInfo (Info l) v = Info ((toDyn v, propigateInfo v):l) getInfo :: IsInfo v => Info -> v getInfo (Info l) = mconcat (mapMaybe (fromDynamic . fst) (reverse l)) + +-- | Maps a function over all values stored in the Info that are of the +-- appropriate type. +mapInfo :: IsInfo v => (v -> v) -> Info -> Info +mapInfo f (Info l) = Info (map go l) + where + go (i, p) = case fromDynamic i of + Nothing -> (i, p) + Just v -> (toDyn (f v), p) -- | Filters out parts of the Info that should not propigate out of a -- container. diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -61,7 +61,7 @@ newtype Context = Context String deriving (Read, Show, Ord, Eq) --- | A context that varies depending on the HostName where it's used. +-- | A context that may vary depending on the HostName where it's used. newtype HostContext = HostContext { mkHostContext :: HostName -> Context } instance Show HostContext where