Default: \(dqSELECT domain FROM domain WHERE domain <> 'ALL' ORDER BY domain;\(dq
-.IP \fB\-\-forward-query\fR
+.IP \fB\-\-exclude-mx\fR,\ \fB-e\fR
+The name of a mail exchanger, the forwards of whose domains we should
+ignore. For example, if one mail exchanger, mx1.example.com, has
+strict spam filtering, it may be acceptable to have remote forwarding
+for domains that have mx1.example.com as their mail exchanger (MX
+record). In that case, you might want to exclude those domains from
+the report by naming mx1.example.com here.
+
+Default: [] (empty)
+
+.IP \fB\-\-forward-query\fR,\ \fB-f\fR
SQL query used to produce a list of all forwards on the mail
system. This query should return the set of all (address, goto)
triples, where \(dqgoto\(dq is the destination address; i.e. to where
Default: \(dqSELECT address,goto FROM alias ORDER BY address;\(dq
-.IP \fB\-\-host\fR
+.IP \fB\-\-host\fR,\ \fB-h\fR
Hostname where the database is located (Postgres-only).
Default: None, a UNIX domain socket connection is attempted (Postgres only)
Default: None, a UNIX domain socket connection is attempted (Postgres only)
-.IP \fB\-\-username\fR
+.IP \fB\-\-username\fR,\ \fB-u\fR
Username used to connect to the database (Postgres-only).
Default: The current user
import System.Console.CmdArgs ( def )
import System.Directory ( doesFileExist )
import System.IO ( hPutStrLn, stderr )
+
import CommandLine ( get_args )
import Configuration ( Configuration(..), merge_optional )
import qualified OptionalConfiguration as OC ( from_rc )
import Report ( report )
+import String ( trim )
-- | Construct a connection string (postgres-only, for now) from a
-- Postgres, and so we want to avoid appending e.g. \"host=\" to the
-- connection string if @(host cfg)@ is 'Nothing'.
--
--- Examples:
+-- ==== __Examples__
--
-- >>> let default_cfg = def :: Configuration
-- >>> let cfg = default_cfg { host = Just "localhost" }
connection_string cfg =
trim $ join " " [host_part, port_part, user_part, pw_part, db_part]
where
- -- | Strip leading/trailing whitespace, and collapse multiple
- -- consecutive spaces into one.
- trim :: String -> String
- trim = unwords . words
-
host_part = let h = fmap ("host=" ++) (host cfg) in fromMaybe "" h
port_part = let p = fmap (("port=" ++) . show) (port cfg) in fromMaybe "" p
user_part = let u = fmap ("user=" ++) (username cfg) in fromMaybe "" u
rc_cfg <- OC.from_rc
cmd_cfg <- get_args
- -- Merge the config file options with the command-line ones,
+ -- Merge the config file options with the command-line ones,
-- prefering the command-line ones.
let opt_config = rc_cfg <> cmd_cfg
type Address = String
type Goto = String
+-- | A data type representing a "forward." That is, an email address
+-- whose mail is sent to some other address.
+--
+-- The 'Address' field represents the alias address, the address to
+-- which mail is sent. The 'Goto' field is the address to which the
+-- mail is forwarded.
+--
data Forward =
Forward Address Goto
deriving (Show)
-get_domain_list :: IConnection a => a -> String -> IO [Domain]
+-- | Given a connection @conn@ and a @query@, return a list of domains
+-- found by executing @query@ on @conn. The @query@ is assumed to
+-- return only one column, containing domains.
+--
+get_domain_list :: IConnection a
+ => a -- ^ A database connection
+ -> String -- ^ The @query@ to execute
+ -> IO [Domain] -- ^ The list of domains returned from @query@
get_domain_list conn query = do
stmt <- prepare conn query
return domains
-get_forward_list :: IConnection a => a -> String -> IO [Forward]
+-- | Convert a row obtained in 'get_forward_list' into a list of
+-- 'Forward's. The row is assumed to have two columns, the first
+-- with an address, and the second with a comma-separated list of
+-- gotos.
+--
+-- We return a list containing one entry for each address, goto pair.
+--
+-- ==== __Examples__
+--
+-- A single address, pointed to itself (common with PostfixAdmin):
+--
+-- >>> let addr = "a@b.test"
+-- >>> let gotos = "a@b.test"
+-- >>> row_to_forwards [addr, gotos]
+-- [Forward "a@b.test" "a@b.test"]
+--
+-- One address forwarded to two other addresses:
+--
+-- >>> let addr = "a@b.test"
+-- >>> let gotos = "a1@b.test,a2@b.test"
+-- >>> row_to_forwards [addr, gotos]
+-- [Forward "a@b.test" "a1@b.test",Forward "a@b.test" "a2@b.test"]
+--
+-- An address that receives mail itself, but also forwards a copy to
+-- another address (also common in PostfixAdmin). We've also mangled
+-- the whitespace a little bit here:
+--
+-- >>> let addr = "a@b.test"
+-- >>> let gotos = "a@b.test ,a2@b.test "
+-- >>> row_to_forwards [addr, gotos]
+-- [Forward "a@b.test" "a@b.test",Forward "a@b.test" "a2@b.test"]
+--
+-- And finally, a one-element list, which should return no forwards:
+--
+-- >>> let addr = "a@b.test"
+-- >>> row_to_forwards [addr]
+-- []
+--
+row_to_forwards :: [String] -> [Forward]
+row_to_forwards (addr:gotos:_) =
+ [Forward addr (strip g) | g <- split "," gotos]
+row_to_forwards _ = []
+
+
+-- | Given a connection @conn@ and a @query@, return a list of
+-- forwards found by executing @query@ on @conn. The @query@ is
+-- assumed to return two columns, the first containing addresses and
+-- the second containing a comma-separated list of gotos (as a
+-- string).
+--
+get_forward_list :: IConnection a
+ => a -- ^ A database connection
+ -> String -- ^ The @query@ to execute
+ -> IO [Forward] -- ^ A list of forwards returned from @query@
get_forward_list conn query = do
stmt <- prepare conn query
let forwards = concatMap (row_to_forwards . catMaybes) rows
return forwards
- where
- row_to_forwards :: [String] -> [Forward]
- row_to_forwards (addr:gotos:_) =
- [Forward addr (strip g) | g <- split "," gotos]
- row_to_forwards _ = []
+-- | Given a list of local 'Domain's and a list of 'Forward's, filter
+-- out all of the local forwards and return only the remaining
+-- (remote) forwards.
+--
+-- ==== __Examples__
+--
+-- >>> let ds = ["example.com", "example.net"]
+-- >>> let f1 = Forward "a@example.com" "a@example.com"
+-- >>> let f2 = Forward "a@example.com" "a1@example.net"
+-- >>> let f3 = Forward "a@example.com" "a2@example.org"
+-- >>> find_remote_forwards ds [f1,f2,f3]
+-- [Forward "a@example.com" "a2@example.org"]
+--
find_remote_forwards :: [Domain] -> [Forward] -> [Forward]
find_remote_forwards domains forwards =
filter is_remote forwards
_ -> True -- Assume it's remote if something is wrong
+-- | Format a 'Forward' for pretty printing.
+--
+-- ==== __Examples__
+--
+-- >>> let fwd = Forward "a@example.com" "b@example.net"
+-- >>> format_forward fwd
+-- "a@example.com -> b@example.net"
+--
format_forward :: Forward -> String
format_forward (Forward addr goto) =
addr ++ " -> " ++ goto
--- If the MX records for a domain are exactly those contained in the
--- MxList, then we exclude that domain from the report. Splitting on
--- the '@' is a lazy way of obtaining the domain, but if it's good
--- enough for determining that a forward is remote, then it's good
--- enough for this.
+
+-- | A filter function to remove specific 'Forward's from a list (of
+-- fowards). Its intended usage is to ignore a 'Forward' if its
+-- 'Address' has an MX record contained in the given list. This
+-- could be useful if, for example, one MX has strict spam filtering
+-- and remote forwards are not a problem for domains with that MX.
+--
+-- If the MX records for a domain are exactly those contained in the
+-- 'MxList', then we exclude that domain from the report. Splitting on
+-- the '@' is a lazy way of obtaining the domain, but if it's good
+-- enough for determining that a forward is remote, then it's good
+-- enough for this.
+--
+-- The empty @MxList []@ special case is necessary! Otherwise if we
+-- have an empty exclude list and a domain that has no MX record, it
+-- will be excluded.
+--
filter_by_mx :: MxList -> [Forward] -> IO [Forward]
--- This special case is necessary! Otherwise if we have an empty
--- exclude list and a domain that has no MX record, it will be
--- excluded.
filter_by_mx (MxList []) = return
filter_by_mx (MxList mxs) =
filterM all_mxs_excluded