{-# LANGUAGE FlexibleContexts #-} module Propellor.Property.Postfix where import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service import qualified Propellor.Property.User as User import qualified Data.Map as M import Data.List import Data.Char installed :: Property NoInfo installed = Apt.serviceInstalledRunning "postfix" restarted :: Property NoInfo restarted = Service.restarted "postfix" reloaded :: Property NoInfo reloaded = Service.reloaded "postfix" -- | Configures postfix as a satellite system, which -- relays all mail through a relay host, which defaults to smtp.domain, -- but can be changed by @mainCf "relayhost"@. -- -- The smarthost may refuse to relay mail on to other domains, without -- further configuration/keys. But this should be enough to get cron job -- mail flowing to a place where it will be seen. satellite :: Property NoInfo satellite = check (not <$> mainCfIsSet "relayhost") setup `requires` installed where setup = property "postfix satellite system" $ do hn <- asks hostName let (_, domain) = separate (== '.') hn ensureProperties [ Apt.reConfigure "postfix" [ ("postfix/main_mailer_type", "select", "Satellite system") , ("postfix/root_address", "string", "root") , ("postfix/destinations", "string", "localhost") , ("postfix/mailname", "string", hn) ] , mainCf ("relayhost", "smtp." ++ domain) `onChange` reloaded ] -- | Sets up a file by running a property (which the filename is passed -- to). If the setup property makes a change, postmap will be run on the -- file, and postfix will be reloaded. mappedFile :: Combines (Property x) (Property NoInfo) => FilePath -> (FilePath -> Property x) -> Property (CInfo x NoInfo) mappedFile f setup = setup f `onChange` (cmdProperty "postmap" [f] `assume` MadeChange) -- | Run newaliases command, which should be done after changing -- @/etc/aliases@. newaliases :: Property NoInfo newaliases = check ("/etc/aliases" `isNewerThan` "/etc/aliases.db") (cmdProperty "newaliases" []) -- | The main config file for postfix. mainCfFile :: FilePath mainCfFile = "/etc/postfix/main.cf" -- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately. mainCf :: (String, String) -> Property NoInfo mainCf (name, value) = check notset set `describe` ("postfix main.cf " ++ setting) where setting = name ++ "=" ++ value notset = (/= Just value) <$> getMainCf name set = cmdProperty "postconf" ["-e", setting] -- | Gets a main.cf setting. getMainCf :: String -> IO (Maybe String) getMainCf name = parse . lines <$> readProcess "postconf" [name] where parse (l:_) = Just $ case separate (== '=') l of (_, (' ':v)) -> v (_, v) -> v parse [] = Nothing -- | Checks if a main.cf field is set. A field that is set to -- the empty string is considered not set. mainCfIsSet :: String -> IO Bool mainCfIsSet name = do v <- getMainCf name return $ v /= Nothing && v /= Just "" -- | Parses main.cf, and removes any initial configuration lines that are -- overridden to other values later in the file. -- -- For example, to add some settings, removing any old settings: -- -- > mainCf `File.containsLines` -- > [ "# I like bars." -- > , "foo = bar" -- > ] `onChange` dedupMainCf -- -- Note that multiline configurations that continue onto the next line -- are not currently supported. dedupMainCf :: Property NoInfo dedupMainCf = File.fileProperty "postfix main.cf dedupped" dedupCf mainCfFile dedupCf :: [String] -> [String] dedupCf ls = let parsed = map parse ls in dedup [] (keycounts $ rights parsed) parsed where parse l | "#" `isPrefixOf` l = Left l | "=" `isInfixOf` l = let (k, v) = separate (== '=') l in Right ((filter (not . isSpace) k), v) | otherwise = Left l fmt k v = k ++ " =" ++ v keycounts = M.fromListWith (+) . map (\(k, _v) -> (k, (1 :: Integer))) dedup c _ [] = reverse c dedup c kc ((Left v):rest) = dedup (v:c) kc rest dedup c kc ((Right (k, v)):rest) = case M.lookup k kc of Just n | n > 1 -> dedup c (M.insert k (n - 1) kc) rest _ -> dedup (fmt k v:c) kc rest -- | The master config file for postfix. masterCfFile :: FilePath masterCfFile = "/etc/postfix/master.cf" -- | A service that can be present in the master config file. data Service = Service { serviceType :: ServiceType , serviceCommand :: String , serviceOpts :: ServiceOpts } deriving (Show, Eq) data ServiceType = InetService (Maybe HostName) ServicePort | UnixService FilePath PrivateService | FifoService FilePath PrivateService | PassService FilePath PrivateService deriving (Show, Eq) -- Can be a port number or service name such as "smtp". type ServicePort = String type PrivateService = Bool -- | Options for a service. data ServiceOpts = ServiceOpts { serviceUnprivileged :: Maybe Bool , serviceChroot :: Maybe Bool , serviceWakeupTime :: Maybe Int , serviceProcessLimit :: Maybe Int } deriving (Show, Eq) defServiceOpts :: ServiceOpts defServiceOpts = ServiceOpts { serviceUnprivileged = Nothing , serviceChroot = Nothing , serviceWakeupTime = Nothing , serviceProcessLimit = Nothing } formatServiceLine :: Service -> File.Line formatServiceLine s = unwords $ map pad [ (10, case serviceType s of InetService (Just h) p -> h ++ ":" ++ p InetService Nothing p -> p UnixService f _ -> f FifoService f _ -> f PassService f _ -> f) , (6, case serviceType s of InetService _ _ -> "inet" UnixService _ _ -> "unix" FifoService _ _ -> "fifo" PassService _ _ -> "pass") , (8, case serviceType s of InetService _ _ -> bool False UnixService _ b -> bool b FifoService _ b -> bool b PassService _ b -> bool b) , (8, v bool serviceUnprivileged) , (8, v bool serviceChroot) , (8, v show serviceWakeupTime) , (8, v show serviceProcessLimit) , (0, serviceCommand s) ] where v f sel = maybe "-" f (sel (serviceOpts s)) bool True = "y" bool False = "n" pad (n, t) = t ++ replicate (n - 1 - length t) ' ' -- | Note that this does not handle multi-line service entries, -- in which subsequent lines are indented. `serviceLine` does not generate -- such entries. parseServiceLine :: File.Line -> Maybe Service parseServiceLine ('#':_) = Nothing parseServiceLine (' ':_) = Nothing -- continuation of multiline entry parseServiceLine l = Service <$> parsetype <*> parsecommand <*> parseopts where parsetype = do t <- getword 2 case t of "inet" -> do v <- getword 1 let (h,p) = separate (== ':') v if null p then Nothing else Just $ InetService (if null h then Nothing else Just h) p "unix" -> UnixService <$> getword 1 <*> parseprivate "fifo" -> FifoService <$> getword 1 <*> parseprivate "pass" -> PassService <$> getword 1 <*> parseprivate _ -> Nothing parseprivate = join . bool =<< getword 3 parsecommand = case unwords (drop 7 ws) of "" -> Nothing s -> Just s parseopts = ServiceOpts <$> (bool =<< getword 4) <*> (bool =<< getword 5) <*> (int =<< getword 6) <*> (int =<< getword 7) bool "-" = Just Nothing bool "y" = Just (Just True) bool "n" = Just (Just False) bool _ = Nothing int "-" = Just Nothing int n = maybe Nothing (Just . Just) (readish n) getword n | nws >= n = Just (ws !! (n -1)) | otherwise = Nothing ws = words l nws = length ws -- | Enables a `Service` in postfix's `masterCfFile`. service :: Service -> RevertableProperty NoInfo service s = (enable disable) `describe` desc where desc = "enabled postfix service " ++ show (serviceType s) enable = masterCfFile `File.containsLine` (formatServiceLine s) `onChange` reloaded disable = File.fileProperty desc (filter (not . matches)) masterCfFile `onChange` reloaded matches l = case parseServiceLine l of Just s' | s' == s -> True _ -> False -- | Installs saslauthd and configures it for postfix, authenticating -- against PAM. -- -- Does not configure postfix to use it; eg @smtpd_sasl_auth_enable = yes@ -- needs to be set to enable use. See -- . -- -- Password brute force attacks are possible when SASL auth is enabled. -- It would be wise to enable fail2ban, for example: -- -- > Fail2Ban.jailEnabled "postfix-sasl" saslAuthdInstalled :: Property NoInfo saslAuthdInstalled = setupdaemon `requires` Service.running "saslauthd" `requires` postfixgroup `requires` dirperm `requires` Apt.installed ["sasl2-bin"] `requires` smtpdconf where setupdaemon = "/etc/default/saslauthd" `File.containsLines` [ "START=yes" , "OPTIONS=\"-c -m " ++ dir ++ "\"" ] `onChange` Service.restarted "saslauthd" smtpdconf = "/etc/postfix/sasl/smtpd.conf" `File.containsLines` [ "pwcheck_method: saslauthd" , "mech_list: PLAIN LOGIN" ] dirperm = check (not <$> doesDirectoryExist dir) $ cmdProperty "dpkg-statoverride" [ "--add", "root", "sasl", "710", dir ] postfixgroup = (User "postfix") `User.hasGroup` (Group "sasl") `onChange` restarted dir = "/var/spool/postfix/var/run/saslauthd" -- | Uses `saslpasswd2` to set the password for a user in the sasldb2 file. -- -- The password is taken from the privdata. saslPasswdSet :: Domain -> User -> Property HasInfo saslPasswdSet domain (User user) = go `changesFileContent` "/etc/sasldb2" where go = withPrivData src ctx $ \getpw -> property desc $ getpw $ \pw -> liftIO $ withHandle StdinHandle createProcessSuccess p $ \h -> do hPutStrLn h (privDataVal pw) hClose h return NoChange desc = "sasl password for " ++ uatd uatd = user ++ "@" ++ domain ps = ["-p", "-c", "-u", domain, user] p = proc "saslpasswd2" ps ctx = Context "sasl" src = PrivDataSource (Password uatd) "enter password"