Email address validation: Simpler, Faster, More Correct

Porges — Wed, 11 Mar 2009 11:10:31 +0000

So, I have merged the obsolete-syntax into the code from the last post. This has resulted in shorter, cleaner, faster validation which is also more correct.

I didn’t like the fact that in the old code there were places where explicit try points needed to be included. It seems that these arose because the ‘obsolete’ syntax was tacked-on to the EBNF for the normal syntax, creating much overlap. Since I merged the syntaxes together, there are no explicit try points needed (there are some implicit ones, I believe, such as in optional). This makes the code both faster and easier to understand.

module Text.Email.Validation (isValid)
where
 
import Text.Parsec
import Text.Parsec.Char
import Data.Char (chr)
 
isValid :: String -> Bool
isValid x = 	either (const False) (const True) (valid x)
 
simply = (>> return ())
-- simply converts a parser returning something to a parser returning nothing
 
valid :: String -> Either ParseError ()
valid = parse addrSpec ""
 
addrSpec = localPart >> char '@' >> domain >> eof
 
localPart = dottedAtoms
domain = dottedAtoms <|> domainLiteral 
 
dottedAtoms = simply $ (optional cfws >> (atom <|> quotedString) >> optional cfws)
	`sepBy1` (char '.')
atom = simply $ many1 atomText
atomText = simply $ alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~"
 
domainLiteral =  between (optional cfws >> char '[') (char ']' >> optional cfws) $
	many (optional fws >> domainText) >> optional fws
domainText = ranges [[33..90],[94..126]] <|> obsNoWsCtl
 
quotedString = between (char '"') (char '"') $
	many (optional fws >> quotedContent) >> optional fws
quotedContent = quotedText <|> quotedPair
quotedText = ranges [[33],[35..91],[93..126]] <|> obsNoWsCtl
quotedPair = char '\\' >> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar)
 
cfws = simply $ many (comment <|> fws)
fws = (many1 wsp >> optional (crlf >> many1 wsp))
	<|> (many1 (crlf >> many1 wsp) >> return ())
 
comment = simply $ between (char '(') (char ')') $
	many (commentContent <|> fws)
commentContent = commentText <|> quotedPair <|> comment
commentText = ranges [[33..39],[42..91],[93..126]] <|> obsNoWsCtl
 
nullChar = simply $ char '\0'
wsp = simply $ oneOf " \t"
cr = simply $ char '\r'
lf = simply $ char '\n'
crlf = simply $ cr >> lf
vchar = ranges [[0x21..0x7e]]
obsNoWsCtl = ranges [[1..8],[11,12],[14..31],[127]]
ranges = simply . oneOf . map chr . concat

This now passes all of Dominic Sayer’s tests that it is meant to—the domain validation used in Dominic Sayer’s tests is more strict than RFC5322 specifies. Expect this to change!

For those who’d like to know, email addresses that now parse that didn’t before include the often-used (‘|’ is merely to indicate the end of whitespace):

I.                        |
 am.                  |
 a.      |
 nice.|
 guy@(yeah)you.com

Properly validating e-mail addresses (or converting EBNF to Parsec)

Porges — Sun, 08 Mar 2009 12:49:52 +0000

Update: See the better code in the next post.

In recent times there have been several calls for websites to properly validate email addresses. Invariably, the compiled regex from Perl’s RFC822 is pasted up as The Way To Do It. The problem with this is (as the source code from the Perl module notes) is that email addresses cannot be validated by a simple regex (due to requiring parenthesis-matching). The Perl code addresses this by first stripping out all comments and then parsing via regex.

With this in mind, I thought that implementing the Addr-Spec specification from RFC 5322 (only released less than 6 months ago) might be a good test of the Haskell library Parsec. So, without further ado I went ahead and translated the EBNF from RFC 5322 directly into Parsec.

The mapping is something like this:

juxtaposition: >>
/: <|>
*: many
1*: many1
[]: optional

Here is the result:

import Text.Parsec
import Text.Parsec.Char
import Data.Char (chr)
 
isValid :: String -> Bool
isValid x = let result = valid x in
	either (const False) (const True) result
 
valid :: String -> Either ParseError ()
valid x = parse addrSpec "" x
 
ignore x = x >> return ()
 
addrSpec = localPart >> char '@' >> domain >> eof
 
localPart = dotAtom <|> quotedString <|> obsLocalPart  "local part"
domain = dotAtom <|> domainLiteral <|> obsDomain  "domain"
 
domainLiteral = optional cfws >> char '[' >>
		many ( optional fws >> dtext) >>
		optional fws  >> char ']' >> optional cfws
		 "domain literal"
 
ranges = oneOf . map chr . concat
vchar = ranges [[0x21..0x7E]] -- from Backus-Naur RFC
dtext = ranges [[33..90],[94..126]] <|> obsDtext
qtext = ranges [[33],[35..91],[93..126]] <|> obsQtext
atext = alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~"
ctext = ranges [[33..39],[42..91],[93..126]] <|> obsCtext
wsp = char ' '
	<|> char '\t'
	 "space or tab"
 
cr = char '\r'  "carriage return"
lf = char '\n'  "line feed"
crlf = cr >> lf  "CRLF line ending"
 
