From ecd15b8e60f56ea8e4ceb464c0a5e677e5d17376 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 9 Jul 2015 15:00:15 -0400 Subject: [PATCH 1/1] Fix parsing of labels beginning with digits. --- src/Network/DNS/RBL/Domain.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Network/DNS/RBL/Domain.hs b/src/Network/DNS/RBL/Domain.hs index a405ff1..73a6988 100644 --- a/src/Network/DNS/RBL/Domain.hs +++ b/src/Network/DNS/RBL/Domain.hs @@ -15,7 +15,7 @@ -- (octets). -- module Network.DNS.RBL.Domain ( - UserDomain, + UserDomain(..), user_domain ) where @@ -400,7 +400,7 @@ length_ldh_str_let_dig (LdhStrLetDig (Just ldhstring) _) = -- letter or a digit. Host software MUST support this more liberal -- syntax. -- -data Label = Label Letter (Maybe LdhStrLetDig) +data Label = Label LetDig (Maybe LdhStrLetDig) deriving (Eq, Show) instance Pretty Label where @@ -428,7 +428,7 @@ instance Pretty Label where -- Make sure we can parse a single character: -- -- >>> parseTest label "a" --- Label (Letter 'a') Nothing +-- Label (LetDigLetter (Letter 'a')) Nothing -- -- And longer strings: -- @@ -452,9 +452,14 @@ instance Pretty Label where -- >>> pretty_print $ parse label "" (replicate 63 'x') -- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -- +-- Ensure that a label can begin with a digit: +-- +-- >>> pretty_print $ parse label "" "3com" +-- 3com +-- label :: Parser Label label = do - l <- letter -- Guaranteed to be there + l <- let_dig -- Guaranteed to be there maybe_s <- optionMaybe ldh_str_let_dig -- Might not be there case maybe_s of -- It can only be one character long, from the letter... @@ -523,7 +528,7 @@ instance Pretty Subdomain where -- Make sure we can parse a single character: -- -- >>> parseTest subdomain "a" --- SubdomainSingleLabel (Label (Letter 'a') Nothing) +-- SubdomainSingleLabel (Label (LetDigLetter (Letter 'a')) Nothing) -- -- >>> pretty_print $ parse subdomain "" "example.com" -- example.com @@ -654,8 +659,8 @@ instance Pretty Domain where -- -- Make sure we can parse a single character: -- --- >>> parseTest domain "a" --- DomainName (SubdomainSingleLabel (Label (Letter 'a') Nothing)) +-- >>> pretty_print $ parse domain "" "a" +-- a -- -- And the empty domain: -- @@ -665,7 +670,7 @@ instance Pretty Domain where -- We will in fact parse the \"empty\" domain off the front of -- pretty much anything: -- --- >>> parseTest domain "8===D" +-- >>> parseTest domain "!8===D" -- DomainRoot -- -- Equality of domains is case-insensitive: -- 2.43.2