nandi/frqpublic Fork 0
767b3bf
Commits
Clone
git clone https://git.rickub.com/nandi/frq.git
git clone ssh://git@rickub.com/nandi/frq.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Sign the reactions we send

freeq takes an unsigned reaction from a guest and refuses one from an
account: `FAIL TAGMSG SIGNATURE_REQUIRED`. Nothing here read FAIL, so a
pill appeared locally and reached nobody — the one client it looked
right on was the one that sent it.

So a signed-in connection now mints an Ed25519 key, registers it with
MSGSIG at welcome, and signs each mutation over freeq's canonical
description of it. The primitives are OpenSSL's, through the libcrypto
jolt already loads for TLS; there is no other crypto to borrow and an
Ed25519 written by hand is not a thing to put in a chat client.

`echo-message` comes with it. Without it our own lines never came back
and the local echo had no msgid, so a reaction on something we said had
no message to name — the same silence, one step earlier.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-08-30T19:45:11-07:00 Browse files
767b3bf parent: fd9ad7e
modified src/frq/irc.jolt +57 -15
@@ -16,6 +16,7 @@
1616 `send-line!` and `close!` accept."
1717 (:require [clojure.string :as str]
1818 [frq.atproto :as atproto]
19+ [frq.msgsig :as msgsig]
1920 [jolt.ffi :as ffi]
2021 [jolt.host :as host]
2122 [jolt.mvn-http :as tls]
@@ -250,7 +251,7 @@
250251 ;; which is 30 seconds of nothing being sent.
251252 (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil))
252253 {:kind :tls :tls t :outbox (atom [])
253- :lock (Object.) :nick nick}))
254+ :lock (Object.) :nick nick :caps (atom #{})}))
254255 (let [ip (#'socket/ip->str (socket/resolve-host host))
255256 fd (socket/c-socket af-inet sock-stream 0)]
256257 (when (neg? fd) (throw (ex-info "socket() failed" {:host host})))
@@ -259,7 +260,7 @@
259260 (socket/c-close fd)
260261 (throw (ex-info "connect() failed" {:host host :ip ip :port port}))))
261262 {:kind :plain :fd fd :buf (ffi/alloc buffer-size)
262- :lock (Object.) :nick nick})))
263+ :lock (Object.) :nick nick :caps (atom #{})})))
263264
264265 (def ^:private sasl-chunk 400)
265266
@@ -284,8 +285,23 @@
284285 whatever someone chose today, and the hostmask carries eight characters of a
285286 DID, too few to resolve. Both need `message-tags` beside them, since IRCv3
286287 sends tags only to clients that asked for tags at all; either one alone is
287- ACKed and then nothing arrives."
288- ["message-tags" "server-time" "account-tag"])
288+ ACKed and then nothing arrives.
289+
290+ `echo-message`: the server sends our own lines back to us, which is the only
291+ way this client learns the msgid of something it said. Without it our own
292+ messages sit in the buffer with no id, and a reaction or a reply aimed at one
293+ has nothing to name the pill appears here and nobody else ever sees it.
294+
295+ `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers
296+ an unsigned mutation from an account with
297+ `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can
298+ register a key and sign one."
299+ ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"])
300+
301+(defn cap-acked?
302+ "Whether the server agreed to `cap` on this connection."
303+ [conn cap]
304+ (boolean (when-let [caps (:caps conn)] (contains? @caps cap))))
289305
290306 (defn- cap-step!
291307 "Drive capability negotiation, and the SASL exchange inside it when there is
@@ -304,9 +320,13 @@
304320 (send-line! conn "CAP END"))
305321 ;; SASL, when acked, ends negotiation itself CAP END waits
306322 ;; for the exchange to finish either way.
307- "ACK" (if (str/includes? (or caps "") "sasl")
308- (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE")
309- (send-line! conn "CAP END"))
323+ "ACK" (do
324+ (when-let [acked (:caps conn)]
325+ (swap! acked into (remove str/blank?
326+ (str/split (or caps "") #"\s+"))))
327+ (if (str/includes? (or caps "") "sasl")
328+ (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE")
329+ (send-line! conn "CAP END")))
310330 "NAK" (send-line! conn "CAP END")
311331 nil))
312332 ;; The challenge arrives as base64url JSON; the nonce inside it is what
@@ -316,8 +336,18 @@
316336 (let [nonce (atproto/json-str
317337 (atproto/b64-decode challenge) "nonce")]
318338 (authenticate! conn (atproto/sasl-response session nonce)))))
319- ;; 903 logged in, 904/905/906 did not.
320- ("903" "904" "905" "906") (send-line! conn "CAP END")
339+ ;; 903 logged in, 904/905/906 did not. A login is also the moment this
340+ ;; connection can have a signing key: the DID it signs as is only settled
341+ ;; here. The key is registered at 001 rather than now MSGSIG is a
342+ ;; registered-client command, and negotiation has not ended yet.
343+ "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session))
344+ (msgsig/generate! (:did session)))
345+ (send-line! conn "CAP END"))
346+ ("904" "905" "906") (send-line! conn "CAP END")
347+ ;; Welcomed. Hand the server the public half, and every reaction from
348+ ;; here on carries a signature it will take.
349+ "001" (when-let [pub (msgsig/public-key)]
350+ (send-line! conn (str "MSGSIG " pub)))
321351 nil))
322352 msg)
323353
@@ -365,15 +395,27 @@
365395 (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target))))
366396
367397 (defn react!
368- "Put `emoji` on the message `msgid`, for everyone in `target` to see."
369- [conn target msgid emoji]
370- (tagmsg! conn target {"+react" emoji "+reply" msgid}))
398+ "Put `emoji` on the message `msgid`, for everyone in `target` to see.
399+
400+ Signed when this connection has a key. `peer-did` is who the DM is with, and
401+ is what a DM signature names the conversation by; a channel does not need it."
402+ ([conn target msgid emoji] (react! conn target msgid emoji nil))
403+ ([conn target msgid emoji peer-did]
404+ (tagmsg! conn target (merge {"+react" emoji "+reply" msgid}
405+ (msgsig/mutation-tags "react" target msgid
406+ emoji peer-did)))))
371407
372408 (defn unreact!
373409 "Take it off again. The server keys the removal by DID where there is one, so
374- it survives a nick change and cannot be done on someone else's behalf."
375- [conn target msgid emoji]
376- (tagmsg! conn target {"+freeq.at/unreact" emoji "+reply" msgid}))
410+ it survives a nick change and cannot be done on someone else's behalf.
411+
412+ Signed like the reaction it undoes — taking a pill off is as much a change to
413+ a message as putting one on, and the server asks for the same proof."
414+ ([conn target msgid emoji] (unreact! conn target msgid emoji nil))
415+ ([conn target msgid emoji peer-did]
416+ (tagmsg! conn target (merge {"+freeq.at/unreact" emoji "+reply" msgid}
417+ (msgsig/mutation-tags "unreact" target msgid
418+ emoji peer-did)))))
377419
378420 (defn close! [conn]
379421 ;; Written straight out rather than queued: the reader may already be gone,
@@ -16,6 +16,7 @@
16 `send-line!` and `close!` accept."16 `send-line!` and `close!` accept."
17 (:require [clojure.string :as str]17 (:require [clojure.string :as str]
18 [frq.atproto :as atproto]18 [frq.atproto :as atproto]
19+ [frq.msgsig :as msgsig]
19 [jolt.ffi :as ffi]20 [jolt.ffi :as ffi]
20 [jolt.host :as host]21 [jolt.host :as host]
21 [jolt.mvn-http :as tls]22 [jolt.mvn-http :as tls]
@@ -250,7 +251,7 @@
250 ;; which is 30 seconds of nothing being sent.251 ;; which is 30 seconds of nothing being sent.
251 (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil))252 (try (#'tls/set-timeouts! (:sock t) tls-poll-ms) (catch Exception _ nil))
252 {:kind :tls :tls t :outbox (atom [])253 {:kind :tls :tls t :outbox (atom [])
253- :lock (Object.) :nick nick}))254+ :lock (Object.) :nick nick :caps (atom #{})}))
254 (let [ip (#'socket/ip->str (socket/resolve-host host))255 (let [ip (#'socket/ip->str (socket/resolve-host host))
255 fd (socket/c-socket af-inet sock-stream 0)]256 fd (socket/c-socket af-inet sock-stream 0)]
256 (when (neg? fd) (throw (ex-info "socket() failed" {:host host})))257 (when (neg? fd) (throw (ex-info "socket() failed" {:host host})))
@@ -259,7 +260,7 @@
259 (socket/c-close fd)260 (socket/c-close fd)
260 (throw (ex-info "connect() failed" {:host host :ip ip :port port}))))261 (throw (ex-info "connect() failed" {:host host :ip ip :port port}))))
261 {:kind :plain :fd fd :buf (ffi/alloc buffer-size)262 {:kind :plain :fd fd :buf (ffi/alloc buffer-size)
262- :lock (Object.) :nick nick})))263+ :lock (Object.) :nick nick :caps (atom #{})})))
263 264
264 (def ^:private sasl-chunk 400)265 (def ^:private sasl-chunk 400)
265 266
@@ -284,8 +285,23 @@
284 whatever someone chose today, and the hostmask carries eight characters of a285 whatever someone chose today, and the hostmask carries eight characters of a
285 DID, too few to resolve. Both need `message-tags` beside them, since IRCv3286 DID, too few to resolve. Both need `message-tags` beside them, since IRCv3
286 sends tags only to clients that asked for tags at all; either one alone is287 sends tags only to clients that asked for tags at all; either one alone is
287- ACKed and then nothing arrives."288+ ACKed and then nothing arrives.
288- ["message-tags" "server-time" "account-tag"])289+
290+ `echo-message`: the server sends our own lines back to us, which is the only
291+ way this client learns the msgid of something it said. Without it our own
292+ messages sit in the buffer with no id, and a reaction or a reply aimed at one
293+ has nothing to name the pill appears here and nobody else ever sees it.
294+
295+ `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers
296+ an unsigned mutation from an account with
297+ `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can
298+ register a key and sign one."
299+ ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"])
300+
301+(defn cap-acked?
302+ "Whether the server agreed to `cap` on this connection."
303+ [conn cap]
304+ (boolean (when-let [caps (:caps conn)] (contains? @caps cap))))
289 305
290 (defn- cap-step!306 (defn- cap-step!
291 "Drive capability negotiation, and the SASL exchange inside it when there is307 "Drive capability negotiation, and the SASL exchange inside it when there is
@@ -304,9 +320,13 @@
304 (send-line! conn "CAP END"))320 (send-line! conn "CAP END"))
305 ;; SASL, when acked, ends negotiation itself CAP END waits321 ;; SASL, when acked, ends negotiation itself CAP END waits
306 ;; for the exchange to finish either way.322 ;; for the exchange to finish either way.
307- "ACK" (if (str/includes? (or caps "") "sasl")323+ "ACK" (do
308- (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE")324+ (when-let [acked (:caps conn)]
309- (send-line! conn "CAP END"))325+ (swap! acked into (remove str/blank?
326+ (str/split (or caps "") #"\s+"))))
327+ (if (str/includes? (or caps "") "sasl")
328+ (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE")
329+ (send-line! conn "CAP END")))
310 "NAK" (send-line! conn "CAP END")330 "NAK" (send-line! conn "CAP END")
311 nil))331 nil))
312 ;; The challenge arrives as base64url JSON; the nonce inside it is what332 ;; The challenge arrives as base64url JSON; the nonce inside it is what
@@ -316,8 +336,18 @@
316 (let [nonce (atproto/json-str336 (let [nonce (atproto/json-str
317 (atproto/b64-decode challenge) "nonce")]337 (atproto/b64-decode challenge) "nonce")]
318 (authenticate! conn (atproto/sasl-response session nonce)))))338 (authenticate! conn (atproto/sasl-response session nonce)))))
319- ;; 903 logged in, 904/905/906 did not.339+ ;; 903 logged in, 904/905/906 did not. A login is also the moment this
320- ("903" "904" "905" "906") (send-line! conn "CAP END")340+ ;; connection can have a signing key: the DID it signs as is only settled
341+ ;; here. The key is registered at 001 rather than now MSGSIG is a
342+ ;; registered-client command, and negotiation has not ended yet.
343+ "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session))
344+ (msgsig/generate! (:did session)))
345+ (send-line! conn "CAP END"))
346+ ("904" "905" "906") (send-line! conn "CAP END")
347+ ;; Welcomed. Hand the server the public half, and every reaction from
348+ ;; here on carries a signature it will take.
349+ "001" (when-let [pub (msgsig/public-key)]
350+ (send-line! conn (str "MSGSIG " pub)))
321 nil))351 nil))
322 msg)352 msg)
323 353
@@ -365,15 +395,27 @@
365 (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target))))395 (send-line! conn (str "@" (str/join ";" pairs) " TAGMSG " target))))
366 396
367 (defn react!397 (defn react!
368- "Put `emoji` on the message `msgid`, for everyone in `target` to see."398+ "Put `emoji` on the message `msgid`, for everyone in `target` to see.
369- [conn target msgid emoji]399+
370- (tagmsg! conn target {"+react" emoji "+reply" msgid}))400+ Signed when this connection has a key. `peer-did` is who the DM is with, and
401+ is what a DM signature names the conversation by; a channel does not need it."
402+ ([conn target msgid emoji] (react! conn target msgid emoji nil))
403+ ([conn target msgid emoji peer-did]
404+ (tagmsg! conn target (merge {"+react" emoji "+reply" msgid}
405+ (msgsig/mutation-tags "react" target msgid
406+ emoji peer-did)))))
371 407
372 (defn unreact!408 (defn unreact!
373 "Take it off again. The server keys the removal by DID where there is one, so409 "Take it off again. The server keys the removal by DID where there is one, so
374- it survives a nick change and cannot be done on someone else's behalf."410+ it survives a nick change and cannot be done on someone else's behalf.
375- [conn target msgid emoji]411+
376- (tagmsg! conn target {"+freeq.at/unreact" emoji "+reply" msgid}))412+ Signed like the reaction it undoes — taking a pill off is as much a change to
413+ a message as putting one on, and the server asks for the same proof."
414+ ([conn target msgid emoji] (unreact! conn target msgid emoji nil))
415+ ([conn target msgid emoji peer-did]
416+ (tagmsg! conn target (merge {"+freeq.at/unreact" emoji "+reply" msgid}
417+ (msgsig/mutation-tags "unreact" target msgid
418+ emoji peer-did)))))
377 419
378 (defn close! [conn]420 (defn close! [conn]
379 ;; Written straight out rather than queued: the reader may already be gone,421 ;; Written straight out rather than queued: the reader may already be gone,
added src/frq/msgsig.jolt +225 -0
new file mode 100644
@@ -0,0 +1,225 @@
1+(ns frq.msgsig
2+ "Ed25519 signatures for the mutations freeq will not take on trust.
3+
4+ A reaction is not a message: it changes something already said, and the
5+ server refuses an unsigned one from an account
6+ `FAIL TAGMSG SIGNATURE_REQUIRED`. Guests are exempt, which is why a react
7+ looks fine from a guest connection and vanishes from every other client the
8+ moment you sign in.
9+
10+ So a signed-in connection mints a throwaway Ed25519 key, registers the public
11+ half with `MSGSIG` once it is welcomed, and signs each mutation over a
12+ canonical description of what it does: who, what kind, which message, where,
13+ and with which emoji. The key lives as long as the connection and is never
14+ written down it says only \"the account on this session did this\", which
15+ is all the server is asking.
16+
17+ The primitives are OpenSSL's, reached through the same libcrypto jolt already
18+ loads for TLS. There is no other crypto here to borrow, and an Ed25519
19+ written by hand is not a thing to put in a chat client."
20+ (:require [clojure.string :as str]
21+ [jolt.ffi :as ffi]
22+ [jolt.host :as host]
23+ [jolt.mvn-http :as tls]))
24+
25+;; ---------------------------------------------------------------- libcrypto
26+
27+(ffi/defcfn c-rand-bytes "RAND_bytes" [:pointer :int] :int)
28+(ffi/defcfn c-new-raw-priv "EVP_PKEY_new_raw_private_key"
29+ [:int :pointer :pointer :size_t] :pointer)
30+(ffi/defcfn c-get-raw-pub "EVP_PKEY_get_raw_public_key"
31+ [:pointer :pointer :pointer] :int)
32+(ffi/defcfn c-pkey-free "EVP_PKEY_free" [:pointer] :void)
33+(ffi/defcfn c-md-ctx-new "EVP_MD_CTX_new" [] :pointer)
34+(ffi/defcfn c-md-ctx-free "EVP_MD_CTX_free" [:pointer] :void)
35+(ffi/defcfn c-sign-init "EVP_DigestSignInit"
36+ [:pointer :pointer :pointer :pointer :pointer] :int)
37+(ffi/defcfn c-sign "EVP_DigestSign" [:pointer :pointer :pointer :pointer :size_t] :int)
38+(ffi/defcfn c-sha256 "SHA256" [:pointer :size_t :pointer] :pointer)
39+
40+;; EVP_PKEY_ED25519. The one NID this namespace needs, and the one number in
41+;; OpenSSL's table that would be a silent wrong key if it were wrong.
42+(def ^:private nid-ed25519 1087)
43+
44+;; ---------------------------------------------------------------- encoding
45+
46+(def ^:private b64url-alphabet
47+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
48+
49+(defn- b64url
50+ "base64url of raw bytes, unpadded — how freeq writes a key and a signature.
51+
52+ `frq.atproto/b64-encode` is the same encoding over a *string*, and a
53+ signature is not one: run through a String it would come back re-encoded and
54+ no longer verify."
55+ [bs]
56+ (let [bs (mapv #(bit-and (int %) 0xff) bs)]
57+ (apply str
58+ (for [group (partition-all 3 bs)
59+ :let [[a b c] group
60+ n (count group)
61+ v (+ (bit-shift-left a 16)
62+ (bit-shift-left (or b 0) 8)
63+ (or c 0))]
64+ i (range (inc n))]
65+ (nth b64url-alphabet
66+ (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
67+
68+(defn- random-bytes
69+ "`n` bytes from OpenSSL's CSPRNG, or nil if it will not give them."
70+ [n]
71+ (let [buf (ffi/alloc n)]
72+ (try (when (= 1 (c-rand-bytes buf n)) (ffi/read-array buf n))
73+ (finally (ffi/free buf)))))
74+
75+(defn- sha256 [bs]
76+ (let [n (alength bs)
77+ in (ffi/alloc (max 1 n))
78+ out (ffi/alloc 32)]
79+ (try (ffi/write-array in bs)
80+ (c-sha256 in n out)
81+ (ffi/read-array out 32)
82+ (finally (ffi/free in) (ffi/free out)))))
83+
84+;; ---------------------------------------------------------------- the key
85+
86+;; One key per connection: {:pkey <EVP_PKEY*> :public <b64url> :kid <b64url>
87+;; :did <did>}. Held here rather than on the connection because a signature is
88+;; not something the transport should be able to hand out.
89+(defonce ^:private signer (atom nil))
90+
91+(defn forget!
92+ "Drop the session key. Called when the connection goes, so a reconnect signs
93+ with a key the server has actually been told about."
94+ []
95+ (when-let [{:keys [pkey]} @signer]
96+ (try (c-pkey-free pkey) (catch Exception _ nil)))
97+ (reset! signer nil))
98+
99+(defn public-key
100+ "This connection's public key as base64url, or nil before there is one."
101+ []
102+ (:public @signer))
103+
104+(defn generate!
105+ "Mint this connection's signing key for `did`, and return the public half as
106+ base64url the argument `MSGSIG` takes. nil if libcrypto will not play, and
107+ then nothing is signed and reactions stay a thing only this client sees.
108+
109+ The private key is a random 32-byte seed rather than a keygen context: for
110+ Ed25519 the seed *is* the key, and `EVP_PKEY_new_raw_private_key` is the
111+ whole of it."
112+ [did]
113+ (forget!)
114+ (try
115+ (tls/ensure-native!)
116+ (when-let [seed (random-bytes 32)]
117+ (let [buf (ffi/alloc 32)]
118+ (try
119+ (ffi/write-array buf seed)
120+ (let [pkey (c-new-raw-priv nid-ed25519 ffi/null buf 32)]
121+ (when-not (ffi/null? pkey)
122+ (let [pub (ffi/alloc 32)
123+ plen (ffi/alloc (ffi/sizeof :size_t))]
124+ (try
125+ (ffi/write plen :size_t 0 32)
126+ (when (= 1 (c-get-raw-pub pkey pub plen))
127+ (let [raw (ffi/read-array pub 32)]
128+ (reset! signer
129+ {:pkey pkey
130+ :did did
131+ :public (b64url raw)
132+ ;; The key id freeq names a signature by: the
133+ ;; first half of the key's own SHA-256.
134+ :kid (b64url (take 16 (sha256 raw)))})
135+ (:public @signer)))
136+ (finally (ffi/free pub) (ffi/free plen))))))
137+ (finally (ffi/free buf)))))
138+ (catch Exception _ nil)))
139+
140+(defn- sign-bytes
141+ "An Ed25519 signature over `bs`, as `ed25519:<kid>:<b64url>` — the shape
142+ freeq's `+freeq.at/sig` carries."
143+ [bs]
144+ (when-let [{:keys [pkey kid]} @signer]
145+ (let [n (alength bs)
146+ msg (ffi/alloc (max 1 n))
147+ sig (ffi/alloc 64)
148+ slen (ffi/alloc (ffi/sizeof :size_t))
149+ ctx (c-md-ctx-new)]
150+ (try
151+ (ffi/write-array msg bs)
152+ (ffi/write slen :size_t 0 64)
153+ (when (and (= 1 (c-sign-init ctx ffi/null ffi/null ffi/null pkey))
154+ (= 1 (c-sign ctx sig slen msg n)))
155+ (str "ed25519:" kid ":" (b64url (ffi/read-array sig (ffi/read slen :size_t)))))
156+ (catch Exception _ nil)
157+ (finally (ffi/free msg) (ffi/free sig) (ffi/free slen) (c-md-ctx-free ctx))))))
158+
159+;; ---------------------------------------------------------------- canonical
160+
161+(defn- json-string [s]
162+ (str "\"" (-> (or s "")
163+ (str/replace "\\" "\\\\")
164+ (str/replace "\"" "\\\""))
165+ "\""))
166+
167+(defn- canonical
168+ "The bytes that get signed: a JSON object with its keys in sorted order and
169+ no space in it. Both ends build this string from the same fields and neither
170+ sends it a signature over anything else is a signature over nothing."
171+ [m]
172+ (.getBytes (str "{"
173+ (str/join "," (for [[k v] (into (sorted-map) m)]
174+ (str (json-string k) ":" (json-string v))))
175+ "}")
176+ "UTF-8"))
177+
178+(def ^:private crockford "0123456789ABCDEFGHJKMNPQRSTVWXYZ")
179+
180+(defn- event-id
181+ "A fresh id for this mutation: ten characters of the clock, then sixteen of
182+ chance. Sortable like the msgids the server hands out, and unguessable
183+ enough that two clients cannot mint the same one."
184+ []
185+ (let [t (loop [t (quot (host/wall-nanos) 1000000) out ""]
186+ (if (>= (count out) 10)
187+ out
188+ (recur (quot t 32) (str (nth crockford (mod t 32)) out))))]
189+ (apply str t (for [b (or (random-bytes 16) (repeat 16 0))]
190+ (nth crockford (mod (bit-and (int b) 0xff) 32))))))
191+
192+(defn signing-target
193+ "How freeq names the place a mutation happens: a channel by its lowercased
194+ name, a DM by both DIDs in sorted order. nil when there is no way to say it
195+ a DM with someone whose DID we have not seen yet and an unsigned
196+ mutation is better than one signed over the wrong thing."
197+ [target our-did peer-did]
198+ (cond
199+ (or (str/starts-with? (or target "") "#")
200+ (str/starts-with? (or target "") "&")) (str/lower-case target)
201+ (and (seq our-did) (seq peer-did)) (if (<= (compare our-did peer-did) 0)
202+ (str "dm:" our-did "," peer-did)
203+ (str "dm:" peer-did "," our-did))
204+ :else nil))
205+
206+(defn mutation-tags
207+ "The two tags that make a mutation acceptable: the event id and the signature
208+ over it. Empty when this connection has no key a guest signs nothing, and
209+ the server asks nothing of one."
210+ [kind target subject emoji peer-did]
211+ (let [{:keys [did]} @signer]
212+ (or (when did
213+ (when-let [signed-target (signing-target target did peer-did)]
214+ (let [id (event-id)
215+ fields (cond-> {"from" did
216+ "kind" kind
217+ "msgid" id
218+ "subject" subject
219+ "target" signed-target}
220+ (and (seq (or emoji "")) (not= "delete" kind))
221+ (assoc "emoji" emoji))]
222+ (when-let [sig (sign-bytes (canonical fields))]
223+ {"+freeq.at/eventid" id
224+ "+freeq.at/sig" sig}))))
225+ {})))
new file mode 100644
@@ -0,0 +1,225 @@
1+(ns frq.msgsig
2+ "Ed25519 signatures for the mutations freeq will not take on trust.
3+
4+ A reaction is not a message: it changes something already said, and the
5+ server refuses an unsigned one from an account
6+ `FAIL TAGMSG SIGNATURE_REQUIRED`. Guests are exempt, which is why a react
7+ looks fine from a guest connection and vanishes from every other client the
8+ moment you sign in.
9+
10+ So a signed-in connection mints a throwaway Ed25519 key, registers the public
11+ half with `MSGSIG` once it is welcomed, and signs each mutation over a
12+ canonical description of what it does: who, what kind, which message, where,
13+ and with which emoji. The key lives as long as the connection and is never
14+ written down it says only \"the account on this session did this\", which
15+ is all the server is asking.
16+
17+ The primitives are OpenSSL's, reached through the same libcrypto jolt already
18+ loads for TLS. There is no other crypto here to borrow, and an Ed25519
19+ written by hand is not a thing to put in a chat client."
20+ (:require [clojure.string :as str]
21+ [jolt.ffi :as ffi]
22+ [jolt.host :as host]
23+ [jolt.mvn-http :as tls]))
24+
25+;; ---------------------------------------------------------------- libcrypto
26+
27+(ffi/defcfn c-rand-bytes "RAND_bytes" [:pointer :int] :int)
28+(ffi/defcfn c-new-raw-priv "EVP_PKEY_new_raw_private_key"
29+ [:int :pointer :pointer :size_t] :pointer)
30+(ffi/defcfn c-get-raw-pub "EVP_PKEY_get_raw_public_key"
31+ [:pointer :pointer :pointer] :int)
32+(ffi/defcfn c-pkey-free "EVP_PKEY_free" [:pointer] :void)
33+(ffi/defcfn c-md-ctx-new "EVP_MD_CTX_new" [] :pointer)
34+(ffi/defcfn c-md-ctx-free "EVP_MD_CTX_free" [:pointer] :void)
35+(ffi/defcfn c-sign-init "EVP_DigestSignInit"
36+ [:pointer :pointer :pointer :pointer :pointer] :int)
37+(ffi/defcfn c-sign "EVP_DigestSign" [:pointer :pointer :pointer :pointer :size_t] :int)
38+(ffi/defcfn c-sha256 "SHA256" [:pointer :size_t :pointer] :pointer)
39+
40+;; EVP_PKEY_ED25519. The one NID this namespace needs, and the one number in
41+;; OpenSSL's table that would be a silent wrong key if it were wrong.
42+(def ^:private nid-ed25519 1087)
43+
44+;; ---------------------------------------------------------------- encoding
45+
46+(def ^:private b64url-alphabet
47+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
48+
49+(defn- b64url
50+ "base64url of raw bytes, unpadded — how freeq writes a key and a signature.
51+
52+ `frq.atproto/b64-encode` is the same encoding over a *string*, and a
53+ signature is not one: run through a String it would come back re-encoded and
54+ no longer verify."
55+ [bs]
56+ (let [bs (mapv #(bit-and (int %) 0xff) bs)]
57+ (apply str
58+ (for [group (partition-all 3 bs)
59+ :let [[a b c] group
60+ n (count group)
61+ v (+ (bit-shift-left a 16)
62+ (bit-shift-left (or b 0) 8)
63+ (or c 0))]
64+ i (range (inc n))]
65+ (nth b64url-alphabet
66+ (bit-and (bit-shift-right v (* 6 (- 3 i))) 0x3f))))))
67+
68+(defn- random-bytes
69+ "`n` bytes from OpenSSL's CSPRNG, or nil if it will not give them."
70+ [n]
71+ (let [buf (ffi/alloc n)]
72+ (try (when (= 1 (c-rand-bytes buf n)) (ffi/read-array buf n))
73+ (finally (ffi/free buf)))))
74+
75+(defn- sha256 [bs]
76+ (let [n (alength bs)
77+ in (ffi/alloc (max 1 n))
78+ out (ffi/alloc 32)]
79+ (try (ffi/write-array in bs)
80+ (c-sha256 in n out)
81+ (ffi/read-array out 32)
82+ (finally (ffi/free in) (ffi/free out)))))
83+
84+;; ---------------------------------------------------------------- the key
85+
86+;; One key per connection: {:pkey <EVP_PKEY*> :public <b64url> :kid <b64url>
87+;; :did <did>}. Held here rather than on the connection because a signature is
88+;; not something the transport should be able to hand out.
89+(defonce ^:private signer (atom nil))
90+
91+(defn forget!
92+ "Drop the session key. Called when the connection goes, so a reconnect signs
93+ with a key the server has actually been told about."
94+ []
95+ (when-let [{:keys [pkey]} @signer]
96+ (try (c-pkey-free pkey) (catch Exception _ nil)))
97+ (reset! signer nil))
98+
99+(defn public-key
100+ "This connection's public key as base64url, or nil before there is one."
101+ []
102+ (:public @signer))
103+
104+(defn generate!
105+ "Mint this connection's signing key for `did`, and return the public half as
106+ base64url the argument `MSGSIG` takes. nil if libcrypto will not play, and
107+ then nothing is signed and reactions stay a thing only this client sees.
108+
109+ The private key is a random 32-byte seed rather than a keygen context: for
110+ Ed25519 the seed *is* the key, and `EVP_PKEY_new_raw_private_key` is the
111+ whole of it."
112+ [did]
113+ (forget!)
114+ (try
115+ (tls/ensure-native!)
116+ (when-let [seed (random-bytes 32)]
117+ (let [buf (ffi/alloc 32)]
118+ (try
119+ (ffi/write-array buf seed)
120+ (let [pkey (c-new-raw-priv nid-ed25519 ffi/null buf 32)]
121+ (when-not (ffi/null? pkey)
122+ (let [pub (ffi/alloc 32)
123+ plen (ffi/alloc (ffi/sizeof :size_t))]
124+ (try
125+ (ffi/write plen :size_t 0 32)
126+ (when (= 1 (c-get-raw-pub pkey pub plen))
127+ (let [raw (ffi/read-array pub 32)]
128+ (reset! signer
129+ {:pkey pkey
130+ :did did
131+ :public (b64url raw)
132+ ;; The key id freeq names a signature by: the
133+ ;; first half of the key's own SHA-256.
134+ :kid (b64url (take 16 (sha256 raw)))})
135+ (:public @signer)))
136+ (finally (ffi/free pub) (ffi/free plen))))))
137+ (finally (ffi/free buf)))))
138+ (catch Exception _ nil)))
139+
140+(defn- sign-bytes
141+ "An Ed25519 signature over `bs`, as `ed25519:<kid>:<b64url>` — the shape
142+ freeq's `+freeq.at/sig` carries."
143+ [bs]
144+ (when-let [{:keys [pkey kid]} @signer]
145+ (let [n (alength bs)
146+ msg (ffi/alloc (max 1 n))
147+ sig (ffi/alloc 64)
148+ slen (ffi/alloc (ffi/sizeof :size_t))
149+ ctx (c-md-ctx-new)]
150+ (try
151+ (ffi/write-array msg bs)
152+ (ffi/write slen :size_t 0 64)
153+ (when (and (= 1 (c-sign-init ctx ffi/null ffi/null ffi/null pkey))
154+ (= 1 (c-sign ctx sig slen msg n)))
155+ (str "ed25519:" kid ":" (b64url (ffi/read-array sig (ffi/read slen :size_t)))))
156+ (catch Exception _ nil)
157+ (finally (ffi/free msg) (ffi/free sig) (ffi/free slen) (c-md-ctx-free ctx))))))
158+
159+;; ---------------------------------------------------------------- canonical
160+
161+(defn- json-string [s]
162+ (str "\"" (-> (or s "")
163+ (str/replace "\\" "\\\\")
164+ (str/replace "\"" "\\\""))
165+ "\""))
166+
167+(defn- canonical
168+ "The bytes that get signed: a JSON object with its keys in sorted order and
169+ no space in it. Both ends build this string from the same fields and neither
170+ sends it a signature over anything else is a signature over nothing."
171+ [m]
172+ (.getBytes (str "{"
173+ (str/join "," (for [[k v] (into (sorted-map) m)]
174+ (str (json-string k) ":" (json-string v))))
175+ "}")
176+ "UTF-8"))
177+
178+(def ^:private crockford "0123456789ABCDEFGHJKMNPQRSTVWXYZ")
179+
180+(defn- event-id
181+ "A fresh id for this mutation: ten characters of the clock, then sixteen of
182+ chance. Sortable like the msgids the server hands out, and unguessable
183+ enough that two clients cannot mint the same one."
184+ []
185+ (let [t (loop [t (quot (host/wall-nanos) 1000000) out ""]
186+ (if (>= (count out) 10)
187+ out
188+ (recur (quot t 32) (str (nth crockford (mod t 32)) out))))]
189+ (apply str t (for [b (or (random-bytes 16) (repeat 16 0))]
190+ (nth crockford (mod (bit-and (int b) 0xff) 32))))))
191+
192+(defn signing-target
193+ "How freeq names the place a mutation happens: a channel by its lowercased
194+ name, a DM by both DIDs in sorted order. nil when there is no way to say it
195+ a DM with someone whose DID we have not seen yet and an unsigned
196+ mutation is better than one signed over the wrong thing."
197+ [target our-did peer-did]
198+ (cond
199+ (or (str/starts-with? (or target "") "#")
200+ (str/starts-with? (or target "") "&")) (str/lower-case target)
201+ (and (seq our-did) (seq peer-did)) (if (<= (compare our-did peer-did) 0)
202+ (str "dm:" our-did "," peer-did)
203+ (str "dm:" peer-did "," our-did))
204+ :else nil))
205+
206+(defn mutation-tags
207+ "The two tags that make a mutation acceptable: the event id and the signature
208+ over it. Empty when this connection has no key a guest signs nothing, and
209+ the server asks nothing of one."
210+ [kind target subject emoji peer-did]
211+ (let [{:keys [did]} @signer]
212+ (or (when did
213+ (when-let [signed-target (signing-target target did peer-did)]
214+ (let [id (event-id)
215+ fields (cond-> {"from" did
216+ "kind" kind
217+ "msgid" id
218+ "subject" subject
219+ "target" signed-target}
220+ (and (seq (or emoji "")) (not= "delete" kind))
221+ (assoc "emoji" emoji))]
222+ (when-let [sig (sign-bytes (canonical fields))]
223+ {"+freeq.at/eventid" id
224+ "+freeq.at/sig" sig}))))
225+ {})))
modified src/frq/state.jolt +37 -9
@@ -12,6 +12,7 @@
1212 [frq.clock :as clock]
1313 [frq.emoji :as emoji]
1414 [frq.irc :as irc]
15+ [frq.msgsig :as msgsig]
1516 [frq.avatars :as avatars]
1617 [frq.media :as media]
1718 [frq.oauth :as oauth]
@@ -340,8 +341,13 @@
340341 at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms))
341342 tags (:tags msg)
342343 ;; a DM addressed to us belongs in a buffer named for the
343- ;; sender, not for our own nick
344- buffer (if (str/starts-with? (or target "") "#") target from)]
344+ ;; sender, not for our own nick — except when the sender
345+ ;; is us: `echo-message` sends our own DM back, and the
346+ ;; buffer it belongs to is the one we sent it to.
347+ buffer (cond
348+ (str/starts-with? (or target "") "#") target
349+ (= from @form-nick) target
350+ :else from)]
345351 (push-message! buffer from text
346352 {:at at
347353 :did (:account msg)
@@ -435,7 +441,11 @@
435441 (store/clear-session!)
436442 (reset! error (str "Bluesky sign-in refused: "
437443 (or (last params) "no reason given"))))
438- "*DISCONNECTED*" (do (reset! conn nil)
444+ ;; The signing key belonged to that connection: the server forgets it
445+ ;; when the session ends, and signing with it afterwards would be
446+ ;; signing with a key nobody can check.
447+ "*DISCONNECTED*" (do (msgsig/forget!)
448+ (reset! conn nil)
439449 (reset! connecting? false)
440450 (swap! channels
441451 #(reduce-kv (fn [m k v]
@@ -878,9 +888,11 @@
878888 ;; Saying something is a way of asking to see it.
879889 (jump-to-present!)
880890 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
881- ;; The local echo carries the same link, so the chip is there before
882- ;; the server's copy of the line comes back — if it ever does.
883- (push-message! target @form-nick line {:reply-to (:id reply-to)})
891+ ;; Only when the server will not send the line back itself. Its copy
892+ ;; carries the msgid, and a message with no id is one nobody can react
893+ ;; or reply to; echoing locally as well would put the line up twice.
894+ (when-not (some-> @conn (irc/cap-acked? "echo-message"))
895+ (push-message! target @form-nick line {:reply-to (:id reply-to)}))
884896 (reset! replying-to nil)
885897 (reset! draft "")
886898 (when att
@@ -930,6 +942,17 @@
930942 group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog))
931943 :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular))))
932944
945+(defn- dm-peer-did
946+ "The DID of whoever this DM buffer is with, from the last thing they said.
947+ nil for a channel, and for a conversation where nobody with a DID has spoken
948+ — a signature over a DM needs both sides named, and there is nothing to name."
949+ [channel]
950+ (when-not (str/starts-with? (or channel "") "#")
951+ (->> (get-in @channels [channel :messages])
952+ (remove #(= @form-nick (:from %)))
953+ (keep :did)
954+ last)))
955+
933956 (defn my-reaction?
934957 "Whether this nick is already on that emoji — which is what makes a second
935958 click take it off rather than send the same reaction twice."
@@ -944,11 +967,16 @@
944967 appear once someone else reacted too."
945968 [channel m emoji]
946969 (when-let [msgid (:id m)]
947- (let [on? (not (my-reaction? m emoji))]
970+ (let [on? (not (my-reaction? m emoji))
971+ ;; Who the DM is with, for the signature: freeq names a DM by both
972+ ;; DIDs rather than by a nick, and nothing else in a buffer says
973+ ;; which account the other side is. nil in a channel, which is named
974+ ;; by itself.
975+ peer (dm-peer-did channel)]
948976 (when-let [c @conn]
949977 (if on?
950- (irc/react! c channel msgid emoji)
951- (irc/unreact! c channel msgid emoji)))
978+ (irc/react! c channel msgid emoji peer)
979+ (irc/unreact! c channel msgid emoji peer)))
952980 (update-reaction! channel msgid emoji @form-nick on?))))
953981
954982 (defn start-call!
@@ -12,6 +12,7 @@
12 [frq.clock :as clock]12 [frq.clock :as clock]
13 [frq.emoji :as emoji]13 [frq.emoji :as emoji]
14 [frq.irc :as irc]14 [frq.irc :as irc]
15+ [frq.msgsig :as msgsig]
15 [frq.avatars :as avatars]16 [frq.avatars :as avatars]
16 [frq.media :as media]17 [frq.media :as media]
17 [frq.oauth :as oauth]18 [frq.oauth :as oauth]
@@ -340,8 +341,13 @@
340 at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms))341 at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms))
341 tags (:tags msg)342 tags (:tags msg)
342 ;; a DM addressed to us belongs in a buffer named for the343 ;; a DM addressed to us belongs in a buffer named for the
343- ;; sender, not for our own nick344+ ;; sender, not for our own nick — except when the sender
344- buffer (if (str/starts-with? (or target "") "#") target from)]345+ ;; is us: `echo-message` sends our own DM back, and the
346+ ;; buffer it belongs to is the one we sent it to.
347+ buffer (cond
348+ (str/starts-with? (or target "") "#") target
349+ (= from @form-nick) target
350+ :else from)]
345 (push-message! buffer from text351 (push-message! buffer from text
346 {:at at352 {:at at
347 :did (:account msg)353 :did (:account msg)
@@ -435,7 +441,11 @@
435 (store/clear-session!)441 (store/clear-session!)
436 (reset! error (str "Bluesky sign-in refused: "442 (reset! error (str "Bluesky sign-in refused: "
437 (or (last params) "no reason given"))))443 (or (last params) "no reason given"))))
438- "*DISCONNECTED*" (do (reset! conn nil)444+ ;; The signing key belonged to that connection: the server forgets it
445+ ;; when the session ends, and signing with it afterwards would be
446+ ;; signing with a key nobody can check.
447+ "*DISCONNECTED*" (do (msgsig/forget!)
448+ (reset! conn nil)
439 (reset! connecting? false)449 (reset! connecting? false)
440 (swap! channels450 (swap! channels
441 #(reduce-kv (fn [m k v]451 #(reduce-kv (fn [m k v]
@@ -878,9 +888,11 @@
878 ;; Saying something is a way of asking to see it.888 ;; Saying something is a way of asking to see it.
879 (jump-to-present!)889 (jump-to-present!)
880 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))890 (when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
881- ;; The local echo carries the same link, so the chip is there before891+ ;; Only when the server will not send the line back itself. Its copy
882- ;; the server's copy of the line comes back — if it ever does.892+ ;; carries the msgid, and a message with no id is one nobody can react
883- (push-message! target @form-nick line {:reply-to (:id reply-to)})893+ ;; or reply to; echoing locally as well would put the line up twice.
894+ (when-not (some-> @conn (irc/cap-acked? "echo-message"))
895+ (push-message! target @form-nick line {:reply-to (:id reply-to)}))
884 (reset! replying-to nil)896 (reset! replying-to nil)
885 (reset! draft "")897 (reset! draft "")
886 (when att898 (when att
@@ -930,6 +942,17 @@
930 group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog))942 group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog))
931 :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular))))943 :else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular))))
932 944
945+(defn- dm-peer-did
946+ "The DID of whoever this DM buffer is with, from the last thing they said.
947+ nil for a channel, and for a conversation where nobody with a DID has spoken
948+ — a signature over a DM needs both sides named, and there is nothing to name."
949+ [channel]
950+ (when-not (str/starts-with? (or channel "") "#")
951+ (->> (get-in @channels [channel :messages])
952+ (remove #(= @form-nick (:from %)))
953+ (keep :did)
954+ last)))
955+
933 (defn my-reaction?956 (defn my-reaction?
934 "Whether this nick is already on that emoji — which is what makes a second957 "Whether this nick is already on that emoji — which is what makes a second
935 click take it off rather than send the same reaction twice."958 click take it off rather than send the same reaction twice."
@@ -944,11 +967,16 @@
944 appear once someone else reacted too."967 appear once someone else reacted too."
945 [channel m emoji]968 [channel m emoji]
946 (when-let [msgid (:id m)]969 (when-let [msgid (:id m)]
947- (let [on? (not (my-reaction? m emoji))]970+ (let [on? (not (my-reaction? m emoji))
971+ ;; Who the DM is with, for the signature: freeq names a DM by both
972+ ;; DIDs rather than by a nick, and nothing else in a buffer says
973+ ;; which account the other side is. nil in a channel, which is named
974+ ;; by itself.
975+ peer (dm-peer-did channel)]
948 (when-let [c @conn]976 (when-let [c @conn]
949 (if on?977 (if on?
950- (irc/react! c channel msgid emoji)978+ (irc/react! c channel msgid emoji peer)
951- (irc/unreact! c channel msgid emoji)))979+ (irc/unreact! c channel msgid emoji peer)))
952 (update-reaction! channel msgid emoji @form-nick on?))))980 (update-reaction! channel msgid emoji @form-nick on?))))
953 981
954 (defn start-call!982 (defn start-call!