From 601325a54bb7e44674bfea2c875ab8cfc2864311 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 28 Apr 2025 02:24:10 +0200 Subject: [PATCH] Fix wildcard parsing. --- src/GenericParser.purs | 3 ++- src/GenericParser/DomainParser.purs | 30 +++++++++++++++++----- src/GenericParser/DomainParserRFC1035.purs | 30 +++++++++++++++++----- test/Main.purs | 4 +++ test/TestValues.purs | 2 ++ 5 files changed, 56 insertions(+), 13 deletions(-) diff --git a/src/GenericParser.purs b/src/GenericParser.purs index a72e891..f6502f2 100644 --- a/src/GenericParser.purs +++ b/src/GenericParser.purs @@ -7,7 +7,8 @@ module GenericParser ) where import GenericParser.DomainParser.Common (DomainError(..), ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size) -import GenericParser.DomainParser (domain, label, subdomain, sub_eof) +import GenericParser.DomainParser (domain, domain', label, name, subdomain, sub_eof, wildcard, wildcard_eof) +-- import GenericParser.DomainParserRFC1035 (domain, domain', label, name, subdomain, sub_eof, wildcard, wildcard_eof) import GenericParser.Parser (char, current_input, current_position, Error, errorParser, error_functor, failure, failureError, Input, item, lookahead, many1, parse, parse_last_char, Parser(..), Position, PositionString, Result, rollback, sat, string, success, try, tryMaybe, until, Value) import GenericParser.RFC5322 (obs_fws, fws, ctext, quoted_pair, ccontent, comment, cfws, address, mailbox, name_addr, angle_addr, group, display_name, mailbox_list, address_list, group_list, atext, atom, dot_atom_text, dot_atom, specials, addr_spec, local_part, {- domain ,-} domain_literal, dtext, obs_angle_addr, obs_route, obs_domain_list, obs_mbox_list, obs_addr_list, obs_group_list, obs_local_part, obs_domain, obs_dtext, obs_no_ws_ctl, obs_ctext, obs_qtext, obs_utext, obs_qp, obs_body, obs_unstruct, obs_phrase, word, phrase, unstructured, obs_phrase_list, qtext, qcontent, quoted_string) -- import GenericParser.RFC5234 diff --git a/src/GenericParser/DomainParser.purs b/src/GenericParser/DomainParser.purs index 3b17f47..2245bd9 100644 --- a/src/GenericParser/DomainParser.purs +++ b/src/GenericParser/DomainParser.purs @@ -71,6 +71,24 @@ sub_eof = do did_we_parse_the_final_point Nothing sub = sub did_we_parse_the_final_point _ sub = sub <> "." +-- | Wildcard ("*") parser: ::= "*." subdomain +wildcard :: Parser DomainError String +wildcard = do + _ <- string "*." + rest <- sub_eof + pure $ "*." <> rest + +-- | Wildcard only ("*") parser: ::= "*" (nothing should follow) +wildcard_eof :: Parser DomainError String +wildcard_eof = do + _ <- string "*" + _ <- eof -- In case there is still some input, it fails. + pure "*" + +-- | `name` provides an easy-to-use validation for the "name" attribute of resource records. +name :: Parser DomainError String +name = wildcard <|> wildcard_eof <|> sub_eof + -- | From RFC 1035: ::= | " " -- | -- | Since RFC 1034 requires to accept '*' as leftmost domain label, the rule should be: @@ -85,9 +103,9 @@ sub_eof = do -- | For documentation about wildcards, see RFC 4592. domain :: Parser DomainError String domain = (string " " *> eof) <|> wildcard <|> sub_eof - where - wildcard :: Parser DomainError String - wildcard = do - _ <- string "*." - rest <- sub_eof - pure $ "*." <> rest + +-- | `domain'` is as `domain` but doesn't accept empty domains (" "). +-- | +-- | ::= | "*." +domain' :: Parser DomainError String +domain' = wildcard <|> sub_eof diff --git a/src/GenericParser/DomainParserRFC1035.purs b/src/GenericParser/DomainParserRFC1035.purs index 5556902..830a119 100644 --- a/src/GenericParser/DomainParserRFC1035.purs +++ b/src/GenericParser/DomainParserRFC1035.purs @@ -77,6 +77,24 @@ sub_eof = do then Parser \_ -> failureError pos (Just <<< DomainTooLarge $ S.length sub) else pure sub +-- | Wildcard ("*") parser: ::= "*." subdomain +wildcard :: Parser DomainError String +wildcard = do + _ <- string "*." + rest <- sub_eof + pure $ "*." <> rest + +-- | Wildcard only ("*") parser: ::= "*" (nothing should follow) +wildcard_eof :: Parser DomainError String +wildcard_eof = do + _ <- string "*" + _ <- eof -- In case there is still some input, it fails. + pure "*" + +-- | `name` provides an easy-to-use validation for the "name" attribute of resource records. +name :: Parser DomainError String +name = wildcard <|> wildcard_eof <|> sub_eof + -- | From RFC 1035: ::= | " " -- | -- | Since RFC 1034 requires to accept '*' as leftmost domain label, the rule should be: @@ -91,9 +109,9 @@ sub_eof = do -- | For documentation about wildcards, see RFC 4592. domain :: Parser DomainError String domain = (string " " *> eof) <|> wildcard <|> sub_eof - where - wildcard :: Parser DomainError String - wildcard = do - _ <- string "*." - rest <- sub_eof - pure $ "*." <> rest + +-- | `domain'` is as `domain` but doesn't accept empty domains (" "). +-- | +-- | ::= | "*." +domain' :: Parser DomainError String +domain' = wildcard <|> sub_eof diff --git a/test/Main.purs b/test/Main.purs index 3ce615b..b03b6a6 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -94,8 +94,12 @@ main = do log "" test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror T.domains log "" + test_series "RFC1035.name" RFC1035.name id showerror T.domains + log "" test_series "RFC1035.domain" RFC1035.domain id showerror T.domains log "" + test_series "ModernDomains.name" ModernDomains.name id showerror T.domains + log "" test_series "ModernDomains.domain" ModernDomains.domain id showerror T.domains log "" diff --git a/test/TestValues.purs b/test/TestValues.purs index 87a26da..7937209 100644 --- a/test/TestValues.purs +++ b/test/TestValues.purs @@ -16,6 +16,8 @@ domains , "xblah.a33.org" , "_dmarc.example.com" , "*.example.com" + , "*." + , "*" ] ipv4_addresses :: Array String