From 575ba76c18ffea9ecd97e6dd75e68dc2ea7ae226 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 11 Jul 2025 15:27:27 +0200 Subject: [PATCH] Delegation. --- src/App/Page/Zone.purs | 18 +- src/App/Templates/Modal.purs | 9 +- src/App/Validation/Delegation.purs | 313 +++++++++++++++++++++++++++++ 3 files changed, 334 insertions(+), 6 deletions(-) create mode 100644 src/App/Validation/Delegation.purs diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index f87d496..bf0be9e 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -52,6 +52,7 @@ import App.Type.DMARC as DMARC import App.Type.LogMessage (LogMessage(..)) import App.Message.DNSManagerDaemon as DNSManager import App.Validation.DNS as Validation +import App.Validation.Delegation as ValidationDelegation import App.Type.RRForm (RRForm, RRUpdateValue(..), default_caa, default_rr, mkEmptyRRForm, update_form) @@ -127,6 +128,12 @@ data Action -- | Update a delegation form field (new nameservers for the domain). | UpdateDelegationForm Delegation.Field + -- | Validate the delegation. + | ValidateDelegation + + -- | Save the delegation. + | SaveDelegation + -- | Validate a new resource record before adding it. | ValidateRR AcceptedRRTypes @@ -241,7 +248,7 @@ render state delegation_modal = Modal.delegation_modal state._domain state._delegation_form - UpdateDelegationForm CancelModal + UpdateDelegationForm ValidateDelegation CancelModal render_zone = case state.rr_modal of @@ -432,6 +439,15 @@ handleAction = case _ of -- Modal doesn't need to be active anymore. handleAction CancelModal + -- | Validate the delegation of the domain. + ValidateDelegation -> do + H.raise $ Log $ SystemLog "Validate the delegation" + handleAction $ SaveDelegation + + -- | Save the delegation of the domain. + SaveDelegation -> do + H.raise $ Log $ SystemLog "Save the delegation" + NewToken rr_id -> do { _domain } <- H.get H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id diff --git a/src/App/Templates/Modal.purs b/src/App/Templates/Modal.purs index 4ea3483..400b268 100644 --- a/src/App/Templates/Modal.purs +++ b/src/App/Templates/Modal.purs @@ -52,10 +52,11 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String) zip_nullable txt raw = A.zip txt ([""] <> raw) +type ActionValidate i = i type ActionUpdateDelegationForm i = (Delegation.Field -> i) delegation_modal :: forall w i. - Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionCancelModal i -> HH.HTML w i -delegation_modal selected_domain form action_update_form action_cancel_modal = + Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionValidate i -> ActionCancelModal i -> HH.HTML w i +delegation_modal selected_domain form action_update_form action_validate action_cancel_modal = Web.modal modal_title modal_content modal_foot where modal_title = "Delegation for " <> selected_domain @@ -73,14 +74,12 @@ delegation_modal selected_domain form action_update_form action_cancel_modal = ] modal_foot :: Array (HH.HTML w i) modal_foot = - [ Web.p "should be a button here mdr" - --[ Web.btn_add action_update_form + [ Web.btn_add action_validate , Web.cancel_button action_cancel_modal ] side_text_for_name_input name_id = Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)") - type Domain = String type ActionUpdateForm i = (Field.Field -> i) type ActionNewToken i = (RRId -> i) diff --git a/src/App/Validation/Delegation.purs b/src/App/Validation/Delegation.purs new file mode 100644 index 0000000..2a91215 --- /dev/null +++ b/src/App/Validation/Delegation.purs @@ -0,0 +1,313 @@ +module App.Validation.DNS where + +import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>), (==)) + +import Control.Alt ((<|>)) +import Data.Array as A +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..), maybe, fromMaybe) +import Data.String.CodeUnits as CU +import Data.String as S +import Data.Validation.Semigroup (V, invalid, toEither) + +import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier) +import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR +import GenericParser.SomeParsers as SomeParsers +import GenericParser.Parser as G +import GenericParser.DomainParser.Common (DomainError) as DomainParser +import GenericParser.DomainParser (name, sub_eof) as DomainParser +import GenericParser.IPAddress as IPAddress +import GenericParser.RFC5234 as RFC5234 + +import App.Type.DKIM as DKIM +import App.Type.DMARC as DMARC +import App.Type.CAA as CAA + +import Utils (id) + +data Error + = UNKNOWN + | VENameServer1 (G.Error DomainParser.DomainError) + | VENameServer2 (G.Error DomainParser.DomainError) + +-- | Current default values. +min_ttl = 30 :: Int +max_ttl = 86000 :: Int +max_txt = 500 :: Int +min_priority = 0 :: Int +max_priority = 65535 :: Int +min_port = 0 :: Int +max_port = 65535 :: Int +min_weight = 0 :: Int +max_weight = 65535 :: Int + +-- Functions handling network-related structures (ResourceRecord). + +type RRPriority = Maybe Int +type RRPort = Maybe Int +type RRWeight = Maybe Int +type RRMname = Maybe String +type RRRname = Maybe String +type RRSerial = Maybe Int +type RRRefresh = Maybe Int +type RRRetry = Maybe Int +type RRExpire = Maybe Int +type RRMinttl = Maybe Int + +data TXTError + = TXTInvalidCharacter + | TXTTooLong Int Int -- max current +-- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`). +txt_parser :: G.Parser TXTError String +txt_parser = do pos <- G.current_position + v <- A.many (RFC5234.vchar <|> RFC5234.sp) + e <- G.tryMaybe SomeParsers.eof + pos2 <- G.current_position + case e of + Nothing -> G.errorParser $ Just TXTInvalidCharacter + Just _ -> do + let nbchar = pos2 - pos + if nbchar < max_txt + then pure $ CU.fromCharArray v + else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar) + +-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error. +-- | The actual validation error contains the parser's error including the position. +parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v +parse (G.Parser p) str c = case p { string: str, position: 0 } of + Left x -> invalid $ [c x] + Right x -> pure x.result + +validationA :: ResourceRecord -> V (Array Error) ResourceRecord +validationA form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse IPAddress.ipv4 form.target VEIPv4 + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target + , token = form.token } + +validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord +validationAAAA form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + -- use read_input to get unaltered input (the IPv6 parser expands the input) + target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6 + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target + , token = form.token } + +validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord +validationTXT form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse txt_parser form.target VETXT + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target } + +validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord +validationCNAME form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse DomainParser.sub_eof form.target VECNAME + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } + +validationNS :: ResourceRecord -> V (Array Error) ResourceRecord +validationNS form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse DomainParser.sub_eof form.target VENS + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target } + +is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int +is_between min max n ve = if between min max n + then pure n + else invalid [ve min max n] + +validationMX :: ResourceRecord -> V (Array Error) ResourceRecord +validationMX form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse DomainParser.sub_eof form.target VEMX + priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX" + , name = name, ttl = ttl, target = target, priority = Just priority } + +validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord +validationSRV form = ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + target <- parse DomainParser.sub_eof form.target VESRV + priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority + port <- is_between min_port max_port (maybe 0 id form.port) VEPort + weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight + in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV" + , name = name, ttl = ttl, target = target + , priority = Just priority, port = Just port, protocol = form.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` validates the different values for each mechanism. +-- | A and MX can both either doesn't have a value or a domain name. +-- | EXISTS requires a domain name. +-- | +-- | **What differs from RFC7208**: +-- | Some features of the mechanisms described in RFC7208 are lacking. +-- | For instance, INCLUDE, A, MX, PTR and EXISTS accept domain *specs* not simply domain *names*. +-- | Also, some of them should accept a CIDR, which currently isn't a thing. +-- | +-- | TODO: I don't intend to implement the full RFC7208, but accepting CIDR can be done. +validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism +validate_SPF_mechanism m = case m.t of + -- RFC: `a = "a" [ ":" domain-spec ] [ dual-cidr-length ]` + RR.A -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName + + -- RFC: `mx = "mx" [ ":" domain-spec ] [ dual-cidr-length ]` + RR.MX -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName + + -- RFC: `exists = "exists" ":" domain-spec` + RR.EXISTS -> test DomainParser.sub_eof VESPFMechanismName + + -- RFC: `ptr = "ptr" [ ":" domain-spec ]` + RR.PTR -> test (or_nothing DomainParser.sub_eof) VESPFMechanismName + + -- RFC: `ip4 = "ip4" ":" ip4-network [ ip4-cidr-length ]` + RR.IP4 -> test (IPAddress.ipv4_range <|> IPAddress.ipv4) VESPFMechanismIPv4 + + -- RFC: `ip6 = "ip6" ":" ip6-network [ ip6-cidr-length ]` + RR.IP6 -> test (IPAddress.ipv6_range <|> IPAddress.ipv6) VESPFMechanismIPv6 + + -- RFC: `include = "include" ":" domain-spec` + RR.INCLUDE -> test DomainParser.sub_eof VESPFMechanismName + + where + test :: forall e. G.Parser e String -> ((G.Error e) -> Error) -> V (Array Error) Mechanism + test p e = ado + name <- parse p m.v e + in first m name -- name is discarded + +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.name 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 = Just modifiers, q = form.q } + +-- | Accepted RSA key sizes = 1024, 2048 or 4096 bits, 256 bits for ED25519. +-- | +-- | Since the public key representation for the RSA algorithm is in PKCS format (RFC 5958) +-- | then converted in PEM (RFC 7468), and knowing this format enables some optional parameters, +-- | it is not possible to expect an exact size for the public key input. +-- | Consequently, we expect *at least* an input of 128 bytes for public key, loosely leading +-- | to accept key sizes of at least 1024 bits. Maximum allowed key size is also arbitrary. +rsa_min_key_size = 128 :: Int +rsa_max_key_size = 1000 :: Int + +-- | Contrary to RSA, ED25519 doesn't use a PEM-converted PKCS representation to exchange +-- | public keys, and the key size is 256 bits (32 bytes). +-- | This key is converted directly in base64, leading to a simple 44-byte key representation. +ed25519_key_size = 44 :: Int + +verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array Error) DKIM.PublicKey +verify_public_key signalgo key = case signalgo of + DKIM.RSA -> ado + k <- if between rsa_min_key_size rsa_max_key_size (S.length key) + then pure key + else invalid [DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size] + in k + DKIM.ED25519 -> ado + k <- if S.length key == ed25519_key_size + then pure key + else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size] + in k + +validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord +validationDKIM form = + let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim + in ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + -- TODO: v n + p <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p + -- 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 = "DKIM" + , name = name, ttl = ttl, target = "" -- `target` is discarded! + , dkim = Just $ dkim { p = p } } + +validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord +validationDMARC form = + let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc + in ado + name <- parse DomainParser.name form.name VEName + ttl <- is_between min_ttl max_ttl form.ttl VETTL + pct <- is_between 0 100 (fromMaybe 100 dmarc.pct) VEDMARCpct + ri <- is_between 0 1000000 (fromMaybe 86400 dmarc.ri) VEDMARCri + -- 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 = "DMARC" + , name = name, ttl = ttl, target = "" -- `target` is discarded! + , 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.name 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` provides a way to validate the content of a RR. +validation :: ResourceRecord -> Either (Array Error) ResourceRecord +validation entry = case entry.rrtype of + "A" -> toEither $ validationA entry + "AAAA" -> toEither $ validationAAAA entry + "TXT" -> toEither $ validationTXT entry + "CNAME" -> toEither $ validationCNAME entry + "NS" -> toEither $ validationNS entry + "MX" -> toEither $ validationMX entry + "CAA" -> toEither $ validationCAA entry + "SRV" -> toEither $ validationSRV entry + "SPF" -> toEither $ validationSPF entry + "DKIM" -> toEither $ validationDKIM entry + "DMARC" -> toEither $ validationDMARC entry + _ -> toEither $ invalid [UNKNOWN]