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 (
_ -> 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
+validate :: Resolver -> Bool -> Address -> IO (Address, Bool)
+validate resolver accept_a address = do
let valid_syntax = validate_syntax 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 actions = map (validate resolver accept_a) nonempty_addresses
-- And compute them in parallel.
results <- parallel actions
stopGlobalPool