1 {-# LANGUAGE DoAndIfThenElse #-}
2 {-# LANGUAGE RecordWildCards #-}
7 import Control.Concurrent.ParallelIO.Global (
10 import qualified Data.ByteString.Char8 as BS (
19 ResolvConf( resolvTimeout ),
23 import Network.DNS.Lookup ( lookupA, lookupMX )
31 Args( Args, accept_a, rfc5322 ),
39 -- | Resolver parameters. We increase the default timeout from 3 to 10
41 resolv_conf :: ResolvConf
42 resolv_conf = defaultResolvConf { resolvTimeout = 10 * 1000 * 1000 }
44 -- | A list of common domains, there's no need to waste MX lookups
46 common_domains :: [Domain]
47 common_domains = map BS.pack [ "aol.com",
55 -- | Check whether the given domain has a valid MX record.
56 validate_mx :: Resolver -> Domain -> IO Bool
57 validate_mx resolver domain
58 | domain `elem` common_domains = return True
60 result <- lookupMX resolver domain
62 -- A list of one or more elements?
63 Right (_:_) -> return True
67 -- | Check whether the given domain has a valid A record.
68 validate_a :: Resolver -> Domain -> IO Bool
69 validate_a resolver domain
70 | domain `elem` common_domains = return True
72 result <- lookupA resolver domain
74 Right (_:_) -> return True
78 -- | Validate an email address by doing some simple syntax checks and
79 -- (if those fail) an MX lookup. We don't count an A record as a mail
81 validate :: Resolver -> Bool -> Bool -> Address -> IO (Address, Bool)
82 validate resolver accept_a rfc5322 address = do
83 let valid_syntax = validate_syntax rfc5322 address
84 if valid_syntax then do
85 let (_,domain) = parts address
86 mx_result <- validate_mx resolver domain
88 then return (address, True)
92 a_result <- validate_a resolver domain
93 return (address, a_result)
95 return (address, False)
97 return (address, False)
105 -- Split stdin into lines, which should result in a list of addresses.
106 input <- BS.hGetContents stdin
107 let addresses = BS.lines input
109 -- And remove the empty ones.
110 let nonempty_addresses = filter (not . BS.null) addresses
112 rs <- makeResolvSeed resolv_conf
113 let validate' addr = withResolver rs $ \resolver ->
114 validate resolver accept_a rfc5322 addr
116 -- Construct a list of [IO (Address, Bool)]. The withResolver calls
117 -- are the ones that should be run in parallel.
118 let actions = map validate' nonempty_addresses
120 -- Run the lookup actions in parallel.
121 results <- parallelInterleaved actions
123 -- Filter the bad ones.
124 let valid_results = filter snd results
126 -- Output the results.
127 let valid_addresses = map fst valid_results
128 mapM_ (BS.hPutStrLn stdout) valid_addresses