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 on
45 -- these. This is a very limited list; I don't want to be in the
46 -- business of monitoring a million domains for MX record updates.
47 common_domains :: [Domain]
48 common_domains = map BS.pack [ "aol.com",
67 -- | Check whether the given domain has a valid MX record.
68 validate_mx :: Resolver -> Domain -> IO Bool
69 validate_mx resolver domain
70 | domain `elem` common_domains = return True
72 result <- lookupMX resolver domain
74 -- A list of one or more elements?
75 Right (_:_) -> return True
79 -- | Check whether the given domain has a valid A record.
80 validate_a :: Resolver -> Domain -> IO Bool
81 validate_a resolver domain
82 | domain `elem` common_domains = return True
84 result <- lookupA resolver domain
86 Right (_:_) -> return True
90 -- | Validate an email address by doing some simple syntax checks and
91 -- (if those fail) an MX lookup. We don't count an A record as a mail
93 validate :: Resolver -> Bool -> Bool -> Address -> IO (Address, Bool)
94 validate resolver accept_a rfc5322 address = do
95 let valid_syntax = validate_syntax rfc5322 address
96 if valid_syntax then do
97 let (_,domain) = parts address
98 mx_result <- validate_mx resolver domain
100 then return (address, True)
104 a_result <- validate_a resolver domain
105 return (address, a_result)
107 return (address, False)
109 return (address, False)
117 -- Split stdin into lines, which should result in a list of addresses.
118 input <- BS.hGetContents stdin
119 let addresses = BS.lines input
121 -- And remove the empty ones.
122 let nonempty_addresses = filter (not . BS.null) addresses
124 rs <- makeResolvSeed resolv_conf
125 let validate' addr = withResolver rs $ \resolver ->
126 validate resolver accept_a rfc5322 addr
128 -- Construct a list of [IO (Address, Bool)]. The withResolver calls
129 -- are the ones that should be run in parallel.
130 let actions = map validate' nonempty_addresses
132 -- Run the lookup actions in parallel.
133 results <- parallelInterleaved actions
135 -- Filter the bad ones.
136 let valid_results = filter snd results
138 -- Output the results.
139 let valid_addresses = map fst valid_results
140 mapM_ (BS.hPutStrLn stdout) valid_addresses