From 6178d60faa3688cbccc5a71bfbb341e92810eaea Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 5 Mar 2024 04:33:51 +0100 Subject: [PATCH] WIP: SPF verifications. --- src/App/DisplayErrors.purs | 10 +++++++ src/App/Validation/DNS.purs | 55 ++++++++++++++++++++++++++++++++++--- src/App/ZoneInterface.purs | 4 +++ 3 files changed, 65 insertions(+), 4 deletions(-) diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index 4558c18..c8118f1 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -34,6 +34,11 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) <> ", current value: " <> show n <> "." ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max <> ", current value: " <> show n <> "." + + -- SPF dedicated RR + 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 ) where default_error = Bulma.p "" @@ -55,6 +60,11 @@ show_error_title v = case v of ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" 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.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 <> ")" + 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 475c466..c156a81 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -1,6 +1,6 @@ module App.Validation.DNS where -import Prelude (apply, between, bind, map, pure, ($), (-), (<)) +import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<$>), (<>)) import Control.Alt ((<|>)) import Data.Array as A @@ -9,7 +9,8 @@ import Data.Maybe (Maybe(..), maybe) import Data.String.CodeUnits as CU import Data.Validation.Semigroup (V, invalid, toEither) -import App.ResourceRecord (ResourceRecord, emptyRR) +import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier) +import App.ResourceRecord (MechanismType(..), ModifierType(..)) as RR import GenericParser.SomeParsers as SomeParsers import GenericParser.Parser as G import GenericParser.DomainParser.Common (DomainError) as DomainParser @@ -48,6 +49,11 @@ data Error | VEPort Int Int Int | VEWeight Int Int Int + -- SPF + | VESPFMechanismName (G.Error DomainParser.DomainError) + | VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error) + | VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error) + type AVErrors = Array Error -- | Current default values. @@ -178,13 +184,54 @@ validationSRV form = ado , name = name, ttl = ttl, target = target , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight } +-- My version of "map" lol. +verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a) +verification_loop _ [] = pure [] +verification_loop f arr = + case A.head arr, A.tail arr of + Nothing, _ -> pure [] + Just value, tail -> ado + v <- f value + following <- verification_loop f $ maybe [] id tail + in [v] <> following + +first :: forall a b. a -> b -> a +first a _ = a + +or_nothing :: forall e. G.Parser e String -> G.Parser e String +or_nothing p = do v <- G.tryMaybe p + e <- G.tryMaybe SomeParsers.eof + case v, e of + Just value, _ -> pure value + _, Just _ -> pure "" + Nothing, Nothing -> p -- at least give the right error results + +validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism +validate_SPF_mechanism m = case m.t of + RR.A -> ado + name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName + in first m name -- name is discarded + RR.MX -> ado + name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName + in first m name -- name is discarded + RR.IP4 -> ado + name <- parse IPAddress.ipv4 m.v VESPFMechanismIPv4 + in first m name -- name is discarded + RR.IP6 -> ado + name <- parse IPAddress.ipv6 m.v VESPFMechanismIPv6 + in first m name -- name is discarded + _ -> pure m + 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) + -- 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 = "" - , v = form.v, mechanisms = maybe (Just []) Just form.mechanisms + , name = name, ttl = ttl, target = "" -- `target` is discarded! + , v = form.v, mechanisms = Just mechanisms , modifiers = form.modifiers, q = form.q } validation :: ResourceRecord -> Either (Array Error) ResourceRecord diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 7a8991e..5bc70c6 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -158,10 +158,14 @@ data Action | SPF_Modifier_v String | SPF_Qualifier Int + -- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`). | SPF_remove_mechanism Int + -- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`). | SPF_remove_modifier Int + -- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`). | SPF_Mechanism_Add + -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`). | SPF_Modifier_Add data RRModal