Get things in shape finally:
authorMichael Orlitzky <michael@orlitzky.com>
Fri, 28 Nov 2014 05:00:25 +0000 (00:00 -0500)
committerMichael Orlitzky <michael@orlitzky.com>
Fri, 28 Nov 2014 05:00:25 +0000 (00:00 -0500)
  * Move the Forward code into its own module.

  * Separate out the excluded MX filtering magic.

  * Write tons of tests for the MX filtering.

  * Normalize every name used in a comparison.

  * Use Data.Map and Data.Set for MX filtering.

  * Update some documentation.

  * Update the ghci file with new modules.

  * Add the Forward module to the cabal file.

  * Make sure no spurious newlines are output.

  * Update the TODO.

.ghci
doc/TODO
doc/list-remote-forwardsrc.example
doc/man1/list-remote-forwards.1
list-remote-forwards.cabal
src/DNS.hs
src/Forward.hs [new file with mode: 0644]
src/Main.hs
src/Report.hs

diff --git a/.ghci b/.ghci
index 9c70fd21cb24de6c21bcdf545ce7d2d199126d83..23b15949d091d5919152ee11cbee8d4da824e703 100644 (file)
--- a/.ghci
+++ b/.ghci
@@ -1,8 +1,28 @@
 :set -isrc -idist/build/autogen
-:load src/Main.hs
-:load src/Report.hs
+
+:{
+:load src/CommandLine.hs
+  src/Configuration.hs
+  src/DNS.hs
+  src/Forward.hs
+  src/Main.hs
+  src/MxList.hs
+  src/OptionalConfiguration.hs
+  src/Report.hs
+  src/String.hs
+:}
 
 import Database.HDBC
 import Database.HDBC.Sqlite3
 
+import CommandLine
+import Configuration
+import DNS
+import Forward
+import Main
+import MxList
+import OptionalConfiguration
+import Report
+import String
+
 :set prompt "list-remote-forwards> "
index 663f403ea32464aab7fc17bba39799132e523a04..0e57166232841ba452664fb9fba26b3ad63f0144 100644 (file)
--- a/doc/TODO
+++ b/doc/TODO
@@ -1,2 +1,5 @@
-1. The --exclude-mx option doesn't work!
-
+1. Use the type system to prevent all the bugs that arise from
+  (de)normalization of domain names. We should use newtype wrappers
+  around string domain names that we can only create by using a
+  normalize_foo constructor. That way we can make sure that we never
+  do a comparison on a denormalized name.
index 3e435603ba0d4cb9d1a07a5a5d1ec3fc22b6de96..86b52cec45d38e167d582f1d3bee11cfff6b002b 100644 (file)
 # 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
+# for domains that have mx1.example.com as their sole mail exchanger (MX
 # record). In that case, you might want to exclude those domains from
 # the report, by naming mx1.example.com here.
 #
-# Given as a list, it can be used to exclude more than one mail
-# exchanger.
+# A forward will be excluded from the report only if *all* of its MX
+# records are contained in the given exclude list.
 #
 # Default: [] (empty)
 #
