@@ -26,6 +26,7 @@ maxServerNameLen = 128
2626maxMessageIdLen = 128
2727maxTokenLen = 256
2828maxChallenges = 10000
29+maxSessions = 10000
2930
3031-- ============================================
3132-- Types
@@ -189,12 +190,12 @@ containsMultipleColons = \s ->
189190 else containsMultipleColons (drop 1 s)
190191
191192hasOctalOctet = \s ->
192− if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) then True {}
193+ if take 1 s == "0" && isDigitChar (take 1 (drop 1 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 2 s) then True {}
193194 else hasOctalOctetAfterDot s
194195
195196hasOctalOctetAfterDot = \s ->
196197 if s == "" then False {}
197− else if take 1 s == "." && take 1 (drop 1 s) == "0" && isDigitChar (take 1 (drop 2 s)) then True {}
198+ else if take 1 s == "." && take 1 (drop 1 s) == "0" && isDigitChar (take 1 (drop 2 s)) && isAllDigitsOrDotsUntilColonOrEnd (drop 3 s) then True {}
198199 else hasOctalOctetAfterDot (drop 1 s)
199200
200201hasHexPrefix = \s ->
@@ -212,6 +213,12 @@ isAllDigitsUntilColonOrEnd = \s ->
212213 else if isDigitChar (take 1 s) then isAllDigitsUntilColonOrEnd (drop 1 s)
213214 else False {}
214215
216+isAllDigitsOrDotsUntilColonOrEnd = \s ->
217+ if s == "" then True {}
218+ else if take 1 s == ":" then True {}
219+ else if isDigitChar (take 1 s) || take 1 s == "." then isAllDigitsOrDotsUntilColonOrEnd (drop 1 s)
220+ else False {}
221+
215222toLowerChar = \c ->
216223 if c == "A" then "a" else if c == "B" then "b" else if c == "C" then "c"
217224 else if c == "D" then "d" else if c == "E" then "e" else if c == "F" then "f"
@@ -228,14 +235,21 @@ toLower = \s ->
228235 if s == "" then ""
229236 else toLowerChar (take 1 s) ++ toLower (drop 1 s)
230237
238+isTrailingDots = \s ->
239+ if s == "" then True {}
240+ else if take 1 s == ":" then True {}
241+ else if take 1 s == "." then isTrailingDots (drop 1 s)
242+ else False {}
243+
231244stripTrailingDot = \s ->
232245 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
246+ else if take 1 s == "." && isTrailingDots (drop 1 s) then stripTrailingDot (drop 1 s)
235247 else take 1 s ++ stripTrailingDot (drop 1 s)
236248
237249isReservedHighRange = \s ->
238− (take 2 s == "24" && isDigitChar (take 1 (drop 2 s)) && take 1 (drop 3 s) == ".")
250+ (take 2 s == "22" && (take 1 (drop 2 s) == "4" || take 1 (drop 2 s) == "5" || take 1 (drop 2 s) == "6" || take 1 (drop 2 s) == "7" || take 1 (drop 2 s) == "8" || take 1 (drop 2 s) == "9") && take 1 (drop 3 s) == ".")
251+ || (take 2 s == "23" && isDigitChar (take 1 (drop 2 s)) && take 1 (drop 3 s) == ".")
252+ || (take 2 s == "24" && isDigitChar (take 1 (drop 2 s)) && take 1 (drop 3 s) == ".")
239253 || (take 3 s == "250" && take 1 (drop 3 s) == ".")
240254 || (take 3 s == "251" && take 1 (drop 3 s) == ".")
241255 || (take 3 s == "252" && take 1 (drop 3 s) == ".")
@@ -256,7 +270,9 @@ isBadServerName = \s ->
256270 || take 7 sn == "172.24." || take 7 sn == "172.25." || take 7 sn == "172.26." || take 7 sn == "172.27."
257271 || take 7 sn == "172.28." || take 7 sn == "172.29." || take 7 sn == "172.30." || take 7 sn == "172.31."
258272 || take 7 sn == "198.18." || take 7 sn == "198.19."
273+ || take 8 sn == "192.0.0."
259274 || take 8 sn == "192.0.2."
275+ || take 10 sn == "192.88.99."
260276 || take 12 sn == "198.51.100."
261277 || take 11 sn == "203.0.113."
262278 || isReservedHighRange sn
@@ -265,7 +281,7 @@ isBadServerName = \s ->
265281 || containsMultipleColons sn
266282 || hasOctalOctet sn
267283 || hasHexPrefix sn
268− || (isDigitChar (take 1 sn) && isAllDigitsUntilColonOrEnd sn)
284+ || (isDigitChar (take 1 sn) && isAllDigitsOrDotsUntilColonOrEnd sn)
269285
270286lookupSession = \sessions token t ->
271287 single (do
@@ -300,7 +316,7 @@ safeCompareLoop = \s1 s2 result ->
300316 then result + (if s1 == "" then 0 else 1)
301317 else safeCompareLoop (drop 1 s1) (drop 1 s2) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
302318
303−safeCompare = \a b -> safeCompareLoop a b 0 == 0
319+safeCompare = \a b -> not (a == "") && not (b == "") && safeCompareLoop a b 0 == 0
304320
305321sendToEach = \servers action ->
306322 if count servers == 0
@@ -312,14 +328,11 @@ sendToEach = \servers action ->
312328 then yield {}
313329 else do
314330 catch (action server) (\err -> do
315− println ("federation: error reaching " ++ server ++ ", retrying (1/2): " ++ show err)
316− sleep 1000
331+ println ("federation: error reaching " ++ server ++ ", retrying: " ++ show err)
332+ sleep 500
317333 catch (action server) (\err2 -> do
318− println ("federation: retry 1 failed for " ++ server ++ ", retrying (2/2): " ++ show err2)
319− sleep 2000
320− catch (action server) (\err3 -> do
321− println ("federation: all retries exhausted for " ++ server ++ ": " ++ show err3)
322− yield {})))
334+ println ("federation: retry failed for " ++ server ++ ": " ++ show err2)
335+ yield {}))
323336 sendToEach rest action
324337
325338pruneExpired = \t -> do
@@ -382,14 +395,14 @@ sendBatchedGossip = \peerServers allEvents ->
382395 sendBatchedGossip peerServers rest
383396
384397broadcastOfflineGossip = \t peerServers expiredLocal -> do
385− let expiredPubkeys = fold (\acc p ->
386− if count (do a <- acc; where a == p.pubkey; yield a) > 0 then acc
387− else union acc [p.pubkey]) [] expiredLocal
388− if not (federationSecret == "") && count expiredPubkeys > 0 && count peerServers > 0
398+ let expiredEntries = fold (\acc p ->
399+ if count (do a <- acc; where a.pubkey == p.pubkey; yield a) > 0 then acc
400+ else union acc [{pubkey: p.pubkey, ttl: clampTtl ((p.expiresAt - p.timestamp) / 1000)}]) [] expiredLocal
401+ if not (federationSecret == "") && count expiredEntries > 0 && count peerServers > 0
389402 then do
390403 let gossipEvents = do
391− pk <- expiredPubkeys
392− yield {eventType: "offline", pubkey: pk, server: serverHost, timestamp: t, ttl: 3600}
404+ e <- expiredEntries
405+ yield {eventType: "offline", pubkey: e.pubkey, server: serverHost, timestamp: t, ttl: e.ttl}
393406 sendBatchedGossip peerServers gossipEvents
394407 else yield {}
395408
@@ -476,8 +489,17 @@ serve = \req -> case req of
476489 let sessionsCapped = if count existingForKey >= 10 && oldestExpiry >= 0
477490 then cappedFold.sessions
478491 else sessions
492+ let globalOldestSessionExpiry = if count sessionsCapped >= maxSessions
493+ then fold (\acc s -> if acc == -1 || s.expiresAt < acc then s.expiresAt else acc) -1 sessionsCapped
494+ else -1
495+ let globalSessionsCapped = if globalOldestSessionExpiry >= 0
496+ then (fold (\acc s ->
497+ if not acc.removed && s.expiresAt == globalOldestSessionExpiry
498+ then {removed: True {}, items: acc.items}
499+ else {removed: acc.removed, items: union acc.items [s]}) {removed: False {}, items: []} sessionsCapped).items
500+ else sessionsCapped
479501 set *sessions = if sigValid
480− then union sessionsCapped [{token: token, pubkey: pubkey, expiresAt: expiry}]
502+ then union globalSessionsCapped [{token: token, pubkey: pubkey, expiresAt: expiry}]
481503 else sessions
482504 let presenceWithout = do
483505 p <- presence
@@ -656,19 +678,10 @@ serve = \req -> case req of
656678 set *messages = case session of
657679 Nothing {} -> messages
658680 Just {value: _} -> diff messages ackedMessages
659− presence <- *presence
660− let knownPeers = fold (\acc p ->
661− if p.server == serverHost then acc
662− else if count (do a <- acc; where a == p.server; yield a) > 0 then acc
663− 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
668681 let ok = case session of
669682 Nothing {} -> False {}
670683 _ -> True {}
671− yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers, knownPeers: knownPeers, knownMsgOrigins: knownMsgOrigins}
684+ yield {ok: ok, ackedMessages: ackedMessages, expiredLocal: pr.expiredLocal, peerServers: pr.peerServers}
672685 let fedMessages = do
673686 m <- result.ackedMessages
674687 where not (m.originServer == "")
@@ -676,8 +689,6 @@ serve = \req -> case req of
676689 yield m
677690 let originServers = fold (\acc m ->
678691 if count (do a <- acc; where a == m.originServer; yield a) > 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
681692 else union acc [m.originServer]) [] fedMessages
682693 respond {ok: result.ok}
683694 if result.ok && count originServers > 0 && not (federationSecret == "")
@@ -760,7 +771,7 @@ serve = \req -> case req of
760771 o <- offlineEntries
761772 where o.pubkey == e.pubkey
762773 where o.server == e.server
763− where o.timestamp >= e.timestamp
774+ where o.timestamp > e.timestamp
764775 yield o) == 0
765776 yield {pubkey: e.pubkey, server: e.server, expiresAt: e.expiresAt, timestamp: e.timestamp}
766777 let affectedKeys = union
@@ -934,13 +945,13 @@ serve = \req -> case req of
934945 o <- offlineEntries
935946 where o.pubkey == normalizeHex e.pubkey
936947 where o.server == e.server
937− where o.timestamp >= e.timestamp
948+ where o.timestamp > e.timestamp
938949 yield o) > 0)
939950 yield e
940951 let effectiveEvents = do
941952 e <- validEvents
942953 where count (do a <- gossipResult.appliedKeys; where a.pubkey == normalizeHex e.pubkey; where a.server == e.server; yield a) > 0
943− yield e
954+ yield {eventType: e.eventType, pubkey: normalizeHex e.pubkey, server: e.server, timestamp: e.timestamp, ttl: e.ttl}
944955 respond {ok: validRequest}
945956 if not gossipResult.withinCapacity
946957 then println ("gossip: presence at capacity (" ++ show maxPresenceEntries ++ "), limiting new entries from " ++ fromServer)