{-# 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"
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
String
hn <- (Host -> String) -> Propellor String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> String
hostName
let (String
_, String
domain) = (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
hn
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Propellor Result)
-> Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Propellor Result
forall a b. (a -> b) -> a -> b
$ String
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc (Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])))
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
-> Property
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property DebianLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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)
]
Props DebianLike
-> Property DebianLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
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." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
domain)
Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
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)
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" [])
mainCfFile :: FilePath
mainCfFile :: String
mainCfFile = String
"/etc/postfix/main.cf"
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]
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
mainCfIsSet :: String -> IO Bool
mainCfIsSet :: String -> IO Bool
mainCfIsSet String
name = do
Maybe String
v <- String -> IO (Maybe String)
getMainCf String
name
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe String
v Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Maybe String
v Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
""
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
masterCfFile :: FilePath
masterCfFile :: String
masterCfFile = String
"/etc/postfix/master.cf"
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)
type ServicePort = String
type PrivateService = Bool
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
' '
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
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
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) = (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
v
if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p
then Maybe ServiceType
forall a. Maybe a
Nothing
else ServiceType -> Maybe ServiceType
forall a. a -> Maybe a
Just (ServiceType -> Maybe ServiceType)
-> ServiceType -> Maybe ServiceType
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> ServiceType
InetService
(if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
h then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
h) String
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
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
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"
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"