1 {-# LANGUAGE DoAndIfThenElse #-}
2 {-# LANGUAGE RecordWildCards #-}
7 import Control.Concurrent.ParallelIO.Global (
10 import Control.Monad ( unless )
11 import qualified Data.ByteString.Char8 as BS (
25 import Network.DNS.Lookup ( lookupA, lookupMX )
26 import System.Directory ( doesFileExist )
27 import System.Exit ( exitWith, ExitCode(..) )
37 import CommandLine ( Args(..), get_args )
42 import ExitCodes ( exit_input_file_doesnt_exist )
45 -- | Resolver parameters. We increase the default timeout from 3 to 10
47 resolv_conf :: ResolvConf
48 resolv_conf = defaultResolvConf { resolvTimeout = 10 * 1000 * 1000 }
50 -- | A list of common domains, there's no need to waste MX lookups
52 common_domains :: [Domain]
53 common_domains = map BS.pack [ "aol.com",
61 -- | Check whether the given domain has a valid MX record.
62 validate_mx :: Resolver -> Domain -> IO Bool
63 validate_mx resolver domain
64 | domain `elem` common_domains = return True
66 result <- lookupMX resolver domain
68 -- A list of one or more elements?
69 Right (_:_) -> return True
73 -- | Check whether the given domain has a valid A record.
74 validate_a :: Resolver -> Domain -> IO Bool
75 validate_a resolver domain
76 | domain `elem` common_domains = return True
78 result <- lookupA resolver domain
80 Right (_:_) -> return True
84 -- | Validate an email address by doing some simple syntax checks and
85 -- (if those fail) an MX lookup. We don't count an A record as a mail
87 validate :: Resolver -> Bool -> Bool -> Address -> IO (Address, Bool)
88 validate resolver accept_a rfc5322 address = do
89 let valid_syntax = validate_syntax rfc5322 address
90 if valid_syntax then do
91 let (_,domain) = parts address
92 mx_result <- validate_mx resolver domain
94 then return (address, True)
98 a_result <- validate_a resolver domain
99 return (address, a_result)
101 return (address, False)
103 return (address, False)
111 -- Get the input from either stdin, or the file given on the command
113 input <- case input_file of
114 Nothing -> BS.hGetContents stdin
116 is_file <- doesFileExist path
118 exitWith (ExitFailure exit_input_file_doesnt_exist)
121 -- Do the same for the output handle and stdout.
122 output_handle <- case output_file of
123 Nothing -> return stdout
124 Just path -> openFile path WriteMode
126 -- Split the input into lines.
127 let addresses = BS.lines input
129 -- And remove the empty ones.
130 let nonempty_addresses = filter (not . BS.null) addresses
132 rs <- makeResolvSeed resolv_conf
133 let validate' addr = withResolver rs $ \resolver ->
134 validate resolver accept_a rfc5322 addr
136 -- Construct a list of [IO (Address, Bool)]. The withResolver calls
137 -- are the ones that should be run in parallel.
138 let actions = map validate' nonempty_addresses
140 -- Run the lookup actions in parallel.
141 results <- parallelInterleaved actions
143 -- Filter the bad ones.
144 let valid_results = filter snd results
146 -- Output the results.
147 let valid_addresses = map fst valid_results
148 mapM_ (BS.hPutStrLn output_handle) valid_addresses
152 -- Clean up. It's safe to try to close stdout.