    {-# 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 DebianLike
    installed :: Property DebianLike
    installed = String -> Property DebianLike
    Apt.serviceInstalledRunning String
    "postfix"

    restarted :: Property DebianLike
    restarted :: Property DebianLike
    restarted = String -> Property DebianLike
    Service.restarted String
    "postfix"

    reloaded :: Property DebianLike
    reloaded :: Property DebianLike
    reloaded = String -> Property DebianLike
    Service.reloaded String
    "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 DebianLike
    satellite :: Property DebianLike
    satellite = IO Bool -> Property DebianLike -> Property DebianLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    mainCfIsSet String
    "relayhost") Property DebianLike
    setup
    	Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    installed
      where
    	desc :: String
    desc = String
    "postfix satellite system"
    	setup :: Property DebianLike
    	setup :: Property DebianLike
    setup = String
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' String
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property DebianLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    		hn <- (Host -> String) -> Propellor String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Host -> String
    hostName
    		let (_, domain) = separate (== '.') hn
    		ensureProperty w $ combineProperties desc $ props
    			& 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 UnixLike)
    	=> FilePath
    	-> (FilePath -> Property x)
    	-> CombinedType (Property x) (Property UnixLike)
    mappedFile :: forall x.
    Combines (Property x) (Property UnixLike) =>
    String
    -> (String -> Property x)
    -> CombinedType (Property x) (Property UnixLike)
    mappedFile String
    f String -> Property x
    setup = String -> Property x
    setup String
    f
    	Property x
    -> Property UnixLike
    -> CombinedType (Property x) (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` (String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "postmap" [String
    f] UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange)

    -- | Run newaliases command, which should be done after changing
    -- @/etc/aliases@.
    newaliases :: Property UnixLike
    newaliases :: Property UnixLike
    newaliases = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (String
    "/etc/aliases" String -> String -> IO Bool
    `isNewerThan` String
    "/etc/aliases.db")
    	(String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "newaliases" [])

    -- | The main config file for postfix.
    mainCfFile :: FilePath
    mainCfFile :: String
    mainCfFile = String
    "/etc/postfix/main.cf"

    -- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately.
    mainCf :: (String, String) -> Property UnixLike
    mainCf :: (String, String) -> Property UnixLike
    mainCf (String
    name, String
    value) = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check IO Bool
    notset UncheckedProperty UnixLike
    set
    	Property UnixLike -> String -> Property UnixLike
    forall p. IsProp p => p -> String -> p
    `describe` (String
    "postfix main.cf " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    setting)
      where
    	setting :: String
    setting = String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    value
    	notset :: IO Bool
    notset = (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String -> Maybe String
    forall a. a -> Maybe a
    Just String
    value) (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe String)
    getMainCf String
    name
    	set :: UncheckedProperty UnixLike
    set = String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "postconf" [String
    "-e", String
    setting]

    -- | Gets a main.cf setting.
    getMainCf :: String -> IO (Maybe String)
    getMainCf :: String -> IO (Maybe String)
    getMainCf String
    name = [String] -> Maybe String
    parse ([String] -> Maybe String)
    -> (String -> [String]) -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> Maybe String) -> IO String -> IO (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> IO String
    readProcess String
    "postconf" [String
    name]
      where
    	parse :: [String] -> Maybe String
    parse (String
    l:[String]
    _) = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $
    		case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    separate (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') String
    l of
    			(String
    _, (Char
    ' ':String
    v)) -> String
    v
    			(String
    _, String
    v) -> String
    v
    	parse [] = Maybe String
    forall a. Maybe a
    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 :: String -> IO Bool
    mainCfIsSet String
    name = do
    	v <- String -> IO (Maybe String)
    getMainCf String
    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 UnixLike
    dedupMainCf :: Property UnixLike
    dedupMainCf = String -> ([String] -> [String]) -> String -> Property UnixLike
    forall c.
    (FileContent c, Eq c) =>
    String -> (c -> c) -> String -> Property UnixLike
    File.fileProperty String
    "postfix main.cf dedupped" [String] -> [String]
    dedupCf String
    mainCfFile

    dedupCf :: [String] -> [String]
    dedupCf :: [String] -> [String]
    dedupCf [String]
    ls =
    	let parsed :: [Either String (String, String)]
    parsed = (String -> Either String (String, String))
    -> [String] -> [Either String (String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Either String (String, String)
    parse [String]
    ls
    	in [String]
    -> Map String Integer
    -> [Either String (String, String)]
    -> [String]
    forall {a}.
    (Ord a, Num a) =>
    [String]
    -> Map String a -> [Either String (String, String)] -> [String]
    dedup [] ([(String, String)] -> Map String Integer
    forall {b}. [(String, b)] -> Map String Integer
    keycounts ([(String, String)] -> Map String Integer)
    -> [(String, String)] -> Map String Integer
    forall a b. (a -> b) -> a -> b
    $ [Either String (String, String)] -> [(String, String)]
    forall a b. [Either a b] -> [b]
    rights [Either String (String, String)]
    parsed) [Either String (String, String)]
    parsed
      where
    	parse :: String -> Either String (String, String)
    parse String
    l
    		| String
    "#" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    l = String -> Either String (String, String)
    forall a b. a -> Either a b
    Left String
    l
    		| String
    "=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    l =
    			let (String
    k, String
    v) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    separate (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=') String
    l
    			in (String, String) -> Either String (String, String)
    forall a b. b -> Either a b
    Right (((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) String
    k), String
    v)
    		| Bool
    otherwise = String -> Either String (String, String)
    forall a b. a -> Either a b
    Left String
    l
    	fmt :: String -> String -> String
    fmt String
    k String
    v = String
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    v

    	keycounts :: [(String, b)] -> Map String Integer
    keycounts = (Integer -> Integer -> Integer)
    -> [(String, Integer)] -> Map String Integer
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (+) ([(String, Integer)] -> Map String Integer)
    -> ([(String, b)] -> [(String, Integer)])
    -> [(String, b)]
    -> Map String Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, b) -> (String, Integer))
    -> [(String, b)] -> [(String, Integer)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    k, b
    _v) -> (String
    k, (Integer
    1 :: Integer)))

    	dedup :: [String]
    -> Map String a -> [Either String (String, String)] -> [String]
    dedup [String]
    c Map String a
    _ [] = [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    c
    	dedup [String]
    c Map String a
    kc ((Left String
    v):[Either String (String, String)]
    rest) = [String]
    -> Map String a -> [Either String (String, String)] -> [String]
    dedup (String
    vString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    c) Map String a
    kc [Either String (String, String)]
    rest
    	dedup [String]
    c Map String a
    kc ((Right (String
    k, String
    v)):[Either String (String, String)]
    rest) = case String -> Map String a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    k Map String a
    kc of
    		Just a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    1 -> [String]
    -> Map String a -> [Either String (String, String)] -> [String]
    dedup [String]
    c (String -> a -> Map String a -> Map String a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    k (a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1) Map String a
    kc) [Either String (String, String)]
    rest
    		Maybe a
    _ -> [String]
    -> Map String a -> [Either String (String, String)] -> [String]
    dedup (String -> String -> String
    fmt String
    k String
    vString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    c) Map String a
    kc [Either String (String, String)]
    rest

    -- | The master config file for postfix.
    masterCfFile :: FilePath
    masterCfFile :: String
    masterCfFile = String
    "/etc/postfix/master.cf"

    -- | A service that can be present in the master config file.
    data Service = Service
    	{ Service -> ServiceType
    serviceType :: ServiceType
    	, Service -> String
    serviceCommand :: String
    	, Service -> ServiceOpts
    serviceOpts :: ServiceOpts
    	}
    	deriving (Int -> Service -> String -> String
    [Service] -> String -> String
    Service -> String
    (Int -> Service -> String -> String)
    -> (Service -> String)
    -> ([Service] -> String -> String)
    -> Show Service
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Service -> String -> String
    showsPrec :: Int -> Service -> String -> String
    $cshow :: Service -> String
    show :: Service -> String
    $cshowList :: [Service] -> String -> String
    showList :: [Service] -> String -> String
    Show, Service -> Service -> Bool
    (Service -> Service -> Bool)
    -> (Service -> Service -> Bool) -> Eq Service
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Service -> Service -> Bool
    == :: Service -> Service -> Bool
    $c/= :: Service -> Service -> Bool
    /= :: Service -> Service -> Bool
    Eq)

    data ServiceType
    	= InetService (Maybe HostName) ServicePort
    	| UnixService FilePath PrivateService
    	| FifoService FilePath PrivateService
    	| PassService FilePath PrivateService
    	deriving (Int -> ServiceType -> String -> String
    [ServiceType] -> String -> String
    ServiceType -> String
    (Int -> ServiceType -> String -> String)
    -> (ServiceType -> String)
    -> ([ServiceType] -> String -> String)
    -> Show ServiceType
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ServiceType -> String -> String
    showsPrec :: Int -> ServiceType -> String -> String
    $cshow :: ServiceType -> String
    show :: ServiceType -> String
    $cshowList :: [ServiceType] -> String -> String
    showList :: [ServiceType] -> String -> String
    Show, ServiceType -> ServiceType -> Bool
    (ServiceType -> ServiceType -> Bool)
    -> (ServiceType -> ServiceType -> Bool) -> Eq ServiceType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ServiceType -> ServiceType -> Bool
    == :: ServiceType -> ServiceType -> Bool
    $c/= :: ServiceType -> ServiceType -> Bool
    /= :: ServiceType -> ServiceType -> Bool
    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
    	{ ServiceOpts -> Maybe Bool
    serviceUnprivileged :: Maybe Bool
    	, ServiceOpts -> Maybe Bool
    serviceChroot :: Maybe Bool
    	, ServiceOpts -> Maybe Int
    serviceWakeupTime :: Maybe Int
    	, ServiceOpts -> Maybe Int
    serviceProcessLimit :: Maybe Int
    	}
    	deriving (Int -> ServiceOpts -> String -> String
    [ServiceOpts] -> String -> String
    ServiceOpts -> String
    (Int -> ServiceOpts -> String -> String)
    -> (ServiceOpts -> String)
    -> ([ServiceOpts] -> String -> String)
    -> Show ServiceOpts
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ServiceOpts -> String -> String
    showsPrec :: Int -> ServiceOpts -> String -> String
    $cshow :: ServiceOpts -> String
    show :: ServiceOpts -> String
    $cshowList :: [ServiceOpts] -> String -> String
    showList :: [ServiceOpts] -> String -> String
    Show, ServiceOpts -> ServiceOpts -> Bool
    (ServiceOpts -> ServiceOpts -> Bool)
    -> (ServiceOpts -> ServiceOpts -> Bool) -> Eq ServiceOpts
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ServiceOpts -> ServiceOpts -> Bool
    == :: ServiceOpts -> ServiceOpts -> Bool
    $c/= :: ServiceOpts -> ServiceOpts -> Bool
    /= :: ServiceOpts -> ServiceOpts -> Bool
    Eq)

    defServiceOpts :: ServiceOpts
    defServiceOpts :: ServiceOpts
    defServiceOpts = ServiceOpts
    	{ serviceUnprivileged :: Maybe Bool
    serviceUnprivileged = Maybe Bool
    forall a. Maybe a
    Nothing
    	, serviceChroot :: Maybe Bool
    serviceChroot = Maybe Bool
    forall a. Maybe a
    Nothing
    	, serviceWakeupTime :: Maybe Int
    serviceWakeupTime = Maybe Int
    forall a. Maybe a
    Nothing
    	, serviceProcessLimit :: Maybe Int
    serviceProcessLimit = Maybe Int
    forall a. Maybe a
    Nothing
    	}

    formatServiceLine :: Service -> File.Line
    formatServiceLine :: Service -> String
    formatServiceLine Service
    s = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ((Int, String) -> String) -> [(Int, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, String) -> String
    pad
    	[ (Int
    10, case Service -> ServiceType
    serviceType Service
    s of
    		InetService (Just String
    h) String
    p -> String
    h String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    p
    		InetService Maybe String
    Nothing String
    p -> String
    p
    		UnixService String
    f Bool
    _ -> String
    f
    		FifoService String
    f Bool
    _ -> String
    f
    		PassService String
    f Bool
    _ -> String
    f)
    	, (Int
    6, case Service -> ServiceType
    serviceType Service
    s of
    		InetService Maybe String
    _ String
    _ -> String
    "inet"
    		UnixService String
    _ Bool
    _ -> String
    "unix"
    		FifoService String
    _ Bool
    _ -> String
    "fifo"
    		PassService String
    _ Bool
    _ -> String
    "pass")
    	, (Int
    8, case Service -> ServiceType
    serviceType Service
    s of
    		InetService Maybe String
    _ String
    _ -> Bool -> String
    bool Bool
    False
    		UnixService String
    _ Bool
    b -> Bool -> String
    bool Bool
    b
    		FifoService String
    _ Bool
    b -> Bool -> String
    bool Bool
    b
    		PassService String
    _ Bool
    b -> Bool -> String
    bool Bool
    b)
    	, (Int
    8, (Bool -> String) -> (ServiceOpts -> Maybe Bool) -> String
    forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
    v Bool -> String
    bool ServiceOpts -> Maybe Bool
    serviceUnprivileged)
    	, (Int
    8, (Bool -> String) -> (ServiceOpts -> Maybe Bool) -> String
    forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
    v Bool -> String
    bool ServiceOpts -> Maybe Bool
    serviceChroot)
    	, (Int
    8, (Int -> String) -> (ServiceOpts -> Maybe Int) -> String
    forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
    v Int -> String
    forall a. Show a => a -> String
    show ServiceOpts -> Maybe Int
    serviceWakeupTime)
    	, (Int
    8, (Int -> String) -> (ServiceOpts -> Maybe Int) -> String
    forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
    v Int -> String
    forall a. Show a => a -> String
    show ServiceOpts -> Maybe Int
    serviceProcessLimit)
    	, (Int
    0, Service -> String
    serviceCommand Service
    s)
    	]
      where
    	v :: (a -> String) -> (ServiceOpts -> Maybe a) -> String
    v a -> String
    f ServiceOpts -> Maybe a
    sel = String -> (a -> String) -> Maybe a -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "-" a -> String
    f (ServiceOpts -> Maybe a
    sel (Service -> ServiceOpts
    serviceOpts Service
    s))
    	bool :: Bool -> String
    bool Bool
    True = String
    "y"
    	bool Bool
    False = String
    "n"
    	pad :: (Int, String) -> String
    pad (Int
    n, String
    t) = String
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    t) Char
    ' '

    -- | 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 :: String -> Maybe Service
    parseServiceLine (Char
    '#':String
    _) = Maybe Service
    forall a. Maybe a
    Nothing
    parseServiceLine (Char
    ' ':String
    _) = Maybe Service
    forall a. Maybe a
    Nothing -- continuation of multiline entry
    parseServiceLine String
    l = ServiceType -> String -> ServiceOpts -> Service
    Service
    	(ServiceType -> String -> ServiceOpts -> Service)
    -> Maybe ServiceType -> Maybe (String -> ServiceOpts -> Service)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ServiceType
    parsetype
    	Maybe (String -> ServiceOpts -> Service)
    -> Maybe String -> Maybe (ServiceOpts -> Service)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe String
    parsecommand
    	Maybe (ServiceOpts -> Service)
    -> Maybe ServiceOpts -> Maybe Service
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe ServiceOpts
    parseopts
      where
    	parsetype :: Maybe ServiceType
    parsetype = do
    		t <- Int -> Maybe String
    getword Int
    2
    		case t of
    			String
    "inet" -> do
    				v <- Int -> Maybe String
    getword Int
    1
    				let (h,p) = separate (== ':') v
    				if null p
    					then Nothing
    					else Just $ InetService
    						(if null h then Nothing else Just h) p
    			String
    "unix" -> String -> Bool -> ServiceType
    UnixService (String -> Bool -> ServiceType)
    -> Maybe String -> Maybe (Bool -> ServiceType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Maybe String
    getword Int
    1 Maybe (Bool -> ServiceType) -> Maybe Bool -> Maybe ServiceType
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Bool
    parseprivate
    			String
    "fifo" -> String -> Bool -> ServiceType
    FifoService (String -> Bool -> ServiceType)
    -> Maybe String -> Maybe (Bool -> ServiceType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Maybe String
    getword Int
    1 Maybe (Bool -> ServiceType) -> Maybe Bool -> Maybe ServiceType
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Bool
    parseprivate
    			String
    "pass" -> String -> Bool -> ServiceType
    PassService (String -> Bool -> ServiceType)
    -> Maybe String -> Maybe (Bool -> ServiceType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Maybe String
    getword Int
    1 Maybe (Bool -> ServiceType) -> Maybe Bool -> Maybe ServiceType
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe Bool
    parseprivate
    			String
    _ -> Maybe ServiceType
    forall a. Maybe a
    Nothing
    	parseprivate :: Maybe Bool
    parseprivate = Maybe (Maybe Bool) -> Maybe Bool
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe Bool) -> Maybe Bool)
    -> (String -> Maybe (Maybe Bool)) -> String -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe (Maybe Bool)
    bool (String -> Maybe Bool) -> Maybe String -> Maybe Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Maybe String
    getword Int
    3

    	parsecommand :: Maybe String
    parsecommand = case [String] -> String
    unwords (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    7 [String]
    ws) of
    		String
    "" -> Maybe String
    forall a. Maybe a
    Nothing
    		String
    s -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s

    	parseopts :: Maybe ServiceOpts
    parseopts = Maybe Bool -> Maybe Bool -> Maybe Int -> Maybe Int -> ServiceOpts
    ServiceOpts
    		(Maybe Bool -> Maybe Bool -> Maybe Int -> Maybe Int -> ServiceOpts)
    -> Maybe (Maybe Bool)
    -> Maybe (Maybe Bool -> Maybe Int -> Maybe Int -> ServiceOpts)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> Maybe (Maybe Bool)
    bool (String -> Maybe (Maybe Bool))
    -> Maybe String -> Maybe (Maybe Bool)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Maybe String
    getword Int
    4)
    		Maybe (Maybe Bool -> Maybe Int -> Maybe Int -> ServiceOpts)
    -> Maybe (Maybe Bool)
    -> Maybe (Maybe Int -> Maybe Int -> ServiceOpts)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (String -> Maybe (Maybe Bool)
    bool (String -> Maybe (Maybe Bool))
    -> Maybe String -> Maybe (Maybe Bool)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Maybe String
    getword Int
    5)
    		Maybe (Maybe Int -> Maybe Int -> ServiceOpts)
    -> Maybe (Maybe Int) -> Maybe (Maybe Int -> ServiceOpts)
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (String -> Maybe (Maybe Int)
    forall {a}. Read a => String -> Maybe (Maybe a)
    int (String -> Maybe (Maybe Int)) -> Maybe String -> Maybe (Maybe Int)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Maybe String
    getword Int
    6)
    		Maybe (Maybe Int -> ServiceOpts)
    -> Maybe (Maybe Int) -> Maybe ServiceOpts
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (String -> Maybe (Maybe Int)
    forall {a}. Read a => String -> Maybe (Maybe a)
    int (String -> Maybe (Maybe Int)) -> Maybe String -> Maybe (Maybe Int)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Maybe String
    getword Int
    7)

    	bool :: String -> Maybe (Maybe Bool)
    bool String
    "-" = Maybe Bool -> Maybe (Maybe Bool)
    forall a. a -> Maybe a
    Just Maybe Bool
    forall a. Maybe a
    Nothing
    	bool String
    "y" = Maybe Bool -> Maybe (Maybe Bool)
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True)
    	bool String
    "n" = Maybe Bool -> Maybe (Maybe Bool)
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
    	bool String
    _ = Maybe (Maybe Bool)
    forall a. Maybe a
    Nothing

    	int :: String -> Maybe (Maybe a)
    int String
    "-" = Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just Maybe a
    forall a. Maybe a
    Nothing
    	int String
    n = Maybe (Maybe a)
    -> (a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe (Maybe a)
    forall a. Maybe a
    Nothing (Maybe a -> Maybe (Maybe a)
    forall a. a -> Maybe a
    Just (Maybe a -> Maybe (Maybe a))
    -> (a -> Maybe a) -> a -> Maybe (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    forall a. a -> Maybe a
    Just) (String -> Maybe a
    forall a. Read a => String -> Maybe a
    readish String
    n)

    	getword :: Int -> Maybe String
    getword Int
    n
    		| Int
    nws Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n = String -> Maybe String
    forall a. a -> Maybe a
    Just ([String]
    ws [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1))
    		| Bool
    otherwise = Maybe String
    forall a. Maybe a
    Nothing
    	ws :: [String]
    ws = String -> [String]
    words String
    l
    	nws :: Int
    nws = [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    ws

    -- | Enables a `Service` in postfix's `masterCfFile`.
    service :: Service -> RevertableProperty DebianLike DebianLike
    service :: Service -> RevertableProperty DebianLike DebianLike
    service Service
    s = (Property DebianLike
    enable Property DebianLike
    -> Property DebianLike -> RevertableProperty DebianLike DebianLike
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property DebianLike
    disable)
    	RevertableProperty DebianLike DebianLike
    -> String -> RevertableProperty DebianLike DebianLike
    forall p. IsProp p => p -> String -> p
    `describe` String
    desc
      where
    	desc :: String
    desc = String
    "enabled postfix service " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ServiceType -> String
    forall a. Show a => a -> String
    show (Service -> ServiceType
    serviceType Service
    s)
    	enable :: CombinedType (Property UnixLike) (Property DebianLike)
    enable = String
    masterCfFile String -> String -> Property UnixLike
    `File.containsLine` (Service -> String
    formatServiceLine Service
    s)
    		Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` Property DebianLike
    reloaded
    	disable :: CombinedType (Property UnixLike) (Property DebianLike)
    disable = String -> ([String] -> [String]) -> String -> Property UnixLike
    forall c.
    (FileContent c, Eq c) =>
    String -> (c -> c) -> String -> Property UnixLike
    File.fileProperty String
    desc ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    matches)) String
    masterCfFile
    		Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` Property DebianLike
    reloaded
    	matches :: String -> Bool
    matches String
    l = case String -> Maybe Service
    parseServiceLine String
    l of
    		Just Service
    s' | Service
    s' Service -> Service -> Bool
    forall a. Eq a => a -> a -> Bool
    == Service
    s -> Bool
    True
    		Maybe Service
    _ -> Bool
    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
    -- <https://wiki.debian.org/PostfixAndSASL>.
    --
    -- 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 DebianLike
    saslAuthdInstalled :: Property DebianLike
    saslAuthdInstalled = Property DebianLike
    setupdaemon
    	Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` String -> Property DebianLike
    Service.running String
    "saslauthd"
    	Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    postfixgroup
    	CombinedType (Property DebianLike) (Property DebianLike)
    -> Property UnixLike
    -> CombinedType
         (CombinedType (Property DebianLike) (Property DebianLike))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property UnixLike
    dirperm
    	CombinedType
      (CombinedType (Property DebianLike) (Property DebianLike))
      (Property UnixLike)
    -> Property DebianLike
    -> CombinedType
         (CombinedType
            (CombinedType (Property DebianLike) (Property DebianLike))
            (Property UnixLike))
         (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` [String] -> Property DebianLike
    Apt.installed [String
    "sasl2-bin"]
    	CombinedType
      (CombinedType
         (CombinedType (Property DebianLike) (Property DebianLike))
         (Property UnixLike))
      (Property DebianLike)
    -> Property UnixLike
    -> CombinedType
         (CombinedType
            (CombinedType
               (CombinedType (Property DebianLike) (Property DebianLike))
               (Property UnixLike))
            (Property DebianLike))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property UnixLike
    smtpdconf
      where
    	setupdaemon :: CombinedType (Property UnixLike) (Property DebianLike)
    setupdaemon = String
    "/etc/default/saslauthd" String -> [String] -> Property UnixLike
    `File.containsLines`
    		[ String
    "START=yes"
    		, String
    "OPTIONS=\"-c -m " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
    		]
    		Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` String -> Property DebianLike
    Service.restarted String
    "saslauthd"
    	smtpdconf :: Property UnixLike
    smtpdconf = String
    "/etc/postfix/sasl/smtpd.conf" String -> [String] -> Property UnixLike
    `File.containsLines`
    		[ String
    "pwcheck_method: saslauthd"
    		, String
    "mech_list: PLAIN LOGIN"
    		]
    	dirperm :: Property UnixLike
    dirperm = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    doesDirectoryExist String
    dir) (UncheckedProperty UnixLike -> Property UnixLike)
    -> UncheckedProperty UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    		String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "dpkg-statoverride"
    			[ String
    "--add", String
    "root", String
    "sasl", String
    "710", String
    dir ]
    	postfixgroup :: CombinedType (Property DebianLike) (Property DebianLike)
    postfixgroup = (String -> User
    User String
    "postfix") User -> Group -> Property DebianLike
    `User.hasGroup` (String -> Group
    Group String
    "sasl")
    		Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` Property DebianLike
    restarted
    	dir :: String
    dir = String
    "/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 + UnixLike)
    saslPasswdSet :: String -> User -> Property (HasInfo + UnixLike)
    saslPasswdSet String
    domain (User String
    user) = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    go Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> String
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> String -> Property i
    `changesFileContent` String
    "/etc/sasldb2"
      where
    	go :: Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    go = PrivDataSource
    -> Context
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property
             (MetaTypes
                '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall c s metatypes.
    (IsContext c, IsPrivDataSource s,
     IncludesInfo metatypes ~ 'True) =>
    s
    -> c
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property metatypes)
    -> Property metatypes
    withPrivData PrivDataSource
    src Context
    ctx ((((PrivData -> Propellor Result) -> Propellor Result)
      -> Property
           (MetaTypes
              '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                 'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> (((PrivData -> Propellor Result) -> Propellor Result)
        -> Property
             (MetaTypes
                '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall a b. (a -> b) -> a -> b
    $ \(PrivData -> Propellor Result) -> Propellor Result
    getpw ->
    		String
    -> Propellor Result
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    desc (Propellor Result
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Propellor Result
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall a b. (a -> b) -> a -> b
    $ (PrivData -> Propellor Result) -> Propellor Result
    getpw ((PrivData -> Propellor Result) -> Propellor Result)
    -> (PrivData -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \PrivData
    pw -> IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    			StdHandle
    -> CreateProcessRunner
    -> CreateProcess
    -> (Handle -> IO Result)
    -> IO Result
    forall a.
    StdHandle
    -> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
    withHandle StdHandle
    StdinHandle CreateProcess
    -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
        -> IO a)
    -> IO a
    CreateProcessRunner
    createProcessSuccess CreateProcess
    p ((Handle -> IO Result) -> IO Result)
    -> (Handle -> IO Result) -> IO Result
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
    				Handle -> String -> IO ()
    hPutStrLn Handle
    h (PrivData -> String
    privDataVal PrivData
    pw)
    				Handle -> IO ()
    hClose Handle
    h
    				Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    	desc :: String
    desc = String
    "sasl password for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    uatd
    	uatd :: String
    uatd = String
    user String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "@" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    domain
    	ps :: [String]
    ps = [String
    "-p", String
    "-c", String
    "-u", String
    domain, String
    user]
    	p :: CreateProcess
    p = String -> [String] -> CreateProcess
    proc String
    "saslpasswd2" [String]
    ps
    	ctx :: Context
    ctx = String -> Context
    Context String
    "sasl"
    	src :: PrivDataSource
    src = PrivDataField -> String -> PrivDataSource
    PrivDataSource (String -> PrivDataField
    Password String
    uatd) String
    "enter password"