{-# 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 = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
mainCfIsSet String
"relayhost") Property DebianLike
setup
	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 = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' String
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		String
hn <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> String
hostName
		let (String
_, String
domain) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
'.') String
hn
		forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> [(String, String, String)] -> Property DebianLike
Apt.reConfigure String
"postfix"
				[ (String
"postfix/main_mailer_type", String
"select", String
"Satellite system")
				, (String
"postfix/root_address", String
"string", String
"root")
				, (String
"postfix/destinations", String
"string", String
"localhost")
				, (String
"postfix/mailname", String
"string", String
hn)
				]
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& (String, String) -> Property UnixLike
mainCf (String
"relayhost", String
"smtp." forall a. [a] -> [a] -> [a]
++ String
domain)
				forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
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
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"postmap" [String
f] 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 = 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) = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
notset UncheckedProperty UnixLike
set
	forall p. IsProp p => p -> String -> p
`describe` (String
"postfix main.cf " forall a. [a] -> [a] -> [a]
++ String
setting)
  where
	setting :: String
setting = String
name forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
value
	notset :: IO Bool
notset = (forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just String
value) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines 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]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 
		case forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
'=') String
l of
			(String
_, (Char
' ':String
v)) -> String
v
			(String
_, String
v) -> String
v
	parse [] = 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
	Maybe String
v <- String -> IO (Maybe String)
getMainCf String
name
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe String
v forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Maybe String
v forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just String
""

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

	keycounts :: [(String, b)] -> Map String Integer
keycounts = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_ [] = 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
vforall 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 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 forall a. Ord a => a -> a -> Bool
> a
1 -> [String]
-> Map String a -> [Either String (String, String)] -> [String]
dedup [String]
c (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
k (a
n 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
vforall 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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Service] -> String -> String
$cshowList :: [Service] -> String -> String
show :: Service -> String
$cshow :: Service -> String
showsPrec :: Int -> Service -> String -> String
$cshowsPrec :: Int -> Service -> String -> String
Show, Service -> Service -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c== :: 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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ServiceType] -> String -> String
$cshowList :: [ServiceType] -> String -> String
show :: ServiceType -> String
$cshow :: ServiceType -> String
showsPrec :: Int -> ServiceType -> String -> String
$cshowsPrec :: Int -> ServiceType -> String -> String
Show, ServiceType -> ServiceType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceType -> ServiceType -> Bool
$c/= :: ServiceType -> ServiceType -> Bool
== :: ServiceType -> ServiceType -> Bool
$c== :: 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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ServiceOpts] -> String -> String
$cshowList :: [ServiceOpts] -> String -> String
show :: ServiceOpts -> String
$cshow :: ServiceOpts -> String
showsPrec :: Int -> ServiceOpts -> String -> String
$cshowsPrec :: Int -> ServiceOpts -> String -> String
Show, ServiceOpts -> ServiceOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceOpts -> ServiceOpts -> Bool
$c/= :: ServiceOpts -> ServiceOpts -> Bool
== :: ServiceOpts -> ServiceOpts -> Bool
$c== :: ServiceOpts -> ServiceOpts -> Bool
Eq)

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

formatServiceLine :: Service -> File.Line
formatServiceLine :: Service -> String
formatServiceLine Service
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ 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, forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
v Bool -> String
bool ServiceOpts -> Maybe Bool
serviceUnprivileged)
	, (Int
8, forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
v Bool -> String
bool ServiceOpts -> Maybe Bool
serviceChroot)
	, (Int
8, forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
v forall a. Show a => a -> String
show ServiceOpts -> Maybe Int
serviceWakeupTime)
	, (Int
8, forall {a}. (a -> String) -> (ServiceOpts -> Maybe a) -> String
v 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 = 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 forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- 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
_) = forall a. Maybe a
Nothing
parseServiceLine (Char
' ':String
_) = forall a. Maybe a
Nothing -- continuation of multiline entry
parseServiceLine String
l = ServiceType -> String -> ServiceOpts -> Service
Service
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServiceType
parsetype
	forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String