index 13ebb4a1028f5471cff70719f06a0115beeb429b..77eec6e43bbd469b7536fc908ad2153094e69590 100644 (file)
@@ -53,11 +53,14 @@ Default: \(dqSELECT domain FROM domain WHERE domain <> 'ALL' ORDER BY domain;\(d
 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
+for domains that have mx1.example.com as their sole mail exchanger (MX
 record). In that case, you might want to exclude those domains from
 the report by naming mx1.example.com here.
 
-Can be repeated to exclude more than one mail exchanger.
+A forward will be excluded from the report only if \fIall\fR of its MX
+records are contained in the given exclude list.
+
+This option can be repeated to add mail exchangers to the exclude list.
 
 Default: [] (empty)
 
@@ -93,11 +96,12 @@ Default: The current user
 .SH EXAMPLES
 
 .nf
-.I $ list-remote-forwards --database=postfixadmin.sqlite3
+.I $ list-remote-forwards --database=test/fixtures/postfixadmin.sqlite3
 user1@example.com -> user1@example.net
 user2@example.com -> user1@example.org
 user2@example.com -> user2@example.org
 user2@example.com -> user3@example.org
+user7@example.com -> user8@example.net
 .fi
 .SH BUGS
 .P
index 4718b35534331b0a5bd58ca1f9d54a44a1126cc7..ba8ffa4ebba7f250517448acf281725e45299eab 100644 (file)
@@ -79,11 +79,14 @@ description:
   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
+  for domains that have mx1.example.com as their sole mail exchanger (MX
   record). In that case, you might want to exclude those domains from
   the report by naming mx1.example.com here.
   .
-  Can be repeated to exclude more than one mail exchanger.
+  A forward will be excluded from the report only if /all/ of its MX
+  records are contained in the given exclude list.
+  .
+  This option can be repeated to add mail exchangers to the exclude list.
   .
   Default: [] (empty)
   .
@@ -133,7 +136,7 @@ description:
   /Examples/:
   .
   @
-  $ list-remote-forwards --database=postfixadmin.sqlite3
+  $ list-remote-forwards --database=test/fixtures/postfixadmin.sqlite3
   user1@example.com -> user1@example.net
   user2@example.com -> user1@example.org
   user2@example.com -> user2@example.org
@@ -168,9 +171,11 @@ executable list-remote-forwards
     Configuration
     CommandLine
     DNS
+    Forward
     OptionalConfiguration
     MxList
     Report
+    String
 
   ghc-options:
     -Wall
index 6010fc96d6d8e27c7a5377ec25b8dbb5e1622037..8d94de51e9c7772d33adcb6cf5ec3e40c9479105 100644 (file)
@@ -1,13 +1,43 @@
-module DNS ( lookup_mxs )
+module DNS (
+  MxSetMap,
+  mx_set_map,
+  normalize_string_domain )
 where
 
+import qualified Data.ByteString.Char8 as BS ( pack, unpack )
+import Data.List ( nub )
+import Data.Map ( Map )
+import qualified Data.Map as Map ( fromList )
+import Data.Set ( Set )
+import qualified Data.Set as Set ( fromList )
 import Network.DNS (
   Domain,
   defaultResolvConf,
   lookupMX,
   makeResolvSeed,
+  normalize,
   withResolver )
 
+-- | A map from domain names (represented as 'String's) to sets of
+--   mail exchanger names (also represented as 'String's).
+--
+type MxSetMap = Map String MxSet
+
+-- | A set of mail exchanger names, represented as 'String's.
+type MxSet = Set String
+
+
+-- | Normalize a domain name string by converting to a 'Domain',
+--   calling 'normalize', and then converting back.
+--
+--   ==== __Examples__
+--
+--   >>> normalize_string_domain "ExAMplE.com"
+--   "example.com."
+--
+normalize_string_domain :: String -> String
+normalize_string_domain = BS.unpack . normalize . BS.pack
+
 
 -- | Retrieve all MX records for the given domain. This is somewhat
 --   inefficient, since we create the resolver every time.
@@ -20,3 +50,47 @@ lookup_mxs domain = do
     return $ case mxs of
                Left  _     -> []
                Right pairs -> map fst pairs
+
+
+-- | Takes a list of domain names represented as 'String's and
+--   constructs a map from domain names to sets of mail exchangers
+--   (for those domain names) also represented as 'String's.
+--
+--   During construction, we have to switch to the DNS internal
+--   representation of a 'Domain' which uses ByteStrings, but before
+--   we return the map to the client, we want everything to be in
+--   terms of standard 'String's for comparison purposes.
+--
+--   The list of domains is normalized and de-duped before lookups are
+--   performed to avoid doing lookups twice for identical domains.
+--
+mx_set_map :: [String] -> IO MxSetMap
+mx_set_map domains = do
+  -- Construct a list of pairs.
+  pairs <- mapM make_pair unique_domains
+
+  -- And make a map from the pairs.
+  return $ Map.fromList pairs
+
+  where
+    -- Convert, normalize, and de-dupe the @domains@.
+    unique_domains :: [Domain]
+    unique_domains = nub $ map (normalize . BS.pack) domains
+
+    -- | Convert a string domain name into a pair containing the
+    --   domain name in the first component and a set of its mail
+    --   exchangers (as strings) in the second component.
+    --
+    make_pair :: Domain -> IO (String, Set String)
+    make_pair domain = do
+      -- Lookup the @domain@'s MX records.
+      mx_list <- lookup_mxs domain
+
+      -- Now convert the MX records *back* to strings.
+      let string_mx_list = map BS.unpack mx_list
+
+      -- Convert the list into a set
+      let string_mx_set = Set.fromList string_mx_list
+
+      -- Finally, construct the pair and return it.
+      return (BS.unpack domain, string_mx_set)
diff --git a/src/Forward.hs b/src/Forward.hs
new file mode 100644 (file)
index 0000000..7de53b8
--- /dev/null
@@ -0,0 +1,251 @@
+-- | The 'Forward' data type, and functions that act thereon.
+--
+module Forward (
+  Forward(..),
+  address_domain,
+  dropby_goto_domains,
+  fwd,
+  pretty_print,
+  strings_to_forwards )
+where
+
+import Data.String.Utils ( split, strip )
+
+import DNS ( normalize_string_domain )
+
+-- | Type synonym to make the signatures below a little more clear.
+--   WARNING: Also defined in the "Report" module.
+type Domain = String
+
+
+-- | A type-safe wrapper around an email address that's represented as
+--   a 'String'. This differs from a 'Goto' in that it should only
+--   appear on the left-hand-side of a alias -> goto relationship.
+--
+newtype Address = Address String deriving ( Show )
+
+
+-- | A type-safe wrapper around an email address that's represented as
+--   a 'String'. This differs from 'Address' in that 'Goto' addresses
+--   are the destinations of mail that is forwarded, rather than the
+--   source.
+newtype Goto = Goto String deriving ( Show )
+
+
+-- | 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)
+
+
+-- | Shortcut constructor for creating 'Forward' objects.
+--
+--   ==== __Examples__
+--
+--   >>> pretty_print $ fwd "user1@example.com" "user2@example.net"
+--   "user1@example.com -> user2@example.net"
+--
+fwd :: String -> String -> Forward
+fwd addr goto = Forward (Address addr) (Goto goto)
+
+
+-- | Pretty-print a 'Forward'.
+--
+--   ==== __Examples__
+--
+--   >>> pretty_print (fwd "a@example.com" "b@example.net")
+--   "a@example.com -> b@example.net"
+--
+pretty_print :: Forward -> String
+pretty_print ( Forward (Address addr) (Goto goto) ) =
+  addr ++ " -> " ++ goto
+
+
+
+-- | Convert a list of 'String's into a list of 'Forward's. The list
+--   of 'String's is assumed to have exactly two elements; the first
+--   being an address, and the second being a comma-separated list of
+--   gotos.
+--
+--   We return a list containing one 'Forward' 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"
+--   >>> strings_to_forwards [addr, gotos]
+--   [Forward (Address "a@b.test") (Goto "a@b.test")]
+--
+--   One address forwarded to two other addresses:
+--
+--   >>> let addr = "a@b.test"
+--   >>> let gotos = "a1@b.test,a2@b.test"
+--   >>> map pretty_print (strings_to_forwards [addr, gotos])
+--   ["a@b.test -> a1@b.test","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    "
+--   >>> map pretty_print (strings_to_forwards [addr, gotos])
+--   ["a@b.test -> a@b.test","a@b.test -> a2@b.test"]
+--
+--   And finally, a one-element list, which should return no forwards:
+--
+--   >>> let addr = "a@b.test"
+--   >>> strings_to_forwards [addr]
+--   []
+--
+strings_to_forwards :: [String] -> [Forward]
+strings_to_forwards (addr:gotos:_) =
+  [Forward (Address addr) (Goto (strip g)) | g <- split "," gotos]
+strings_to_forwards _ = []
+
+
+-- | Find the domain of the 'Goto' associated with a 'Forward'. This
+--   returns the __domain of the goto address__, not the domain of the
+--   'Address' itself.
+--
+--   ==== __Examples__
+--
+--   A normal forward:
+--
+--   >>> let f = fwd "user1@example.com" "user2@example.net"
+--   >>> goto_domain f
+--   Just "example.net"
+--
+--   A forward to a subdomain:
+--
+--   >>> let f = fwd "user1@example.com" "user2@sub.example.net"
+--   >>> goto_domain f
+--   Just "sub.example.net"
+--
+--   A goto without an '@' character:
+--
+--   >>> let f = fwd "user1@example.com" "example.net"
+--   >>> goto_domain f
+--   Nothing
+--
+--   A goto with three '@' characters:
+--
+--   >>> let f = fwd "user1@example.com" "@example@.net@"
+--   >>> goto_domain f
+--   Nothing
+--
+goto_domain :: Forward -> Maybe Domain
+goto_domain (Forward _ (Goto goto)) = domain_part goto
+
+
+-- | Find the domain of the 'Address' associated with a 'Forward'. This
+--   returns the __domain of the address__, not the domain of the
+--   'Goto'.
+--
+--   ==== __Examples__
+--
+--   A normal forward:
+--
+--   >>> let f = fwd "user1@example.com" "user2@example.net"
+--   >>> address_domain f
+--   Just "example.com"
+--
+--   A forward to/from subdomains:
+--
+--   >>> let f = fwd "user1@sub.example.com" "user2@sub.example.net"
+--   >>> address_domain f
+--   Just "sub.example.com"
+--
+--   An address/goto without an '@' character:
+--
+--   >>> let f = fwd "example.com" "example.net"
+--   >>> address_domain f
+--   Nothing
+--
+--   An address/goto with three '@' characters:
+--
+--   >>> let f = fwd "@example@.com@" "@example@.net@"
+--   >>> address_domain f
+--   Nothing
+--
+address_domain :: Forward -> Maybe Domain
+address_domain (Forward (Address addr) _) = domain_part addr
+
+
+-- | Return the domain part of an email address (represented by a
+--   'String').
+--
+--   The way we determine the domain is simple: we take whatever
+--   appears after the first '@' character in the address. If there is
+--   no '@' symbol, or if there's more than one, then we don't know
+--   what the domain is, so we return 'Nothing' instead.
+--
+--   ==== __Examples__
+--
+--   A normal address:
+--
+--   >>> domain_part "user2@example.net"
+--   Just "example.net"
+--
+--   A subdomain:
+--
+--   >>> domain_part "user2@sub.example.net"
+--   Just "sub.example.net"
+--
+--   An address without an '@' character:
+--
+--   >>> domain_part "example.net"
+--   Nothing
+--
+--   An address with two '@' characters:
+--
+--   >>> domain_part "@example@.net@"
+--   Nothing
+--
+domain_part :: String -> Maybe Domain
+domain_part address =
+  case parts of
+    (_:domain:[]) -> Just domain
+    _             -> Nothing
+  where
+    parts = split "@" address
+
+
+-- | Given a list of 'Domain's @domains@ and a list of 'Forward's
+--   @forwards@, filter out all elements of @forwards@ that have a
+--   goto domain in the list of @domains@.
+--
+--   ==== __Examples__
+--
+--   >>> let ds = ["example.com", "example.net"]
+--   >>> let f1 = fwd "a@example.com" "a@example.com"
+--   >>> let f2 = fwd "a@example.com" "a1@example.net"
+--   >>> let f3 = fwd "a@example.com" "a2@example.org"
+--   >>> map pretty_print (dropby_goto_domains ds [f1,f2,f3])
+--   ["a@example.com -> a2@example.org"]
+--
+dropby_goto_domains :: [Domain] -> [Forward] -> [Forward]
+dropby_goto_domains domains =
+  filter (not . is_bad)
+  where
+    -- If we don't normalize these first, comparison (i.e. `elem`)
+    -- doesn't work so great.
+    normalized_domains = map normalize_string_domain domains
+
+    -- | A 'Forward' is bad if its goto domain appears in the list, or
+    --   if we can't figure out its goto domain.
+    --
+    is_bad :: Forward -> Bool
+    is_bad f =
+      case (goto_domain f) of
+        Nothing -> True -- Drop these, too.
+        Just d  -> (normalize_string_domain d) `elem` normalized_domains
index 13371a836d9f7c537583842241db904ec39df1c8..ab4d05590458d819413da4dccab941d61a3c28cc 100644 (file)
@@ -74,7 +74,7 @@ main = do
           else connectPostgreSQL (connection_string cfg) >>= report cfg
 
     -- The DB connection is implicitly closed when it gets garbage collected.
-    putStrLn r
+    putStr r
 
   where
     show_sql_error :: SqlError -> IO ()
index a189664e1ff8d199b3cd87bca91a46b97a3e0832..5b3853350efc3a07c581ad20b354741c3d127cc5 100644 (file)
@@ -5,41 +5,35 @@ module Report (
   report_tests )
 where
 
-import Control.Monad ( filterM )
-import qualified Data.ByteString.Char8 as BS ( pack )
+import Data.Map ( mapKeys )
+import qualified Data.Map as Map ( lookup )
 import Data.Maybe ( catMaybes, listToMaybe )
-import Data.String.Utils ( join, split, strip )
+import Data.Set ( fromList, isSubsetOf )
+import qualified Data.Set as Set ( map )
+import Data.String.Utils ( join )
 import Database.HDBC (
   IConnection,
   execute,
   prepare,
   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 )
+import DNS ( MxSetMap, mx_set_map, normalize_string_domain )
+import Forward (
+  Forward(..),
+  address_domain,
+  dropby_goto_domains,
+  pretty_print,
+  strings_to_forwards )
 import MxList ( MxList(..) )
 
--- Type synonyms to make the signatures below a little more clear.
+-- | Type synonym to make the signatures below a little more clear.
+--   WARNING: Also defined in the "Forward" module.
 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)
 
 -- | Given a connection @conn@ and a @query@, return a list of domains
 --   found by executing @query@ on @conn. The @query@ is assumed to
@@ -69,48 +63,6 @@ get_domain_list conn query = do
   return domains
 
 
--- | 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
@@ -135,81 +87,133 @@ get_forward_list conn query = do
   rows <- sFetchAllRows' stmt
 
   -- forwards :: [Forward]
-  let forwards = concatMap (row_to_forwards . catMaybes) rows
+  let forwards = concatMap (strings_to_forwards . catMaybes) rows
 
   return 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.
+-- | A filter function to remove specific 'Forward's from a list (of
+--   forwards).  Its intended usage is to ignore a 'Forward' if its
+--   'Address' has MX records that are all 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.
 --
---   ==== __Examples__
+--   If the MX records for a domain are contained in the 'MxList',
+--   then we exclude that domain from the report.
 --
---   >>> 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"]
+--   For performance reasons, we want to have precomputed the MX
+--   records for all of the address domains in our list of
+--   forwards. We do this so we don't look up the MX records twice for
+--   two addresses within the same domain. We could just as well do
+--   this within this function, but by taking the @domain_mxs@ as a
+--   parameter, we allow ourselves to be a pure function.
 --
-find_remote_forwards :: [Domain] -> [Forward] -> [Forward]
-find_remote_forwards domains forwards =
-  filter is_remote forwards
-  where
-    is_remote :: Forward -> Bool
-    is_remote (Forward _ goto) =
-      let parts = split "@" goto
-      in
-        case parts of
-          (_:dp:[]) -> not $ dp `elem` domains
-          _        -> True -- Assume it's remote if something is wrong
-
-
--- | Format a 'Forward' for pretty printing.
+--   If the domain of a forward address can't be determined, it won't
+--   be dropped! This is intentional: the existence of a forward
+--   address without a domain part probably indicates a configuration
+--   error somewhere, and we should report it.
+--
+--   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.
 --
 --   ==== __Examples__
 --
---   >>> let fwd = Forward "a@example.com" "b@example.net"
---   >>> format_forward fwd
---   "a@example.com -> b@example.net"
+--   Our single forward should be dropped from the list, because its
+--   MX record list, ["mx.example.com"], is contained in the list of
+--   excluded MXs:
 --
-format_forward :: Forward -> String
-format_forward (Forward addr goto) =
-  addr ++ " -> " ++ goto
-
-
-
--- | 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.
+--   >>> import qualified Data.Map as Map ( fromList )
+--   >>> import qualified Data.Set as Set ( fromList )
+--   >>> import Forward ( fwd )
+--   >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+--   >>> let mx_set = Set.fromList ["mx.example.com"]
+--   >>> let example_mx_pairs = [("example.com.", mx_set)]
+--   >>> let mx_map = Map.fromList example_mx_pairs
+--   >>> let droplist = MxList ["mx.example.com", "mx2.example.com"]
+--   >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+--   []
 --
---   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.
+--   Repeat the previous test with the goto domain, to make sure we're
+--   dropping based on the address and not the goto:
 --
---   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.
+--   >>> import qualified Data.Map as Map ( fromList )
+--   >>> import qualified Data.Set as Set ( fromList )
+--   >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+--   >>> let mx_set = Set.fromList ["mx.example.net"]
+--   >>> let example_mx_pairs = [("example.net.", mx_set)]
+--   >>> let mx_map = Map.fromList example_mx_pairs
+--   >>> let droplist = MxList ["mx.example.net", "mx2.example.net"]
+--   >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+--   ["user1@example.com -> user2@example.net"]
 --
-filter_by_mx :: MxList -> [Forward] -> IO [Forward]
-filter_by_mx (MxList [])  = return
-filter_by_mx (MxList mxs) =
-  filterM all_mxs_excluded
+--   Use weird caps, and optional trailing dot all over the place to
+--   make sure everything is handled normalized:
+--
+--   >>> import qualified Data.Set as Set ( fromList )
+--   >>> import Forward ( fwd )
+--   >>> let fwds = [fwd "user1@exAmPle.com." "user2@examPle.net"]
+--   >>> let mx_set = Set.fromList ["mx.EXAMPLE.com"]
+--   >>> let example_mx_pairs = [("Example.com", mx_set)]
+--   >>> let mx_map = Map.fromList example_mx_pairs
+--   >>> let droplist = MxList ["mx.EXAMple.com", "mx2.example.COM"]
+--   >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+--   []
+--
+--   This time it shouldn't be dropped, because ["mx.example.com"] is
+--   not contained in ["nope.example.com"]:
+--
+--   >>> import qualified Data.Map as Map ( fromList )
+--   >>> import qualified Data.Set as Set ( fromList )
+--   >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+--   >>> let mx_set = Set.fromList ["mx.example.com"]
+--   >>> let example_mx_pairs = [("example.com.", mx_set)]
+--   >>> let mx_map = Map.fromList example_mx_pairs
+--   >>> let droplist = MxList ["nope.example.com"]
+--   >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+--   ["user1@example.com -> user2@example.net"]
+--
+--   Now we check that if a forward has two MXes, one of which appears
+--   in the list of excluded MXes, it doesn't get dropped:
+--
+--   >>> import qualified Data.Map as Map ( fromList )
+--   >>> import qualified Data.Set as Set ( fromList )
+--   >>> let fwds = [fwd "user1@example.com" "user2@example.net"]
+--   >>> let mx_set = Set.fromList ["mx1.example.com", "mx2.example.com"]
+--   >>> let example_mx_pairs = [("example.com.", mx_set)]
+--   >>> let mx_map = Map.fromList example_mx_pairs
+--   >>> let droplist = MxList ["mx1.example.com"]
+--   >>> map pretty_print (dropby_mxlist droplist mx_map fwds)
+--   ["user1@example.com -> user2@example.net"]
+--
+dropby_mxlist :: MxList -> MxSetMap -> [Forward] -> [Forward]
+dropby_mxlist (MxList []) _ = id
+dropby_mxlist (MxList mxs) domain_mx_map =
+  filter (not . is_bad)
   where
-    all_mxs_excluded :: Forward -> IO Bool
-    all_mxs_excluded (Forward addr _) =
-      case (split "@" addr) of
-        (_:domain_part:[]) -> do
-          fw_mxs <- lookup_mxs (BS.pack domain_part)
-          let norm_mxs = map (normalize . BS.pack) mxs
-          if (norm_mxs \\ fw_mxs) == [] then return False else return True
-        _ -> return True -- Report it if we can't figure out the domain.
+    -- If we don't normalize these first, comparison (isSubsetOf)
+    -- doesn't work so great.
+    mx_set = fromList (map normalize_string_domain mxs)
+
+    -- We perform a lookup using a normalized key, so we'd better
+    -- normalize the keys in the map first!
+    normal_mxmap = mapKeys normalize_string_domain domain_mx_map
+
+    is_bad :: Forward -> Bool
+    is_bad f =
+      case (address_domain f) of
+        Nothing -> False -- Do **NOT** drop these.
+        Just d  -> case (Map.lookup (normalize_string_domain d) normal_mxmap) of
+                     Nothing -> False -- No domain MX? Don't drop.
+
+                     -- We need to normalize the set of MXes for the
+                     -- domain, too.
+                     Just dmxs ->
+                       let ndmxs = (Set.map normalize_string_domain dmxs)
+                       in
+                         ndmxs `isSubsetOf` mx_set
 
 
 -- | Given a connection and a 'Configuration', produces the report as
@@ -220,11 +224,28 @@ report cfg conn = do
   domains <- get_domain_list conn (domain_query cfg)
   forwards <- get_forward_list conn (forward_query cfg)
 
-  valid_forwards <- filter_by_mx (exclude_mx cfg) forwards
-  let remote_forwards = find_remote_forwards domains valid_forwards
-  let forward_strings = map format_forward remote_forwards
+  -- valid_forwards are those not excluded based on their address's MXes.
+  --
+  -- WARNING: Don't do MX lookups if the exclude list is empty! It
+  -- wastes a ton of time!
+  --
+  -- Don't ask why, but this doesn't work if you factor out the
+  -- "return" below.
+  --
+  let exclude_mx_list = exclude_mx cfg
+  valid_forwards <- if null (get_mxs exclude_mx_list)
+                    then return forwards
+                    else do
+                      domain_mxs <- mx_set_map domains
+                      return $ dropby_mxlist exclude_mx_list domain_mxs forwards
+
+  let remote_forwards = dropby_goto_domains domains valid_forwards
+  let forward_strings = map pretty_print remote_forwards
 
-  return $ (join "\n" forward_strings)
+  -- Don't append the final newline if there's nothing to report.
+  return $ if (null forward_strings)
+           then ""
+           else (join "\n" forward_strings) ++ "\n"
 
 
 
@@ -248,4 +269,4 @@ test_example1 =
                "user2@example.com -> user1@example.org\n" ++
                "user2@example.com -> user2@example.org\n" ++
                "user2@example.com -> user3@example.org\n" ++
-               "user7@example.com -> user8@example.net"
+               "user7@example.com -> user8@example.net\n"