tui: fix /ask-* silent hang, autocomplete, and input wrap overdraw
ober
22a1e8d7daa07c500f47b9ad66d2e00bc7ef844f
--- a/src/jcode/tool/external-llm.ss +++ b/src/jcode/tool/external-llm.ss @@ -19,6 +19,7 @@ (import :jerboa/core :jerboa/runtime :std/os/path + :std/os/platform :std/os/sandbox :std/misc/ports :std/misc/string @@ -104,6 +105,60 @@ (if (file-exists? path) (read-file-string path) "") (catch (e) ""))) +;; Auth paths per provider (the same lists embedded in provider-spec, but +;; reachable by name so we can build a deny-list of OTHER providers' +;; tokens for the macOS profile). +(def (provider-auth-paths name) + (case name + ((claude) + (list (path-join (home) ".claude") + (path-join (home) ".claude.json") + (path-join (home) "Library/Application Support/claude"))) + ((gemini) + (list (path-join (home) ".gemini") + (path-join (home) ".config/gemini"))) + ((codex) + (list (path-join (home) ".codex") + (path-join (home) ".config/codex"))) + ((opencode) + (list (path-join (home) ".config/opencode") + (path-join (home) ".local/share/opencode") + (path-join (home) ".cache/opencode"))) + (else '()))) + +(def (sensitive-deny-paths chosen) + ;; Other providers' auth dirs + universally sensitive locations. + ;; jcode.json (project root) is denied so a CLI can't lift our keys. + (let ((other-providers + (filter (lambda (p) (not (eq? p chosen))) + (external-llm-providers)))) + (append + (apply append (map provider-auth-paths other-providers)) + (list (path-join (home) ".ssh") + (path-join (home) ".aws") + (path-join (home) ".gnupg") + (path-join (home) ".netrc") + (path-join (home) ".config/gh") + (path-join (home) ".docker") + (path-join (current-directory) "jcode.json"))))) + +;; macOS Seatbelt: jerboa's default `(deny default)` profile blocks +;; network and sub-process fork, which kills any LLM CLI before it can +;; reach its API. Use the inverse model: allow default, then deny only +;; the specific paths we want kept invisible. +(def (build-deny-profile chosen) + (let ((deny (sensitive-deny-paths chosen))) + (string-append + "(version 1)(allow default)" + (apply string-append + (map (lambda (p) + (format "(deny file-read* (subpath ~s))" p)) + deny)) + (apply string-append + (map (lambda (p) + (format "(deny file-write* (subpath ~s))" p)) + deny))))) + (def (ask-external-llm provider prompt) "Run PROVIDER's CLI in a sandboxed child, pass PROMPT, return captured stdout+stderr text. PROVIDER is one of the symbols returned by @@ -124,10 +179,13 @@ (let* ((label (car spec)) (build (cadr spec)) (auth (caddr spec)) + (chosen (string->symbol label)) (argv (build prompt)) (cwd (current-directory)) (tmp-out (path-join "/tmp" (format "jcode-ask-~a.log" label))) (cmd (build-cmdline argv tmp-out)) + ;; Linux/BSD path lists (Landlock / Capsicum / unveil consume + ;; these directly). macOS branch builds its own SBPL below. (read-paths (list "/usr" "/bin" "/sbin" "/etc" "/opt" "/Library" "/System" "/private/etc" "/private/var/db" "/dev" @@ -136,11 +194,18 @@ (write-paths (cons cwd (cons "/tmp" (cons "/private/tmp" auth)))) (exec-paths - (list "/usr/bin" "/bin" "/usr/local/bin" "/opt/homebrew/bin"))) + (list "/usr/bin" "/bin" "/usr/local/bin" "/opt/homebrew/bin" + (path-join (home) ".local/bin")))) (log-info logger "ask-external-llm" `((provider . ,label) (cmd . ,cmd))) (let ((status (try - (sandbox-run/command read-paths write-paths exec-paths cmd) + (cond + ((platform-macos?) + (sandbox-run/profile (build-deny-profile chosen) + (lambda () (system cmd)))) + (else + (sandbox-run/command read-paths write-paths + exec-paths cmd))) (catch (e) -1)))) (let ((text (read-text-or-empty tmp-out))) (cond --- a/src/jcode/ui/tui-input.ss +++ b/src/jcode/ui/tui-input.ss @@ -12,6 +12,7 @@ input-handle-key! input-submit! input-clear! input-lines + input-wrapped-row-count render-input! render-completion! *slash-commands*) @@ -39,17 +40,21 @@ ;; ---- Slash commands ---- (def *slash-commands* - '(("/help" . "Show help") - ("/model" . "Show or set model") - ("/provider" . "Show or set provider") - ("/tools" . "List available tools") - ("/clear" . "Start new session") - ("/sessions" . "List saved sessions") - ("/search" . "Search session history") - ("/compact" . "Compact conversation") - ("/quit" . "Exit jcode") - ("/theme" . "Switch color theme") - ("/sidebar" . "Toggle sidebar"))) + '(("/help" . "Show help") + ("/model" . "Show or set model") + ("/provider" . "Show or set provider") + ("/tools" . "List available tools") + ("/clear" . "Start new session") + ("/sessions" . "List saved sessions") + ("/search" . "Search session history") + ("/compact" . "Compact conversation") + ("/quit" . "Exit jcode") + ("/theme" . "Switch color theme") + ("/sidebar" . "Toggle sidebar") + ("/ask-claude" . "Second opinion from claude CLI (sandboxed)") + ("/ask-gemini" . "Second opinion from gemini CLI (sandboxed)") + ("/ask-codex" . "Second opinion from codex CLI (sandboxed)") + ("/ask-opencode" . "Second opinion from opencode CLI (sandboxed)"))) ;; ---- Key handling ---- ;; Returns: 'submit | 'cancel | 'continue | 'quit @@ -257,6 +262,15 @@ "Split input text into logical lines (by \\n)." (string-split (input-state-text inp) #\newline)) +(def (input-wrapped-row-count inp width prompt-len) + "How many visible rows render-input! will actually draw, capped to + *input-max-visible-rows*. Used by the render loop to reserve space + BEFORE computing the input-y coordinate, so wrap doesn't overdraw + the spinner row or the status bar." + (let* ((rows (input-visual-rows (input-state-text inp) width prompt-len)) + (n (length rows))) + (max 1 (min *input-max-visible-rows* n)))) + ;; ---- Visual layout (with auto-wrap) ---- ;; Long lines wrap at the input area's right edge so typed text never ;; bleeds into the sidebar column range (where it was being clobbered on --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -1126,16 +1126,25 @@ (draw-spinner! state)) ;; Input prompt + ;; Update input-height BEFORE computing iy: render-input! draws + ;; visually-wrapped rows, but `input-y` derives from input-height — + ;; if we wait until after render to update, the current frame draws + ;; with stale height and wrap spills onto the spinner / status bar. (let* ((prompt-text (make-prompt-text)) (inp (app-state-input state)) - (iy (input-y state)) - (mw (msg-area-width state))) - (let ((rows (render-input! inp 0 iy mw prompt-text))) - (app-state-input-height-set! state (max 1 (min 8 rows)))) - ;; Completion overlay (above input) - (when (input-state-completion inp) - (let ((comp-h (length (input-state-completion inp)))) - (render-completion! inp 0 (- iy comp-h) mw)))) + (mw (msg-area-width state)) + (visible (input-wrapped-row-count inp mw + (string-length prompt-text)))) + (app-state-input-height-set! state visible) + (let* ((iy (input-y state)) + (rows (render-input! inp 0 iy mw prompt-text))) + ;; render-input! returns the same count; keep state in sync if + ;; it ever drifts (e.g., width math edge case). + (app-state-input-height-set! state (max 1 (min 8 rows))) + ;; Completion overlay (above input) + (when (input-state-completion inp) + (let ((comp-h (length (input-state-completion inp)))) + (render-completion! inp 0 (- iy comp-h) mw))))) ;; Status bar (render-status-bar! 0 (status-y state) (app-state-width state)