src/Main.hs: support NULLMX (RFC7505)

We now reject NULLMX records, i.e. those that contain a single
dot. This is only a partial solution since we should be rejecting
these domains even if --accept-a was given.

diff --git a/src/Main.hs b/src/Main.hs
index c220aaadc186d1be01d2432c7b22694323ee756d..74789e70f4e2cedbf0be6584c3b14626046bed52 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -64,14 +64,35 @@ common_domains = map BS.pack [ "aol.com",
                                "verizon.net" ]
 
 
--- | Check whether the given domain has a valid MX record.
+-- | Check whether the given domain has a valid MX record. NULLMX
+--   (RFC7505) records consisting of a single period must not be
+--   accepted.
+--
+--   Two points about NULLMX:
+--
+--   * RFC7505 states that a domain MUST NOT have any other MX records
+--   if it has a NULLMX record. We don't enforce this. If you have a
+--   NULLMX record and some other MX record, we will reluctantly
+--   consider the second one valid.
+--
+--   * RFC7505 also states that a NULLMX record must have a priority
+--   of 0. We do not enforce this either. We ignore any records
+--   containing an empty label (i.e. a single dot). Such a record will
+--   not be deliverable anyway, and in light of the first item, means
+--   that we will not \"incorrectly\" reject batshit-crazy domains
+--   that have a NULLMX record (but with a non-zero priority) in
+--   addition to other, valid MX records.
+--
+
 validate_mx :: Resolver -> Domain -> IO Bool
 validate_mx resolver domain
   | domain `elem` common_domains = return True
   | otherwise = do
       result <- lookupMX resolver domain
-      case result of
-        -- A list of one or more elements?
+      let nullmx = BS.pack "." :: Domain
+      let non_null = (\(mx,_) -> mx /= nullmx) :: (Domain,Int) -> Bool
+      let non_null_mxs = fmap (filter non_null) result
+      case non_null_mxs of
         Right (_:_) -> return True
         _           -> return False