updates to fix ,mux?
ober
91e0a396a0ece602d45f3bb714b788306a1e86a1
--- a/jerboa-src/src/jsh/mux-screen.ss +++ b/jerboa-src/src/jsh/mux-screen.ss @@ -331,7 +331,8 @@ (set! last-fg fg) (set! last-bg bg) (set! last-attrs attrs)) - (write-char ch out))) + (unless (> (bitwise-and attrs ATTR-WIDE-CONT) 0) + (write-char ch out)))) ;; Clear to end of line if vt-cols < screen-cols (when (< vt-cols screen-cols) (display "\x1B;[0m\x1B;[K" out)) --- a/jerboa-src/src/jsh/mux-server.ss +++ b/jerboa-src/src/jsh/mux-server.ss @@ -177,8 +177,11 @@ [mutable fail-count] ;; auth failure counter [mutable session-id] ;; which session this client is viewing [mutable forward-channels] ;; alist: (channel-id . target-fd) for -D forwarding - [immutable forward-mutex] ;; guards channel reservations/activation/removal - [mutable write-mutex])) ;; mutex for thread-safe writes + [immutable forward-mutex] + [mutable write-mutex] + [mutable output-queue] + [mutable output-offset] + [mutable output-bytes])) ;; Convenience: get transport I/O functions for a client (define (client-read-fn client) @@ -718,7 +721,9 @@ (cleanup-dead-clients! state) (accept-new-clients! state) (handle-client-input! state) + (flush-pending-pane-inputs! state) (handle-pty-output! state) + (flush-client-outputs! state) (check-idle-alerts! state) ;; Remove dead panes/windows; redraw clients if layout changed (when (sm-cleanup-dead-panes! (server-state-sm state)) @@ -1112,7 +1117,7 @@ 'pending #f challenge (+ (ffi-clock-monotonic-ns) 30000000000) 0 -1 '() - (make-mutex) (make-mutex))]) + (make-mutex) (make-mutex) '() 0 0)]) (server-state-clients-set! state (cons client (server-state-clients state))))) (begin @@ -1126,7 +1131,7 @@ (let* ([sid (ensure-default-session! state 80 24)] [client (make-mux-client tr 80 24 #t 'authenticated #f #f #f 0 sid '() - (make-mutex) (make-mutex))]) + (make-mutex) (make-mutex) '() 0 0)]) (server-debug (string-append "MUX-CLIENT: client authenticated, session=" (number->string sid))) (server-state-clients-set! state @@ -1642,32 +1647,63 @@ (or (= (bytevector-u8-ref bv i) byte) (loop (+ i 1))))))) +(define *pane-pending-input* (make-eqv-hashtable)) +(define max-pane-pending-input (* 16 1024 1024)) + +(define (flush-pane-input-state! pane key state) + (let ([segments (vector-ref state 0)] + [offset (vector-ref state 1)]) + (cond + [(null? segments) + (hashtable-delete! *pane-pending-input* key)] + [(>= offset (bytevector-length (car segments))) + (vector-set! state 0 (cdr segments)) + (vector-set! state 1 0) + (flush-pane-input-state! pane key state)] + [else + (let* ([segment (car segments)] + [n (ffi-bv-write + (mux-pane-master-fd pane) + segment offset (- (bytevector-length segment) offset))]) + (when (> n 0) + (vector-set! state 1 (+ offset n)) + (vector-set! state 2 (- (vector-ref state 2) n)) + (flush-pane-input-state! pane key state)))]))) + +(define (flush-pane-input! pane) + (let* ([key (mux-pane-id pane)] + [state (hashtable-ref *pane-pending-input* key #f)]) + (cond + [(not (mux-pane-alive? pane)) + (hashtable-delete! *pane-pending-input* key)] + [state (flush-pane-input-state! pane key state)]))) + +(define (enqueue-pane-input! pane payload) + (flush-pane-input! pane) + (let* ([key (mux-pane-id pane)] + [state (or (hashtable-ref *pane-pending-input* key #f) + (let ([fresh (vector '() 0 0)]) + (hashtable-set! *pane-pending-input* key fresh) + fresh))] + [len (bytevector-length payload)] + [new-total (+ (vector-ref state 2) len)]) + (if (> new-total max-pane-pending-input) + (server-debug + (string-append "PTY input queue full pane=" (number->string key))) + (begin + (vector-set! state 0 (append (vector-ref state 0) (list payload))) + (vector-set! state 2 new-total) + (flush-pane-input! pane))))) + +(define (flush-pending-pane-inputs! state) + (for-each flush-pane-input! (sm-all-panes (server-state-sm state)))) + (define (forward-to-pane state client payload) (let ([pane (client-active-pane state client)]) (when (and pane (mux-pane-alive? pane)) - ;; Ctrl-Z commonly stops a full-screen program without letting it emit - ;; its normal alternate-screen cleanup. Leave the mux VT alt state before - ;; the shell's job-control output arrives, so prompt redraws land on the - ;; main pane screen. (when (bytevector-contains-byte? payload 26) (vt-leave-alt-screen! (mux-pane-vt pane))) - ;; Terminal input is an arbitrary byte stream, not UTF-8 text. Preserve - ;; bytes exactly and finish partial nonblocking PTY writes within a short - ;; deadline instead of silently dropping a paste suffix. - (let ([fd (mux-pane-master-fd pane)] - [len (bytevector-length payload)] - [deadline (+ (ffi-clock-monotonic-ns) 100000000)]) - (let loop ([offset 0]) - (when (< offset len) - (let ([n (ffi-bv-write fd payload offset (- len offset))]) - (cond - [(> n 0) (loop (+ offset n))] - [(< (ffi-clock-monotonic-ns) deadline) - (ffi-nanosleep-us 1000) - (loop offset)] - [else - (error 'mux-server "PTY input write timed out" - offset len)])))))))) + (enqueue-pane-input! pane payload)))) ;; ---- Handle PTY output ---- @@ -1905,7 +1941,7 @@ (map string->utf8 '("\x1B;[J" "\x1B;[0J" "\x1B;[1J" "\x1B;[2J" "\x1B;[3J" - "\x1B;c" + "\x1B;c" "\x1B;[r" "\x1B;[;r" "\x1B;[?1049h" "\x1B;[?1049l"))) (define (status-overlay-needed? data-bv) @@ -2005,7 +2041,8 @@ (for-each (lambda (client) (when (and (mux-client-attached? client) - (eq? (mux-client-auth-state client) 'authenticated)) + (eq? (mux-client-auth-state client) 'authenticated) + (vt-clean-boundary? (mux-pane-vt pane))) (guard (e [#t (server-debug " STATUS-OVERLAY-SEND-ERROR")]) (send-status-overlay-to-client state client)))) @@ -2018,17 +2055,59 @@ ;; The outer write-mutex serialises mux-write-message; crypto-state's ;; internal mutex serialises seq increment + encrypt independently ;; (both held here, but mux-encrypt-message is safe regardless). +(define max-client-output-bytes (* 16 1024 1024)) + +(define (flush-client-output-locked! client) + (let ([queue (mux-client-output-queue client)]) + (when (pair? queue) + (let* ([frame (car queue)] + [offset (mux-client-output-offset client)] + [remaining (- (bytevector-length frame) offset)] + [n ((client-write-fn client) (client-id client) + frame offset remaining)]) + (cond + [(> n 0) + (mux-client-output-offset-set! client (+ offset n)) + (mux-client-output-bytes-set! + client (- (mux-client-output-bytes client) n)) + (when (>= (+ offset n) (bytevector-length frame)) + (mux-client-output-queue-set! client (cdr queue)) + (mux-client-output-offset-set! client 0)) + (flush-client-output-locked! client)] + [(< n 0) + (mux-client-output-queue-set! client '()) + (mux-client-output-offset-set! client 0) + (mux-client-output-bytes-set! client 0) + (fail-client-protocol! client "client output write failed")] + [else (void)]))))) + +(define (flush-client-output! client) + (with-mutex (mux-client-write-mutex client) + (flush-client-output-locked! client))) + +(define (flush-client-outputs! state) + (for-each flush-client-output! (server-state-clients state))) + (define (send-to-client-safe client type payload) - (let ([wfn (client-write-fn client)] - [cid (client-id client)] - [cs (mux-client-crypto-state client)] - [mtx (mux-client-write-mutex client)]) - (with-mutex mtx - (if cs - (let* ([inner (mux-encode type payload)] - [encrypted (mux-encrypt-message cs inner)]) - (mux-write-message wfn cid MSG-ENCRYPTED encrypted)) - (mux-write-message wfn cid type payload))))) + (with-mutex (mux-client-write-mutex client) + (let* ([cs (mux-client-crypto-state client)] + [frame (if cs + (let* ([inner (mux-encode type payload)] + [encrypted (mux-encrypt-message cs inner)]) + (mux-encode MSG-ENCRYPTED encrypted)) + (mux-encode type payload))] + [new-total (+ (mux-client-output-bytes client) + (bytevector-length frame))]) + (if (> new-total max-client-output-bytes) + (begin + (fail-client-protocol! client "client output queue full") + #f) + (begin + (mux-client-output-queue-set! client + (append (mux-client-output-queue client) (list frame))) + (mux-client-output-bytes-set! client new-total) + (flush-client-output-locked! client) + #t))))) ;; Make a 4-byte channel-id bytevector (define (encode-channel-id channel-id) --- a/jerboa-src/src/jsh/vt.ss +++ b/jerboa-src/src/jsh/vt.ss @@ -20,13 +20,14 @@ vt-cell-ref vt-cell-char vt-cell-fg vt-cell-bg vt-cell-attrs ;; Processing vt-process! vt-process-bytes! + vt-clean-boundary? vt-leave-alt-screen! ;; Resize vt-resize! ;; Rendering vt-render-to-string ;; Attribute constants - ATTR-BOLD ATTR-UNDERLINE ATTR-REVERSE ATTR-DIM ATTR-ITALIC + ATTR-BOLD ATTR-UNDERLINE ATTR-REVERSE ATTR-DIM ATTR-ITALIC ATTR-WIDE-CONT ;; Default colors COLOR-DEFAULT-FG COLOR-DEFAULT-BG) @@ -38,6 +39,7 @@ (define ATTR-REVERSE 4) (define ATTR-DIM 8) (define ATTR-ITALIC 16) +(define ATTR-WIDE-CONT 32) ;; Default colors (-1 = terminal default) (define COLOR-DEFAULT-FG -1) @@ -227,6 +229,35 @@ ;; ---- Normal state ---- +(define (char-display-width ch) + (let ([n (char->integer ch)]) + (cond + [(or (= n 0) + (and (>= n #x300) (<= n #x36F)) + (and (>= n #x1AB0) (<= n #x1AFF)) + (and (>= n #x1DC0) (<= n #x1DFF)) + (and (>= n #x20D0) (<= n #x20FF)) + (and (>= n #xFE00) (<= n #xFE0F)) + (= n #x200D) + (and (>= n #x1F3FB) (<= n #x1F3FF)) + (and (>= n #xE0100) (<= n #xE01EF))) 0] + [(and (>= n #x1F1E6) (<= n #x1F1FF)) 1] + [(or (and (>= n #x1100) (<= n #x115F)) + (and (>= n #x2E80) (<= n #xA4CF)) + (and (>= n #xAC00) (<= n #xD7A3)) + (and (>= n #xF900) (<= n #xFAFF)) + (and (>= n #xFE10) (<= n #xFE6F)) + (and (>= n #xFF00) (<= n #xFF60)) + (and (>= n #xFFE0) (<= n #xFFE6)) + (and (>= n #x1F000) (<= n #x1FAFF)) + (and (>= n #x20000) (<= n #x3FFFD))) 2] + [else 1]))) + +(define (vt-clean-boundary? vt) + (and (eq? (vt-parse-state vt) 'normal) + (= (vt-utf8-state vt) 0) + (not (vt-wrap-pending? vt)))) + (define (clear-wrap-pending! vt) (vt-wrap-pending?-set! vt #f)) @@ -236,6 +267,48 @@ (vt-cursor-x-set! vt 0) (line-feed! vt))) +(define (wide-continuation? cell) + (> (bitwise-and (cell-attrs cell) ATTR-WIDE-CONT) 0)) + +(define (clear-wide-neighbors! vt row x) + (let ([cols (vt-cols vt)]) + (when (and (> x 0) (wide-continuation? (vector-ref row x))) + (vector-set! row (- x 1) (blank-cell))) + (when (and (< (+ x 1) cols) + (wide-continuation? (vector-ref row (+ x 1)))) + (vector-set! row (+ x 1) (blank-cell))))) + +(define (put-wide-continuation! vt) + (let* ([row (vector-ref (vt-grid vt) (vt-cursor-y vt))] + [x (+ (vt-cursor-x vt) 1)] + [cell (vector-ref row x)]) + (cell-char-set! cell #\space) + (cell-fg-set! cell (vt-fg vt)) + (cell-bg-set! cell (vt-bg vt)) + (cell-attrs-set! cell (bitwise-ior (vt-attrs vt) ATTR-WIDE-CONT)))) + +(define (process-printable! vt ch) + (let* ([raw-width (char-display-width ch)] + [width (if (and (= raw-width 2) (< (vt-cols vt) 2)) 1 raw-width)]) + (when (> width 0) + (wrap-if-pending! vt) + (when (and (= width 2) + (= (vt-cursor-x vt) (- (vt-cols vt) 1))) + (vt-cursor-x-set! vt 0) + (line-feed! vt)) + (put-char! vt ch) + (if (= width 2) + (begin + (put-wide-continuation! vt) + (if (= (vt-cursor-x vt) (- (vt-cols vt) 2)) + (begin + (vt-cursor-x-set! vt (- (vt-cols vt) 1)) + (vt-wrap-pending?-set! vt #t)) + (vt-cursor-x-set! vt (+ (vt-cursor-x vt) 2)))) + (if (= (vt-cursor-x vt) (- (vt-cols vt) 1)) + (vt-wrap-pending?-set! vt #t) + (vt-cursor-x-set! vt (+ (vt-cursor-x vt) 1))))))) + (define (process-normal! vt ch) (cond [(char=? ch #\x1B) @@ -266,19 +339,18 @@ [(char=? ch #\x0F) ;; SI — shift in, ignore (void)] [else - ;; Printable character - (when (and (>= (char->integer ch) 32) - (< (vt-cursor-x vt) (vt-cols vt))) - (wrap-if-pending! vt) - (put-char! vt ch) - (if (= (vt-cursor-x vt) (- (vt-cols vt) 1)) - (vt-wrap-pending?-set! vt #t) - (vt-cursor-x-set! vt (+ (vt-cursor-x vt) 1))))])) - -;; Put a character at cursor position with current attributes. + (let ([n (char->integer ch)]) + (when (and (>= n 32) + (not (= n 127)) + (not (and (>= n #x80) (<= n #x9F))) + (< (vt-cursor-x vt) (vt-cols vt))) + (process-printable! vt ch)))])) + (define (put-char! vt ch) (let* ([row (vector-ref (vt-grid vt) (vt-cursor-y vt))] - [cell (vector-ref row (vt-cursor-x vt))]) + [x (vt-cursor-x vt)] + [cell (vector-ref row x)]) + (clear-wide-neighbors! vt row x) (cell-char-set! cell ch) (cell-fg-set! cell (vt-fg vt)) (cell-bg-set! cell (vt-bg vt)) new file mode 100644 --- /dev/null +++ b/test/test-mux-vt.ss @@ -0,0 +1,40 @@ +(import (chezscheme) (jsh vt)) + +(define failures 0) + +(define (check label value) + (unless value + (set! failures (+ failures 1)) + (printf "FAIL: ~a~n" label))) + +(let ([terminal (make-vt 8 2)]) + (vt-process-bytes! terminal (string->utf8 "A鱼B")) + (check "wide cursor" (= (vt-cursor-x terminal) 4)) + (check "wide marker" + (> (bitwise-and (vt-cell-attrs terminal 0 2) ATTR-WIDE-CONT) 0)) + (check "wide alignment" (char=? (vt-cell-char terminal 0 3) #\B))) + +(let ([terminal (make-vt 8 2)]) + (check "clean start" (vt-clean-boundary? terminal)) + (vt-process! terminal #\x1B) + (check "partial escape" (not (vt-clean-boundary? terminal))) + (vt-process! terminal #\[) + (check "partial CSI" (not (vt-clean-boundary? terminal))) + (vt-process! terminal #\H) + (check "complete CSI" (vt-clean-boundary? terminal))) + +(let ([terminal (make-vt 8 2)]) + (vt-process! terminal #\delete) + (check "DEL ignored" (= (vt-cursor-x terminal) 0))) + +(let ([terminal (make-vt 12 2)]) + (vt-process-bytes! terminal (string->utf8 "👍🏻X")) + (check "emoji modifier is zero-width" (= (vt-cursor-x terminal) 3))) + +(let ([terminal (make-vt 12 2)]) + (vt-process-bytes! terminal (string->utf8 "🇺🇸X")) + (check "regional indicator pair occupies two cells" + (= (vt-cursor-x terminal) 3))) +(if (= failures 0) + (printf "PASS: mux VT regressions~n") + (exit 1)) new file mode 100644 --- /dev/null +++ b/test/test-select-features.sh @@ -0,0 +1,36 @@ +#!/usr/bin/env bash +# Regression coverage for feature selection batch reuse. + +set -euo pipefail + +ROOT="$(cd "$(dirname "$0")/.." && pwd)" +cd "$ROOT" + +fail() { + echo "FAIL: $*" >&2 + exit 1 +} + +tmp="$(mktemp -d "${TMPDIR:-/tmp}/jsh-features-test.XXXXXX")" +trap 'rm -rf "$tmp"' EXIT + +conf="$tmp/features.conf" +missing="$tmp/missing.conf" + +tools/select-features.sh --write "$conf" --none >/dev/null + +if ! tools/select-features.sh --write "$conf" </dev/null >"$tmp/reuse.out" 2>"$tmp/reuse.err"; then + cat "$tmp/reuse.out" >&2 + cat "$tmp/reuse.err" >&2 + fail "noninteractive selector did not reuse existing features.conf" +fi +grep -Fqx "(features)" "$conf" || fail "existing feature selection was not preserved" +grep -Fq "Wrote $conf (0/" "$tmp/reuse.out" || fail "reuse did not report the selected feature count" + +if tools/select-features.sh --write "$missing" </dev/null >"$tmp/missing.out" 2>"$tmp/missing.err"; then + fail "noninteractive selector succeeded without an existing features.conf" +fi +grep -Fq "interactive feature selection needs a TTY" "$tmp/missing.err" || \ + fail "missing config failure did not explain the TTY requirement" + +echo "PASS: select-features batch reuse"