sFetchAllRows')
import Database.HDBC.Sqlite3 ( connectSqlite3 )
import Data.List ( (\\) )
+import Network.DNS.Utils ( normalize )
import System.Console.CmdArgs.Default ( Default(..) )
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
import Configuration ( Configuration(..) )
-import DNS ( lookup_mxs, normalize )
+import DNS ( lookup_mxs )
import MxList ( MxList(..) )
-- Type synonyms to make the signatures below a little more clear.
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
let remote_forwards = find_remote_forwards domains valid_forwards
let forward_strings = map format_forward remote_forwards
- return $ (join "\n" forward_strings) ++ "\n"
+ return $ (join "\n" forward_strings)
expected = "user1@example.com -> user1@example.net\n" ++
"user2@example.com -> user1@example.org\n" ++
"user2@example.com -> user2@example.org\n" ++
- "user2@example.com -> user3@example.org\n"
+ "user2@example.com -> user3@example.org\n" ++
+ "user7@example.com -> user8@example.net"
projects / list-remote-forwards.git / blobdiff