Shuffle around some tests.
Disable the domain-with-underscore test pending an upstream fix.
Add the new option to the man page.
Document how to adjust the number of threads.
-\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
.P
These checks are performed in parallel using the number of available
.P
These checks are performed in parallel using the number of available
+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
Specify the output file to which the good addresses will be written,
rather than using stdout (the default).
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.
+
cmdargs == 0.10.*,
directory == 1.2.*,
dns == 0.3.*,
cmdargs == 0.10.*,
directory == 1.2.*,
dns == 0.3.*,
HUnit == 1.2.*,
parallel-io == 0.3.*,
pcre-light >= 0.4,
HUnit == 1.2.*,
parallel-io == 0.3.*,
pcre-light >= 0.4,
cmdargs == 0.10.*,
directory == 1.2.*,
dns == 0.3.*,
cmdargs == 0.10.*,
directory == 1.2.*,
dns == 0.3.*,
HUnit == 1.2.*,
parallel-io == 0.3.*,
pcre-light >= 0.4,
HUnit == 1.2.*,
parallel-io == 0.3.*,
pcre-light >= 0.4,
-- stdin/stdout.
data Args = Args { accept_a :: Bool,
input_file :: Maybe FilePath,
-- 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
deriving (Show, Data, Typeable)
description :: String
output_file_help =
"Path to the output file (default: stdout)"
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,
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]
&= program program_name
&= summary my_summary
&= details [description]
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BSU
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)
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
-- | 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
bad_addresses :: [Address]
bad_addresses =
map BSU.fromString [
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",
"(fail)@domain.com",
"no spaces@domain.com",
".beginswith@a-dot.com",
"ok|char@domain.com",
"ok}char@domain.com",
"ok~char@domain.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 =
test_good_addresses :: Test
test_good_addresses =
where
desc = "Good addresses are accepted."
expected = True
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 =
test_bad_addresses :: Test
test_bad_addresses =
where
desc = "Bad addresses are not accepted."
expected = True
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 =
test_unsupported_addresses :: Test
test_unsupported_addresses =
where
desc = "Unsupported addresses are not accepted."
expected = True
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,
email_address_tests :: Test
email_address_tests =
testGroup "EmailAddress Tests" [
test_good_addresses,
+ test_good_addresses_rfc,
- 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 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
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)]
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
-- And compute them in parallel.
results <- parallel actions
stopGlobalPool
projects / email-validator.git / commitdiff