-- # modification: added try
cfws = try (many1 (optional fws >> comment) >> optional fws) <|> ignore fws
-- # modification from RFC: adding try because of overlap
fws = try (optional (many wsp >> crlf) >> many1 wsp)
	<|> many1 wsp
	<|> obsFws
 
-- # modification: added try
comment = between (char '(') (char ')') (many (try (optional fws >> ccontent)) >> optional fws)
	 "comment"
ccontent = ignore ctext
	<|> ignore quotedPair
	<|> comment
 
atom = optional cfws >> many1 atext >> optional cfws
dotAtomText = many1 atext >> many (char '.' >> many1 atext)
dotAtom = optional cfws >> dotAtomText >> optional cfws
 
-- # other change from RFC -- merge prefix
quotedPair = char '\\' >> ((vchar <|> wsp) <|> obsQp)
qcontent = qtext <|> quotedPair
quotedString = optional cfws >>	char '\"' >> many (optional fws >> qcontent) >>
	optional fws >>	char '\"' >> optional cfws
	 "quoted string"
 
-- # Obsolete syntax
obsNoWsCtl = ranges [[1..8],[11..12],[14..31],[127]]
obsCtext = obsNoWsCtl
obsDtext = obsNoWsCtl <|> quotedPair
obsQtext = obsNoWsCtl
-- # change: see above
obsQp = (char (chr 0) <|> obsNoWsCtl <|> lf <|> cr)
obsLocalPart = word >> many (char '.' >> word) >> return ()
obsDomain = atom >> many (char '.' >> atom) >> return ()
obsFws = many1 wsp >> many (crlf >> many1 wsp) >> return []
word = atom <|> quotedString

A note before I continue: since Parsec by default does no backtracking (in order to remain efficient), there are a couple of places (two that I’ve found so far) where the original EBNF needs to be changed slightly. I have noted these in the source above. It is possible there are a couple more places that need fixing, but I haven’t run this against a large test suite yet to find them. (They are most likely to be in the ‘obsolete syntax’ section.)

And of course, some demonstrations (keep in mind that there is an extra level of escaping operating here… where relevant I’ve included the unescaped email address in a comment):

isValid "porges@example.com" == True
isValid "porges@@example.com" == False
isValid "\"porges@\"@example.com" == True -- # "porges@"@porg.es
isValid "\"por(g)es@\"@example.com" == True -- # "por(g)es@"@porg.es
isValid "porges(comment)@example.com" == True
isValid "porges(comme(nests)nt)@example.com" == True
isValid "porges(comme(nests)nt())@example.com" == True
isValid "porges(()comme(nests)nt())@example.com" == True
isValid "()porges(()comme(nests)nt())@example.com" == True
isValid "((lol)porges(()comme(nests)nt())@example.com" == False
isValid "((lol))porges(()comme(nests)nt())@example.com" == True
isValid "(lol))porges(()comme(nests)nt())@example.com" == False
isValid "((lol))porges(()comme(nests)nt())@example.com" == True
isValid "\"s\\\0\"@example.com" == True
-- # "s\NUL"@example.com, where NUL is actually the
-- # null character! Yep, can't strlen() on email addresses...

I managed to find this post on email addresses by Phil Haack which has the following tests:

[("\"Abc\\@def\"@example.com",True),
("\"Fred Bloggs\"@example.com",True),
("\"Joe\\Blow\"@example.com",True),
("\"Abc@def\"@example.com",True),
("customer/department=shipping@example.com",True),
("$A12345@example.com",True),
("!def!xyz%abc@example.com",True),
("_somename@example.com",True),
("NotAnEmail",False),
("@NotAnEmail",False),
("\"test\\\\blah\"@example.com",True),
("\"test\\blah\"@example.com",True),
-- # Phil gets false for this, which I think is wrong
-- # (Dominic Sayers notes the same at the end of the comment thread)
("\"test\\\rblah\"@example.com",True),
("\"test\rblah\"@example.com",False),
("\"test\\\"blah\"@example.com",True),
("\"test\"blah\"@example.com",False),
("customer/department@example.com",True),
("$A12345@example.com",True),
("!def!xyz%abc@example.com",True),
("_Yosemite.Sam@example.com",True),
("~@example.com",True),
(".wooly@example.com",False),
("wo..oly@example.com",False),
("pootietang.@example.com",False),
(".@example.com",False),
("\"Austin@Powers\"@example.com",True),
("Ima.Fool@example.com",True),
("\"Ima.Fool\"@example.com",False),
("\"Ima Fool\"@example.com",False),
("Ima Fool@example.com",False)]

Next job is to test it against this batch…

Update: Yep, fails in several areas with the obsolete syntax. I’ve fixed one above. (Note that I’m not concerned with the failures in the domain part of the address, as the RFC5322 EBNF for this is more liberal than the tests require.)

Might have to refactor the syntax… there is a large overlap with the obsolete syntax. (Or just use ‘try’, but that’s not so efficient.)

porges » validation

Email address validation: Simpler, Faster, More Correct

Properly validating e-mail addresses (or converting EBNF to Parsec)