on master help sign in
Fix 5 bugs: GossipEvent record JSON/forward-compat, HTTP body cap, SSRF dword-IP bypass, session IP binding
commitc7311856c96b1ad1fbe8c83cc4552eb4a9e571f4 authoriko <mail@iko.soy> dateFri 12 Jun 2026, 00:51 (4 months ago) parente3237eb
2 files changed+61−37
install.sh+4−1 server.knot+57−36
install.sh+4−1
@@ -67,7 +67,10 @@ Wants=network-online.target
6767
6868[Service]
6969Type=simple
70−ExecStart=/usr/local/bin/skrepka-server
70+# --http-max-body-bytes must exceed maxBlobLen (40 MiB hex) plus the JSON
71+# envelope, otherwise the runtime's default 16 MiB body cap rejects a
72+# max-size blob with 413 before the handler's BlobHex check is ever reached.
73+ExecStart=/usr/local/bin/skrepka-server --http-max-body-bytes=42M
7174Restart=on-failure
7275RestartSec=5
7376
server.knot+57−36
@@ -166,22 +166,16 @@ federationUrl = \server -> federationScheme ++ server
166166-- polling pubkey. The server cannot read the blob.
167167type PollEvent = {encryptedBlob: BlobHex}
168168
169−-- One presence change exchanged between federated servers. Per-variant
170−-- payloads keep room for future event kinds that aren't tied to a pubkey.
171−-- `GossipUnknown` is the parser's fallback for forward-compatibility.
172−data GossipEventType
173− = GossipOnline {pubkey: PubkeyHex}
174− | GossipOffline {pubkey: PubkeyHex}
175− | GossipUnknown {}
176−
177−impl ToJSON GossipEventType where
178− toJson et = case et of
179− GossipOnline {pubkey} -> toJson {eventType: "online", pubkey}
180− GossipOffline {pubkey} -> toJson {eventType: "offline", pubkey}
181− GossipUnknown {} -> toJson {eventType: "unknown"}
182−
183−impl FromJSON GossipEventType where
184− parseJson t = (\raw -> if raw.eventType == "online" then GossipOnline {raw.pubkey} else if raw.eventType == "offline" then GossipOffline {raw.pubkey} else GossipUnknown {}) (parseJson t : {eventType: Text, pubkey: PubkeyHex})
169+-- One presence change exchanged between federated servers. A flat wire record
170+-- (`{"eventType": "online"|"offline", "pubkey": "<hex>"}`) rather than an ADT:
171+-- the built-in record JSON round-trips it directly (a `Just` pubkey encodes as
172+-- the bare hex string, `Nothing` as `null`/an absent field). `eventType` is
173+-- free `Text`, so an unrecognized future event kind decodes cleanly instead of
174+-- failing the whole batch, and `pubkey` is optional so a future pubkey-less
175+-- kind still parses. `handleRecvGossip` ignores any event whose `eventType` it
176+-- doesn't recognize or that carries no pubkey — that is the forward-compat
177+-- fallback (the old `GossipUnknown` variant).
178+type GossipEvent = {eventType: Text, pubkey: Maybe PubkeyHex}
185179
186180-- /messages is all-or-nothing per call: either every message in the batch is
187181-- enqueued (delivered, federated, or buffered for federation), or none are
@@ -332,7 +326,7 @@ route ClientApi where
332326 POST {messages: [{to: PubkeyHex, encryptedBlob: BlobHex}]} /messages headers {authorization: Text, xForwardedFor: Maybe Text} -> {} rateLimit sendLimit = SendMessages
333327
334328route FederationApi where
335− POST {events: [GossipEventType], fromServer: ServerName} /federation/gossip -> {} rateLimit gossipLimit = RecvGossip
329+ POST {events: [GossipEvent], fromServer: ServerName} /federation/gossip -> {} rateLimit gossipLimit = RecvGossip
336330 POST {toKey: PubkeyHex, encryptedBlob: BlobHex} /federation/forward -> {} rateLimit forwardLimit = ForwardMessage
337331
338332route Api = AuthApi | ClientApi | FederationApi
@@ -402,12 +396,30 @@ countChar = \c s -> if s == ""
402396then 0
403397else (if take 1 s == c then 1 else 0) + countChar c (drop 1 s)
404398
405−-- Block private/reserved/internal hostnames (SSRF defense). Skips obscure encoding
406−-- tricks (octal, hex, percent-encoding) but covers the high-value cases:
407−-- `localhost`, RFC1918 ranges (10/8, 172.16/12, 192.168/16) plus link-local
399+-- The host portion of `sn` — everything before the first `:`. With the
400+-- one-colon ceiling enforced in `isBadServerName`, this strips an optional
401+-- `:port` so `isNumericHost` sees just the host.
402+beforeColon : Text -> Text
403+beforeColon = \s -> if s == "" || take 1 s == ":"
404+then ""
405+else take 1 s ++ beforeColon (drop 1 s)
406+
407+-- True when the host part is a bare integer (no dots) — a decimal or octal
408+-- "dword" IP like `2130706433` or `017700000001` (both = 127.0.0.1). These
409+-- carry no dotted octets, so the prefix list below never matches them, yet
410+-- they resolve to the same internal addresses.
411+isNumericHost : Text -> Bool
412+isNumericHost = \sn -> do
413+ let host = beforeColon sn
414+ host != "" && all (\c -> contains c "0123456789") (chars host)
415+
416+-- Block private/reserved/internal hostnames (SSRF defense). Skips percent-encoding
417+-- tricks but covers the high-value cases: `localhost`, RFC1918 ranges (10/8,
418+-- 172.16/12, 192.168/16) plus link-local
408419-- 169.254/16, the IPv4 zero net, bare IPv6 literals (any string with more than one `:` — covers loopback
409420-- `::`/`::1`, link-local `fe80::/10`, ULA `fc00::/7`, globals like `2001:db8::1`),
410−-- bracketed IPv6 literals, and the `.local` / `.internal` / `.arpa` / `.onion`
421+-- bracketed IPv6 literals, integer/octal "dword" IPv4 (`isNumericHost`) and the
422+-- `0x`-prefixed hex form, and the `.local` / `.internal` / `.arpa` / `.onion`
411423-- suffixes. Enforced on inbound requests (`handleRecvGossip`, so a peer can't
412424-- claim a bogus `fromServer`) and again at every federation egress site
413425-- (`sendBatchedGossip`, `retryPendingForwards`, `forkForwardsTo`) as
@@ -416,7 +428,7 @@ else (if take 1 s == c then 1 else 0) + countChar c (drop 1 s)
416428-- A legitimate `host:port` server name has exactly one `:`, so the multi-colon
417429-- check leaves that case intact.
418430isBadServerName : Text -> Bool
419−isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:" sn || any (\c -> not contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") (chars sn) || countChar ":" sn > 1 || any (\p -> hasPrefix p sn) [
431+isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:" sn || isNumericHost sn || hasPrefix "0x" sn || any (\c -> not contains c "0123456789abcdefghijklmnopqrstuvwxyz-.:") (chars sn) || countChar ":" sn > 1 || any (\p -> hasPrefix p sn) [
420432 ".",
421433 ":",
422434 "[",
@@ -456,11 +468,16 @@ isBadServerName = \sn -> sn == "" || sn == "localhost" || hasPrefix "localhost:"
456468matchIp : Text -> Text -> Bool
457469matchIp = \clientIp sessionIp -> sessionIp == "" || clientIp == sessionIp
458470
459−-- Unwrap an X-Forwarded-For header value to a plain IP string. Empty when the
460−-- header is absent (no reverse proxy in front).
471+-- The client IP a session/challenge is bound to: the last (trusted) hop of the
472+-- X-Forwarded-For chain, matching the rate limiter's `pickClientIp`. Taking the
473+-- last hop rather than the whole header means client-supplied spoofed hops don't
474+-- become part of the binding (a trusted proxy appends the real address last).
475+-- Empty when the header is absent or `trustForwardedFor` is off — handlers have
476+-- no access to the raw connection address, and an empty bound IP makes `matchIp`
477+-- skip the check (so IP binding is simply disabled without a trusted proxy).
461478clientIpOf : Maybe Text -> Text
462479clientIpOf = \h -> case h of
463− Just {value: ip} -> ip
480+ Just {value: ips} -> if trustForwardedFor then lastForwardedHop ips else ""
464481 Nothing {} -> ""
465482
466483-- Resolve a Bearer token to its session pubkey if the session is unexpired and
@@ -605,7 +622,7 @@ pruneExpired = \t -> atomic do
605622-- Fan out one bundle of gossip events to each peer, skipping denylisted
606623-- peers and peers in backoff. No-op when `events` is empty so callers don't
607624-- need to guard. Records or clears federation-failure counters per call.
608−sendBatchedGossip : [Text] -> [GossipEventType] -> IO {rw *forwardFailures, network, clock} {}
625+sendBatchedGossip : [Text] -> [GossipEvent] -> IO {rw *forwardFailures, network, clock} {}
609626sendBatchedGossip = \peers events -> when (count events > 0) (do
610627 t <- now
611628 failures <- *forwardFailures
@@ -740,7 +757,7 @@ handleVerifyAuth = \pubkey challenge signature revokeOthers clientIp -> do
740757 case result of
741758 Nothing {} -> yield (Err {error: {status: 401, message: "invalid"}})
742759 Just {value: peers} -> do
743− when federationEnabled (fork (sendBatchedGossip peers [GossipOnline {pubkey}]))
760+ when federationEnabled (fork (sendBatchedGossip peers [{eventType: "online", pubkey: Just {value: pubkey}}]))
744761 yield (Ok {value: {token, expiresAt: expiry}})
745762
746763-- ============================================
@@ -773,7 +790,7 @@ handlePoll = \cursor authorization clientIp -> do
773790 case setup of
774791 Nothing {} -> yield (Err {error: {status: 401, message: "unauthorized"}})
775792 Just {value: s} -> do
776− when federationEnabled (fork (sendBatchedGossip s.refreshPeers [GossipOnline {s.pubkey}]))
793+ when federationEnabled (fork (sendBatchedGossip s.refreshPeers [{eventType: "online", pubkey: Just {value: s.pubkey}}]))
777794 pollResult <- doPoll s t
778795 yield (Ok {value: pollResult})
779796
@@ -915,10 +932,11 @@ forkForwardsTo = \to encryptedBlob servers -> forEach servers (\server -> when (
915932-- POST /federation/gossip: ingest peer presence events. The transport-level
916933-- `fromServer` is the home server for every event. Drops every (pubkey,
917934-- fromServer) row touched by this batch, then re-adds fresh-TTL rows for
918−-- pubkeys with a `GossipOnline` event (so Online wins on collision). For keys
935+-- pubkeys with an `online` event (so Online wins on collision). For keys
919936-- that transition offline → online, flushes any locally-buffered messages via
920−-- `forwardQueuedToServer`.
921−handleRecvGossip : [GossipEventType] -> Text -> IO {r *messages, rw *forwards, rw *presence, clock} (Result HttpError {})
937+-- `forwardQueuedToServer`. Events with an unrecognized `eventType` or no
938+-- `pubkey` are skipped (forward-compat) rather than rejecting the batch.
939+handleRecvGossip : [GossipEvent] -> Text -> IO {r *messages, rw *forwards, rw *presence, clock} (Result HttpError {})
922940handleRecvGossip = \events fromServer -> do
923941 t <- now
924942 if not federationEnabled
@@ -928,13 +946,16 @@ handleRecvGossip = \events fromServer -> do
928946 else do
929947 newlyOnline <- atomic (do
930948 pres <- *presence
931− let collected = fold (\acc e -> case e of
932− GossipOnline {pubkey} -> {
949+ let collected = fold (\acc e -> case e.pubkey of
950+ Just {value: pubkey} -> if e.eventType == "online"
951+ then {
933952 touched: union acc.touched [pubkey],
934953 added: union acc.added [{pubkey, server: fromServer, expiresAt: t + onlineGossipTtl}]
935954 }
936− GossipOffline {pubkey} -> {acc.added, touched: union acc.touched [pubkey]}
937− _ -> acc) {touched: [], added: []} events
955+ else if e.eventType == "offline"
956+ then {acc.added, touched: union acc.touched [pubkey]}
957+ else acc
958+ Nothing {} -> acc) {touched: [], added: []} events
938959 let kept = filter (\p -> p.server != fromServer || not elem p.pubkey collected.touched) pres
939960 *presence = union kept collected.added
940961 yield (filter (\pk -> not any (\p -> p.pubkey == pk && p.server == fromServer && p.expiresAt > t) pres) (map (\p -> p.pubkey) collected.added)))
@@ -998,7 +1019,7 @@ backgroundPrune = do
9981019 expiredLocal <- pruneExpired t
9991020 when federationEnabled (fork (do
10001021 pres <- *presence
1001− sendBatchedGossip (collectPeers pres (\p -> p.server)) (map (\pk -> GossipOffline {pubkey: pk}) expiredLocal)))
1022+ sendBatchedGossip (collectPeers pres (\p -> p.server)) (map (\pk -> {eventType: "offline", pubkey: Just {value: pk}}) expiredLocal)))
10021023 sleep backgroundPruneInterval
10031024 backgroundPrune
10041025