CAA: seems to work.

This commit is contained in:
Philippe PITTOLI 2024-06-08 04:04:26 +02:00
parent bf2da895e0
commit da64f3d2a6
2 changed files with 22 additions and 0 deletions

View File

@ -46,6 +46,9 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "." <> ", current value: " <> show n <> "."
ValidationDNS.VECAAflag min max n -> Bulma.p $ "CAA flag should have a value between " <> show min <> " and " <> show max
<> ", current value: " <> show n <> "."
-- SPF dedicated RR -- SPF dedicated RR
ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
@ -81,6 +84,7 @@ show_error_title v = case v of
ValidationDNS.VEProtocol _ -> "Invalid Protocol" ValidationDNS.VEProtocol _ -> "Invalid Protocol"
ValidationDNS.VEPort _ _ _ -> "Invalid Port" ValidationDNS.VEPort _ _ _ -> "Invalid Port"
ValidationDNS.VEWeight _ _ _ -> "Invalid Weight" ValidationDNS.VEWeight _ _ _ -> "Invalid Weight"
ValidationDNS.VECAAflag _ _ _ -> "Invalid CAA Flag"
-- SPF dedicated RR -- SPF dedicated RR
ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong" ValidationDNS.VESPFMechanismName _ -> "The domain name in a SPF mechanism is wrong"

View File

@ -21,6 +21,7 @@ import GenericParser.RFC5234 as RFC5234
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC import App.Type.DMARC as DMARC
import App.Type.CAA as CAA
-- | **History:** -- | **History:**
-- | The module once used dedicated types for each type of RR. -- | The module once used dedicated types for each type of RR.
@ -55,6 +56,8 @@ data Error
| VEDMARCpct Int Int Int | VEDMARCpct Int Int Int
| VEDMARCri Int Int Int | VEDMARCri Int Int Int
| VECAAflag Int Int Int -- CAA flag should be between 0 and 255 (1 byte).
-- SPF -- SPF
| VESPFMechanismName (G.Error DomainParser.DomainError) | VESPFMechanismName (G.Error DomainParser.DomainError)
| VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error) | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
@ -326,6 +329,20 @@ validationDMARC form =
, name = name, ttl = ttl, target = "" -- `target` is discarded! , name = name, ttl = ttl, target = "" -- `target` is discarded!
, dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } } , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
validationCAA form =
let caa = fromMaybe CAA.emptyCAARR form.caa
in ado
name <- parse DomainParser.sub_eof form.name VEName
ttl <- is_between min_ttl max_ttl form.ttl VETTL
flag <- is_between 0 255 caa.flag VECAAflag
-- TODO: verify the `value` field.
-- No need to validate the target, actually, it will be completely discarded.
-- The different specific entries replace `target` completely.
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, caa = Just $ caa { flag = flag } }
validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation :: ResourceRecord -> Either (Array Error) ResourceRecord
validation entry = case entry.rrtype of validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry "A" -> toEither $ validationA entry
@ -334,6 +351,7 @@ validation entry = case entry.rrtype of
"CNAME" -> toEither $ validationCNAME entry "CNAME" -> toEither $ validationCNAME entry
"NS" -> toEither $ validationNS entry "NS" -> toEither $ validationNS entry
"MX" -> toEither $ validationMX entry "MX" -> toEither $ validationMX entry
"CAA" -> toEither $ validationCAA entry
"SRV" -> toEither $ validationSRV entry "SRV" -> toEither $ validationSRV entry
"SPF" -> toEither $ validationSPF entry "SPF" -> toEither $ validationSPF entry
"DKIM" -> toEither $ validationDKIM entry "DKIM" -> toEither $ validationDKIM entry