From 03eb76c0dc4238bc8c579beddb0e65fbed64d28d Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 24 Apr 2024 20:33:40 -0400 Subject: [PATCH] src/Main.hs: support NULLMX fully We now ignore --accept-a for domains that have NULLMX records. --- src/Main.hs | 89 +++++++++++++++++++++++++++++------------------------ 1 file changed, 49 insertions(+), 40 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 74789e7..ab5f93a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -64,38 +64,40 @@ common_domains = map BS.pack [ "aol.com", "verizon.net" ] --- | Check whether the given domain has a valid MX record. NULLMX --- (RFC7505) records consisting of a single period must not be --- accepted. +-- | Check whether the given domain has a valid MX record. -- --- Two points about NULLMX: +-- NULLMX (RFC7505) records consisting of a single period must not +-- be accepted. Moreover, the existence of a NULLMX must be reported +-- back to the caller because the whole point of a NULLMX is that +-- its existence should preempt an @A@ record check. We abuse the +-- return type for this, and return @Nothing@ in the event of a +-- NULLMX. Otherwise we return @Just True@ or @Just False@ to +-- indicate the existence (or not) of MX records. -- --- * 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 states that a domain MUST NOT have any other MX records +-- if it has a NULLMX record. We enforce this. If you have a NULLMX +-- record and some other MX record, we consider the set invalid. -- --- * 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 -> IO (Maybe Bool) validate_mx resolver domain - | domain `elem` common_domains = return True + | domain `elem` common_domains = return $ Just True | otherwise = do result <- lookupMX resolver domain - 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 - + case result of + Left _ -> + return $ Just False + Right mxs -> + case mxs of + [] -> return $ Just False + _ -> if any (is_null) mxs + then return Nothing + else return $ Just True + where + nullmx :: Domain + nullmx = BS.pack "." + + is_null :: (Domain,Int) -> Bool + is_null (mx,prio) = mx == nullmx && prio == 0 -- | Check whether the given domain has a valid A record. validate_a :: Resolver -> Domain -> IO Bool @@ -109,26 +111,33 @@ validate_a resolver domain -- | Validate an email address by doing some simple syntax checks and --- (if those fail) an MX lookup. We don't count an A record as a mail --- exchanger. +-- (if those fail) an MX lookup. We don't count an @A@ record as a mail +-- exchanger unless @accept_a@ is True. And even then, the existence +-- of a NULLMX record will preclude the acceptance of an @A@ record. +-- The domain @example.com@ is a great test case for this behavior. validate :: Resolver -> Bool -> Bool -> Address -> IO (Address, Bool) validate resolver accept_a rfc5322 address = do let valid_syntax = validate_syntax rfc5322 address if valid_syntax then do let (_,domain) = parts address mx_result <- validate_mx resolver domain - if mx_result - then return (address, True) - else - if accept_a - then do - a_result <- validate_a resolver domain - return (address, a_result) - else - return (address, False) - else - return (address, False) - + case mx_result of + Nothing -> + -- NULLMX, don't fall back to 'A' records under any + -- circumstances. + return (address, False) + Just mxr -> + if mxr + then return (address, True) + else + if accept_a + then do + a_result <- validate_a resolver domain + return (address, a_result) + else + return (address, False) + else + return (address, False) main :: IO () -- 2.44.2