parsecommand
	forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ServiceOpts
parseopts
  where
	parsetype :: Maybe ServiceType
parsetype = do
		String
t <- Int -> Maybe String
getword Int
2
		case String
t of
			String
"inet" -> do
				String
v <- Int -> Maybe String
getword Int
1
				let (String
h,String
p) = forall a. (a -> Bool) -> [a] -> ([a], [a])
separate (forall a. Eq a => a -> a -> Bool
== Char
':') String
v
				if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p
					then forall a. Maybe a
Nothing
					else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> ServiceType
InetService
						(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
h then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just String
h) String
p
			String
"unix" -> String -> Bool -> ServiceType
UnixService forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe String
getword Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool
parseprivate
			String
"fifo" -> String -> Bool -> ServiceType
FifoService forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe String
getword Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool
parseprivate
			String
"pass" -> String -> Bool -> ServiceType
PassService forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe String
getword Int
1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool
parseprivate
			String
_ -> forall a. Maybe a
Nothing
	parseprivate :: Maybe Bool
parseprivate = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Maybe Bool)
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 (forall a. Int -> [a] -> [a]
drop Int
7 [String]
ws) of
		String
"" -> forall a. Maybe a
Nothing
		String
s -> forall a. a -> Maybe a
Just String
s

	parseopts :: Maybe ServiceOpts
parseopts = Maybe Bool -> Maybe Bool -> Maybe Int -> Maybe Int -> ServiceOpts
ServiceOpts
		forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe (Maybe Bool)
bool forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Maybe String
getword Int
4)
		forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Maybe (Maybe Bool)
bool forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Maybe String
getword Int
5)
		forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {a}. Read a => String -> Maybe (Maybe a)
int forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Maybe String
getword Int
6)
		forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {a}. Read a => String -> Maybe (Maybe a)
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
"-" = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
	bool String
"y" = forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just Bool
True)
	bool String
"n" = forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just Bool
False)
	bool String
_ = forall a. Maybe a
Nothing

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

	getword :: Int -> Maybe String
getword Int
n
		| Int
nws forall a. Ord a => a -> a -> Bool
>= Int
n = forall a. a -> Maybe a
Just ([String]
ws forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
-Int
1))
		| Bool
otherwise = forall a. Maybe a
Nothing
	ws :: [String]
ws = String -> [String]
words String
l
	nws :: Int
nws = 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 forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
disable)
	forall p. IsProp p => p -> String -> p
`describe` String
desc
  where
	desc :: String
desc = String
"enabled postfix service " forall a. [a] -> [a] -> [a]
++ 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)
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
reloaded
	disable :: CombinedType (Property UnixLike) (Property DebianLike)
disable = forall c.
(FileContent c, Eq c) =>
String -> (c -> c) -> String -> Property UnixLike
File.fileProperty String
desc (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
matches)) String
masterCfFile
		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' 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
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property DebianLike
Service.running String
"saslauthd"
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
postfixgroup
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
dirperm
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [String] -> Property DebianLike
Apt.installed [String
"sasl2-bin"]
	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 " forall a. [a] -> [a] -> [a]
++ String
dir forall a. [a] -> [a] -> [a]
++ String
"\""
		]
		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 = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesDirectoryExist String
dir) 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")
		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 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 = 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 forall a b. (a -> b) -> a -> b
$ \(PrivData -> Propellor Result) -> Propellor Result
getpw ->
		forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
desc forall a b. (a -> b) -> a -> b
$ (PrivData -> Propellor Result) -> Propellor Result
getpw forall a b. (a -> b) -> a -> b
$ \PrivData
pw -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
			forall a.
StdHandle
-> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a
withHandle StdHandle
StdinHandle CreateProcessRunner
createProcessSuccess CreateProcess
p 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
				forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
	desc :: String
desc = String
"sasl password for " forall a. [a] -> [a] -> [a]
++ String
uatd
	uatd :: String
uatd = String
user forall a. [a] -> [a] -> [a]
++ 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"