defaultResolvConf,
makeResolvSeed,
withResolver)
-import Network.DNS.Lookup (lookupMX)
+import Network.DNS.Lookup (lookupA, lookupMX)
import System.Directory (doesFileExist)
import System.Exit (exitWith, ExitCode(..))
import System.IO (
import ExitCodes (exit_input_file_doesnt_exist)
--- | Resolver parameters. We increase the default timeout from 3 to 5
+-- | Resolver parameters. We increase the default timeout from 3 to 10
-- seconds.
resolv_conf :: ResolvConf
-resolv_conf = defaultResolvConf { resolvTimeout = 5 * 1000 * 1000 }
+resolv_conf = defaultResolvConf { resolvTimeout = 10 * 1000 * 1000 }
-- | A list of common domains, there's no need to waste MX lookups
-- on these.
_ -> return True
+-- | Check whether the given domain has a valid A record.
+validate_a :: Resolver -> Domain -> IO Bool
+validate_a resolver domain
+ | domain `elem` common_domains = return True
+ | otherwise = do
+ result <- lookupA resolver domain
+ case result of
+ Nothing -> return False
+ _ -> return True
+
-- | 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.
-validate :: Resolver -> Address -> IO (Address, Bool)
-validate resolver address = do
- let valid_syntax = validate_syntax address
+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
- return (address, mx_result)
+ 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)
rs <- makeResolvSeed resolv_conf
withResolver rs $ \resolver -> do
-- Construst a list of [IO (Address, Bool)]
- let actions = map (validate resolver) nonempty_addresses
+ let validate' = validate resolver accept_a rfc5322
+ let actions = map validate' nonempty_addresses
-- And compute them in parallel.
results <- parallel actions
stopGlobalPool