Delegation.
This commit is contained in:
parent
32aba841f4
commit
575ba76c18
3 changed files with 334 additions and 6 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
313
src/App/Validation/Delegation.purs
Normal file
313
src/App/Validation/Delegation.purs
Normal file
|
|
@ -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]
|
||||
Loading…
Add table
Reference in a new issue