@@ -267,6 +267,16 @@ containsLocalhostSuffix = \s ->
267267 else if take 10 s == ".localhost" && (drop 10 s == "" || take 1 (drop 10 s) == ":") then True {}
268268 else containsLocalhostSuffix (drop 1 s)
269269
270+containsLocalSuffix = \s ->
271+ if s == "" then False {}
272+ else if take 6 s == ".local" && (drop 6 s == "" || take 1 (drop 6 s) == ":") then True {}
273+ else containsLocalSuffix (drop 1 s)
274+
275+containsInternalSuffix = \s ->
276+ if s == "" then False {}
277+ else if take 9 s == ".internal" && (drop 9 s == "" || take 1 (drop 9 s) == ":") then True {}
278+ else containsInternalSuffix (drop 1 s)
279+
270280isBadServerName = \s ->
271281 let sn = toLower (stripTrailingDot s)
272282 sn == ""
@@ -276,6 +286,9 @@ isBadServerName = \s ->
276286 || sn == "localhost" || take 10 sn == "localhost:"
277287 || sn == "localhost.localdomain" || take 22 sn == "localhost.localdomain:"
278288 || containsLocalhostSuffix sn
289+ || containsLocalSuffix sn
290+ || containsInternalSuffix sn
291+ || sn == "metadata" || take 9 sn == "metadata:"
279292 || take 4 sn == "127." || take 3 sn == "10."
280293 || take 8 sn == "192.168." || take 7 sn == "169.254."
281294 || take 2 sn == "0." || take 1 sn == "["
@@ -365,8 +378,8 @@ evictOldestAckedIds = \items n ->
365378 in diff items toEvict
366379
367380safeCompareLoop = \s1 s2 n result ->
368− if n <= 0
369− then result + (if s1 == "" then 0 else 1) + (if s2 == "" then 0 else 1)
381+ if n <= 0 && s1 == "" && s2 == ""
382+ then result
370383 else safeCompareLoop (drop 1 s1) (drop 1 s2) (n - 1) (result + (if take 1 s1 == take 1 s2 then 0 else 1))
371384
372385safeCompare = \a b ->
@@ -945,7 +958,7 @@ serve = \req -> case req of
945958 t <- now
946959 let authorized = verifyFederationAuth authorization
947960 let cappedHops = if hopsRemaining > 5 then 5 else hopsRemaining
948− let fromServer = normalizeServerName fromServer
961+ let fromServer = if tooLong fromServer maxServerNameLen then fromServer else normalizeServerName fromServer
949962 let validRequest = authorized && cappedHops >= 1 && not (fromServer == "") && not (fromServer == serverHostN) && not (tooLong fromServer maxServerNameLen) && not (isBadServerName fromServer) && count events <= maxGossipEvents
950963 let onlineEntries = do
951964 e <- events
@@ -1191,7 +1204,7 @@ serve = \req -> case req of
11911204 let fromKey = if isValidHex fromKey then normalizeHex fromKey else fromKey
11921205 let encryptedBlob = if isValidHex encryptedBlob then normalizeHex encryptedBlob else encryptedBlob
11931206 let messageId = if isValidHex messageId then normalizeHex messageId else messageId
1194− let originServer = normalizeServerName originServer
1207+ let originServer = if tooLong originServer maxServerNameLen then originServer else normalizeServerName originServer
11951208 t <- now
11961209 let authorized = verifyFederationAuth authorization
11971210 let validOrigin = not (originServer == "") && not (originServer == serverHostN) && not (tooLong originServer maxServerNameLen) && not (isBadServerName originServer)
@@ -1233,8 +1246,8 @@ serve = \req -> case req of
12331246 broadcastOfflineGossip t result.peerServers result.expiredLocal
12341247
12351248 FederationAck {messageIds, originServer, fromServer, authorization, respond} -> do
1236− let fromServer = normalizeServerName fromServer
1237− let originServer = normalizeServerName originServer
1249+ let fromServer = if tooLong fromServer maxServerNameLen then fromServer else normalizeServerName fromServer
1250+ let originServer = if tooLong originServer maxServerNameLen then originServer else normalizeServerName originServer
12381251 t <- now
12391252 let authorized = verifyFederationAuth authorization
12401253 let dedupedIds = fold (\acc mid ->
@@ -1335,7 +1348,7 @@ backgroundPrune = do
13351348 else yield {}) (\err ->
13361349 println ("background prune: ack send failed: " ++ show err))) (\err ->
13371350 println ("background prune: " ++ show err))
1338− backgroundPrune
1351+ spawn backgroundPrune
13391352
13401353main = do
13411354 println "Skrepka relay server starting on port 8080..."