karchnu
/
halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

WIP: DKIM.

dev
Philippe Pittoli 2024-03-06 13:29:15 +01:00
parent 6178d60faa
commit ca34673de4
4 changed files with 74 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/App/ResourceRecord.purs
View File

@ -8,6 +8,13 @@ import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR
type PubKey = String
type CryptoHash = String
type Signature = String
type Algorithm = String
type Selector = String
type Time = Int
type ResourceRecord
= { rrtype :: String
, rrid :: Int
@ -34,15 +41,40 @@ type ResourceRecord
, minttl :: Maybe Int
-- SPF specific entries.
, v :: Maybe String -- Default: spf1
, v :: Maybe String -- Default: spf1
, mechanisms :: Maybe (Array Mechanism)
, modifiers :: Maybe (Array Modifier)
, q :: Maybe Qualifier -- Qualifier for default mechanism (`all`).
-- TODO: DKIM specific entries.
-- DKIM is so complex, it deserves its own type.
--, dkim :: Maybe DKIM
-- TODO: DMARC specific entries.
}
-- DKIM specific entries.
type DKIM
= { v :: Maybe Int -- Default: 1
, a :: Maybe Algorithm -- TODO: (required), signing algorithm (example: `rsa-sha256`)
, d :: Maybe String -- TODO: (required), Signing Domain Identifier (SDID) (example: `netlib.re`)
, s :: Maybe Selector -- TODO: (required), selector (name of the DNS TXT entry for DKIM, such as `baguette` for `_baguette._dkim.netlib.re`)
, c :: Maybe Algorithm -- TODO: (optional), canonicalization algorithm(s) for header and body (ex: "relaxed/simple")
, q :: Maybe String -- TODO: (optional), default query method (example: `dns/txt`)
, i :: Maybe String -- TODO: (optional), Agent or User Identifier (AUID) (in practice, an email address)
, t :: Maybe Time -- TODO: (recommended), signature timestamp (time = number, such as `1117574938`)
, x :: Maybe Time -- TODO: (recommended), expire time (time = number, such as `1117574938`)
, l :: Maybe Int -- TODO: (optional), body length (such as `200`)
, h :: Maybe String -- TODO: (required), header fields - list of those that have been signed
, z :: Maybe String -- TODO: (optional), header fields - copy of selected header fields and values
, bh :: Maybe CryptoHash -- TODO: (required), body hash
, b :: Maybe Signature -- TODO: (required), signature of headers and body
}
-- h=from:to:subject:date:keywords:keywords;
-- z=From:foo@eng.example.net|To:joe@example.com|
-- Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700;
-- bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=;
-- b=dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZVoG4ZHRNiYzR
codec :: JsonCodec ResourceRecord
codec = CA.object "ResourceRecord"
(CAR.record
@ -75,6 +107,7 @@ codec = CA.object "ResourceRecord"
, mechanisms: CAR.optional (CA.array codecMechanism)
, modifiers: CAR.optional (CA.array codecModifier)
, q: CAR.optional codecQualifier
--, dkim: CAR.optional codecDKIM
})
type Mechanism
@ -125,7 +158,7 @@ show_mechanism m =
show_qualifier_char :: Qualifier -> String
show_qualifier_char = case _ of
Pass -> "+"
None -> "?"
Neutral -> "?"
SoftFail -> "~"
HardFail -> "-"
@ -212,13 +245,15 @@ emptyRR
, mechanisms: Nothing
, modifiers: Nothing
, q: Nothing
--, dkim: Nothing
}
data Qualifier = Pass | None | SoftFail | HardFail
data Qualifier = Pass | Neutral | SoftFail | HardFail
all_qualifiers :: Array Qualifier
all_qualifiers = [Pass, None, SoftFail, HardFail]
all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
qualifier_types :: Array String
qualifier_types = ["pass", "none", "soft_fail", "hard_fail"]
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
-- | Codec for just encoding a single value of type `Qualifier`.
codecQualifier :: CA.JsonCodec Qualifier
@ -227,7 +262,7 @@ codecQualifier = CA.prismaticCodec "Qualifier" str_to_qualifier show_qualifier C
str_to_qualifier :: String -> Maybe Qualifier
str_to_qualifier = case _ of
"pass" -> Just Pass -- +
"none" -> Just None -- ?
"neutral" -> Just Neutral -- ?
"soft_fail" -> Just SoftFail -- ~
"hard_fail" -> Just HardFail -- -
_ -> Nothing
@ -235,6 +270,6 @@ str_to_qualifier = case _ of
show_qualifier :: Qualifier -> String
show_qualifier = case _ of
Pass -> "pass"
None -> "none"
Neutral -> "neutral"
SoftFail -> "soft_fail"
HardFail -> "hard_fail"

