1 {-# LANGUAGE DoAndIfThenElse #-}
6 import Control.Concurrent.ParallelIO.Global (parallel, stopGlobalPool)
7 import qualified Data.ByteString as BS
8 import qualified Data.ByteString.UTF8 as BSU
16 import Network.DNS.Lookup (lookupMX)
17 import System.IO (hGetContents, hFlush, hPutStrLn, stdin, stdout)
18 import Text.Regex.PCRE.Light (compile, match, utf8)
20 type Address = BSU.ByteString
22 -- | Resolver parameters. We increase the default timeout from 3 to 5
24 resolv_conf :: ResolvConf
25 resolv_conf = defaultResolvConf { resolvTimeout = 5 * 1000 * 1000 }
27 -- | A list of common domains, there's no need to waste MX lookups
29 common_domains :: [Domain]
30 common_domains = map BSU.fromString [ "aol.com",
37 validate_mx :: Resolver -> Domain -> IO Bool
38 validate_mx resolver domain
39 | domain `elem` common_domains = return True
41 result <- lookupMX resolver domain
43 Nothing -> return False
46 -- | Split an address into local/domain parts.
47 parts :: Address -> (BSU.ByteString, BSU.ByteString)
48 parts address = bytestring_split address '@'
50 -- | Check that the lengths of the local/domain parts are within spec.
51 validate_length :: Address -> Bool
52 validate_length address =
53 (BSU.length localpart <= 64) && (BSU.length domain <= 255)
55 (localpart, domain) = parts address
57 -- | Validate an email address against a simple regex. This should
58 -- catch common addresses but disallows a lot of (legal) weird stuff.
59 validate_regex :: Address -> Bool
60 validate_regex address =
65 regex_str = "(\\w+)([\\w\\-\\.]*)@(([0-9a-zA-Z\\-]+\\.)+)[a-zA-Z]{2,4}"
66 regex_bs = BSU.fromString regex_str
67 regex = compile regex_bs [utf8]
68 matches = match regex address []
70 -- | Validate the syntax of an email address by checking its length
71 -- and validating it against a simple regex.
72 validate_syntax :: Address -> Bool
73 validate_syntax address =
74 (validate_length address) && (validate_regex address)
76 -- | Split a 'ByteString' @s@ at the first occurrence of @character@.
77 bytestring_split :: BSU.ByteString -> Char -> (BSU.ByteString, BSU.ByteString)
78 bytestring_split s character =
81 break_func = (== character)
82 (before, rest) = BSU.break break_func s
86 -- | Validate an email address by doing some simple syntax checks and
87 -- (if those fail) an MX lookup. We don't count an A record as a mail
89 validate :: Resolver -> Address -> IO (Address, Bool)
90 validate resolver address = do
91 let valid_syntax = validate_syntax address
92 if valid_syntax then do
93 let (_,domain) = parts address
94 mx_result <- validate_mx resolver domain
95 return (address, mx_result)
97 return (address, False)
101 input <- hGetContents stdin
103 let addresses = BSU.lines $ BSU.fromString input
104 let nonempty_addresses = filter (not . BS.null) addresses
106 rs <- makeResolvSeed resolv_conf
107 withResolver rs $ \resolver -> do
108 let actions = map (validate resolver) nonempty_addresses
109 results <- parallel actions
110 let good_pairs = filter snd results
111 mapM_ ((hPutStrLn stdout) . BSU.toString . fst) good_pairs