From bf5efccca7f76107753ef0794a23b13ccc2fa6b5 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 7 Mar 2024 02:35:59 +0100
Subject: [PATCH] SPF: verify the domain names of modifiers.

---
 src/App/DisplayErrors.purs  |  5 ++++-
 src/App/Validation/DNS.purs | 14 +++++++++++++-
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs
index 819d3c9..6eac1ff 100644
--- a/src/App/DisplayErrors.purs
+++ b/src/App/DisplayErrors.purs
@@ -39,6 +39,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
       ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
       ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
       ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
+      ValidationDNS.VESPFModifierName  err -> maybe default_error show_error_domain err.error
   )
   where default_error = Bulma.p ""
 
@@ -61,10 +62,12 @@ show_error_title v = case v of
   ValidationDNS.VEWeight min max n   -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
 
   -- SPF dedicated RR
-  ValidationDNS.VESPFMechanismName err -> "The name (domain label) in a SPF mechanism is wrong (position: " <> show err.position <> ")"
+  ValidationDNS.VESPFMechanismName err -> "The domain name in a SPF mechanism is wrong (position: " <> show err.position <> ")"
   ValidationDNS.VESPFMechanismIPv4 err -> "The IPv4 address in a SPF mechanism is wrong (position: "        <> show err.position <> ")"
   ValidationDNS.VESPFMechanismIPv6 err -> "The IPv6 address in a SPF mechanism is wrong (position: "        <> show err.position <> ")"
 
+  ValidationDNS.VESPFModifierName err -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong (position: " <> show err.position <> ")"
+
 show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
 show_error_domain e = case e of
   DomainParser.LabelTooLarge size ->
diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs
index 29cd776..7c05bf7 100644
--- a/src/App/Validation/DNS.purs
+++ b/src/App/Validation/DNS.purs
@@ -54,6 +54,8 @@ data Error
   | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
   | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
 
+  | VESPFModifierName (G.Error DomainParser.DomainError)
+
 type AVErrors = Array Error
 
 -- | Current default values.
@@ -213,17 +215,27 @@ validate_SPF_mechanism m = case m.t of
     in first m name -- name is discarded
   _ -> pure m
 
+validate_SPF_modifier :: Modifier -> V (Array Error) Modifier
+validate_SPF_modifier m = case m.t of
+  RR.EXP -> ado
+    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+    in first m name -- name is discarded
+  RR.REDIRECT -> ado
+    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+    in first m name -- name is discarded
+
 validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
 validationSPF form = ado
   name     <- parse DomainParser.sub_eof form.name     VEName
   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
   mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
+  modifiers  <- verification_loop validate_SPF_modifier  (maybe [] id form.modifiers)
   -- 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 = "SPF"
              , name = name, ttl = ttl, target = "" -- `target` is discarded!
              , v = form.v, mechanisms = Just mechanisms
-             , modifiers = form.modifiers, q = form.q }
+             , modifiers = Just modifiers, q = form.q }
 
 --validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
 --validationDKIM form = ado