13
src/App/Text/Explanations.purs
View File

@ -1,5 +1,6 @@
module App.Text.Explanations where
import Halogen.HTML as HH
import Bulma as Bulma
spf_introduction :: forall w i. Array (HH.HTML w i)
spf_introduction =
@ -29,8 +30,14 @@ spf_introduction =
]
spf_default_behavior :: forall w i. Array (HH.HTML w i)
spf_default_behavior = [HH.text """
spf_default_behavior = [Bulma.p """
What should someone do when receiving a mail with your email address but not from a listed domain or IP address?
By default, let's be neutral ("none", meaning no policy).
"""
, HH.text """
By default, let's advise to drop the mail (a
"""
, HH.u_ [HH.text "hard fail"]
, HH.text """).
The only way for DKIM to be really meaningful is to block any mail not coming from the intended email servers.
Otherwise, it's just a statu quo, and the spamming will continue.
"""]

13
src/App/Validation/DNS.purs
View File

@ -234,6 +234,18 @@ validationSPF form = ado
, v = form.v, mechanisms = Just mechanisms
, modifiers = form.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 }
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry
@ -244,6 +256,7 @@ validation entry = case entry.rrtype of
"MX" -> toEither $ validationMX entry
"SRV" -> toEither $ validationSRV entry
"SPF" -> toEither $ validationSPF entry
--"DKIM" -> toEither $ validationDKIM entry
_ -> toEither $ invalid [UNKNOWN]
id :: forall a. a -> a

11
src/App/ZoneInterface.purs
View File

@ -184,6 +184,7 @@ show_accepted_type = case _ of
MX -> "MX"
SRV -> "SRV"
SPF -> "SPF"
--DKIM -> "DKIM"
string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
string_to_acceptedtype str = case str of
@ -195,6 +196,7 @@ string_to_acceptedtype str = case str of
"MX" -> Just MX
"SRV" -> Just SRV
"SPF" -> Just SPF
--"DKIM" -> Just DKIM
_ -> Nothing
type State =
@ -315,6 +317,7 @@ render state
"MX" -> template modal_content_mx (foot_content MX)
"SRV" -> template modal_content_srv (foot_content SRV)
"SPF" -> template modal_content_spf (foot_content SPF)
--"DKIM" -> template modal_content_dkim (foot_content DKIM)
_ -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
where
-- DRY
@ -436,7 +439,7 @@ render state
]
]
default_qualifier_str = "none" :: String
default_qualifier_str = "hard_fail" :: String
display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
@ -487,8 +490,9 @@ handleAction = case _ of
default_rr_SRV = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www"
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
default_rr_SPF = emptyRR { rrtype = "SPF", name = "", target = "www"
default_rr_SPF = emptyRR { rrtype = "SPF", name = "", target = ""
, mechanisms = Just default_mechanisms }
--default_rr_DKIM = emptyRR { rrtype = "DKIM", name = "_default._dkim", target = "" }
case t of
A -> H.modify_ _ { _currentRR = default_rr_A }
@ -499,6 +503,7 @@ handleAction = case _ of
MX -> H.modify_ _ { _currentRR = default_rr_MX }
SRV -> H.modify_ _ { _currentRR = default_rr_SRV }
SPF -> H.modify_ _ { _currentRR = default_rr_SPF }
--DKIM -> H.modify_ _ { _currentRR = default_rr_DKIM }
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
Initialize -> do
@ -866,7 +871,7 @@ render_new_records _
-- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
, Bulma.level [
Bulma.btn "SPF" (CreateNewRRModal SPF)
, Bulma.btn_ro (C.is_small <> C.is_warning) "DKIM"
--Bulma.btn "DKIM" (CreateNewRRModal DKIM)
, Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
] []
, Bulma.hr