fix: use 2FA response, selective FIDO2 error handling, request cleanup, https validation, constant-time SRP
ober
10c393f232ec4761c92e94dc15f313c011226456
--- a/proton-bridge/api/http.ss +++ b/proton-bridge/api/http.ss @@ -6,6 +6,7 @@ default-proton-api-base-url default-proton-app-version proton-api-url + proton-api-base-url-scheme proton-api-default-headers proton-api-auth-headers proton-api-header @@ -51,6 +52,16 @@ (string-append base path) (string-append base "/" path)))) + ;; Classify a base URL's scheme: 'https, 'http, or #f when the URL does not + ;; start with a recognised HTTP(S) scheme. Callers use this to refuse + ;; credential-bearing requests over plain http:// unless explicitly allowed. + (def (proton-api-base-url-scheme url) + (cond + [(not (string? url)) #f] + [(api-string-prefix? "https://" url) 'https] + [(api-string-prefix? "http://" url) 'http] + [else #f])) + (def (proton-api-header name value) (list name ':: value)) @@ -121,9 +132,18 @@ 'data: (string->utf8 (json-object->string payload)))] [else (error 'proton-api-request-json "unsupported method" method)])] - [status (request-status req)] - [text (request-text req)]) - (request-close req) + [status #f] + [text #f]) + ;; dynamic-wind guarantees the request is closed even if reading the + ;; status/body raises, so we never leak the underlying connection. + (dynamic-wind + (lambda () #f) + (lambda () + (set! status (request-status req)) + (set! text (request-text req))) + (lambda () + (guard (e [(condition? e) #f]) + (request-close req)))) (if (success-status? status) (parse-json-or-empty text) (error 'proton-api-request-json (response-error-message status text))))) --- a/proton-bridge/cli.ss +++ b/proton-bridge/cli.ss @@ -40,6 +40,9 @@ "\n" "secret automation (non-terminal descriptors only):\n" " --password-fd FD --mailbox-password-fd FD --pin-fd FD\n" + "network:\n" + " --base-url URL Proton API base URL (https:// required)\n" + " --insecure Allow an http:// --base-url (discouraged)\n" "exact body output:\n" " --body-file PATH Create a new private 0600 file; never replace\n")) @@ -202,7 +205,18 @@ password)) (define (auth-base-url opts) - (or (opt opts "--base-url") default-proton-api-base-url)) + (let* ([url (or (opt opts "--base-url") default-proton-api-base-url)] + [scheme (proton-api-base-url-scheme url)]) + (case scheme + [(https) url] + [(http) + (if (opt opts "--insecure") + (begin + (eprintln "warning: --insecure set; sending credentials over plain http://") + url) + (die 2 "refusing http:// base URL without --insecure; use https://"))] + [else + (die 2 "base URL must use an http:// or https:// scheme")]))) (define (auth-username opts) (let ([username (opt opts "--username")]) @@ -228,10 +242,14 @@ (eprintln "Touch your YubiKey when it blinks.") (call-with-values (lambda () (proton-fido2-assert auth 'pin: pin)) - (lambda (auth-data assertion payload-json) - (proton-auth-submit-fido2 auth payload-json 'base-url: base-url) - (values (proton-session-from-auth base-url auth) - key-pass))))] + (lambda (auth-data assertion payload-json) + ;; The /auth/v4/2fa response finalizes the login: it carries + ;; the real access token/scopes. Build the session from it, + ;; not from the pre-2FA `auth` object. + (let ([auth2fa (proton-auth-submit-fido2 + auth payload-json 'base-url: base-url)]) + (values (proton-session-from-auth base-url auth2fa) + key-pass)))))] [(proton-auth-totp-required? auth) (die 2 "TOTP 2FA is required, but TOTP submission is not implemented yet")] [else @@ -430,6 +448,7 @@ (define auth-known-options '(("--username" . #t) ("--base-url" . #t) + ("--insecure" . #f) ("--password-env" . #t) ("--password-fd" . #t) ("--mailbox-password-env" . #t) @@ -447,6 +466,7 @@ ("--auth-info" . #t) ("--username" . #t) ("--base-url" . #t) + ("--insecure" . #f) ("--password-env" . #t) ("--password-fd" . #t) ("--mailbox-password-env" . #t) --- a/proton-bridge/fido2.ss +++ b/proton-bridge/fido2.ss @@ -159,14 +159,39 @@ [(eq? (car xs) kw) (cadr xs)] [else (loop (cddr xs))]))) - (def (try-assert-with-credentials auth-data ids pin last-error) + ;; Cap the number of hardware assertion attempts. A wrong FIDO2 PIN + ;; decrements the YubiKey's PIN retry counter on every failed assertion; + ;; bounding the attempts here prevents a long credential list from + ;; exhausting that counter. + (def max-fido2-assert-attempts 3) + + ;; Expected FIDO2 errors are the ones raised by the assertion path itself: + ;; yubikey-fido2-assert routes every failure through yk-error with who + ;; 'yubikey-fido2-assert. Those mean "this credential did not work, try the + ;; next". Anything else (a non-condition raise, or a condition raised + ;; elsewhere) is unexpected and must propagate instead of being swallowed. + (def (expected-fido2-error? e) + (and (condition? e) + (guard (c [#t #f]) + (eq? (condition-who e) 'yubikey-fido2-assert)))) + + (def (try-assert-with-credentials auth-data ids pin last-error attempts-left) (cond [(null? ids) (if last-error (raise last-error) (error 'proton-fido2-assert "no credential IDs available"))] + [(<= attempts-left 0) + (if last-error + (raise last-error) + (error 'proton-fido2-assert + "exhausted FIDO2 assertion attempts without success"))] [else - (guard (e [#t (try-assert-with-credentials auth-data (cdr ids) pin e)]) + ;; Only catch expected per-credential FIDO2 failures and move on to the + ;; next credential. guard re-raises any unexpected error automatically. + (guard (e [(expected-fido2-error? e) + (try-assert-with-credentials + auth-data (cdr ids) pin e (- attempts-left 1))]) (yubikey-fido2-assert (proton-fido2-auth-data-rp-id auth-data) (proton-fido2-auth-data-client-data-json auth-data) @@ -183,7 +208,8 @@ auth-data (proton-fido2-auth-data-credential-ids auth-data) pin - #f)]) + #f + max-fido2-assert-attempts)]) (values auth-data assertion (proton-fido2-auth2fa-json auth-data assertion)))) ) --- a/proton-bridge/srp.ss +++ b/proton-bridge/srp.ss @@ -297,10 +297,29 @@ (lambda (proofs payload) (values proofs (json-object->string payload))))) + ;; Constant-time string equality. Always scans the full length of `a` and + ;; accumulates byte differences with bitwise OR, so the running time does not + ;; depend on where (or whether) the strings differ. This avoids leaking + ;; information about the expected SRP server proof through a timing side + ;; channel that a plain string=? would expose. Lengths are compared first; + ;; the proof length is public, so that early-out is not secret. + (def (constant-time-string=? a b) + (let ([ab (string->utf8 a)] + [bb (string->utf8 b)]) + (and (= (bytevector-length ab) (bytevector-length bb)) + (let ([n (bytevector-length ab)]) + (let loop ([i 0] [acc 0]) + (if (= i n) + (= acc 0) + (loop (+ i 1) + (bitwise-ior acc + (bitwise-xor (bytevector-u8-ref ab i) + (bytevector-u8-ref bb i)))))))))) + (def (proton-srp-server-proof-valid? proofs server-proof) (and (proton-srp-proofs? proofs) (string? server-proof) - (string=? (proton-srp-proofs-expected-server-proof proofs) - server-proof))) + (constant-time-string=? (proton-srp-proofs-expected-server-proof proofs) + server-proof))) )