Sign in from the phone with the handshake both halves now share
Signing in was the last thing the phone could not do, and none of what it needed was platform work: CAP negotiation and the SASL exchange inside it are the same question at every step — given what the server just said, what does this client say back — and the only part that differed was who writes the answer. So frq.irc.handshake answers with lines and leaves the writing to the caller: a blocking reader thread on the desktop, a Stream on the phone, neither with any say in what the lines are. src/frq/irc.clj loses ninety lines to it and behaves the same. The phone sends CAP LS 302 before NICK, drives `step` from its on-msg, and signs in with an app password before the socket opens — a PDS session is an HTTPS round trip that has nothing to do with IRC. A sign-in that fails dials nothing: connecting anyway would land us there as a guest, which looks like a success and is not the one that was asked for. Two things the app-password path turned up on the way. A `:page` now fills its column, because it is a scroll view and sizing it to its contents made it overflow the moment the viewport shrank — which on a phone is every time the keyboard opens. And a failed sign-in reports ex-message rather than the exception, since a PDS that answers a resolve with an HTML error page puts the whole page in the ex-data. Verified on a Pixel 6a: guest connects with caps negotiated and real server-time backlog, and a bad handle fails on one readable line. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
dd67233 parent: 3b05705 added
common/frq/irc/handshake.cljc +122 -0 | new file mode 100644 | ||
| @@ -0,0 +1,122 @@ | ||
| 1 | +(ns frq.irc.handshake | |
| 2 | + "CAP negotiation and the SASL exchange inside it, as lines to send. | |
| 3 | + | |
| 4 | + This is the whole of signing in, and none of it is a socket: every step is | |
| 5 | + the same question — given what the server just said, what does this client | |
| 6 | + say back. So it answers with lines and the caller writes them, which is the | |
| 7 | + one part that differs. The desktop writes them from a blocking reader | |
| 8 | + thread and the phone from a `Stream`, and neither has any say in what they | |
| 9 | + are. | |
| 10 | + | |
| 11 | + What it reasons over is shared too, which is why this could move at all: | |
| 12 | + `frq.atproto.core` builds the SASL payload and `frq.msgsig` mints the | |
| 13 | + signing key. The last thing in the chain was the transport, and the | |
| 14 | + transport is the caller's." | |
| 15 | + (:require [clojure.string :as str] | |
| 16 | + [frq.atproto.core :as atproto] | |
| 17 | + [frq.msgsig :as msgsig])) | |
| 18 | + | |
| 19 | +(def sasl-chunk | |
| 20 | + "AUTHENTICATE takes at most 400 characters a line." | |
| 21 | + 400) | |
| 22 | + | |
| 23 | +(def wanted-caps | |
| 24 | + "What this client can use, and why a guest connection negotiates at all. | |
| 25 | + | |
| 26 | + `server-time`: without it a replayed backlog arrives untimed and every old | |
| 27 | + line reads as having just been said. `account-tag`: it puts the sender's DID | |
| 28 | + on the message, which is the only identity a client is given — a nick is | |
| 29 | + whatever someone chose today, and the hostmask carries eight characters of a | |
| 30 | + DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 | |
| 31 | + sends tags only to clients that asked for tags at all; either one alone is | |
| 32 | + ACKed and then nothing arrives. | |
| 33 | + | |
| 34 | + `echo-message`: the server sends our own lines back to us, which is the only | |
| 35 | + way this client learns the msgid of something it said. Without it our own | |
| 36 | + messages sit in the buffer with no id, and a reaction or a reply aimed at one | |
| 37 | + has nothing to name — the pill appears here and nobody else ever sees it. | |
| 38 | + | |
| 39 | + `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | |
| 40 | + an unsigned mutation from an account with | |
| 41 | + `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | |
| 42 | + register a key and sign one." | |
| 43 | + ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | |
| 44 | + | |
| 45 | +(defn sasl-lines | |
| 46 | + "A payload split the way AUTHENTICATE wants it. | |
| 47 | + | |
| 48 | + One that lands exactly on the boundary is followed by a bare `+`, so the | |
| 49 | + server knows it ended rather than waiting for a continuation that is not | |
| 50 | + coming." | |
| 51 | + [payload] | |
| 52 | + (loop [rest payload out []] | |
| 53 | + (if (> (count rest) sasl-chunk) | |
| 54 | + (recur (subs rest sasl-chunk) | |
| 55 | + (conj out (str "AUTHENTICATE " (subs rest 0 sasl-chunk)))) | |
| 56 | + (cond-> (conj out (str "AUTHENTICATE " rest)) | |
| 57 | + (= sasl-chunk (count rest)) (conj "AUTHENTICATE +"))))) | |
| 58 | + | |
| 59 | +(defn acked? | |
| 60 | + "Whether the server agreed to `cap`, given the set it has acked so far." | |
| 61 | + [caps cap] | |
| 62 | + (boolean (and caps (contains? caps cap)))) | |
| 63 | + | |
| 64 | +(defn step | |
| 65 | + "What to send in answer to `msg`, and what it did to the acked set. | |
| 66 | + | |
| 67 | + Returns `{:send [lines] :caps <set>}`. `caps` comes back whether it changed | |
| 68 | + or not, so a caller can keep it in whatever it keeps state in — an atom on | |
| 69 | + the desktop, a cell on the phone — without this namespace holding any." | |
| 70 | + [{:keys [session caps]} msg] | |
| 71 | + (let [{:keys [command params]} msg | |
| 72 | + caps (or caps #{}) | |
| 73 | + nothing {:send [] :caps caps}] | |
| 74 | + (case (str command) | |
| 75 | + "CAP" | |
| 76 | + (let [[_ sub offered-str] params | |
| 77 | + offered (set (str/split (or offered-str "") #"\s+")) | |
| 78 | + wanted (cond-> (filterv offered wanted-caps) | |
| 79 | + (and session (offered "sasl")) (conj "sasl"))] | |
| 80 | + (case (str sub) | |
| 81 | + "LS" {:caps caps | |
| 82 | + :send [(if (seq wanted) | |
| 83 | + (str "CAP REQ :" (str/join " " wanted)) | |
| 84 | + "CAP END")]} | |
| 85 | + ;; SASL, when acked, ends negotiation itself — CAP END waits for the | |
| 86 | + ;; exchange to finish either way. | |
| 87 | + "ACK" (let [caps (into caps (remove str/blank? | |
| 88 | + (str/split (or offered-str "") #"\s+")))] | |
| 89 | + {:caps caps | |
| 90 | + :send [(if (str/includes? (or offered-str "") "sasl") | |
| 91 | + "AUTHENTICATE ATPROTO-CHALLENGE" | |
| 92 | + "CAP END")]}) | |
| 93 | + "NAK" {:caps caps :send ["CAP END"]} | |
| 94 | + nothing)) | |
| 95 | + | |
| 96 | + ;; The challenge arrives as base64url JSON; the nonce inside it is what | |
| 97 | + ;; binds our PDS token to this connection. | |
| 98 | + "AUTHENTICATE" | |
| 99 | + (let [challenge (first params)] | |
| 100 | + (if (and challenge (not= "+" challenge)) | |
| 101 | + (let [nonce (atproto/json-str (atproto/b64-decode challenge) "nonce")] | |
| 102 | + {:caps caps :send (sasl-lines (atproto/sasl-response session nonce))}) | |
| 103 | + nothing)) | |
| 104 | + | |
| 105 | + ;; 903 logged in, 904/905/906 did not. A login is also the moment this | |
| 106 | + ;; connection can have a signing key: the DID it signs as is only settled | |
| 107 | + ;; here. The key is registered at 001 rather than now — MSGSIG is a | |
| 108 | + ;; registered-client command, and negotiation has not ended yet. | |
| 109 | + "903" (do (when (and (acked? caps "freeq.at/msgsig") (:did session)) | |
| 110 | + (msgsig/generate! (:did session))) | |
| 111 | + {:caps caps :send ["CAP END"]}) | |
| 112 | + | |
| 113 | + ("904" "905" "906") {:caps caps :send ["CAP END"]} | |
| 114 | + | |
| 115 | + ;; Welcomed. Hand the server the public half, and every reaction from | |
| 116 | + ;; here on carries a signature it will take. | |
| 117 | + "001" {:caps caps | |
| 118 | + :send (if-let [pub (msgsig/public-key)] | |
| 119 | + [(str "MSGSIG " pub)] | |
| 120 | + [])} | |
| 121 | + | |
| 122 | + nothing))) | |
| new file mode 100644 | |||
| @@ -0,0 +1,122 @@ | |||
| 1 | +(ns frq.irc.handshake | ||
| 2 | + "CAP negotiation and the SASL exchange inside it, as lines to send. | ||
| 3 | + | ||
| 4 | + This is the whole of signing in, and none of it is a socket: every step is | ||
| 5 | + the same question — given what the server just said, what does this client | ||
| 6 | + say back. So it answers with lines and the caller writes them, which is the | ||
| 7 | + one part that differs. The desktop writes them from a blocking reader | ||
| 8 | + thread and the phone from a `Stream`, and neither has any say in what they | ||
| 9 | + are. | ||
| 10 | + | ||
| 11 | + What it reasons over is shared too, which is why this could move at all: | ||
| 12 | + `frq.atproto.core` builds the SASL payload and `frq.msgsig` mints the | ||
| 13 | + signing key. The last thing in the chain was the transport, and the | ||
| 14 | + transport is the caller's." | ||
| 15 | + (:require [clojure.string :as str] | ||
| 16 | + [frq.atproto.core :as atproto] | ||
| 17 | + [frq.msgsig :as msgsig])) | ||
| 18 | + | ||
| 19 | +(def sasl-chunk | ||
| 20 | + "AUTHENTICATE takes at most 400 characters a line." | ||
| 21 | + 400) | ||
| 22 | + | ||
| 23 | +(def wanted-caps | ||
| 24 | + "What this client can use, and why a guest connection negotiates at all. | ||
| 25 | + | ||
| 26 | + `server-time`: without it a replayed backlog arrives untimed and every old | ||
| 27 | + line reads as having just been said. `account-tag`: it puts the sender's DID | ||
| 28 | + on the message, which is the only identity a client is given — a nick is | ||
| 29 | + whatever someone chose today, and the hostmask carries eight characters of a | ||
| 30 | + DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 | ||
| 31 | + sends tags only to clients that asked for tags at all; either one alone is | ||
| 32 | + ACKed and then nothing arrives. | ||
| 33 | + | ||
| 34 | + `echo-message`: the server sends our own lines back to us, which is the only | ||
| 35 | + way this client learns the msgid of something it said. Without it our own | ||
| 36 | + messages sit in the buffer with no id, and a reaction or a reply aimed at one | ||
| 37 | + has nothing to name — the pill appears here and nobody else ever sees it. | ||
| 38 | + | ||
| 39 | + `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | ||
| 40 | + an unsigned mutation from an account with | ||
| 41 | + `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | ||
| 42 | + register a key and sign one." | ||
| 43 | + ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | ||
| 44 | + | ||
| 45 | +(defn sasl-lines | ||
| 46 | + "A payload split the way AUTHENTICATE wants it. | ||
| 47 | + | ||
| 48 | + One that lands exactly on the boundary is followed by a bare `+`, so the | ||
| 49 | + server knows it ended rather than waiting for a continuation that is not | ||
| 50 | + coming." | ||
| 51 | + [payload] | ||
| 52 | + (loop [rest payload out []] | ||
| 53 | + (if (> (count rest) sasl-chunk) | ||
| 54 | + (recur (subs rest sasl-chunk) | ||
| 55 | + (conj out (str "AUTHENTICATE " (subs rest 0 sasl-chunk)))) | ||
| 56 | + (cond-> (conj out (str "AUTHENTICATE " rest)) | ||
| 57 | + (= sasl-chunk (count rest)) (conj "AUTHENTICATE +"))))) | ||
| 58 | + | ||
| 59 | +(defn acked? | ||
| 60 | + "Whether the server agreed to `cap`, given the set it has acked so far." | ||
| 61 | + [caps cap] | ||
| 62 | + (boolean (and caps (contains? caps cap)))) | ||
| 63 | + | ||
| 64 | +(defn step | ||
| 65 | + "What to send in answer to `msg`, and what it did to the acked set. | ||
| 66 | + | ||
| 67 | + Returns `{:send [lines] :caps <set>}`. `caps` comes back whether it changed | ||
| 68 | + or not, so a caller can keep it in whatever it keeps state in — an atom on | ||
| 69 | + the desktop, a cell on the phone — without this namespace holding any." | ||
| 70 | + [{:keys [session caps]} msg] | ||
| 71 | + (let [{:keys [command params]} msg | ||
| 72 | + caps (or caps #{}) | ||
| 73 | + nothing {:send [] :caps caps}] | ||
| 74 | + (case (str command) | ||
| 75 | + "CAP" | ||
| 76 | + (let [[_ sub offered-str] params | ||
| 77 | + offered (set (str/split (or offered-str "") #"\s+")) | ||
| 78 | + wanted (cond-> (filterv offered wanted-caps) | ||
| 79 | + (and session (offered "sasl")) (conj "sasl"))] | ||
| 80 | + (case (str sub) | ||
| 81 | + "LS" {:caps caps | ||
| 82 | + :send [(if (seq wanted) | ||
| 83 | + (str "CAP REQ :" (str/join " " wanted)) | ||
| 84 | + "CAP END")]} | ||
| 85 | + ;; SASL, when acked, ends negotiation itself — CAP END waits for the | ||
| 86 | + ;; exchange to finish either way. | ||
| 87 | + "ACK" (let [caps (into caps (remove str/blank? | ||
| 88 | + (str/split (or offered-str "") #"\s+")))] | ||
| 89 | + {:caps caps | ||
| 90 | + :send [(if (str/includes? (or offered-str "") "sasl") | ||
| 91 | + "AUTHENTICATE ATPROTO-CHALLENGE" | ||
| 92 | + "CAP END")]}) | ||
| 93 | + "NAK" {:caps caps :send ["CAP END"]} | ||
| 94 | + nothing)) | ||
| 95 | + | ||
| 96 | + ;; The challenge arrives as base64url JSON; the nonce inside it is what | ||
| 97 | + ;; binds our PDS token to this connection. | ||
| 98 | + "AUTHENTICATE" | ||
| 99 | + (let [challenge (first params)] | ||
| 100 | + (if (and challenge (not= "+" challenge)) | ||
| 101 | + (let [nonce (atproto/json-str (atproto/b64-decode challenge) "nonce")] | ||
| 102 | + {:caps caps :send (sasl-lines (atproto/sasl-response session nonce))}) | ||
| 103 | + nothing)) | ||
| 104 | + | ||
| 105 | + ;; 903 logged in, 904/905/906 did not. A login is also the moment this | ||
| 106 | + ;; connection can have a signing key: the DID it signs as is only settled | ||
| 107 | + ;; here. The key is registered at 001 rather than now — MSGSIG is a | ||
| 108 | + ;; registered-client command, and negotiation has not ended yet. | ||
| 109 | + "903" (do (when (and (acked? caps "freeq.at/msgsig") (:did session)) | ||
| 110 | + (msgsig/generate! (:did session))) | ||
| 111 | + {:caps caps :send ["CAP END"]}) | ||
| 112 | + | ||
| 113 | + ("904" "905" "906") {:caps caps :send ["CAP END"]} | ||
| 114 | + | ||
| 115 | + ;; Welcomed. Hand the server the public half, and every reaction from | ||
| 116 | + ;; here on carries a signature it will take. | ||
| 117 | + "001" {:caps caps | ||
| 118 | + :send (if-let [pub (msgsig/public-key)] | ||
| 119 | + [(str "MSGSIG " pub)] | ||
| 120 | + [])} | ||
| 121 | + | ||
| 122 | + nothing))) | ||
modified
common/frq/screens/connect.cljc +3 -4 | @@ -24,10 +24,9 @@ | ||
| 24 | 24 | ClojureDart TLS is in the Dart runtime — `SecureSocket`, nothing to load — |
| 25 | 25 | and that sentence would now be a lie. |
| 26 | 26 | |
| 27 | - Sign-in is still unavailable on the phone, but for a different reason worth | |
| 28 | - naming rather than papering over: the SASL handshake wants `frq.msgsig` and | |
| 29 | - `frq.atproto`'s session, and msgsig is not ported yet." | |
| 30 | - #?(:cljd "TLS comes from dart:io, so :6697 works here; untick it for a plain :6667 listener. Sign-in needs SASL, which is not ported to the phone yet." | |
| 27 | + Sign-in itself is no longer one of those differences: `frq.irc.handshake` | |
| 28 | + drives SASL from common/, so both halves sign in the same way." | |
| 29 | + #?(:cljd "TLS comes from dart:io, so :6697 works here; untick it for a plain :6667 listener." | |
| 31 | 30 | :jolt "TLS rides jolt's OpenSSL bindings; untick it for a plain :6667 listener. Sign-in needs TLS, so it is desktop-only.")) |
| 32 | 31 | |
| 33 | 32 | (defn error-note |
| @@ -24,10 +24,9 @@ | |||
| 24 | ClojureDart TLS is in the Dart runtime — `SecureSocket`, nothing to load — | 24 | ClojureDart TLS is in the Dart runtime — `SecureSocket`, nothing to load — |
| 25 | and that sentence would now be a lie. | 25 | and that sentence would now be a lie. |
| 26 | 26 | ||
| 27 | - Sign-in is still unavailable on the phone, but for a different reason worth | 27 | + Sign-in itself is no longer one of those differences: `frq.irc.handshake` |
| 28 | - naming rather than papering over: the SASL handshake wants `frq.msgsig` and | 28 | + drives SASL from common/, so both halves sign in the same way." |
| 29 | - `frq.atproto`'s session, and msgsig is not ported yet." | 29 | + #?(:cljd "TLS comes from dart:io, so :6697 works here; untick it for a plain :6667 listener." |
| 30 | - #?(:cljd "TLS comes from dart:io, so :6697 works here; untick it for a plain :6667 listener. Sign-in needs SASL, which is not ported to the phone yet." | ||
| 31 | :jolt "TLS rides jolt's OpenSSL bindings; untick it for a plain :6667 listener. Sign-in needs TLS, so it is desktop-only.")) | 30 | :jolt "TLS rides jolt's OpenSSL bindings; untick it for a plain :6667 listener. Sign-in needs TLS, so it is desktop-only.")) |
| 32 | 31 | ||
| 33 | (defn error-note | 32 | (defn error-note |
modified
flutter/src/frq/hiccup.cljd +8 -3 | @@ -161,10 +161,15 @@ | ||
| 161 | 161 | (and (vector? node) |
| 162 | 162 | (let [tag (first node) |
| 163 | 163 | p (second node)] |
| 164 | - (or (= :scroll tag) | |
| 164 | + (or (contains? #{:scroll :page} tag) | |
| 165 | 165 | (and (map? p) (:fill-height p)) |
| 166 | - ;; Containers pass it up; `:page` does not, because a page | |
| 167 | - ;; scrolls and nothing inside a scroll can take what is left. | |
| 166 | + ;; A `:page` fills for the same reason a `:scroll` does — it is | |
| 167 | + ;; one — but it does not pass the question *up* from its | |
| 168 | + ;; children, because nothing inside a scroll can take what is | |
| 169 | + ;; left of a height the scroll does not have. Sized to its | |
| 170 | + ;; contents instead, a page overflows the moment the viewport | |
| 171 | + ;; shrinks under it, which on a phone is every time the keyboard | |
| 172 | + ;; opens. | |
| 168 | 173 | ;; |
| 169 | 174 | ;; `:hbox` is in the list for the chat screen: its message band is |
| 170 | 175 | ;; a fill-height column sitting in a row beside the people panel, |
| @@ -161,10 +161,15 @@ | |||
| 161 | (and (vector? node) | 161 | (and (vector? node) |
| 162 | (let [tag (first node) | 162 | (let [tag (first node) |
| 163 | p (second node)] | 163 | p (second node)] |
| 164 | - (or (= :scroll tag) | 164 | + (or (contains? #{:scroll :page} tag) |
| 165 | (and (map? p) (:fill-height p)) | 165 | (and (map? p) (:fill-height p)) |
| 166 | - ;; Containers pass it up; `:page` does not, because a page | 166 | + ;; A `:page` fills for the same reason a `:scroll` does — it is |
| 167 | - ;; scrolls and nothing inside a scroll can take what is left. | 167 | + ;; one — but it does not pass the question *up* from its |
| 168 | + ;; children, because nothing inside a scroll can take what is | ||
| 169 | + ;; left of a height the scroll does not have. Sized to its | ||
| 170 | + ;; contents instead, a page overflows the moment the viewport | ||
| 171 | + ;; shrinks under it, which on a phone is every time the keyboard | ||
| 172 | + ;; opens. | ||
| 168 | ;; | 173 | ;; |
| 169 | ;; `:hbox` is in the list for the chat screen: its message band is | 174 | ;; `:hbox` is in the list for the chat screen: its message band is |
| 170 | ;; a fill-height column sitting in a row beside the people panel, | 175 | ;; a fill-height column sitting in a row beside the people panel, |
modified
flutter/src/frq/main.cljd +124 -70 | @@ -36,7 +36,8 @@ | ||
| 36 | 36 | [frq.screens.settings :as settings] |
| 37 | 37 | [frq.screens.app :as screens] |
| 38 | 38 | [frq.rooms :as rooms] |
| 39 | - [frq.irc.parse :as irc])) | |
| 39 | + [frq.irc.parse :as irc] | |
| 40 | + [frq.irc.handshake :as handshake])) | |
| 40 | 41 | |
| 41 | 42 | (defonce ^:private lines (atom [])) |
| 42 | 43 | (defonce ^:private conn (atom nil)) |
| @@ -87,6 +88,12 @@ | ||
| 87 | 88 | |
| 88 | 89 | (defonce ^:private attempt (atom 0)) |
| 89 | 90 | |
| 91 | +(defonce ^:private caps | |
| 92 | + ;; What the server has agreed to on this connection. `frq.irc.handshake` | |
| 93 | + ;; holds none of it: it takes the set and hands a new one back, so the | |
| 94 | + ;; desktop can keep it in an atom on the connection and the phone here. | |
| 95 | + (atom #{})) | |
| 96 | + | |
| 90 | 97 | (defonce ^:private closing? |
| 91 | 98 | ;; Whether the close about to arrive is one we asked for. Without it a tap |
| 92 | 99 | ;; on Disconnect comes back as "closed by the server", which is both untrue |
| @@ -107,7 +114,9 @@ | ||
| 107 | 114 | host, the port and the TLS tick are `frq.cells`, filled in by the entry and |
| 108 | 115 | the checkbutton on screen. |
| 109 | 116 | |
| 110 | - Guest registration only. SASL wants `frq.msgsig`, which is not portable yet." | |
| 117 | + Guest and app-password both. The handshake itself is not here: it is | |
| 118 | + `frq.irc.handshake`, which answers each line with the lines to send back, | |
| 119 | + and all this does is write them." | |
| 111 | 120 | [] |
| 112 | 121 | ;; Close whatever was open first. Connecting twice left the old socket |
| 113 | 122 | ;; holding the nick, so the second attempt got 433 from its own predecessor. |
| @@ -115,76 +124,121 @@ | ||
| 115 | 124 | (reset! closing? true) |
| 116 | 125 | (net/close! c) |
| 117 | 126 | (reset! conn nil)) |
| 118 | - (let [n (swap! attempt inc)] | |
| 119 | - (reset! cells/connecting? true) | |
| 120 | - (reset! cells/error nil) | |
| 121 | - (reset! cells/status (str "Connecting to " @cells/form-host "…")) | |
| 122 | - (reset! lines []) | |
| 123 | - ;; A watchdog, because "no answer at all" is a real outcome: a TLS | |
| 124 | - ;; handshake that hangs, or a server that accepts the socket and says | |
| 125 | - ;; nothing, leaves every callback below unfired. | |
| 126 | - (.then (async/Future.delayed (Duration .seconds 20)) | |
| 127 | - (fn [_] | |
| 128 | - (when (and @cells/connecting? (= n @attempt)) | |
| 129 | - (fail! "No answer from the server after 20s")))) | |
| 130 | - (try | |
| 131 | - (let [sock (await (net/connect! | |
| 132 | - {:host @cells/form-host | |
| 133 | - ;; The cell is a string, because it is what an | |
| 134 | - ;; :entry holds. | |
| 135 | - :port (or (parse-long (str @cells/form-port)) 6697) | |
| 136 | - :tls? (boolean @cells/form-tls?) | |
| 137 | - :on-msg (fn [m] | |
| 138 | - (note! m) | |
| 139 | - (room! m) | |
| 140 | - (let [cmd (str (:command m)) | |
| 141 | - text (str (last (:params m)))] | |
| 142 | - (cond | |
| 143 | - (= "001" cmd) | |
| 144 | - (do (reset! cells/connecting? false) | |
| 145 | - (reset! cells/error nil) | |
| 146 | - (reset! cells/status | |
| 147 | - (str "Connected as " @cells/form-nick)) | |
| 148 | - ;; Off the connect screen, as | |
| 149 | - ;; frq.state does on 001. Without | |
| 150 | - ;; this a successful connect just | |
| 151 | - ;; puts the Connect button back | |
| 152 | - ;; and looks exactly like a | |
| 153 | - ;; failure. | |
| 154 | - (reset! cells/screen :chats) | |
| 155 | - (when-let [c @conn] | |
| 156 | - (net/send-line! c "JOIN #test"))) | |
| 127 | + ;; A guest carries no session, and must not carry the last one either: a | |
| 128 | + ;; leftover session would have `handshake/step` ask for sasl and then | |
| 129 | + ;; authenticate as whoever signed in before. | |
| 130 | + (when (= :guest @cells/auth-mode) | |
| 131 | + (reset! cells/session nil)) | |
| 132 | + ;; An app password signs in before the socket opens: the SASL payload is | |
| 133 | + ;; built from a PDS session, and getting one is an HTTPS round trip that has | |
| 134 | + ;; nothing to do with IRC. `frq.atproto.core` says what to ask and what the | |
| 135 | + ;; answer means; `frq.atproto.dart` waits for it. Nothing dials out if it | |
| 136 | + ;; fails — connecting anyway would land us on the server as a guest, which | |
| 137 | + ;; looks like a success and is not the one that was asked for. | |
| 138 | + (when | |
| 139 | + (if (= :app-password @cells/auth-mode) | |
| 140 | + (do (reset! cells/connecting? true) | |
| 141 | + (reset! cells/error nil) | |
| 142 | + (reset! cells/status "Signing in…") | |
| 143 | + (try | |
| 144 | + (reset! cells/session | |
| 145 | + (await (atproto/create-session @cells/form-handle | |
| 146 | + @cells/form-app-password))) | |
| 147 | + true | |
| 148 | + (catch Object e | |
| 149 | + (reset! cells/session nil) | |
| 150 | + ;; The message, not the exception: `frq.atproto.core` puts the | |
| 151 | + ;; body it could not read in the ex-data, and a PDS that answers | |
| 152 | + ;; a resolve with an HTML error page puts the whole page there. | |
| 153 | + (fail! (str "Sign-in failed: " (or (ex-message e) e))) | |
| 154 | + false))) | |
| 155 | + true) | |
| 156 | + (let [n (swap! attempt inc)] | |
| 157 | + (reset! caps #{}) | |
| 158 | + (reset! cells/connecting? true) | |
| 159 | + (reset! cells/error nil) | |
| 160 | + (reset! cells/status (str "Connecting to " @cells/form-host "…")) | |
| 161 | + (reset! lines []) | |
| 162 | + ;; A watchdog, because "no answer at all" is a real outcome: a TLS | |
| 163 | + ;; handshake that hangs, or a server that accepts the socket and says | |
| 164 | + ;; nothing, leaves every callback below unfired. | |
| 165 | + (.then (async/Future.delayed (Duration .seconds 20)) | |
| 166 | + (fn [_] | |
| 167 | + (when (and @cells/connecting? (= n @attempt)) | |
| 168 | + (fail! "No answer from the server after 20s")))) | |
| 169 | + (try | |
| 170 | + (let [sock (await (net/connect! | |
| 171 | + {:host @cells/form-host | |
| 172 | + ;; The cell is a string, because it is what an | |
| 173 | + ;; :entry holds. | |
| 174 | + :port (or (parse-long (str @cells/form-port)) 6697) | |
| 175 | + :tls? (boolean @cells/form-tls?) | |
| 176 | + :on-msg (fn [m] | |
| 177 | + (note! m) | |
| 178 | + (room! m) | |
| 179 | + ;; Capability negotiation and SASL, out of | |
| 180 | + ;; common/ — the same steps the desktop | |
| 181 | + ;; takes, and all this does is write what | |
| 182 | + ;; they answer with. | |
| 183 | + (let [{:keys [send] next-caps :caps} | |
| 184 | + (handshake/step {:session @cells/session | |
| 185 | + :caps @caps} | |
| 186 | + m)] | |
| 187 | + (reset! caps next-caps) | |
| 188 | + (doseq [line send] | |
| 189 | + (when-let [c @conn] (net/send-line! c line)))) | |
| 190 | + (let [cmd (str (:command m)) | |
| 191 | + text (str (last (:params m)))] | |
| 192 | + (cond | |
| 193 | + (= "001" cmd) | |
| 194 | + (do (reset! cells/connecting? false) | |
| 195 | + (reset! cells/error nil) | |
| 196 | + (reset! cells/status | |
| 197 | + (str "Connected as " @cells/form-nick)) | |
| 198 | + ;; Off the connect screen, as | |
| 199 | + ;; frq.state does on 001. Without | |
| 200 | + ;; this a successful connect just | |
| 201 | + ;; puts the Connect button back | |
| 202 | + ;; and looks exactly like a | |
| 203 | + ;; failure. | |
| 204 | + (reset! cells/screen :chats) | |
| 205 | + (when-let [c @conn] | |
| 206 | + (net/send-line! c "JOIN #test"))) | |
| 157 | 207 | |
| 158 | - (contains? registration-failed cmd) | |
| 159 | - (fail! (if (= "433" cmd) | |
| 160 | - (str "Nick " @cells/form-nick | |
| 161 | - " is already in use — try another") | |
| 162 | - (str cmd " " text))) | |
| 208 | + (contains? registration-failed cmd) | |
| 209 | + (fail! (if (= "433" cmd) | |
| 210 | + (str "Nick " @cells/form-nick | |
| 211 | + " is already in use — try another") | |
| 212 | + (str cmd " " text))) | |
| 163 | 213 | |
| 164 | - ;; Something is happening; say so | |
| 165 | - ;; rather than sit on one message. | |
| 166 | - @cells/connecting? | |
| 167 | - (reset! cells/status (str "… " cmd))))) | |
| 168 | - :on-close (fn [why] | |
| 169 | - (reset! conn nil) | |
| 170 | - ;; Say what the last thing seen was. A | |
| 171 | - ;; connection that registers and then | |
| 172 | - ;; drops is a different bug from one | |
| 173 | - ;; that never registers, and only the | |
| 174 | - ;; last line apart tells them. | |
| 175 | - (if @closing? | |
| 176 | - (reset! closing? false) | |
| 177 | - (fail! (str (or why "closed by the server") | |
| 178 | - " (after " (count @lines) | |
| 179 | - " lines, last: " @last-line ")"))))}))] | |
| 180 | - (reset! conn sock) | |
| 181 | - (net/send-line! sock (str "NICK " @cells/form-nick)) | |
| 182 | - (net/send-line! sock (str "USER " @cells/form-nick " 0 * :frq"))) | |
| 183 | - ;; Object, not Exception. Dart keeps Error and Exception in separate | |
| 184 | - ;; hierarchies, so a TypeError is not an Exception and would leave | |
| 185 | - ;; `connecting?` true for ever. | |
| 186 | - (catch Object e | |
| 187 | - (fail! (str e)))))) | |
| 214 | + ;; Something is happening; say so | |
| 215 | + ;; rather than sit on one message. | |
| 216 | + @cells/connecting? | |
| 217 | + (reset! cells/status (str "… " cmd))))) | |
| 218 | + :on-close (fn [why] | |
| 219 | + (reset! conn nil) | |
| 220 | + ;; Say what the last thing seen was. A | |
| 221 | + ;; connection that registers and then | |
| 222 | + ;; drops is a different bug from one | |
| 223 | + ;; that never registers, and only the | |
| 224 | + ;; last line apart tells them. | |
| 225 | + (if @closing? | |
| 226 | + (reset! closing? false) | |
| 227 | + (fail! (str (or why "closed by the server") | |
| 228 | + " (after " (count @lines) | |
| 229 | + " lines, last: " @last-line ")"))))}))] | |
| 230 | + (reset! conn sock) | |
| 231 | + ;; CAP first, then registration — the order the server expects, and the | |
| 232 | + ;; order `frq.irc` uses. | |
| 233 | + (net/send-line! sock "CAP LS 302") | |
| 234 | + (let [nick (if-let [h (:handle @cells/session)] h @cells/form-nick)] | |
| 235 | + (net/send-line! sock (str "NICK " nick)) | |
| 236 | + (net/send-line! sock (str "USER " nick " 0 * :frq")))) | |
| 237 | + ;; Object, not Exception. Dart keeps Error and Exception in separate | |
| 238 | + ;; hierarchies, so a TypeError is not an Exception and would leave | |
| 239 | + ;; `connecting?` true for ever. | |
| 240 | + (catch Object e | |
| 241 | + (fail! (str e))))))) | |
| 188 | 242 | |
| 189 | 243 | (defn- disconnect! [] |
| 190 | 244 | (reset! closing? true) |
| @@ -36,7 +36,8 @@ | |||
| 36 | [frq.screens.settings :as settings] | 36 | [frq.screens.settings :as settings] |
| 37 | [frq.screens.app :as screens] | 37 | [frq.screens.app :as screens] |
| 38 | [frq.rooms :as rooms] | 38 | [frq.rooms :as rooms] |
| 39 | - [frq.irc.parse :as irc])) | 39 | + [frq.irc.parse :as irc] |
| 40 | + [frq.irc.handshake :as handshake])) | ||
| 40 | 41 | ||
| 41 | (defonce ^:private lines (atom [])) | 42 | (defonce ^:private lines (atom [])) |
| 42 | (defonce ^:private conn (atom nil)) | 43 | (defonce ^:private conn (atom nil)) |
| @@ -87,6 +88,12 @@ | |||
| 87 | 88 | ||
| 88 | (defonce ^:private attempt (atom 0)) | 89 | (defonce ^:private attempt (atom 0)) |
| 89 | 90 | ||
| 91 | +(defonce ^:private caps | ||
| 92 | + ;; What the server has agreed to on this connection. `frq.irc.handshake` | ||
| 93 | + ;; holds none of it: it takes the set and hands a new one back, so the | ||
| 94 | + ;; desktop can keep it in an atom on the connection and the phone here. | ||
| 95 | + (atom #{})) | ||
| 96 | + | ||
| 90 | (defonce ^:private closing? | 97 | (defonce ^:private closing? |
| 91 | ;; Whether the close about to arrive is one we asked for. Without it a tap | 98 | ;; Whether the close about to arrive is one we asked for. Without it a tap |
| 92 | ;; on Disconnect comes back as "closed by the server", which is both untrue | 99 | ;; on Disconnect comes back as "closed by the server", which is both untrue |
| @@ -107,7 +114,9 @@ | |||
| 107 | host, the port and the TLS tick are `frq.cells`, filled in by the entry and | 114 | host, the port and the TLS tick are `frq.cells`, filled in by the entry and |
| 108 | the checkbutton on screen. | 115 | the checkbutton on screen. |
| 109 | 116 | ||
| 110 | - Guest registration only. SASL wants `frq.msgsig`, which is not portable yet." | 117 | + Guest and app-password both. The handshake itself is not here: it is |
| 118 | + `frq.irc.handshake`, which answers each line with the lines to send back, | ||
| 119 | + and all this does is write them." | ||
| 111 | [] | 120 | [] |
| 112 | ;; Close whatever was open first. Connecting twice left the old socket | 121 | ;; Close whatever was open first. Connecting twice left the old socket |
| 113 | ;; holding the nick, so the second attempt got 433 from its own predecessor. | 122 | ;; holding the nick, so the second attempt got 433 from its own predecessor. |
| @@ -115,76 +124,121 @@ | |||
| 115 | (reset! closing? true) | 124 | (reset! closing? true) |
| 116 | (net/close! c) | 125 | (net/close! c) |
| 117 | (reset! conn nil)) | 126 | (reset! conn nil)) |
| 118 | - (let [n (swap! attempt inc)] | 127 | + ;; A guest carries no session, and must not carry the last one either: a |
| 119 | - (reset! cells/connecting? true) | 128 | + ;; leftover session would have `handshake/step` ask for sasl and then |
| 120 | - (reset! cells/error nil) | 129 | + ;; authenticate as whoever signed in before. |
| 121 | - (reset! cells/status (str "Connecting to " @cells/form-host "…")) | 130 | + (when (= :guest @cells/auth-mode) |
| 122 | - (reset! lines []) | 131 | + (reset! cells/session nil)) |
| 123 | - ;; A watchdog, because "no answer at all" is a real outcome: a TLS | 132 | + ;; An app password signs in before the socket opens: the SASL payload is |
| 124 | - ;; handshake that hangs, or a server that accepts the socket and says | 133 | + ;; built from a PDS session, and getting one is an HTTPS round trip that has |
| 125 | - ;; nothing, leaves every callback below unfired. | 134 | + ;; nothing to do with IRC. `frq.atproto.core` says what to ask and what the |
| 126 | - (.then (async/Future.delayed (Duration .seconds 20)) | 135 | + ;; answer means; `frq.atproto.dart` waits for it. Nothing dials out if it |
| 127 | - (fn [_] | 136 | + ;; fails — connecting anyway would land us on the server as a guest, which |
| 128 | - (when (and @cells/connecting? (= n @attempt)) | 137 | + ;; looks like a success and is not the one that was asked for. |
| 129 | - (fail! "No answer from the server after 20s")))) | 138 | + (when |
| 130 | - (try | 139 | + (if (= :app-password @cells/auth-mode) |
| 131 | - (let [sock (await (net/connect! | 140 | + (do (reset! cells/connecting? true) |
| 132 | - {:host @cells/form-host | 141 | + (reset! cells/error nil) |
| 133 | - ;; The cell is a string, because it is what an | 142 | + (reset! cells/status "Signing in…") |
| 134 | - ;; :entry holds. | 143 | + (try |
| 135 | - :port (or (parse-long (str @cells/form-port)) 6697) | 144 | + (reset! cells/session |
| 136 | - :tls? (boolean @cells/form-tls?) | 145 | + (await (atproto/create-session @cells/form-handle |
| 137 | - :on-msg (fn [m] | 146 | + @cells/form-app-password))) |
| 138 | - (note! m) | 147 | + true |
| 139 | - (room! m) | 148 | + (catch Object e |
| 140 | - (let [cmd (str (:command m)) | 149 | + (reset! cells/session nil) |
| 141 | - text (str (last (:params m)))] | 150 | + ;; The message, not the exception: `frq.atproto.core` puts the |
| 142 | - (cond | 151 | + ;; body it could not read in the ex-data, and a PDS that answers |
| 143 | - (= "001" cmd) | 152 | + ;; a resolve with an HTML error page puts the whole page there. |
| 144 | - (do (reset! cells/connecting? false) | 153 | + (fail! (str "Sign-in failed: " (or (ex-message e) e))) |
| 145 | - (reset! cells/error nil) | 154 | + false))) |
| 146 | - (reset! cells/status | 155 | + true) |
| 147 | - (str "Connected as " @cells/form-nick)) | 156 | + (let [n (swap! attempt inc)] |
| 148 | - ;; Off the connect screen, as | 157 | + (reset! caps #{}) |
| 149 | - ;; frq.state does on 001. Without | 158 | + (reset! cells/connecting? true) |
| 150 | - ;; this a successful connect just | 159 | + (reset! cells/error nil) |
| 151 | - ;; puts the Connect button back | 160 | + (reset! cells/status (str "Connecting to " @cells/form-host "…")) |
| 152 | - ;; and looks exactly like a | 161 | + (reset! lines []) |
| 153 | - ;; failure. | 162 | + ;; A watchdog, because "no answer at all" is a real outcome: a TLS |
| 154 | - (reset! cells/screen :chats) | 163 | + ;; handshake that hangs, or a server that accepts the socket and says |
| 155 | - (when-let [c @conn] | 164 | + ;; nothing, leaves every callback below unfired. |
| 156 | - (net/send-line! c "JOIN #test"))) | 165 | + (.then (async/Future.delayed (Duration .seconds 20)) |
| 166 | + (fn [_] | ||
| 167 | + (when (and @cells/connecting? (= n @attempt)) | ||
| 168 | + (fail! "No answer from the server after 20s")))) | ||
| 169 | + (try | ||
| 170 | + (let [sock (await (net/connect! | ||
| 171 | + {:host @cells/form-host | ||
| 172 | + ;; The cell is a string, because it is what an | ||
| 173 | + ;; :entry holds. | ||
| 174 | + :port (or (parse-long (str @cells/form-port)) 6697) | ||
| 175 | + :tls? (boolean @cells/form-tls?) | ||
| 176 | + :on-msg (fn [m] | ||
| 177 | + (note! m) | ||
| 178 | + (room! m) | ||
| 179 | + ;; Capability negotiation and SASL, out of | ||
| 180 | + ;; common/ — the same steps the desktop | ||
| 181 | + ;; takes, and all this does is write what | ||
| 182 | + ;; they answer with. | ||
| 183 | + (let [{:keys [send] next-caps :caps} | ||
| 184 | + (handshake/step {:session @cells/session | ||
| 185 | + :caps @caps} | ||
| 186 | + m)] | ||
| 187 | + (reset! caps next-caps) | ||
| 188 | + (doseq [line send] | ||
| 189 | + (when-let [c @conn] (net/send-line! c line)))) | ||
| 190 | + (let [cmd (str (:command m)) | ||
| 191 | + text (str (last (:params m)))] | ||
| 192 | + (cond | ||
| 193 | + (= "001" cmd) | ||
| 194 | + (do (reset! cells/connecting? false) | ||
| 195 | + (reset! cells/error nil) | ||
| 196 | + (reset! cells/status | ||
| 197 | + (str "Connected as " @cells/form-nick)) | ||
| 198 | + ;; Off the connect screen, as | ||
| 199 | + ;; frq.state does on 001. Without | ||
| 200 | + ;; this a successful connect just | ||
| 201 | + ;; puts the Connect button back | ||
| 202 | + ;; and looks exactly like a | ||
| 203 | + ;; failure. | ||
| 204 | + (reset! cells/screen :chats) | ||
| 205 | + (when-let [c @conn] | ||
| 206 | + (net/send-line! c "JOIN #test"))) | ||
| 157 | 207 | ||
| 158 | - (contains? registration-failed cmd) | 208 | + (contains? registration-failed cmd) |
| 159 | - (fail! (if (= "433" cmd) | 209 | + (fail! (if (= "433" cmd) |
| 160 | - (str "Nick " @cells/form-nick | 210 | + (str "Nick " @cells/form-nick |
| 161 | - " is already in use — try another") | 211 | + " is already in use — try another") |
| 162 | - (str cmd " " text))) | 212 | + (str cmd " " text))) |
| 163 | 213 | ||
| 164 | - ;; Something is happening; say so | 214 | + ;; Something is happening; say so |
| 165 | - ;; rather than sit on one message. | 215 | + ;; rather than sit on one message. |
| 166 | - @cells/connecting? | 216 | + @cells/connecting? |
| 167 | - (reset! cells/status (str "… " cmd))))) | 217 | + (reset! cells/status (str "… " cmd))))) |
| 168 | - :on-close (fn [why] | 218 | + :on-close (fn [why] |
| 169 | - (reset! conn nil) | 219 | + (reset! conn nil) |
| 170 | - ;; Say what the last thing seen was. A | 220 | + ;; Say what the last thing seen was. A |
| 171 | - ;; connection that registers and then | 221 | + ;; connection that registers and then |
| 172 | - ;; drops is a different bug from one | 222 | + ;; drops is a different bug from one |
| 173 | - ;; that never registers, and only the | 223 | + ;; that never registers, and only the |
| 174 | - ;; last line apart tells them. | 224 | + ;; last line apart tells them. |
| 175 | - (if @closing? | 225 | + (if @closing? |
| 176 | - (reset! closing? false) | 226 | + (reset! closing? false) |
| 177 | - (fail! (str (or why "closed by the server") | 227 | + (fail! (str (or why "closed by the server") |
| 178 | - " (after " (count @lines) | 228 | + " (after " (count @lines) |
| 179 | - " lines, last: " @last-line ")"))))}))] | 229 | + " lines, last: " @last-line ")"))))}))] |
| 180 | - (reset! conn sock) | 230 | + (reset! conn sock) |
| 181 | - (net/send-line! sock (str "NICK " @cells/form-nick)) | 231 | + ;; CAP first, then registration — the order the server expects, and the |
| 182 | - (net/send-line! sock (str "USER " @cells/form-nick " 0 * :frq"))) | 232 | + ;; order `frq.irc` uses. |
| 183 | - ;; Object, not Exception. Dart keeps Error and Exception in separate | 233 | + (net/send-line! sock "CAP LS 302") |
| 184 | - ;; hierarchies, so a TypeError is not an Exception and would leave | 234 | + (let [nick (if-let [h (:handle @cells/session)] h @cells/form-nick)] |
| 185 | - ;; `connecting?` true for ever. | 235 | + (net/send-line! sock (str "NICK " nick)) |
| 186 | - (catch Object e | 236 | + (net/send-line! sock (str "USER " nick " 0 * :frq")))) |
| 187 | - (fail! (str e)))))) | 237 | + ;; Object, not Exception. Dart keeps Error and Exception in separate |
| 238 | + ;; hierarchies, so a TypeError is not an Exception and would leave | ||
| 239 | + ;; `connecting?` true for ever. | ||
| 240 | + (catch Object e | ||
| 241 | + (fail! (str e))))))) | ||
| 188 | 242 | ||
| 189 | (defn- disconnect! [] | 243 | (defn- disconnect! [] |
| 190 | (reset! closing? true) | 244 | (reset! closing? true) |
modified
src/frq/irc.clj +14 -81 | @@ -17,6 +17,7 @@ | ||
| 17 | 17 | (:require [clojure.string :as str] |
| 18 | 18 | [frq.atproto :as atproto] |
| 19 | 19 | [frq.irc.parse :as parse] |
| 20 | + [frq.irc.handshake :as handshake] | |
| 20 | 21 | [frq.msgsig :as msgsig] |
| 21 | 22 | [frq.wire :as wire] |
| 22 | 23 | [jolt.ffi :as ffi] |
| @@ -182,93 +183,25 @@ | ||
| 182 | 183 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) |
| 183 | 184 | :lock (Object.) :nick nick :caps (atom #{})}))) |
| 184 | 185 | |
| 185 | -(def ^:private sasl-chunk 400) | |
| 186 | - | |
| 187 | -(defn- authenticate! | |
| 188 | - "AUTHENTICATE takes at most 400 characters a line; a payload that lands on | |
| 189 | - the boundary is followed by a bare `+` so the server knows it ended." | |
| 190 | - [conn payload] | |
| 191 | - (loop [rest payload] | |
| 192 | - (if (> (count rest) sasl-chunk) | |
| 193 | - (do (send-line! conn (str "AUTHENTICATE " (subs rest 0 sasl-chunk))) | |
| 194 | - (recur (subs rest sasl-chunk))) | |
| 195 | - (do (send-line! conn (str "AUTHENTICATE " rest)) | |
| 196 | - (when (= sasl-chunk (count rest)) | |
| 197 | - (send-line! conn "AUTHENTICATE +")))))) | |
| 198 | - | |
| 199 | -(def ^:private wanted-caps | |
| 200 | - "What this client can use, and why a guest connection negotiates at all. | |
| 201 | - | |
| 202 | - `server-time`: without it a replayed backlog arrives untimed and every old | |
| 203 | - line reads as having just been said. `account-tag`: it puts the sender's DID | |
| 204 | - on the message, which is the only identity a client is given — a nick is | |
| 205 | - whatever someone chose today, and the hostmask carries eight characters of a | |
| 206 | - DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 | |
| 207 | - sends tags only to clients that asked for tags at all; either one alone is | |
| 208 | - ACKed and then nothing arrives. | |
| 209 | - | |
| 210 | - `echo-message`: the server sends our own lines back to us, which is the only | |
| 211 | - way this client learns the msgid of something it said. Without it our own | |
| 212 | - messages sit in the buffer with no id, and a reaction or a reply aimed at one | |
| 213 | - has nothing to name — the pill appears here and nobody else ever sees it. | |
| 214 | - | |
| 215 | - `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | |
| 216 | - an unsigned mutation from an account with | |
| 217 | - `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | |
| 218 | - register a key and sign one." | |
| 219 | - ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | |
| 220 | - | |
| 221 | -(defn cap-acked? | |
| 186 | +(def cap-acked? | |
| 222 | 187 | "Whether the server agreed to `cap` on this connection." |
| 223 | - [conn cap] | |
| 224 | - (boolean (when-let [caps (:caps conn)] (contains? @caps cap)))) | |
| 188 | + (fn [conn cap] | |
| 189 | + (handshake/acked? (when-let [caps (:caps conn)] @caps) cap))) | |
| 225 | 190 | |
| 226 | 191 | (defn- cap-step! |
| 227 | 192 | "Drive capability negotiation, and the SASL exchange inside it when there is |
| 228 | 193 | a session to authenticate with. Returns the message unchanged, so the caller |
| 229 | - can go on handling it." | |
| 194 | + can go on handling it. | |
| 195 | + | |
| 196 | + All of the deciding is `frq.irc.handshake`, which is shared: it answers with | |
| 197 | + the lines to send and this writes them. What is left here is the writing and | |
| 198 | + the atom the acked set lives in." | |
| 230 | 199 | [conn session msg] |
| 231 | - (let [{:keys [command params]} msg] | |
| 232 | - (case command | |
| 233 | - "CAP" (let [[_ sub caps] params | |
| 234 | - offered (set (str/split (or caps "") #"\s+")) | |
| 235 | - wanted (cond-> (filterv offered wanted-caps) | |
| 236 | - (and session (offered "sasl")) (conj "sasl"))] | |
| 237 | - (case sub | |
| 238 | - "LS" (if (seq wanted) | |
| 239 | - (send-line! conn (str "CAP REQ :" (str/join " " wanted))) | |
| 240 | - (send-line! conn "CAP END")) | |
| 241 | - ;; SASL, when acked, ends negotiation itself — CAP END waits | |
| 242 | - ;; for the exchange to finish either way. | |
| 243 | - "ACK" (do | |
| 244 | - (when-let [acked (:caps conn)] | |
| 245 | - (swap! acked into (remove str/blank? | |
| 246 | - (str/split (or caps "") #"\s+")))) | |
| 247 | - (if (str/includes? (or caps "") "sasl") | |
| 248 | - (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | |
| 249 | - (send-line! conn "CAP END"))) | |
| 250 | - "NAK" (send-line! conn "CAP END") | |
| 251 | - nil)) | |
| 252 | - ;; The challenge arrives as base64url JSON; the nonce inside it is what | |
| 253 | - ;; binds our PDS token to this connection. | |
| 254 | - "AUTHENTICATE" (let [challenge (first params)] | |
| 255 | - (when (and challenge (not= "+" challenge)) | |
| 256 | - (let [nonce (atproto/json-str | |
| 257 | - (atproto/b64-decode challenge) "nonce")] | |
| 258 | - (authenticate! conn (atproto/sasl-response session nonce))))) | |
| 259 | - ;; 903 logged in, 904/905/906 did not. A login is also the moment this | |
| 260 | - ;; connection can have a signing key: the DID it signs as is only settled | |
| 261 | - ;; here. The key is registered at 001 rather than now — MSGSIG is a | |
| 262 | - ;; registered-client command, and negotiation has not ended yet. | |
| 263 | - "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session)) | |
| 264 | - (msgsig/generate! (:did session))) | |
| 265 | - (send-line! conn "CAP END")) | |
| 266 | - ("904" "905" "906") (send-line! conn "CAP END") | |
| 267 | - ;; Welcomed. Hand the server the public half, and every reaction from | |
| 268 | - ;; here on carries a signature it will take. | |
| 269 | - "001" (when-let [pub (msgsig/public-key)] | |
| 270 | - (send-line! conn (str "MSGSIG " pub))) | |
| 271 | - nil)) | |
| 200 | + (let [caps (:caps conn) | |
| 201 | + {:keys [send] next-caps :caps} | |
| 202 | + (handshake/step {:session session :caps (when caps @caps)} msg)] | |
| 203 | + (when caps (reset! caps next-caps)) | |
| 204 | + (doseq [line send] (send-line! conn line))) | |
| 272 | 205 | msg) |
| 273 | 206 | |
| 274 | 207 | (defn connect! |
| @@ -17,6 +17,7 @@ | |||
| 17 | (:require [clojure.string :as str] | 17 | (:require [clojure.string :as str] |
| 18 | [frq.atproto :as atproto] | 18 | [frq.atproto :as atproto] |
| 19 | [frq.irc.parse :as parse] | 19 | [frq.irc.parse :as parse] |
| 20 | + [frq.irc.handshake :as handshake] | ||
| 20 | [frq.msgsig :as msgsig] | 21 | [frq.msgsig :as msgsig] |
| 21 | [frq.wire :as wire] | 22 | [frq.wire :as wire] |
| 22 | [jolt.ffi :as ffi] | 23 | [jolt.ffi :as ffi] |
| @@ -182,93 +183,25 @@ | |||
| 182 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) | 183 | {:kind :plain :fd fd :buf (ffi/alloc buffer-size) |
| 183 | :lock (Object.) :nick nick :caps (atom #{})}))) | 184 | :lock (Object.) :nick nick :caps (atom #{})}))) |
| 184 | 185 | ||
| 185 | -(def ^:private sasl-chunk 400) | 186 | +(def cap-acked? |
| 186 | - | ||
| 187 | -(defn- authenticate! | ||
| 188 | - "AUTHENTICATE takes at most 400 characters a line; a payload that lands on | ||
| 189 | - the boundary is followed by a bare `+` so the server knows it ended." | ||
| 190 | - [conn payload] | ||
| 191 | - (loop [rest payload] | ||
| 192 | - (if (> (count rest) sasl-chunk) | ||
| 193 | - (do (send-line! conn (str "AUTHENTICATE " (subs rest 0 sasl-chunk))) | ||
| 194 | - (recur (subs rest sasl-chunk))) | ||
| 195 | - (do (send-line! conn (str "AUTHENTICATE " rest)) | ||
| 196 | - (when (= sasl-chunk (count rest)) | ||
| 197 | - (send-line! conn "AUTHENTICATE +")))))) | ||
| 198 | - | ||
| 199 | -(def ^:private wanted-caps | ||
| 200 | - "What this client can use, and why a guest connection negotiates at all. | ||
| 201 | - | ||
| 202 | - `server-time`: without it a replayed backlog arrives untimed and every old | ||
| 203 | - line reads as having just been said. `account-tag`: it puts the sender's DID | ||
| 204 | - on the message, which is the only identity a client is given — a nick is | ||
| 205 | - whatever someone chose today, and the hostmask carries eight characters of a | ||
| 206 | - DID, too few to resolve. Both need `message-tags` beside them, since IRCv3 | ||
| 207 | - sends tags only to clients that asked for tags at all; either one alone is | ||
| 208 | - ACKed and then nothing arrives. | ||
| 209 | - | ||
| 210 | - `echo-message`: the server sends our own lines back to us, which is the only | ||
| 211 | - way this client learns the msgid of something it said. Without it our own | ||
| 212 | - messages sit in the buffer with no id, and a reaction or a reply aimed at one | ||
| 213 | - has nothing to name — the pill appears here and nobody else ever sees it. | ||
| 214 | - | ||
| 215 | - `freeq.at/msgsig`: what lets a signed-in account react at all. freeq answers | ||
| 216 | - an unsigned mutation from an account with | ||
| 217 | - `FAIL TAGMSG SIGNATURE_REQUIRED`, and this cap is how a client says it can | ||
| 218 | - register a key and sign one." | ||
| 219 | - ["message-tags" "server-time" "account-tag" "echo-message" "freeq.at/msgsig"]) | ||
| 220 | - | ||
| 221 | -(defn cap-acked? | ||
| 222 | "Whether the server agreed to `cap` on this connection." | 187 | "Whether the server agreed to `cap` on this connection." |
| 223 | - [conn cap] | 188 | + (fn [conn cap] |
| 224 | - (boolean (when-let [caps (:caps conn)] (contains? @caps cap)))) | 189 | + (handshake/acked? (when-let [caps (:caps conn)] @caps) cap))) |
| 225 | 190 | ||
| 226 | (defn- cap-step! | 191 | (defn- cap-step! |
| 227 | "Drive capability negotiation, and the SASL exchange inside it when there is | 192 | "Drive capability negotiation, and the SASL exchange inside it when there is |
| 228 | a session to authenticate with. Returns the message unchanged, so the caller | 193 | a session to authenticate with. Returns the message unchanged, so the caller |
| 229 | - can go on handling it." | 194 | + can go on handling it. |
| 195 | + | ||
| 196 | + All of the deciding is `frq.irc.handshake`, which is shared: it answers with | ||
| 197 | + the lines to send and this writes them. What is left here is the writing and | ||
| 198 | + the atom the acked set lives in." | ||
| 230 | [conn session msg] | 199 | [conn session msg] |
| 231 | - (let [{:keys [command params]} msg] | 200 | + (let [caps (:caps conn) |
| 232 | - (case command | 201 | + {:keys [send] next-caps :caps} |
| 233 | - "CAP" (let [[_ sub caps] params | 202 | + (handshake/step {:session session :caps (when caps @caps)} msg)] |
| 234 | - offered (set (str/split (or caps "") #"\s+")) | 203 | + (when caps (reset! caps next-caps)) |
| 235 | - wanted (cond-> (filterv offered wanted-caps) | 204 | + (doseq [line send] (send-line! conn line))) |
| 236 | - (and session (offered "sasl")) (conj "sasl"))] | ||
| 237 | - (case sub | ||
| 238 | - "LS" (if (seq wanted) | ||
| 239 | - (send-line! conn (str "CAP REQ :" (str/join " " wanted))) | ||
| 240 | - (send-line! conn "CAP END")) | ||
| 241 | - ;; SASL, when acked, ends negotiation itself — CAP END waits | ||
| 242 | - ;; for the exchange to finish either way. | ||
| 243 | - "ACK" (do | ||
| 244 | - (when-let [acked (:caps conn)] | ||
| 245 | - (swap! acked into (remove str/blank? | ||
| 246 | - (str/split (or caps "") #"\s+")))) | ||
| 247 | - (if (str/includes? (or caps "") "sasl") | ||
| 248 | - (send-line! conn "AUTHENTICATE ATPROTO-CHALLENGE") | ||
| 249 | - (send-line! conn "CAP END"))) | ||
| 250 | - "NAK" (send-line! conn "CAP END") | ||
| 251 | - nil)) | ||
| 252 | - ;; The challenge arrives as base64url JSON; the nonce inside it is what | ||
| 253 | - ;; binds our PDS token to this connection. | ||
| 254 | - "AUTHENTICATE" (let [challenge (first params)] | ||
| 255 | - (when (and challenge (not= "+" challenge)) | ||
| 256 | - (let [nonce (atproto/json-str | ||
| 257 | - (atproto/b64-decode challenge) "nonce")] | ||
| 258 | - (authenticate! conn (atproto/sasl-response session nonce))))) | ||
| 259 | - ;; 903 logged in, 904/905/906 did not. A login is also the moment this | ||
| 260 | - ;; connection can have a signing key: the DID it signs as is only settled | ||
| 261 | - ;; here. The key is registered at 001 rather than now — MSGSIG is a | ||
| 262 | - ;; registered-client command, and negotiation has not ended yet. | ||
| 263 | - "903" (do (when (and (cap-acked? conn "freeq.at/msgsig") (:did session)) | ||
| 264 | - (msgsig/generate! (:did session))) | ||
| 265 | - (send-line! conn "CAP END")) | ||
| 266 | - ("904" "905" "906") (send-line! conn "CAP END") | ||
| 267 | - ;; Welcomed. Hand the server the public half, and every reaction from | ||
| 268 | - ;; here on carries a signature it will take. | ||
| 269 | - "001" (when-let [pub (msgsig/public-key)] | ||
| 270 | - (send-line! conn (str "MSGSIG " pub))) | ||
| 271 | - nil)) | ||
| 272 | msg) | 205 | msg) |
| 273 | 206 | ||
| 274 | (defn connect! | 207 | (defn connect! |