WIP: DKIM: verify the key length.
This commit is contained in:
parent
462351f32f
commit
1c080cc948
@ -1,7 +1,9 @@
|
|||||||
-- | This module provides functions to display errors in a fancy way.
|
-- | This module provides functions to display errors in a fancy way.
|
||||||
module App.DisplayErrors where
|
module App.DisplayErrors where
|
||||||
|
|
||||||
import Prelude (show, ($), (<>))
|
import Prelude (show, ($), (<>), map, (<<<), (*))
|
||||||
|
|
||||||
|
import Data.Array as A
|
||||||
|
|
||||||
-- import Data.Foldable as Foldable
|
-- import Data.Foldable as Foldable
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
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.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
|
||||||
ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 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.VESPFModifierName err -> maybe default_error show_error_domain err.error
|
||||||
|
|
||||||
|
ValidationDNS.DKIMInvalidKeySize err -> show_error_key_sizes err
|
||||||
)
|
)
|
||||||
where default_error = Bulma.p ""
|
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` 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 :: ValidationDNS.Error -> String
|
||||||
show_error_title v = case v of
|
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.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.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 :: forall w i. DomainParser.DomainError -> HH.HTML w i
|
||||||
show_error_domain e = case e of
|
show_error_domain e = case e of
|
||||||
|
@ -1,12 +1,13 @@
|
|||||||
module App.Validation.DNS where
|
module App.Validation.DNS where
|
||||||
|
|
||||||
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>))
|
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>), (<$>))
|
||||||
|
|
||||||
import Control.Alt ((<|>))
|
import Control.Alt ((<|>))
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), maybe, fromMaybe)
|
||||||
import Data.String.CodeUnits as CU
|
import Data.String.CodeUnits as CU
|
||||||
|
import Data.String as S
|
||||||
import Data.Validation.Semigroup (V, invalid, toEither)
|
import Data.Validation.Semigroup (V, invalid, toEither)
|
||||||
|
|
||||||
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier)
|
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.IPAddress as IPAddress
|
||||||
import GenericParser.RFC5234 as RFC5234
|
import GenericParser.RFC5234 as RFC5234
|
||||||
|
|
||||||
|
import App.DKIM as DKIM
|
||||||
|
|
||||||
-- | **History:**
|
-- | **History:**
|
||||||
-- | The module once used dedicated types for each type of RR.
|
-- | The module once used dedicated types for each type of RR.
|
||||||
-- | That comes with several advantages.
|
-- | That comes with several advantages.
|
||||||
@ -56,6 +59,8 @@ data Error
|
|||||||
|
|
||||||
| VESPFModifierName (G.Error DomainParser.DomainError)
|
| VESPFModifierName (G.Error DomainParser.DomainError)
|
||||||
|
|
||||||
|
| DKIMInvalidKeySize (Array Int)
|
||||||
|
|
||||||
type AVErrors = Array Error
|
type AVErrors = Array Error
|
||||||
|
|
||||||
-- | Current default values.
|
-- | Current default values.
|
||||||
@ -260,17 +265,30 @@ validationSPF form = ado
|
|||||||
, v = form.v, mechanisms = Just mechanisms
|
, v = form.v, mechanisms = Just mechanisms
|
||||||
, modifiers = Just modifiers, q = form.q }
|
, modifiers = Just modifiers, q = form.q }
|
||||||
|
|
||||||
--validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
|
-- | Accepted RSA key sizes = 2048 or 4096 bits, meaning 256 or 512 characters.
|
||||||
--validationDKIM form = ado
|
accepted_rsa_key_sizes = [256, 512] :: Array Int
|
||||||
-- name <- parse DomainParser.sub_eof form.name VEName
|
|
||||||
-- ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array Error) DKIM.PublicKey
|
||||||
-- mechanisms <- verification_loop validate_DKIM_mechanism (maybe [] id form.mechanisms)
|
verify_public_key signalgo key = case signalgo of
|
||||||
-- -- No need to validate the target, actually, it will be completely discarded.
|
DKIM.RSA -> ado
|
||||||
-- -- The different specific entries replace `target` completely.
|
k <- if A.elem (S.length key) accepted_rsa_key_sizes
|
||||||
-- in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
|
then pure key
|
||||||
-- , name = name, ttl = ttl, target = "" -- `target` is discarded!
|
else invalid [DKIMInvalidKeySize accepted_rsa_key_sizes]
|
||||||
-- , v = form.v, mechanisms = Just mechanisms
|
in k
|
||||||
-- , modifiers = form.modifiers, q = form.q }
|
|
||||||
|
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 :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||||
validation entry = case entry.rrtype of
|
validation entry = case entry.rrtype of
|
||||||
@ -282,7 +300,7 @@ validation entry = case entry.rrtype of
|
|||||||
"MX" -> toEither $ validationMX entry
|
"MX" -> toEither $ validationMX 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
|
||||||
_ -> toEither $ invalid [UNKNOWN]
|
_ -> toEither $ invalid [UNKNOWN]
|
||||||
|
|
||||||
id :: forall a. a -> a
|
id :: forall a. a -> a
|
||||||
|
Loading…
Reference in New Issue
Block a user