From: Michael Orlitzky <michael@orlitzky.com>
Date: Thu, 25 Apr 2024 00:07:38 +0000 (-0400)
Subject: src/Main.hs: support NULLMX (RFC7505)
X-Git-Tag: 1.1.0~4
X-Git-Url: https://gitweb.michael.orlitzky.com/email-validator.git/?p=email-validator.git;a=commitdiff_plain;h=432089f7b63e96b6e15ad7895f0e4b6aa1a52efc

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 c220aaa..74789e7 100644
--- 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