@@ -212,24 +212,60 @@ isAllDigitsUntilColonOrEnd = \s ->
212212 else if isDigitChar (take 1 s) then isAllDigitsUntilColonOrEnd (drop 1 s)
213213 else False {}
214214
215+toLowerChar = \c ->
216+ if c == "A" then "a" else if c == "B" then "b" else if c == "C" then "c"
217+ else if c == "D" then "d" else if c == "E" then "e" else if c == "F" then "f"
218+ else if c == "G" then "g" else if c == "H" then "h" else if c == "I" then "i"
219+ else if c == "J" then "j" else if c == "K" then "k" else if c == "L" then "l"
220+ else if c == "M" then "m" else if c == "N" then "n" else if c == "O" then "o"
221+ else if c == "P" then "p" else if c == "Q" then "q" else if c == "R" then "r"
222+ else if c == "S" then "s" else if c == "T" then "t" else if c == "U" then "u"
223+ else if c == "V" then "v" else if c == "W" then "w" else if c == "X" then "x"
224+ else if c == "Y" then "y" else if c == "Z" then "z"
225+ else c
226+
227+toLower = \s ->
228+ if s == "" then ""
229+ else toLowerChar (take 1 s) ++ toLower (drop 1 s)
230+
231+stripTrailingDot = \s ->
232+ if s == "" then ""
233+ else if take 1 s == "." && drop 1 s == "" then ""
234+ else if take 1 s == "." && take 1 (drop 1 s) == ":" then drop 1 s
235+ else take 1 s ++ stripTrailingDot (drop 1 s)
236+
237+isReservedHighRange = \s ->
238+ (take 2 s == "24" && isDigitChar (take 1 (drop 2 s)) && take 1 (drop 3 s) == ".")
239+ || (take 3 s == "250" && take 1 (drop 3 s) == ".")
240+ || (take 3 s == "251" && take 1 (drop 3 s) == ".")
241+ || (take 3 s == "252" && take 1 (drop 3 s) == ".")
242+ || (take 3 s == "253" && take 1 (drop 3 s) == ".")
243+ || (take 3 s == "254" && take 1 (drop 3 s) == ".")
244+ || (take 3 s == "255" && take 1 (drop 3 s) == ".")
245+
215246isBadServerName = \s ->
216− s == ""
217− || containsBadUrlChar s
218− || s == "localhost" || take 10 s == "localhost:"
219− || take 4 s == "127." || take 3 s == "10."
220− || take 8 s == "192.168." || take 7 s == "169.254."
221− || take 2 s == "0." || take 1 s == "["
222− || take 7 s == "172.16." || take 7 s == "172.17." || take 7 s == "172.18." || take 7 s == "172.19."
223− || take 7 s == "172.20." || take 7 s == "172.21." || take 7 s == "172.22." || take 7 s == "172.23."
224− || take 7 s == "172.24." || take 7 s == "172.25." || take 7 s == "172.26." || take 7 s == "172.27."
225− || take 7 s == "172.28." || take 7 s == "172.29." || take 7 s == "172.30." || take 7 s == "172.31."
226− || take 7 s == "198.18." || take 7 s == "198.19."
227− || take 2 s == "::"
228− || isCgnatRange s
229− || containsMultipleColons s
230− || hasOctalOctet s
231− || hasHexPrefix s
232− || (isDigitChar (take 1 s) && isAllDigitsUntilColonOrEnd s)
247+ let sn = toLower (stripTrailingDot s)
248+ sn == ""
249+ || containsBadUrlChar sn
250+ || sn == "localhost" || take 10 sn == "localhost:"
251+ || take 4 sn == "127." || take 3 sn == "10."
252+ || take 8 sn == "192.168." || take 7 sn == "169.254."
253+ || take 2 sn == "0." || take 1 sn == "["
254+ || take 7 sn == "172.16." || take 7 sn == "172.17." || take 7 sn == "172.18." || take 7 sn == "172.19."
255+ || take 7 sn == "172.20." || take 7 sn == "172.21." || take 7 sn == "172.22." || take 7 sn == "172.23."
256+ || take 7 sn == "172.24." || take 7 sn == "172.25." || take 7 sn == "172.26." || take 7 sn == "172.27."
257+ || take 7 sn == "172.28." || take 7 sn == "172.29." || take 7 sn == "172.30." || take 7 sn == "172.31."
258+ || take 7 sn == "198.18." || take 7 sn == "198.19."
259+ || take 8 sn == "192.0.2."
260+ || take 12 sn == "198.51.100."
261+ || take 11 sn == "203.0.113."
262+ || isReservedHighRange sn
263+ || take 2 sn == "::"
264+ || isCgnatRange sn
265+ || containsMultipleColons sn
266+ || hasOctalOctet sn
267+ || hasHexPrefix sn
268+ || (isDigitChar (take 1 sn) && isAllDigitsUntilColonOrEnd sn)
233269
234270lookupSession = \sessions token t ->
235271 single (do
@@ -260,8 +296,8 @@ verifyMaintenanceAuth = \authorization ->
260296clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
261297
262298safeCompareLoop = \s1 s2 result ->
263− if s1 == "" && s2 == ""
264− then result
299+ if s2 == ""
300+ then result + (if s1 == "" then 0 else 1)
265301 else safeCompareLoop (drop 1 s1) (drop 1 s2) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
266302
267303safeCompare = \a b -> safeCompareLoop a b 0 == 0
@@ -525,7 +561,7 @@ serve = \req -> case req of
525561 let encryptedBlob = if isValidHex encryptedBlob then normalizeHex encryptedBlob else encryptedBlob
526562 t <- now
527563 msgId <- genToken
528− let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
564+ let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
529565 result <- atomic do
530566 pr <- pruneExpired t
531567 sessions <- *sessions
@@ -625,10 +661,14 @@ serve = \req -> case req of
625661 if p.server == serverHost then acc
626662 else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
627663 else union acc [p.server]) [] presence
664+ let knownMsgOrigins = fold (\acc m ->
665+ if m.originServer == "" || m.originServer == serverHost then acc
666+ else if count (do a <- acc; where a == m.originServer; yield a) > 0 then acc
667+ else union acc [m.originServer]) [] messages
628668 let ok = case session of
629669 Nothing {} -> False {}
630670 _ -> True {}
631− yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, knownPeers: knownPeers}
671+ yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, knownPeers: knownPeers, knownMsgOrigins: knownMsgOrigins}
632672 let fedMessages = do
633673 m <- result.ackedMessages
634674 where not (m.originServer == "")
@@ -636,7 +676,8 @@ serve = \req -> case req of
636676 yield m
637677 let originServers = fold (\acc m ->
638678 if count (do a <- acc; where a == m.originServer; yield a) > 0 then acc
639− else if count (do k <- result.knownPeers; where k == m.originServer; yield k) == 0 then acc
679+ else if count (do k <- result.knownPeers; where k == m.originServer; yield k) == 0
680+ && count (do k <- result.knownMsgOrigins; where k == m.originServer; yield k) == 0 then acc
640681 else union acc [m.originServer]) [] fedMessages
641682 respond {ok: result.ok}
642683 if result.ok && count originServers > 0 && not (federationSecret == "")
@@ -929,7 +970,7 @@ serve = \req -> case req of
929970 t <- now
930971 let authorized = verifyFederationAuth authorization
931972 let validOrigin = not (originServer == "") && not (originServer == serverHost) && not (tooLong originServer maxServerNameLen) && not (isBadServerName originServer)
932− let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t else timestamp
973+ let clampedTs = if timestamp > t then t else if timestamp < t - messageMaxAge then t - messageMaxAge else timestamp
933974 result <- atomic do
934975 pr <- pruneExpired t
935976 messages <- *messages