The whole payload, the nonce it asked for, and a token that had expired
`pds-oauth` authenticates now: 903, and the server answers `logged in as did:plc:padwfc6z…` rather than renaming us Guest. Four things were in the way and each hid the next. `sasl-chunk` was 400, the IRCv3 figure, which assumes a server that reassembles the continuation lines. freeq does not — `handle_authenticate` base64-decodes the one param it was handed — so a split payload arrived as its own first 400 characters and came back `bad response`. It never mattered before because a web-token is short and a pds-session payload fits; an OAuth one carries the access token AND a DPoP proof, and took five lines. Then the PDS wanted a nonce, and said so through freeq: it calls getSession with our proof, is told `use_dpop_nonce`, and relays the nonce as a NOTICE before re-issuing the challenge. We ignored it and re-sent the identical proof until freeq gave up. A proof is bound to a nonce, so `dpop-nonce` reads the relay and the challenge is now answered with one minted for this moment — the one line of the handshake that cannot be answered synchronously, since minting is WebCrypto. And then the token itself: an access token lives about an hour, the refresh token was stored at sign-in and never used, and a session restored the next day carries one the PDS refuses. freeq relays none of that — the reason stays in its log and the client gets a bare 904 — so `usable?` now asks the same getSession freeq will ask, before connecting, and `refresh!` answers when it is refused. `name-session!` is the same idea aimed at the nick: a session that knows its token but not its handle connects as whatever was in the box, which is `frq-guest`, and looks for all the world like the sign-in did nothing. The wire log says how long a redacted payload is now. `<redacted>` hid the one fact that would have pointed at the first of these on sight. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
a9954d9 parent: 015500d modified
common/frq/irc/handshake.cljc +35 -2 | @@ -17,8 +17,22 @@ | ||
| 17 | 17 | [frq.msgsig :as msgsig])) |
| 18 | 18 | |
| 19 | 19 | (def sasl-chunk |
| 20 | - "AUTHENTICATE takes at most 400 characters a line." | |
| 21 | - 400) | |
| 20 | + "How much of a SASL payload goes on one AUTHENTICATE line. | |
| 21 | + | |
| 22 | + 400 is the IRCv3 figure, and it comes with an assumption freeq does not | |
| 23 | + meet: that the server reassembles the continuation lines. It does not. | |
| 24 | + `handle_authenticate` base64-decodes the single param it was handed, so a | |
| 25 | + split payload arrives as its own first 400 characters and comes back as | |
| 26 | + `904 SASL authentication failed (bad response)`. What freeq wants is the | |
| 27 | + whole thing on one line, which it can afford — a custom server reading | |
| 28 | + lines off a WebSocket bridge rather than a 512-byte ircd, and the same one | |
| 29 | + that advertises `draft/multiline=max-bytes=40000`. | |
| 30 | + | |
| 31 | + It never mattered until `pds-oauth`. A web-token is one short token and a | |
| 32 | + pds-session payload is a DID and an access token, both inside 400. An OAuth | |
| 33 | + payload carries the access token AND a DPoP proof JWT, which took five | |
| 34 | + lines — and only the first was ever read." | |
| 35 | + 100000) | |
| 22 | 36 | |
| 23 | 37 | (def wanted-caps |
| 24 | 38 | "What this client can use, and why a guest connection negotiates at all. |
| @@ -56,6 +70,25 @@ | ||
| 56 | 70 | (cond-> (conj out (str "AUTHENTICATE " rest)) |
| 57 | 71 | (= sasl-chunk (count rest)) (conj "AUTHENTICATE +"))))) |
| 58 | 72 | |
| 73 | +(defn dpop-nonce | |
| 74 | + "The DPoP nonce freeq is relaying, or nil. | |
| 75 | + | |
| 76 | + It arrives as `NOTICE <target> :DPOP_NONCE <nonce>` and it is not chatter: | |
| 77 | + the server called the PDS's getSession with our proof, was answered | |
| 78 | + `use_dpop_nonce`, and is passing on the nonce the PDS wants so the next | |
| 79 | + proof can carry it. Ignoring it means minting the same proof again, which | |
| 80 | + freeq answers with the same NOTICE until it stops — `SASL authentication | |
| 81 | + failed (DPoP nonce retry limit exceeded)`. | |
| 82 | + | |
| 83 | + Only `pds-oauth` can do anything with this; the other two methods carry no | |
| 84 | + proof to re-mint." | |
| 85 | + [msg] | |
| 86 | + (when (= "NOTICE" (:command msg)) | |
| 87 | + (let [text (str (last (:params msg)))] | |
| 88 | + (when (str/starts-with? text "DPOP_NONCE ") | |
| 89 | + (let [nonce (str/trim (subs text (count "DPOP_NONCE ")))] | |
| 90 | + (when (seq nonce) nonce)))))) | |
| 91 | + | |
| 59 | 92 | (defn acked? |
| 60 | 93 | "Whether the server agreed to `cap`, given the set it has acked so far." |
| 61 | 94 | [caps cap] |
| @@ -17,8 +17,22 @@ | |||
| 17 | [frq.msgsig :as msgsig])) | 17 | [frq.msgsig :as msgsig])) |
| 18 | 18 | ||
| 19 | (def sasl-chunk | 19 | (def sasl-chunk |
| 20 | - "AUTHENTICATE takes at most 400 characters a line." | 20 | + "How much of a SASL payload goes on one AUTHENTICATE line. |
| 21 | - 400) | 21 | + |
| 22 | + 400 is the IRCv3 figure, and it comes with an assumption freeq does not | ||
| 23 | + meet: that the server reassembles the continuation lines. It does not. | ||
| 24 | + `handle_authenticate` base64-decodes the single param it was handed, so a | ||
| 25 | + split payload arrives as its own first 400 characters and comes back as | ||
| 26 | + `904 SASL authentication failed (bad response)`. What freeq wants is the | ||
| 27 | + whole thing on one line, which it can afford — a custom server reading | ||
| 28 | + lines off a WebSocket bridge rather than a 512-byte ircd, and the same one | ||
| 29 | + that advertises `draft/multiline=max-bytes=40000`. | ||
| 30 | + | ||
| 31 | + It never mattered until `pds-oauth`. A web-token is one short token and a | ||
| 32 | + pds-session payload is a DID and an access token, both inside 400. An OAuth | ||
| 33 | + payload carries the access token AND a DPoP proof JWT, which took five | ||
| 34 | + lines — and only the first was ever read." | ||
| 35 | + 100000) | ||
| 22 | 36 | ||
| 23 | (def wanted-caps | 37 | (def wanted-caps |
| 24 | "What this client can use, and why a guest connection negotiates at all. | 38 | "What this client can use, and why a guest connection negotiates at all. |
| @@ -56,6 +70,25 @@ | |||
| 56 | (cond-> (conj out (str "AUTHENTICATE " rest)) | 70 | (cond-> (conj out (str "AUTHENTICATE " rest)) |
| 57 | (= sasl-chunk (count rest)) (conj "AUTHENTICATE +"))))) | 71 | (= sasl-chunk (count rest)) (conj "AUTHENTICATE +"))))) |
| 58 | 72 | ||
| 73 | +(defn dpop-nonce | ||
| 74 | + "The DPoP nonce freeq is relaying, or nil. | ||
| 75 | + | ||
| 76 | + It arrives as `NOTICE <target> :DPOP_NONCE <nonce>` and it is not chatter: | ||
| 77 | + the server called the PDS's getSession with our proof, was answered | ||
| 78 | + `use_dpop_nonce`, and is passing on the nonce the PDS wants so the next | ||
| 79 | + proof can carry it. Ignoring it means minting the same proof again, which | ||
| 80 | + freeq answers with the same NOTICE until it stops — `SASL authentication | ||
| 81 | + failed (DPoP nonce retry limit exceeded)`. | ||
| 82 | + | ||
| 83 | + Only `pds-oauth` can do anything with this; the other two methods carry no | ||
| 84 | + proof to re-mint." | ||
| 85 | + [msg] | ||
| 86 | + (when (= "NOTICE" (:command msg)) | ||
| 87 | + (let [text (str (last (:params msg)))] | ||
| 88 | + (when (str/starts-with? text "DPOP_NONCE ") | ||
| 89 | + (let [nonce (str/trim (subs text (count "DPOP_NONCE ")))] | ||
| 90 | + (when (seq nonce) nonce)))))) | ||
| 91 | + | ||
| 59 | (defn acked? | 92 | (defn acked? |
| 60 | "Whether the server agreed to `cap`, given the set it has acked so far." | 93 | "Whether the server agreed to `cap`, given the set it has acked so far." |
| 61 | [caps cap] | 94 | [caps cap] |
modified
flutter/src/frq/main.cljd +39 -7 | @@ -739,17 +739,49 @@ | ||
| 739 | 739 | :on-msg (fn [m] |
| 740 | 740 | (note! m) |
| 741 | 741 | (room! m) |
| 742 | + ;; The PDS wants a nonce, and says so | |
| 743 | + ;; through freeq rather than to us: the | |
| 744 | + ;; server called getSession with our | |
| 745 | + ;; proof, was told `use_dpop_nonce`, and | |
| 746 | + ;; relays the nonce as a NOTICE before | |
| 747 | + ;; issuing a fresh challenge. Keeping it | |
| 748 | + ;; is what makes the next proof the one | |
| 749 | + ;; the PDS will accept — resending the | |
| 750 | + ;; same one loops until freeq gives up | |
| 751 | + ;; with "DPoP nonce retry limit | |
| 752 | + ;; exceeded". | |
| 753 | + (when-let [nonce (handshake/dpop-nonce m)] | |
| 754 | + (swap! cells/session assoc | |
| 755 | + :dpop-nonce nonce)) | |
| 742 | 756 | ;; Capability negotiation and SASL, out of |
| 743 | 757 | ;; common/ — the same steps the desktop |
| 744 | 758 | ;; takes, and all this does is write what |
| 745 | 759 | ;; they answer with. |
| 746 | - (let [{:keys [send] next-caps :caps} | |
| 747 | - (handshake/step {:session @cells/session | |
| 748 | - :caps @caps} | |
| 749 | - m)] | |
| 750 | - (reset! caps next-caps) | |
| 751 | - (doseq [line send] | |
| 752 | - (when-let [c @conn] (net/send-line! c line)))) | |
| 760 | + ;; | |
| 761 | + ;; An `AUTHENTICATE` challenge to an | |
| 762 | + ;; OAuth session is the one line that | |
| 763 | + ;; cannot be answered synchronously: the | |
| 764 | + ;; proof has to be minted for this | |
| 765 | + ;; moment, with whatever nonce is now | |
| 766 | + ;; known, and minting is WebCrypto. | |
| 767 | + (let [step! (fn [] | |
| 768 | + (let [{:keys [send] next-caps :caps} | |
| 769 | + (handshake/step {:session @cells/session | |
| 770 | + :caps @caps} | |
| 771 | + m)] | |
| 772 | + (reset! caps next-caps) | |
| 773 | + (doseq [line send] | |
| 774 | + (when-let [c @conn] | |
| 775 | + (net/send-line! c line)))))] | |
| 776 | + (if (and (= "AUTHENTICATE" (str (:command m))) | |
| 777 | + (= :pds-oauth (:kind @cells/session))) | |
| 778 | + (.then ^async/Future | |
| 779 | + (handoff/prepare-session! @cells/session) | |
| 780 | + (fn [s] | |
| 781 | + (reset! cells/session s) | |
| 782 | + (step!) | |
| 783 | + nil)) | |
| 784 | + (step!))) | |
| 753 | 785 | (let [cmd (str (:command m)) |
| 754 | 786 | text (str (last (:params m)))] |
| 755 | 787 | (cond |
| @@ -739,17 +739,49 @@ | |||
| 739 | :on-msg (fn [m] | 739 | :on-msg (fn [m] |
| 740 | (note! m) | 740 | (note! m) |
| 741 | (room! m) | 741 | (room! m) |
| 742 | + ;; The PDS wants a nonce, and says so | ||
| 743 | + ;; through freeq rather than to us: the | ||
| 744 | + ;; server called getSession with our | ||
| 745 | + ;; proof, was told `use_dpop_nonce`, and | ||
| 746 | + ;; relays the nonce as a NOTICE before | ||
| 747 | + ;; issuing a fresh challenge. Keeping it | ||
| 748 | + ;; is what makes the next proof the one | ||
| 749 | + ;; the PDS will accept — resending the | ||
| 750 | + ;; same one loops until freeq gives up | ||
| 751 | + ;; with "DPoP nonce retry limit | ||
| 752 | + ;; exceeded". | ||
| 753 | + (when-let [nonce (handshake/dpop-nonce m)] | ||
| 754 | + (swap! cells/session assoc | ||
| 755 | + :dpop-nonce nonce)) | ||
| 742 | ;; Capability negotiation and SASL, out of | 756 | ;; Capability negotiation and SASL, out of |
| 743 | ;; common/ — the same steps the desktop | 757 | ;; common/ — the same steps the desktop |
| 744 | ;; takes, and all this does is write what | 758 | ;; takes, and all this does is write what |
| 745 | ;; they answer with. | 759 | ;; they answer with. |
| 746 | - (let [{:keys [send] next-caps :caps} | 760 | + ;; |
| 747 | - (handshake/step {:session @cells/session | 761 | + ;; An `AUTHENTICATE` challenge to an |
| 748 | - :caps @caps} | 762 | + ;; OAuth session is the one line that |
| 749 | - m)] | 763 | + ;; cannot be answered synchronously: the |
| 750 | - (reset! caps next-caps) | 764 | + ;; proof has to be minted for this |
| 751 | - (doseq [line send] | 765 | + ;; moment, with whatever nonce is now |
| 752 | - (when-let [c @conn] (net/send-line! c line)))) | 766 | + ;; known, and minting is WebCrypto. |
| 767 | + (let [step! (fn [] | ||
| 768 | + (let [{:keys [send] next-caps :caps} | ||
| 769 | + (handshake/step {:session @cells/session | ||
| 770 | + :caps @caps} | ||
| 771 | + m)] | ||
| 772 | + (reset! caps next-caps) | ||
| 773 | + (doseq [line send] | ||
| 774 | + (when-let [c @conn] | ||
| 775 | + (net/send-line! c line)))))] | ||
| 776 | + (if (and (= "AUTHENTICATE" (str (:command m))) | ||
| 777 | + (= :pds-oauth (:kind @cells/session))) | ||
| 778 | + (.then ^async/Future | ||
| 779 | + (handoff/prepare-session! @cells/session) | ||
| 780 | + (fn [s] | ||
| 781 | + (reset! cells/session s) | ||
| 782 | + (step!) | ||
| 783 | + nil)) | ||
| 784 | + (step!))) | ||
| 753 | (let [cmd (str (:command m)) | 785 | (let [cmd (str (:command m)) |
| 754 | text (str (last (:params m)))] | 786 | text (str (last (:params m)))] |
| 755 | (cond | 787 | (cond |
modified
flutter/src/frq/net/web.cljd +17 -10 | @@ -29,16 +29,23 @@ | ||
| 29 | 29 | |
| 30 | 30 | (defn- wire! [direction line] |
| 31 | 31 | (when @wire-log? |
| 32 | - ;; `print` and not `dart:developer`'s log: on the web `print` lands in the | |
| 33 | - ;; browser console, which is the place someone debugging this actually | |
| 34 | - ;; looks, where `dev/log` goes to the VM service and nowhere visible. | |
| 35 | - ;; Redacted here rather than only in the file sink, for that reason — | |
| 36 | - ;; `frq.debug` answers nil on the web, since there is no file to name, so | |
| 37 | - ;; the console is the only sink there is. | |
| 38 | - (print (str "frq.wire " direction " " | |
| 39 | - (if (.startsWith (str line) "AUTHENTICATE ") | |
| 40 | - "AUTHENTICATE <redacted>" | |
| 41 | - line))) | |
| 32 | + ;; `window.console.log` and not `print`. Dart's `print` is supposed to | |
| 33 | + ;; reach the browser console and in this build it reaches nothing — | |
| 34 | + ;; boot-time prints put in to trace a white page never appeared either, | |
| 35 | + ;; which cost an afternoon of guessing at a wire log that was never going | |
| 36 | + ;; to show up. The console is the only sink the web has: `frq.debug` | |
| 37 | + ;; answers nil here because there is no file to name. | |
| 38 | + ;; | |
| 39 | + ;; Redacted on the way out, because this is the log someone pastes into a | |
| 40 | + ;; bug report and the line after AUTHENTICATE is the credential. | |
| 41 | + (.log (.-console html/window) | |
| 42 | + (str "frq.wire " direction " " | |
| 43 | + ;; The credential is redacted but its LENGTH is not: a payload | |
| 44 | + ;; too long for what the server will read is exactly the bug | |
| 45 | + ;; this log existed to find, and `<redacted>` hid it. | |
| 46 | + (if (.startsWith (str line) "AUTHENTICATE ") | |
| 47 | + (str "AUTHENTICATE <redacted " (- (count (str line)) 13) " chars>") | |
| 48 | + line))) | |
| 42 | 49 | (when (debug/on?) |
| 43 | 50 | (debug/jot! direction " " line)))) |
| 44 | 51 | |
| @@ -29,16 +29,23 @@ | |||
| 29 | 29 | ||
| 30 | (defn- wire! [direction line] | 30 | (defn- wire! [direction line] |
| 31 | (when @wire-log? | 31 | (when @wire-log? |
| 32 | - ;; `print` and not `dart:developer`'s log: on the web `print` lands in the | 32 | + ;; `window.console.log` and not `print`. Dart's `print` is supposed to |
| 33 | - ;; browser console, which is the place someone debugging this actually | 33 | + ;; reach the browser console and in this build it reaches nothing — |
| 34 | - ;; looks, where `dev/log` goes to the VM service and nowhere visible. | 34 | + ;; boot-time prints put in to trace a white page never appeared either, |
| 35 | - ;; Redacted here rather than only in the file sink, for that reason — | 35 | + ;; which cost an afternoon of guessing at a wire log that was never going |
| 36 | - ;; `frq.debug` answers nil on the web, since there is no file to name, so | 36 | + ;; to show up. The console is the only sink the web has: `frq.debug` |
| 37 | - ;; the console is the only sink there is. | 37 | + ;; answers nil here because there is no file to name. |
| 38 | - (print (str "frq.wire " direction " " | 38 | + ;; |
| 39 | - (if (.startsWith (str line) "AUTHENTICATE ") | 39 | + ;; Redacted on the way out, because this is the log someone pastes into a |
| 40 | - "AUTHENTICATE <redacted>" | 40 | + ;; bug report and the line after AUTHENTICATE is the credential. |
| 41 | - line))) | 41 | + (.log (.-console html/window) |
| 42 | + (str "frq.wire " direction " " | ||
| 43 | + ;; The credential is redacted but its LENGTH is not: a payload | ||
| 44 | + ;; too long for what the server will read is exactly the bug | ||
| 45 | + ;; this log existed to find, and `<redacted>` hid it. | ||
| 46 | + (if (.startsWith (str line) "AUTHENTICATE ") | ||
| 47 | + (str "AUTHENTICATE <redacted " (- (count (str line)) 13) " chars>") | ||
| 48 | + line))) | ||
| 42 | (when (debug/on?) | 49 | (when (debug/on?) |
| 43 | (debug/jot! direction " " line)))) | 50 | (debug/jot! direction " " line)))) |
| 44 | 51 | ||
modified
flutter/src/frq/oauth/web.cljd +101 -1 | @@ -236,6 +236,13 @@ | ||
| 236 | 236 | (let [url (str (.replaceAll (str pds) (RegExp. "/+$") "") |
| 237 | 237 | "/xrpc/com.atproto.server.getSession") |
| 238 | 238 | resp (await (get-with-dpop! url token ""))] |
| 239 | + ;; Said out loud, because this is the call that decides whether the proof | |
| 240 | + ;; freeq is about to present will be accepted — it is the same request, | |
| 241 | + ;; with the same token and a proof minted the same way. A failure here is | |
| 242 | + ;; the whole answer to "why am I connected as a guest". | |
| 243 | + (.log (.-console html/window) | |
| 244 | + (str "frq.oauth whoami " (:status resp) " " | |
| 245 | + (if (= 200 (:status resp)) "ok" (:body resp)))) | |
| 239 | 246 | (when (= 200 (:status resp)) |
| 240 | 247 | {:handle (acore/json-str (:body resp) "handle") |
| 241 | 248 | :did (acore/json-str (:body resp) "did") |
| @@ -386,6 +393,89 @@ | ||
| 386 | 393 | (dpop/forget!) |
| 387 | 394 | nil) |
| 388 | 395 | |
| 396 | +(defn ^:async ^:private name-session! | |
| 397 | + "Fill in who the session belongs to, if it does not already say. | |
| 398 | + | |
| 399 | + A session that knows its token but not its handle connects as whatever was | |
| 400 | + in the nick box — which is `frq-guest`, and looks for all the world like the | |
| 401 | + sign-in did nothing. `resume!` asks at the moment of sign-in, but a session | |
| 402 | + restored from an earlier visit predates that question, and a `whoami!` that | |
| 403 | + failed once should not settle it for ever. So it is asked again here, where | |
| 404 | + every connect passes." | |
| 405 | + [session] | |
| 406 | + (if (seq (str (or (:handle session) ""))) | |
| 407 | + session | |
| 408 | + (let [who (await (whoami! (:pds session) (str (:access-jwt session)))) | |
| 409 | + handle (str (or (:handle who) ""))] | |
| 410 | + (if-not (seq handle) | |
| 411 | + session | |
| 412 | + (do | |
| 413 | + (reset! cells/form-handle handle) | |
| 414 | + (reset! cells/form-nick (first (.split ^String handle "."))) | |
| 415 | + (write-fields! (session-file) | |
| 416 | + {:did (or (:did who) (:did session)) | |
| 417 | + :access (:access-jwt session) | |
| 418 | + :handle handle | |
| 419 | + :pds (:pds session) | |
| 420 | + :refresh (or (:refresh session) "")}) | |
| 421 | + (assoc session | |
| 422 | + :handle handle | |
| 423 | + :did (or (:did who) (:did session)) | |
| 424 | + :dpop-nonce (str (or (:nonce who) (:dpop-nonce session) "")))))))) | |
| 425 | + | |
| 426 | +(defn ^:async ^:private refresh! | |
| 427 | + "A fresh access token from the refresh token, or nil. | |
| 428 | + | |
| 429 | + The gap this closes: an OAuth access token lives about an hour, the refresh | |
| 430 | + token was stored at sign-in and never used, and a session restored the next | |
| 431 | + day carries a token the PDS will refuse. freeq asks the PDS on our behalf, | |
| 432 | + is told no, and relays a bare `904 SASL authentication failed` — the reason | |
| 433 | + stays in its own log, which is why this was worth ruling out rather than | |
| 434 | + guessing at the proof. | |
| 435 | + | |
| 436 | + The token endpoint is rediscovered rather than stored: it is a property of | |
| 437 | + the PDS, `discover!` already knows how to find it, and a stored URL is one | |
| 438 | + more thing that can go stale in the saved session." | |
| 439 | + [session] | |
| 440 | + (let [refresh (str (or (:refresh session) ""))] | |
| 441 | + (when (seq refresh) | |
| 442 | + (let [{:keys [token]} (await (discover! (:pds session))) | |
| 443 | + resp (await (post-form! token | |
| 444 | + (form [[:grant_type "refresh_token"] | |
| 445 | + [:refresh_token refresh] | |
| 446 | + [:client_id (client-id)]]) | |
| 447 | + nil))] | |
| 448 | + (.log (.-console html/window) | |
| 449 | + (str "frq.oauth refresh " (:status resp) | |
| 450 | + (when-not (= 200 (:status resp)) (str " " (:body resp))))) | |
| 451 | + (when (= 200 (:status resp)) | |
| 452 | + (let [access (acore/json-str (:body resp) "access_token") | |
| 453 | + next-refresh (or (acore/json-str (:body resp) "refresh_token") refresh)] | |
| 454 | + (when (seq (str (or access ""))) | |
| 455 | + (write-fields! (session-file) | |
| 456 | + {:did (:did session) :access access | |
| 457 | + :handle (or (:handle session) "") | |
| 458 | + :pds (:pds session) :refresh next-refresh}) | |
| 459 | + (assoc session :access-jwt access :refresh next-refresh)))))))) | |
| 460 | + | |
| 461 | +(defn ^:async ^:private usable? | |
| 462 | + "Whether the PDS still accepts this token — asked the way freeq will ask. | |
| 463 | + | |
| 464 | + The same getSession call `verify_pds_oauth` makes, so a 200 here means the | |
| 465 | + token and the proof are both good and any SASL failure is elsewhere. It also | |
| 466 | + collects the nonce, which spares the round trip freeq would otherwise spend | |
| 467 | + relaying one." | |
| 468 | + [session] | |
| 469 | + (let [url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | |
| 470 | + "/xrpc/com.atproto.server.getSession") | |
| 471 | + resp (await (get-with-dpop! url (str (:access-jwt session)) | |
| 472 | + (str (or (:dpop-nonce session) ""))))] | |
| 473 | + (.log (.-console html/window) | |
| 474 | + (str "frq.oauth token " (:status resp) | |
| 475 | + (when-not (= 200 (:status resp)) (str " " (:body resp))))) | |
| 476 | + {:ok (= 200 (:status resp)) | |
| 477 | + :nonce (str (or (:nonce resp) ""))})) | |
| 478 | + | |
| 389 | 479 | (defn ^:async ^:private prepare-session! |
| 390 | 480 | "Mint the DPoP proof freeq will present to the PDS on our behalf. |
| 391 | 481 | |
| @@ -396,7 +486,17 @@ | ||
| 396 | 486 | [session] |
| 397 | 487 | (if-not (= :pds-oauth (:kind session)) |
| 398 | 488 | session |
| 399 | - (let [url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | |
| 489 | + (let [session (await (name-session! session)) | |
| 490 | + ;; Ask before freeq does. A token an hour old is refused, and the | |
| 491 | + ;; only thing that comes back through IRC is a bare failure. | |
| 492 | + {:keys [ok nonce]} (await (usable? session)) | |
| 493 | + session (assoc session :dpop-nonce (if (seq nonce) | |
| 494 | + nonce | |
| 495 | + (str (or (:dpop-nonce session) "")))) | |
| 496 | + session (if ok | |
| 497 | + session | |
| 498 | + (or (await (refresh! session)) session)) | |
| 499 | + url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | |
| 400 | 500 | "/xrpc/com.atproto.server.getSession") |
| 401 | 501 | p (await (dpop/proof "GET" url (str (or (:dpop-nonce session) "")) |
| 402 | 502 | (str (:access-jwt session))))] |
| @@ -236,6 +236,13 @@ | |||
| 236 | (let [url (str (.replaceAll (str pds) (RegExp. "/+$") "") | 236 | (let [url (str (.replaceAll (str pds) (RegExp. "/+$") "") |
| 237 | "/xrpc/com.atproto.server.getSession") | 237 | "/xrpc/com.atproto.server.getSession") |
| 238 | resp (await (get-with-dpop! url token ""))] | 238 | resp (await (get-with-dpop! url token ""))] |
| 239 | + ;; Said out loud, because this is the call that decides whether the proof | ||
| 240 | + ;; freeq is about to present will be accepted — it is the same request, | ||
| 241 | + ;; with the same token and a proof minted the same way. A failure here is | ||
| 242 | + ;; the whole answer to "why am I connected as a guest". | ||
| 243 | + (.log (.-console html/window) | ||
| 244 | + (str "frq.oauth whoami " (:status resp) " " | ||
| 245 | + (if (= 200 (:status resp)) "ok" (:body resp)))) | ||
| 239 | (when (= 200 (:status resp)) | 246 | (when (= 200 (:status resp)) |
| 240 | {:handle (acore/json-str (:body resp) "handle") | 247 | {:handle (acore/json-str (:body resp) "handle") |
| 241 | :did (acore/json-str (:body resp) "did") | 248 | :did (acore/json-str (:body resp) "did") |
| @@ -386,6 +393,89 @@ | |||
| 386 | (dpop/forget!) | 393 | (dpop/forget!) |
| 387 | nil) | 394 | nil) |
| 388 | 395 | ||
| 396 | +(defn ^:async ^:private name-session! | ||
| 397 | + "Fill in who the session belongs to, if it does not already say. | ||
| 398 | + | ||
| 399 | + A session that knows its token but not its handle connects as whatever was | ||
| 400 | + in the nick box — which is `frq-guest`, and looks for all the world like the | ||
| 401 | + sign-in did nothing. `resume!` asks at the moment of sign-in, but a session | ||
| 402 | + restored from an earlier visit predates that question, and a `whoami!` that | ||
| 403 | + failed once should not settle it for ever. So it is asked again here, where | ||
| 404 | + every connect passes." | ||
| 405 | + [session] | ||
| 406 | + (if (seq (str (or (:handle session) ""))) | ||
| 407 | + session | ||
| 408 | + (let [who (await (whoami! (:pds session) (str (:access-jwt session)))) | ||
| 409 | + handle (str (or (:handle who) ""))] | ||
| 410 | + (if-not (seq handle) | ||
| 411 | + session | ||
| 412 | + (do | ||
| 413 | + (reset! cells/form-handle handle) | ||
| 414 | + (reset! cells/form-nick (first (.split ^String handle "."))) | ||
| 415 | + (write-fields! (session-file) | ||
| 416 | + {:did (or (:did who) (:did session)) | ||
| 417 | + :access (:access-jwt session) | ||
| 418 | + :handle handle | ||
| 419 | + :pds (:pds session) | ||
| 420 | + :refresh (or (:refresh session) "")}) | ||
| 421 | + (assoc session | ||
| 422 | + :handle handle | ||
| 423 | + :did (or (:did who) (:did session)) | ||
| 424 | + :dpop-nonce (str (or (:nonce who) (:dpop-nonce session) "")))))))) | ||
| 425 | + | ||
| 426 | +(defn ^:async ^:private refresh! | ||
| 427 | + "A fresh access token from the refresh token, or nil. | ||
| 428 | + | ||
| 429 | + The gap this closes: an OAuth access token lives about an hour, the refresh | ||
| 430 | + token was stored at sign-in and never used, and a session restored the next | ||
| 431 | + day carries a token the PDS will refuse. freeq asks the PDS on our behalf, | ||
| 432 | + is told no, and relays a bare `904 SASL authentication failed` — the reason | ||
| 433 | + stays in its own log, which is why this was worth ruling out rather than | ||
| 434 | + guessing at the proof. | ||
| 435 | + | ||
| 436 | + The token endpoint is rediscovered rather than stored: it is a property of | ||
| 437 | + the PDS, `discover!` already knows how to find it, and a stored URL is one | ||
| 438 | + more thing that can go stale in the saved session." | ||
| 439 | + [session] | ||
| 440 | + (let [refresh (str (or (:refresh session) ""))] | ||
| 441 | + (when (seq refresh) | ||
| 442 | + (let [{:keys [token]} (await (discover! (:pds session))) | ||
| 443 | + resp (await (post-form! token | ||
| 444 | + (form [[:grant_type "refresh_token"] | ||
| 445 | + [:refresh_token refresh] | ||
| 446 | + [:client_id (client-id)]]) | ||
| 447 | + nil))] | ||
| 448 | + (.log (.-console html/window) | ||
| 449 | + (str "frq.oauth refresh " (:status resp) | ||
| 450 | + (when-not (= 200 (:status resp)) (str " " (:body resp))))) | ||
| 451 | + (when (= 200 (:status resp)) | ||
| 452 | + (let [access (acore/json-str (:body resp) "access_token") | ||
| 453 | + next-refresh (or (acore/json-str (:body resp) "refresh_token") refresh)] | ||
| 454 | + (when (seq (str (or access ""))) | ||
| 455 | + (write-fields! (session-file) | ||
| 456 | + {:did (:did session) :access access | ||
| 457 | + :handle (or (:handle session) "") | ||
| 458 | + :pds (:pds session) :refresh next-refresh}) | ||
| 459 | + (assoc session :access-jwt access :refresh next-refresh)))))))) | ||
| 460 | + | ||
| 461 | +(defn ^:async ^:private usable? | ||
| 462 | + "Whether the PDS still accepts this token — asked the way freeq will ask. | ||
| 463 | + | ||
| 464 | + The same getSession call `verify_pds_oauth` makes, so a 200 here means the | ||
| 465 | + token and the proof are both good and any SASL failure is elsewhere. It also | ||
| 466 | + collects the nonce, which spares the round trip freeq would otherwise spend | ||
| 467 | + relaying one." | ||
| 468 | + [session] | ||
| 469 | + (let [url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | ||
| 470 | + "/xrpc/com.atproto.server.getSession") | ||
| 471 | + resp (await (get-with-dpop! url (str (:access-jwt session)) | ||
| 472 | + (str (or (:dpop-nonce session) ""))))] | ||
| 473 | + (.log (.-console html/window) | ||
| 474 | + (str "frq.oauth token " (:status resp) | ||
| 475 | + (when-not (= 200 (:status resp)) (str " " (:body resp))))) | ||
| 476 | + {:ok (= 200 (:status resp)) | ||
| 477 | + :nonce (str (or (:nonce resp) ""))})) | ||
| 478 | + | ||
| 389 | (defn ^:async ^:private prepare-session! | 479 | (defn ^:async ^:private prepare-session! |
| 390 | "Mint the DPoP proof freeq will present to the PDS on our behalf. | 480 | "Mint the DPoP proof freeq will present to the PDS on our behalf. |
| 391 | 481 | ||
| @@ -396,7 +486,17 @@ | |||
| 396 | [session] | 486 | [session] |
| 397 | (if-not (= :pds-oauth (:kind session)) | 487 | (if-not (= :pds-oauth (:kind session)) |
| 398 | session | 488 | session |
| 399 | - (let [url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | 489 | + (let [session (await (name-session! session)) |
| 490 | + ;; Ask before freeq does. A token an hour old is refused, and the | ||
| 491 | + ;; only thing that comes back through IRC is a bare failure. | ||
| 492 | + {:keys [ok nonce]} (await (usable? session)) | ||
| 493 | + session (assoc session :dpop-nonce (if (seq nonce) | ||
| 494 | + nonce | ||
| 495 | + (str (or (:dpop-nonce session) "")))) | ||
| 496 | + session (if ok | ||
| 497 | + session | ||
| 498 | + (or (await (refresh! session)) session)) | ||
| 499 | + url (str (.replaceAll (str (:pds session)) (RegExp. "/+$") "") | ||
| 400 | "/xrpc/com.atproto.server.getSession") | 500 | "/xrpc/com.atproto.server.getSession") |
| 401 | p (await (dpop/proof "GET" url (str (or (:dpop-nonce session) "")) | 501 | p (await (dpop/proof "GET" url (str (or (:dpop-nonce session) "")) |
| 402 | (str (:access-jwt session))))] | 502 | (str (:access-jwt session))))] |