.SH SYNOPSIS
-\fBemail-validator\fR [\fB\-ha\fR] [\fB-i \fIFILE\fR] [\fB-o \fIFILE\fR] \fI<input>\fR
+\fBemail-validator\fR [\fB\-har\fR] [\fB-i \fIFILE\fR] [\fB-o \fIFILE\fR] \fI<input>\fR
.SH INPUT
.P
These checks are performed in parallel using the number of available
-threads.
+threads. To increase the number of threads, you can pass the
+appropriate flag to the GHC runtime.
+
+.P
+This will set the number of threads to 25:
+
+.nf
+.B $ email-validator -i addresses.csv +RTS -N25
.SH OPTIONS
Specify the output file to which the good addresses will be written,
rather than using stdout (the default).
+.IP \fB\-\-rfc5322\fR,\ \fB\-r\fR
+Verify addresses against RFC 5322 rather than a naive regular
+expression. This is much more lenient than the default.
+
.SH BUGS
.P
-- stdin/stdout.
data Args = Args { accept_a :: Bool,
input_file :: Maybe FilePath,
- output_file :: Maybe FilePath }
+ output_file :: Maybe FilePath,
+ rfc5322 :: Bool }
deriving (Show, Data, Typeable)
description :: String
output_file_help =
"Path to the output file (default: stdout)"
+rfc5322_help :: String
+rfc5322_help =
+ "Validate according to RFC 5322 (incredibly lenient)."
+
arg_spec :: Mode (CmdArgs Args)
arg_spec =
cmdArgsMode $
Args { accept_a = def &= help accept_a_help,
input_file = def &= typFile &= help input_file_help,
- output_file = def &= typFile &= help output_file_help }
+ output_file = def &= typFile &= help output_file_help,
+ rfc5322 = def &= help rfc5322_help }
&= program program_name
&= summary my_summary
&= details [description]
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BSU
+import Text.Email.Validate (isValid)
import Test.HUnit (assertEqual)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
-- | Validate the syntax of an email address by checking its length
--- and validating it against a simple regex.
-validate_syntax :: Address -> Bool
-validate_syntax address =
- (validate_length address) && (validate_regex address)
+-- and validating it against either a simple regex or RFC5322,
+-- depending on the --rfc5322 flag.
+validate_syntax :: Bool -> Address -> Bool
+validate_syntax rfc5322 address =
+ (validate_length address) &&
+ if rfc5322
+ then isValid address
+ else validate_regex address
-- HUnit tests
bad_addresses :: [Address]
bad_addresses =
map BSU.fromString [
- "bad%char@domain.com",
- "bad^char@domain.com",
- "badunderscore@dom_ain.com",
+-- Bad, but not caught by email-validate-1.0.0.
+-- "badunderscore@dom_ain.com",
"(fail)@domain.com",
"no spaces@domain.com",
".beginswith@a-dot.com",
"ok|char@domain.com",
"ok}char@domain.com",
"ok~char@domain.com",
- "tom.phillips@[127.0.0.1]" ]
+ "tom.phillips@[127.0.0.1]",
+ "bad%char@domain.com",
+ "bad^char@domain.com" ]
test_good_addresses :: Test
test_good_addresses =
where
desc = "Good addresses are accepted."
expected = True
- actual = all validate_syntax good_addresses
+ actual = all (validate_syntax False) good_addresses
+
+test_good_addresses_rfc :: Test
+test_good_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Good addresses are accepted with --rfc5322."
+ expected = True
+ actual = all (validate_syntax True) good_addresses
test_bad_addresses :: Test
test_bad_addresses =
where
desc = "Bad addresses are not accepted."
expected = True
- actual = all (not . validate_syntax) bad_addresses
+ actual = all (not . (validate_syntax False)) bad_addresses
+
+test_bad_addresses_rfc :: Test
+test_bad_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Bad addresses are not accepted with --rfc5322."
+ expected = True
+ actual = all (not . (validate_syntax True)) bad_addresses
test_unsupported_addresses :: Test
test_unsupported_addresses =
where
desc = "Unsupported addresses are not accepted."
expected = True
- actual = all (not . validate_syntax) unsupported_addresses
+ actual = all (not . (validate_syntax False)) unsupported_addresses
+test_unsupported_addresses_rfc :: Test
+test_unsupported_addresses_rfc =
+ testCase desc $
+ assertEqual desc expected actual
+ where
+ desc = "Unsupported addresses are accepted with --rfc5322."
+ expected = True
+ actual = all (validate_syntax True) unsupported_addresses
email_address_tests :: Test
email_address_tests =
testGroup "EmailAddress Tests" [
test_good_addresses,
+ test_good_addresses_rfc,
test_bad_addresses,
- test_unsupported_addresses ]
+ test_bad_addresses_rfc,
+ test_unsupported_addresses,
+ test_unsupported_addresses_rfc ]
-- | 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 -> Bool -> Address -> IO (Address, Bool)
-validate resolver accept_a address = do
- let valid_syntax = validate_syntax address
+validate :: Resolver -> Bool -> Bool -> Address -> IO (Address, Bool)
+validate resolver accept_a rfc5322 address = do
+ let valid_syntax = validate_syntax rfc5322 address
if valid_syntax then do
let (_,domain) = parts address
mx_result <- validate_mx resolver domain
rs <- makeResolvSeed resolv_conf
withResolver rs $ \resolver -> do
-- Construst a list of [IO (Address, Bool)]
- let actions = map (validate resolver accept_a) nonempty_addresses
+ let validate' = validate resolver accept_a rfc5322
+ let actions = map validate' nonempty_addresses
-- And compute them in parallel.
results <- parallel actions
stopGlobalPool
projects / email-validator.git / commitdiff