Stage 5: password manager — in-process, memory-only credential vault
ober
a015dbe42e806ec7817046fac1cff629e1115e9b
--- a/.build.yml +++ b/.build.yml @@ -137,5 +137,16 @@ tasks: export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" make test-hint + - test-pass: | + cd jerboa-browser + # Stage 5 password manager: in-RAM vault round-trip + plaintext zeroing, + # masked prompt, save/fill/forget autofill against a rendered data: form + # (offscreen, hermetic). The vault touches no env/config/disk by design. + export QT_QPA_PLATFORM=offscreen JWB_TEST_NO_NETWORK=1 + export QTWEBENGINE_DISABLE_SANDBOX=1 + export QTWEBENGINE_CHROMIUM_FLAGS="--no-sandbox --disable-gpu" + export JERBOA_HOME="$HOME/jerboa" SCHEME="$(command -v scheme)" + export JERBOA_BROWSER_LIB="$PWD/qt-webengine/build/libjerboa_browser.so" + make test-pass # Stage all harness snapshots (stage0 + stage1 + stage2) as an artifact. tar czf gui-snapshots.tar.gz test-artifacts --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ JERBOA_HOME ?= $(realpath $(CURDIR)/../jerboa) SCHEME ?= $(JERBOA_HOME)/.chez/bin/scheme LIBDIRS := $(CURDIR)/scheme:$(JERBOA_HOME)/lib -.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-gui test-buffers repl clean help +.PHONY: binary test test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-pass test-gui test-buffers repl clean help .DEFAULT_GOAL := help # Build the self-contained native ./jerboa-browser (Chez + boot + (browser)). @@ -45,6 +45,12 @@ test-hint: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-hint-test.ss +# Stage 5 password-manager functional tests: in-RAM vault round-trip + zeroing, +# masked prompt, save/fill/forget autofill against a rendered data: form. +test-pass: + QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script scheme/browser-pass-test.ss + # Offline Qt GUI / snapshot harness (headless). Writes PNGs to ./test-artifacts. test-gui: QT_QPA_PLATFORM=offscreen JERBOA_HOME=$(JERBOA_HOME) \ --- a/ROADMAP.md +++ b/ROADMAP.md @@ -189,16 +189,34 @@ nyxt-style link hinting, JS-only (rides on `browser-eval`; no new C entry point) - **Deferred**: form-field passthrough (when an input is focused, route keys to the page instead of the keymap) — a focus-mode concern, not needed for parity. -### Stage 5 — Password manager (in-process, memory-only) -- **Scheme**: `(browser passwords)` — an in-RAM table keyed by origin → - {username, secret-bytevector}; entries added via a no-echo prompt - (reuse/port `ffi_embed_read_passphrase`); bytevectors zeroed after use - (port jsh's `zero-bv!` + constant-time compare). NEVER written to disk, env, - or any config. Optional: import on demand from jsh's `,pass` store. -- **Autofill**: on a login page, a command (`fill-login`, bound e.g. `C-c C-p`) - injects JS to set the username/password fields for the current origin. -- **Tests**: store a secret for a local test form, trigger autofill, eval the - field values back, assert they match; assert nothing hits disk/env. +### Stage 5 — Password manager (in-process, memory-only) ✅ DONE +HARD constraint (user, verbatim): **in process, not in an env var or a config of +any sort** — in-RAM only, zeroed after use, never disk/env/config/argv. +- **`(browser passwords)`** — a heap hashtable keyed by `page-key` (origin + `scheme://host[:port]` for http(s), else the whole URL so data:/local forms + round-trip) → `{username, masked-secret, pad}`. Each secret is XOR-masked with + a per-entry pad drawn from `/dev/urandom` (reading the CSPRNG persists + nothing), so no plaintext password string sits in the heap. `vault-put!` + consumes (zeroes) the caller's plaintext; `vault-with-secret` reconstitutes + the plaintext into a transient bytevector for one use and zeroes it in a + `dynamic-wind` after. Pure Scheme — no native crypto dep added to the binary + (decision: masking as defense-in-depth; the real guarantees are no-persist + + zero-after-use). Built on `(std security secret)`'s `wipe-bytevector!`. +- **Masked entry**: the minibuffer gained a `mask` field — a password prompt + renders input as `*`, so the secret never reaches the chrome/snapshot/echo; + `minibuffer-input`/`-result` still return the real value for the action. +- **Commands** (`C-c p s/f/k`): `save-login` chains a username prompt then a + masked password prompt and stores; `fill-login` injects username+password + into the page's form (`input[type=password]` + the first text/email/tel field + in its form, firing input/change) reconstituting the plaintext for the eval + alone; `forget-login` wipes the entry. JS string injection is escaped via + `js-quote`. The only unavoidable plaintext exposure is the page field itself. +- **Tests** (`make test-pass`, 12): vault round-trip; `vault-put!` zeroes the + caller's bytevector; the transient is zeroed after the consumer returns; + remove/clear; `page-key` origin vs whole-URL; registry + the `C-c p` chords; + masked render (`Password: **`) with real input preserved; end-to-end masked + save → autofill (`#u`=alice, `#p`=hunter2 read back) → forget. Hermetic data: + form. By construction the module writes no secret to env/config/disk. ### Stage 6 — Polish Status bar (url + buffer index + modes), echo-area messages/errors, complete the --- a/WISHLIST.md +++ b/WISHLIST.md @@ -12,7 +12,7 @@ offline Qt snapshot + functional tests modeled on `~/mine/jerboa-emacs`. - [x] **Keymap engine + emacs bindings + minibuffer (prompt-buffer)** with fuzzy completion — *Stage 2* — `(browser keymap/fuzzy/minibuffer/commands)`; app-wide Qt key filter → poll queue → emacs dispatch; `make test-keymap/-minibuffer/-commands/-keys` (84 cases); `jerboa-browser <url>` is keyboard-driven - [x] **Navigation parity** — scroll (`C-n/C-p/C-v/M-v/M-</M->`), zoom (`C-+/C--/C-0`), find-in-page (`C-s`, `C-M-s/r`), copy url/title (`C-c u/t`); history/reload already — *Stage 3* — `make test-nav` (10) - [x] **Hint-mode** — link hinting / follow (`f`, `M-g`, `; f`) via JS overlay; home-row labels, follow this/new buffer, C-g/escape cancels — *Stage 4* — `make test-hint` (10) -- [ ] **Password manager** — in-process, memory-only (no env, no config/file), autofill — *Stage 5* +- [x] **Password manager** — in-process, memory-only (no env, no config/file), masked entry, autofill; secrets XOR-masked in RAM + zeroed after use — *Stage 5* — `(browser passwords)`; `C-c p s/f/k`; `make test-pass` (12) - [ ] **Polish** — status bar, echo-area messages, command-palette completeness, bookmarks, docs — *Stage 6* Later / maybe: vi keyscheme parity, AppImage packaging, history persistence new file mode 100644 --- /dev/null +++ b/scheme/browser-pass-test.ss @@ -0,0 +1,217 @@ +#!chezscheme +;;; browser-pass-test.ss — Stage 5 password-manager functional tests. +;;; +;;; Exercises the in-RAM, memory-only vault (browser passwords) and the +;;; save/fill/forget commands end-to-end: store a credential, drive the masked +;;; minibuffer, autofill a rendered data: form, and read the field values back. +;;; +;;; Security properties asserted here: the caller's plaintext bytevector is +;;; zeroed by vault-put! (consumed), and the transient plaintext handed to +;;; vault-with-secret is zeroed the instant the consumer returns. By construction +;;; the module touches no env var, config, or disk (it only reads the kernel +;;; CSPRNG and stores in a heap hashtable), so nothing here writes a secret out. +;;; +;;; Run: QT_QPA_PLATFORM=offscreen make test-pass +;;; Exits 0 on success, 1 on any failed case. + +(import (chezscheme) (browser) (browser buffers) + (browser keymap) (browser minibuffer) (browser passwords) (browser commands)) + +;;; ─── tiny test framework (shared shape with the other test files) ───────── +(define *pass* 0) +(define *fail* 0) +(define *test-name* "(none)") + +(define-syntax test-group + (syntax-rules () + [(_ name body ...) + (begin (display "\n=== ") (display name) (display " ===\n") + (flush-output-port (current-output-port)) body ...)])) + +(define (run-test-case name thunk) + (set! *test-name* name) + (let ((ok (guard (e (#t + (set! *fail* (+ *fail* 1)) + (display " FAIL: ") (display name) (newline) + (display " error: ") + (display (if (message-condition? e) (condition-message e) + (format "~s" e))) + (newline) (flush-output-port (current-output-port)) #f)) + (thunk) #t))) + (when ok + (set! *pass* (+ *pass* 1)) + (display " pass: ") (display name) (newline) + (flush-output-port (current-output-port))))) + +(define-syntax test-case + (syntax-rules () [(_ name body ...) (run-test-case name (lambda () body ...))])) + +(define-syntax check + (syntax-rules (=> ?) + [(_ expr => expected) + (let ((got expr) (exp expected)) + (unless (equal? got exp) + (error 'check (format "~a: expected ~s, got ~s" *test-name* exp got))))] + [(_ expr ? pred) + (let ((got expr)) + (unless (pred got) (error 'check (format "~a: predicate failed for ~s" *test-name* got))))])) + +;;; ─── helpers ─────────────────────────────────────────────────────────────── +(unless (getenv "QT_QPA_PLATFORM") (error 'setup "run under QT_QPA_PLATFORM=offscreen (use: make test-pass)")) + +(define (all-zero? bv) + (let ((n (bytevector-length bv))) + (let loop ((i 0)) + (cond ((= i n) #t) + ((= 0 (bytevector-u8-ref bv i)) (loop (+ i 1))) + (else #f))))) + +;; Is `needle` a substring of `hay`? +(define (str-has? hay needle) + (let ((hn (string-length hay)) (nn (string-length needle))) + (let loop ((i 0)) + (cond ((> (+ i nn) hn) #f) + ((string=? (substring hay i (+ i nn)) needle) #t) + (else (loop (+ i 1))))))) + +;; A hermetic page: no-network session, window shown + sized + pumped, controller. +(define-syntax with-page + (syntax-rules () + [(_ (app s v) url body ...) + (let* ((s (open-browser-session (browser-capabilities))) ; no network + (win (session-window s))) + (browser-window-resize win 800 600) + (browser-window-show win) + (session-open-buffer s url) + (browser-pump 300) + (let* ((app (make-browser-app s)) + (v (buffer-view (session-current-buffer s)))) + body ... + (close-browser-session! s)))])) + +;; A login form: a text field (#u) + a password field (#p) inside a <form>. +(define form-page + (string-append + "data:text/html,<html><body><form>" + "<input%20type=%22text%22%20id=%22u%22>" + "<input%20type=%22password%22%20id=%22p%22>" + "</form></body></html>")) + +(define (field-value v sel) + (let ((r (browser-eval v (string-append "''+document.querySelector('" sel "').value")))) + (and (browser-ok? r) (browser-value r)))) + +;;; ─── vault: round-trip + zero-after-use ───────────────────────────────────── +(test-group "vault stores in RAM, round-trips, and zeroes plaintext" + (test-case "make-vault is empty; put!/has?/username/count" + (let ((vlt (make-vault))) + (check (vault? vlt) => #t) + (check (vault-count vlt) => 0) + (vault-put! vlt "https://ex.com" "alice" (string->utf8 "hunter2")) + (check (vault-has? vlt "https://ex.com") => #t) + (check (vault-username vlt "https://ex.com") => "alice") + (check (vault-count vlt) => 1) + (check (vault-has? vlt "https://other.com") => #f))) + + (test-case "vault-with-secret reconstitutes the exact plaintext" + (let ((vlt (make-vault))) + (vault-put! vlt "k" "u" (string->utf8 "s3cr3t!")) + (check (vault-with-secret vlt "k" (lambda (bv) (utf8->string bv))) => "s3cr3t!"))) + + (test-case "vault-put! zeroes the caller's plaintext bytevector (consumed)" + (let ((vlt (make-vault)) (bv (string->utf8 "topsecret"))) + (check (all-zero? bv) => #f) + (vault-put! vlt "k" "u" bv) + (check (all-zero? bv) => #t))) + + (test-case "the transient plaintext is zeroed after the consumer returns" + (let ((vlt (make-vault)) (leaked #f)) + (vault-put! vlt "k" "u" (string->utf8 "ephemeral")) + (vault-with-secret vlt "k" (lambda (bv) (set! leaked bv) #t)) + (check (all-zero? leaked) => #t))) ; wiped by the dynamic-wind + + (test-case "remove! / clear! drop entries; missing key → #f" + (let ((vlt (make-vault))) + (vault-put! vlt "a" "ua" (string->utf8 "pa")) + (vault-put! vlt "b" "ub" (string->utf8 "pb")) + (check (vault-count vlt) => 2) + (vault-remove! vlt "a") + (check (vault-has? vlt "a") => #f) + (check (vault-with-secret vlt "a" (lambda (bv) #t)) => #f) + (vault-clear! vlt) + (check (vault-count vlt) => 0)))) + +;;; ─── page-key (origin keying) ─────────────────────────────────────────────── +(test-group "page-key: origin for http(s), whole URL otherwise" + (test-case "https/http collapse to scheme://host[:port]" + (check (page-key "https://example.com/login?next=/x") => "https://example.com") + (check (page-key "http://host:8080/a/b") => "http://host:8080") + (check (page-key "https://example.com") => "https://example.com")) + (test-case "data:/about: key by their full URL (no shared origin)" + (check (page-key "data:text/html,foo") => "data:text/html,foo") + (check (page-key "about:blank") => "about:blank"))) + +;;; ─── command registry + keymap ────────────────────────────────────────────── +(test-group "Stage 5 commands + C-c p bindings" + (test-case "save/fill/forget-login are registered" + (for-each (lambda (n) (check (and (command-ref n) #t) => #t)) + '(save-login fill-login forget-login))) + (test-case "C-c p {s,f,k} chord to save/fill/forget-login" + (define km (emacs-keymap)) + (let ((d (make-key-dispatcher km))) + (check (dispatcher-feed! d "C-c") => 'pending) + (check (dispatcher-feed! d "p") => 'pending) + (check (dispatcher-feed! d "s") => '(run . save-login))) + (let ((d (make-key-dispatcher km))) + (dispatcher-feed! d "C-c") (dispatcher-feed! d "p") + (check (dispatcher-feed! d "f") => '(run . fill-login))) + (let ((d (make-key-dispatcher km))) + (dispatcher-feed! d "C-c") (dispatcher-feed! d "p") + (check (dispatcher-feed! d "k") => '(run . forget-login))))) + +;;; ─── masked minibuffer ────────────────────────────────────────────────────── +(test-group "masked prompt hides input but yields the real value" + (test-case "render shows bullets; input/result keep the secret" + (let ((mb (open-minibuffer "Password: " '() (lambda (x) x) #t))) + (check (minibuffer-mask mb) => #t) + (minibuffer-self-insert! mb #\h) + (minibuffer-self-insert! mb #\i) + (check (minibuffer-render mb) => "Password: **") + (check (minibuffer-input mb) => "hi") + (check (minibuffer-result mb) => "hi")))) + +;;; ─── end-to-end: save (masked) → autofill → forget ───────────────────────── +(test-group "save-login (masked prompt) then fill-login autofills the form" + (test-case "C-c p s stores via the masked prompt; C-c p f fills #u/#p" + (with-page (app s v) form-page + (let ((key (page-key (browser-value (browser-url v))))) + ;; save: C-c p s → username prompt → RET → masked password prompt → RET + (app-feed-token! app "C-c") (app-feed-token! app "p") (app-feed-token! app "s") + (check (str-has? (minibuffer-prompt (app-minibuffer app)) "Username") => #t) + (app-type! app "alice") + (app-feed-token! app "RET") + (check (minibuffer-mask (app-minibuffer app)) => #t) ; password is masked + (app-type! app "hunter2") + (app-feed-token! app "RET") + (check (app-minibuffer app) => #f) + (check (vault-has? (app-vault app) key) => #t) + (check (vault-username (app-vault app) key) => "alice") + ;; fill: C-c p f injects the values into the live form fields + (app-feed-token! app "C-c") (app-feed-token! app "p") (app-feed-token! app "f") + (check (str-has? (app-echo app) "Filled login") => #t) + (check (field-value v "#u") => "alice") + (check (field-value v "#p") => "hunter2") + ;; forget: C-c p k wipes it from RAM + (app-feed-token! app "C-c") (app-feed-token! app "p") (app-feed-token! app "k") + (check (vault-has? (app-vault app) key) => #f))))) + +(test-group "fill-login with nothing saved reports cleanly" + (test-case "fill on an unknown page echoes No saved login" + (with-page (app s v) form-page + (run-command-by-name app "fill-login") + (check (str-has? (app-echo app) "No saved login") => #t)))) + +(newline) +(display "browser-pass-test: ") (display *pass*) (display " passed, ") +(display *fail*) (display " failed") (newline) +(exit (if (zero? *fail*) 0 1)) --- a/scheme/browser/commands.ss +++ b/scheme/browser/commands.ss @@ -17,7 +17,7 @@ (export make-browser-app app? app-session app-keymap app-dispatcher app-minibuffer app-echo app-should-quit? - app-hints app-hint-buf + app-hints app-hint-buf app-vault app-feed-token! app-type! app-render! app-pump-keys! app-run-loop! emacs-keymap buffer-label @@ -38,7 +38,8 @@ (browser) (browser buffers) (browser keymap) - (browser minibuffer)) + (browser minibuffer) + (browser passwords)) ;; --- string helpers ----------------------------------------------------- (def (substr? hay needle) @@ -80,12 +81,13 @@ ;; hints : hint-mode label→href alist while hinting, else #f ;; hint-buf : chars typed so far toward a hint label ;; hint-new : #t when a followed hint should open in a new buffer + ;; vault : the in-RAM, memory-only credential store (browser passwords) (defstruct app (session keymap dispatcher minibuffer prompt-action echo quit search - hints hint-buf hint-new)) + hints hint-buf hint-new vault)) (def (make-browser-app session) (let* ((km (emacs-keymap)) (d (make-key-dispatcher km))) - (make-app session km d #f #f "" #f #f #f "" #f))) + (make-app session km d #f #f "" #f #f #f "" #f (make-vault)))) (def (app-should-quit? app) (and (app-quit app) #t)) (def (app-window app) (session-window (app-session app))) @@ -99,9 +101,11 @@ (browser-window-set-minibuffer win "" #f)) (session-update-status! (app-session app)))) - (def (open-prompt! app prompt candidates key action) - (app-minibuffer-set! app (open-minibuffer prompt candidates key)) - (app-prompt-action-set! app action)) + ;; opt = (mask?). A masked prompt (password entry) renders input as bullets. + (def (open-prompt! app prompt candidates key action . opt) + (let ((mask (and (pair? opt) (car opt)))) + (app-minibuffer-set! app (open-minibuffer prompt candidates key mask)) + (app-prompt-action-set! app action))) (def (close-prompt! app) (app-minibuffer-set! app #f) (app-prompt-action-set! app #f)) @@ -397,6 +401,57 @@ (app-echo-set! app (string-append "Follow hint: " buf)) 'continue)))) (else 'continue))) + ;; --- password manager (Stage 5) ----------------------------------------- + ;; Credentials live only in the app's in-RAM vault (browser passwords): never + ;; disk/env/config, plaintext zeroed after each use. Entry is via a *masked* + ;; minibuffer (the secret is never echoed). Autofill injects the username + + ;; password into the page's form, reconstituting the plaintext for the eval + ;; alone — the only unavoidable plaintext exposure is the page field itself. + (def (current-url app) + (let ((v (current-view app))) + (if (and v (browser-ok? (browser-url v))) (browser-value (browser-url v)) ""))) + + ;; Four lowercase hex digits of `n` (avoids depending on format's ~x). + (def (hex4 n) + (let ((h "0123456789abcdef")) + (string (string-ref h (bitwise-and (bitwise-arithmetic-shift-right n 12) 15)) + (string-ref h (bitwise-and (bitwise-arithmetic-shift-right n 8) 15)) + (string-ref h (bitwise-and (bitwise-arithmetic-shift-right n 4) 15)) + (string-ref h (bitwise-and n 15))))) + + ;; Render `s` as a safe double-quoted JS string literal for injection. + (def (js-quote s) + (let ((out (open-output-string))) + (display #\" out) + (string-for-each + (lambda (ch) + (let ((c (char->integer ch))) + (cond + ((char=? ch #\") (display "\\\"" out)) + ((char=? ch #\\) (display "\\\\" out)) + ((char=? ch #\newline) (display "\\n" out)) + ((char=? ch #\return) (display "\\r" out)) + ((< c 32) (display "\\u" out) (display (hex4 c) out)) + (else (display ch out))))) + s) + (display #\" out) + (get-output-string out))) + + ;; Set the page's username + password fields (first password input, and the + ;; first text/email/tel input in its form) and fire input/change events. + (def (autofill-js user pass) + (string-append + "(function(u,p){" + "var pw=document.querySelector('input[type=password]');" + "if(!pw)return 'no-password-field';" + "var scope=pw.form||document;" + "var uf=scope.querySelector('input[type=email],input[type=text],input[type=tel],input:not([type])');" + "if(uf){uf.value=u;uf.dispatchEvent(new Event('input',{bubbles:true}));" + "uf.dispatchEvent(new Event('change',{bubbles:true}));}" + "pw.value=p;pw.dispatchEvent(new Event('input',{bubbles:true}));" + "pw.dispatchEvent(new Event('change',{bubbles:true}));" + "return 'filled';})(" (js-quote user) "," (js-quote pass) ")")) + ;; --- the emacs keyscheme (from nyxt source/mode/base.lisp) --------------- ;; Defined before the command registrations below because an R6RS library body ;; must place every definition ahead of any (register-command! …) expression. @@ -435,6 +490,10 @@ ("f" . follow-hint) ("M-g" . follow-hint-new-buffer) ("; f" . follow-hint-new-buffer) + ;; password manager (Stage 5) — C-c p {s,f,k}: save / fill / forget + ("C-c p s" . save-login) + ("C-c p f" . fill-login) + ("C-c p k" . forget-login) ("C-x C-c" . quit) ("C-g" . keyboard-quit))) @@ -533,6 +592,43 @@ (register-command! 'follow-hint-new-buffer "Hint links and open the chosen one in a new buffer." (lambda (app) (start-hint-mode! app #t))) + ;; --- password manager commands (in-RAM only) ---------------------------- + (register-command! 'save-login "Save a username + password for this page (kept in RAM only)." + (lambda (app) + (let ((key (page-key (current-url app)))) + (open-prompt! app (string-append "Username @ " key ": ") '() (lambda (x) x) + (lambda (app user) + (open-prompt! app "Password (RAM only): " '() (lambda (x) x) + (lambda (app pass) + (vault-put! (app-vault app) key user (string->utf8 pass)) + (app-echo-set! app (string-append "Saved login for " user " @ " key))) + #t)))))) ; #t => masked prompt + + (register-command! 'fill-login "Autofill the saved login for this page." + (lambda (app) + (let* ((v (current-view app)) (vault (app-vault app)) + (key (page-key (current-url app)))) + (cond + ((not v) (app-echo-set! app "No buffer")) + ((not (vault-has? vault key)) + (app-echo-set! app (string-append "No saved login for " key))) + (else + (let* ((user (vault-username vault key)) + (res (vault-with-secret vault key + (lambda (bv) (browser-eval v (autofill-js user (utf8->string bv))))))) + (app-echo-set! app + (if (and res (browser-ok? res) (string=? (browser-value res) "filled")) + (string-append "Filled login for " user " @ " key) + "No password field on this page")))))))) + + (register-command! 'forget-login "Forget the saved login for this page (wipes it from RAM)." + (lambda (app) + (let* ((vault (app-vault app)) (key (page-key (current-url app)))) + (if (vault-has? vault key) + (begin (vault-remove! vault key) + (app-echo-set! app (string-append "Forgot login for " key))) + (app-echo-set! app (string-append "No saved login for " key)))))) + (register-command! 'switch-buffer-next "Switch to the next buffer (cyclic)." (lambda (app) (session-switch-next! (app-session app)))) (register-command! 'switch-buffer-previous "Switch to the previous buffer (cyclic)." --- a/scheme/browser/minibuffer.ss +++ b/scheme/browser/minibuffer.ss @@ -20,7 +20,7 @@ minibuffer-selected minibuffer-selected-string minibuffer-result minibuffer-set-input! minibuffer-self-insert! minibuffer-backspace! minibuffer-next! minibuffer-previous! - minibuffer-handle-key! + minibuffer-handle-key! minibuffer-mask minibuffer-render minibuffer-candidate-strings) (import (except (chezscheme) @@ -41,11 +41,14 @@ ;; key : candidate -> display string (for matching + rendering) ;; filtered : current fuzzy-filtered+ranked candidates ;; sel : index into `filtered`, or -1 when empty - (defstruct minibuffer (prompt input candidates key filtered selection)) + ;; mask : #t for a password prompt — input renders as `*` (never echoed) + (defstruct minibuffer (prompt input candidates key filtered selection mask)) + ;; opt = (key [mask?]). A masked prompt has no candidates and hides its input. (def (open-minibuffer prompt candidates . opt) - (let* ((key (if (pair? opt) (car opt) (lambda (x) x))) - (mb (make-minibuffer prompt "" candidates key '() -1))) + (let* ((key (if (pair? opt) (car opt) (lambda (x) x))) + (mask (and (pair? opt) (pair? (cdr opt)) (cadr opt))) + (mb (make-minibuffer prompt "" candidates key '() -1 mask))) (minibuffer-set-input! mb "") mb)) @@ -107,8 +110,13 @@ (else 'continue))) ; ignore other keys while the prompt is open ;; --- rendering (for the Qt minibuffer line + snapshots/echo) ------------- + ;; A masked prompt renders its input as bullets, so the secret never reaches + ;; the window chrome, snapshots, or the echo area. (def (minibuffer-render mb) - (string-append (minibuffer-prompt mb) (minibuffer-input mb))) + (string-append (minibuffer-prompt mb) + (if (minibuffer-mask mb) + (make-string (string-length (minibuffer-input mb)) #\*) + (minibuffer-input mb)))) ;; Up to `limit` candidate display strings, the selected one prefixed "> ". (def (minibuffer-candidate-strings mb limit) new file mode 100644 --- /dev/null +++ b/scheme/browser/passwords.ss @@ -0,0 +1,143 @@ +#!chezscheme +;;; (browser passwords) — in-process, memory-only credential vault. +;;; +;;; HARD constraint (user, verbatim): secrets live ONLY in RAM — never an env +;;; var, never a config, never disk, never argv. This module reads no files for +;;; its store and writes none; the vault is a plain hashtable in the Scheme heap. +;;; +;;; Defense-in-depth: a stored secret is never kept as a plaintext string. It is +;;; held masked — XOR'd with a per-entry random pad drawn from the kernel CSPRNG +;;; (/dev/urandom; reading it persists nothing) — so a heap scan for the password +;;; finds neither the bytes nor a lingering string. The plaintext is reconstituted +;;; into a transient bytevector only for the duration of one autofill and zeroed +;;; immediately after (vault-with-secret's dynamic-wind). Pure Scheme: no native +;;; crypto dependency (the mask is obfuscation, not authenticated encryption; the +;;; real guarantees are no-persist + zero-after-use). Built on (std security +;;; secret)'s wipe and modelled on jsh's in-RAM embed/pass handling. + +(library (browser passwords) + (export + make-vault vault? + vault-put! vault-has? vault-username vault-origins vault-count + vault-with-secret vault-remove! vault-clear! + page-key) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (only (std security secret) wipe-bytevector!)) + + ;; --- entropy ------------------------------------------------------------ + ;; Kernel CSPRNG. Reading /dev/urandom writes nothing and stores no secret on + ;; disk, so it does not breach the no-persistence constraint. + (def (random-bytes n) + (if (<= n 0) + (make-bytevector 0) + (let ((p (open-file-input-port "/dev/urandom"))) + (dynamic-wind + (lambda () #f) + (lambda () + (let ((bv (get-bytevector-n p n))) + (if (and (bytevector? bv) (= (bytevector-length bv) n)) + bv + (error 'random-bytes "short read from /dev/urandom")))) + (lambda () (close-port p)))))) + + ;; --- masking ------------------------------------------------------------ + ;; dst[i] ^= src[i] for i < min length (in place). + (def (xor-into! dst src) + (let ((n (min (bytevector-length dst) (bytevector-length src)))) + (do ((i 0 (+ i 1))) ((= i n)) + (bytevector-u8-set! dst i (bitwise-xor (bytevector-u8-ref dst i) + (bytevector-u8-ref src i)))))) + + (def (copy-bytes bv) + (let* ((n (bytevector-length bv)) (out (make-bytevector n 0))) + (bytevector-copy! bv 0 out 0 n) + out)) + + ;; --- string search (for page-key) --------------------------------------- + (def (find-substring hay needle) + (let ((hn (string-length hay)) (nn (string-length needle))) + (let loop ((i 0)) + (cond ((> (+ i nn) hn) #f) + ((string=? (substring hay i (+ i nn)) needle) i) + (else (loop (+ i 1))))))) + + ;; The vault key for a page: the origin (scheme://host[:port]) for http/https + ;; — so a credential saved on /login autofills across that site — else the + ;; whole URL (data:/about:/file: have no shared origin, so key them exactly; + ;; this also lets hermetic data: test forms round-trip). + (def (page-key url) + (let ((i (find-substring url "://"))) + (if (not i) + url + (let* ((scheme (substring url 0 i)) + (rest (substring url (+ i 3) (string-length url))) + (rn (string-length rest)) + (slash (let loop ((j 0)) + (cond ((= j rn) j) + ((char=? (string-ref rest j) #\/) j) + (else (loop (+ j 1))))))) + (if (or (string=? scheme "http") (string=? scheme "https")) + (string-append scheme "://" (substring rest 0 slash)) + url))))) + + ;; --- the vault ---------------------------------------------------------- + ;; cred: username (plaintext string) + masked secret + its equal-length pad. + (defstruct cred (username masked pad)) + (defstruct %vault (table)) ; key string -> cred + + (def (make-vault) (make-%vault (make-hashtable string-hash string=?))) + (def (vault? x) (%vault? x)) + (def (vault-count v) (hashtable-size (%vault-table v))) + (def (vault-has? v key) (and (hashtable-ref (%vault-table v) key #f) #t)) + (def (vault-origins v) (vector->list (hashtable-keys (%vault-table v)))) + (def (vault-username v key) + (let ((c (hashtable-ref (%vault-table v) key #f))) (and c (cred-username c)))) + + ;; Wipe and drop the entry for `key` (zeroes both the masked secret and pad). + (def (vault-remove! v key) + (let ((c (hashtable-ref (%vault-table v) key #f))) + (when c + (wipe-bytevector! (cred-masked c)) + (wipe-bytevector! (cred-pad c)) + (hashtable-delete! (%vault-table v) key)))) + + (def (vault-clear! v) + (for-each (lambda (k) (vault-remove! v k)) (vault-origins v))) + + ;; Store `secret-bv` for `key` under `username`. The secret is masked with a + ;; fresh random pad and the caller's plaintext bytevector is zeroed (consumed), + ;; so no plaintext copy survives this call. + (def (vault-put! v key username secret-bv) + (vault-remove! v key) ; wipe any prior entry first + (let* ((n (bytevector-length secret-bv)) + (pad (random-bytes n)) + (masked (copy-bytes secret-bv))) + (xor-into! masked pad) + (wipe-bytevector! secret-bv) + (hashtable-set! (%vault-table v) key (make-cred username masked pad)))) + + ;; Reconstitute the plaintext for `key` into a transient bytevector, pass it to + ;; `proc`, and zero it immediately after (even on non-local exit). Returns + ;; proc's result, or #f if there is no entry. proc MUST NOT retain the + ;; bytevector — it is wiped the instant proc returns. + (def (vault-with-secret v key proc) + (let ((c (hashtable-ref (%vault-table v) key #f))) + (and c + (let ((tmp (copy-bytes (cred-masked c)))) + (xor-into! tmp (cred-pad c)) ; tmp now holds the plaintext + (dynamic-wind + (lambda () #f) + (lambda () (proc tmp)) + (lambda () (wipe-bytevector! tmp))))))) + + ) ; library (browser passwords)