import Control.Concurrent.ParallelIO.Global (
parallelInterleaved,
stopGlobalPool )
-import Control.Monad ( unless )
import qualified Data.ByteString.Char8 as BS (
hGetContents,
hPutStrLn,
lines,
null,
- pack,
- readFile )
+ pack )
import Network.DNS (
Domain,
Resolver,
- ResolvConf(..),
+ ResolvConf( resolvTimeout ),
defaultResolvConf,
makeResolvSeed,
withResolver )
import Network.DNS.Lookup ( lookupA, lookupMX )
-import System.Directory ( doesFileExist )
-import System.Exit ( exitWith, ExitCode(..) )
import System.IO (
- IOMode( WriteMode ),
- hClose,
hFlush,
- openFile,
stdin,
stdout )
-import CommandLine ( Args(..), get_args )
+import CommandLine (
+ Args( Args, accept_a, rfc5322 ),
+ get_args )
import EmailAddress(
Address,
parts,
validate_syntax )
-import ExitCodes ( exit_input_file_doesnt_exist )
-- | Resolver parameters. We increase the default timeout from 3 to 10
resolv_conf :: ResolvConf
resolv_conf = defaultResolvConf { resolvTimeout = 10 * 1000 * 1000 }
--- | A list of common domains, there's no need to waste MX lookups
--- on these.
+-- | A list of common domains, there's no need to waste MX lookups on
+-- these. This is a very limited list; I don't want to be in the
+-- business of monitoring a million domains for MX record updates.
common_domains :: [Domain]
common_domains = map BS.pack [ "aol.com",
"comcast.net",
+ "cox.net",
"gmail.com",
+ "gmx.de",
+ "googlemail.com",
+ "hotmail.com",
+ "icloud.com",
+ "live.com",
+ "me.com",
"msn.com",
+ "outlook.com",
+ "proton.me",
+ "protonmail.ch",
+ "protonmail.com",
"yahoo.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
main = do
Args{..} <- get_args
- -- Get the input from either stdin, or the file given on the command
- -- line.
- input <- case input_file of
- Nothing -> BS.hGetContents stdin
- Just path -> do
- is_file <- doesFileExist path
- unless is_file $
- exitWith (ExitFailure exit_input_file_doesnt_exist)
- BS.readFile path
-
- -- Do the same for the output handle and stdout.
- output_handle <- case output_file of
- Nothing -> return stdout
- Just path -> openFile path WriteMode
-
- -- Split the input into lines.
+ -- Split stdin into lines, which should result in a list of addresses.
+ input <- BS.hGetContents stdin
let addresses = BS.lines input
-- And remove the empty ones.
-- Output the results.
let valid_addresses = map fst valid_results
- mapM_ (BS.hPutStrLn output_handle) valid_addresses
+ mapM_ (BS.hPutStrLn stdout) valid_addresses
stopGlobalPool
-
- -- Clean up. It's safe to try to close stdout.
- hFlush output_handle
- hClose output_handle
+ hFlush stdout