From 1c080cc948230847354b63379d73cbdbede79497 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 11 Mar 2024 03:11:28 +0100 Subject: [PATCH] WIP: DKIM: verify the key length. --- src/App/DisplayErrors.purs | 12 +++++++++- src/App/Validation/DNS.purs | 46 ++++++++++++++++++++++++++----------- 2 files changed, 43 insertions(+), 15 deletions(-) diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index 6eac1ff..0f6ddd7 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -1,7 +1,9 @@ -- | This module provides functions to display errors in a fancy way. module App.DisplayErrors where -import Prelude (show, ($), (<>)) +import Prelude (show, ($), (<>), map, (<<<), (*)) + +import Data.Array as A -- import Data.Foldable as Foldable import Data.Maybe (Maybe(..), maybe) @@ -40,9 +42,16 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) 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 + + ValidationDNS.DKIMInvalidKeySize err -> show_error_key_sizes err ) where default_error = Bulma.p "" +show_error_key_sizes :: forall w i. Array Int -> HH.HTML w i +show_error_key_sizes arr + = Bulma.p $ "Chosen signature algorithm only accepts those key sizes (in bits): [" + <> (A.fold $ A.intersperse ", " $ map (show <<< (8*_)) arr) <> "]" + -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. show_error_title :: ValidationDNS.Error -> String show_error_title v = case v of @@ -67,6 +76,7 @@ show_error_title v = case v of 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 <> ")" + ValidationDNS.DKIMInvalidKeySize _ -> "Public key has an invalid length." show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i show_error_domain e = case e of diff --git a/src/App/Validation/DNS.purs b/src/App/Validation/DNS.purs index 8dd661a..c1585d8 100644 --- a/src/App/Validation/DNS.purs +++ b/src/App/Validation/DNS.purs @@ -1,12 +1,13 @@ 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 import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), maybe) +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.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier) @@ -18,6 +19,8 @@ import GenericParser.DomainParser (sub_eof) as DomainParser import GenericParser.IPAddress as IPAddress import GenericParser.RFC5234 as RFC5234 +import App.DKIM as DKIM + -- | **History:** -- | The module once used dedicated types for each type of RR. -- | That comes with several advantages. @@ -56,6 +59,8 @@ data Error | VESPFModifierName (G.Error DomainParser.DomainError) + | DKIMInvalidKeySize (Array Int) + type AVErrors = Array Error -- | Current default values. @@ -260,17 +265,30 @@ validationSPF form = ado , v = form.v, mechanisms = Just mechanisms , modifiers = Just modifiers, q = form.q } ---validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord ---validationDKIM form = ado --- name <- parse DomainParser.sub_eof form.name VEName --- ttl <- is_between min_ttl max_ttl form.ttl VETTL --- mechanisms <- verification_loop validate_DKIM_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 = "DKIM" --- , name = name, ttl = ttl, target = "" -- `target` is discarded! --- , v = form.v, mechanisms = Just mechanisms --- , modifiers = form.modifiers, q = form.q } +-- | Accepted RSA key sizes = 2048 or 4096 bits, meaning 256 or 512 characters. +accepted_rsa_key_sizes = [256, 512] :: Array 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 A.elem (S.length key) accepted_rsa_key_sizes + then pure key + else invalid [DKIMInvalidKeySize accepted_rsa_key_sizes] + in k + +validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord +validationDKIM form = + let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim + in ado + name <- parse DomainParser.sub_eof 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 } } validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation entry = case entry.rrtype of @@ -282,7 +300,7 @@ validation entry = case entry.rrtype of "MX" -> toEither $ validationMX entry "SRV" -> toEither $ validationSRV entry "SPF" -> toEither $ validationSPF entry - --"DKIM" -> toEither $ validationDKIM entry + "DKIM" -> toEither $ validationDKIM entry _ -> toEither $ invalid [UNKNOWN] id :: forall a. a -> a