X-Git-Url: http://gitweb.michael.orlitzky.com/?p=list-remote-forwards.git;a=blobdiff_plain;f=src%2FReport.hs;h=a189664e1ff8d199b3cd87bca91a46b97a3e0832;hp=82409c42ef95a71b7fd346520cc3c85e40805d2b;hb=48e2203550c93bd05ef34df7b17d8447f4fac93c;hpb=fed9e141735b74540fd380b051671ac1c451a178 diff --git a/src/Report.hs b/src/Report.hs index 82409c4..a189664 100644 --- a/src/Report.hs +++ b/src/Report.hs @@ -30,11 +30,25 @@ type Domain = String 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 @@ -55,7 +69,60 @@ get_domain_list conn query = do 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 @@ -71,14 +138,22 @@ get_forward_list conn query = do 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 @@ -92,20 +167,37 @@ find_remote_forwards domains 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 @@ -132,7 +224,7 @@ report cfg conn = do 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) @@ -155,4 +247,5 @@ test_example1 = 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"