@@ -27,6 +27,7 @@ maxMessageIdLen = 128
2727maxTokenLen = 256
2828maxChallenges = 10000
2929maxSessions = 10000
30+maxAckedIds = 10000
3031maxChallengesPerKey = 5
3132maxSessionsPerKey = 10
3233challengeExpiry = 60000 -- 1 minute in milliseconds
@@ -167,18 +168,22 @@ isCgnatRange = \s ->
167168 if not (take 4 s == "100.") then False {}
168169 else if (take 1 (drop 4 s) == "7" || take 1 (drop 4 s) == "8" || take 1 (drop 4 s) == "9")
169170 && isDigitChar (take 1 (drop 5 s)) && take 1 (drop 6 s) == "."
171+ && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
170172 then True {}
171173 else if take 1 (drop 4 s) == "6"
172174 && (take 1 (drop 5 s) == "4" || take 1 (drop 5 s) == "5" || take 1 (drop 5 s) == "6" || take 1 (drop 5 s) == "7" || take 1 (drop 5 s) == "8" || take 1 (drop 5 s) == "9")
173175 && take 1 (drop 6 s) == "."
176+ && isAllDigitsOrDotsUntilColonOrEnd (drop 7 s)
174177 then True {}
175178 else if take 1 (drop 4 s) == "1" && (take 1 (drop 5 s) == "0" || take 1 (drop 5 s) == "1")
176179 && isDigitChar (take 1 (drop 6 s)) && take 1 (drop 7 s) == "."
180+ && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)
177181 then True {}
178182 else if take 1 (drop 4 s) == "1" && take 1 (drop 5 s) == "2"
179183 && (take 1 (drop 6 s) == "0" || take 1 (drop 6 s) == "1" || take 1 (drop 6 s) == "2" || take 1 (drop 6 s) == "3"
180184 || take 1 (drop 6 s) == "4" || take 1 (drop 6 s) == "5" || take 1 (drop 6 s) == "6" || take 1 (drop 6 s) == "7")
181185 && take 1 (drop 7 s) == "."
186+ && isAllDigitsOrDotsUntilColonOrEnd (drop 8 s)
182187 then True {}
183188 else False {}
184189
@@ -328,8 +333,8 @@ verifyMaintenanceAuth = \authorization ->
328333clampTtl = \ttl -> if ttl < 1 then 1 else if ttl > maxPresenceTtl then maxPresenceTtl else ttl
329334
330335safeCompareLoop = \s1 s2 result ->
331− if s1 == "" && s2 == ""
332− then result
336+ if s2 == ""
337+ then result + (if s1 == "" then 0 else 1)
333338 else safeCompareLoop (drop 1 s1) (drop 1 s2) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
334339
335340safeCompare = \a b ->
@@ -344,11 +349,8 @@ sendToEach = \servers action ->
344349 if server == ""
345350 then yield {}
346351 else do
347− catch (action server) (\err -> do
348− println ("federation: error reaching " ++ server ++ ", retrying: " ++ show err)
349− catch (action server) (\err2 -> do
350− println ("federation: retry failed for " ++ server ++ ": " ++ show err2)
351− yield {}))
352+ catch (action server) (\err ->
353+ println ("federation: error reaching " ++ server ++ ": " ++ show err))
352354 sendToEach rest action
353355
354356pruneExpired = \t -> do
@@ -436,10 +438,12 @@ retryPendingForwards = \pending ->
436438 if f.messageId == ""
437439 then yield {}
438440 else do
439− catch (fetch (federationScheme ++ f.toServer) (ForwardMessage {
440− toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob,
441− timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
442− authorization: "Bearer " ++ federationSecret})) (\err ->
441+ catch (do
442+ fetch (federationScheme ++ f.toServer) (ForwardMessage {
443+ toKey: f.toKey, fromKey: f.fromKey, encryptedBlob: f.encryptedBlob,
444+ timestamp: f.timestamp, originServer: serverHostN, messageId: f.messageId,
445+ authorization: "Bearer " ++ federationSecret})
446+ yield {}) (\err ->
443447 println ("prune: retry forward to " ++ f.toServer ++ " failed: " ++ show err))
444448 retryPendingForwards rest
445449
@@ -676,7 +680,7 @@ serve = \req -> case req of
676680 then union forwards (do s <- remoteServers; yield {messageId: msgId, toServer: s, createdAt: t, toKey: to, fromKey: fromKey, encryptedBlob: encryptedBlob, timestamp: clampedTs})
677681 else forwards
678682 yield {status: status, remoteServers: remoteServers, fromKey: fromKey, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, forwardsAtCapacity: forwardsAtCapacity}
679− let finalStatus = if result.status == "federated" && federationSecret == "" then "queued" else result.status
683+ let finalStatus = if result.status == "federated" && (federationSecret == "" || result.forwardsAtCapacity) then "queued" else result.status
680684 respond {status: finalStatus, messageId: (if result.status == "unauthorized" then "" else if result.status == "invalid" then "" else msgId)}
681685 if count result.remoteServers > 0 && not (result.status == "unauthorized") && not (result.status == "invalid") && not (federationSecret == "")
682686 then sendToEach result.remoteServers (\server ->
@@ -721,7 +725,16 @@ serve = \req -> case req of
721725 where not (m.originServer == serverHostN)
722726 yield {messageId: m.messageId, toKey: m.toKey, ackedAt: t}
723727 ackedIds <- *ackedIds
724− set *ackedIds = union ackedIds ackedFederated
728+ let combinedAckedIds = union ackedIds ackedFederated
729+ let oldestAckedAt = if count combinedAckedIds > maxAckedIds
730+ then fold (\acc a -> if acc == -1 || a.ackedAt < acc then a.ackedAt else acc) -1 combinedAckedIds
731+ else -1
732+ set *ackedIds = if oldestAckedAt >= 0
733+ then (fold (\acc a ->
734+ if not acc.removed && a.ackedAt == oldestAckedAt
735+ then {removed: True {}, items: acc.items}
736+ else {removed: acc.removed, items: union acc.items [a]}) {removed: False {}, items: []} combinedAckedIds).items
737+ else combinedAckedIds
725738 let ok = case session of
726739 Nothing {} -> False {}
727740 _ -> True {}