Keep TUI capture off the event loop
ober
400061809a28bcfd1d25811b952ad9df26a5cb9e
--- a/signal/tui/main.ss +++ b/signal/tui/main.ss @@ -48,7 +48,30 @@ (defstruct tui-state (account version receive-mode width height input status quit? event-count conversations selected-index mode picker-query picker-index removed aliases - logdb live-capture? resend challenge rate-limits send-events)) + logdb live-capture? resend challenge rate-limits send-events + capture-events capture-stop-box capture-worker)) + + ;; Open the encrypted message log. Passphrase comes from JERBOA_SIGNAL_DB_KEY + ;; if set (enables headless use), otherwise we prompt. A blank passphrase or a + ;; missing shim disables logging and the TUI runs normally. + (def (open-tui-message-log acct) + (ensure-tui-log-persist-default!) + (and (logdb-available?) + (let* ([env (getenv "JERBOA_SIGNAL_DB_KEY")] + [key (if (and env (not (string=? env ""))) + env + (logdb-prompt-passphrase + "jerboa-signal: passphrase for encrypted message log (blank to skip): "))]) + (and key + (not (string=? key "")) + (begin + (ensure-store-dir!) + (logdb-open (messages-store-path acct) key)))))) + + (def (ensure-tui-log-persist-default!) + (let ([v (getenv "JERBOA_SIGNAL_LOG_PERSIST")]) + (unless (and (string? v) (not (string=? v ""))) + (putenv "JERBOA_SIGNAL_LOG_PERSIST" "batch")))) (def (run-tui-terminal account actor version receive-mode) ;; Prompt for the log passphrase and open the DB BEFORE termbox grabs the @@ -94,8 +117,12 @@ (tb-hide-cursor!) (draw! state) (tb-present!) + (start-capture-worker! state) (start-startup-worker! state actor) - (event-loop state actor))))) + (dynamic-wind + (lambda () (void)) + (lambda () (event-loop state actor)) + (lambda () (stop-capture-worker! state))))))) (def (configure-tui-output!) (let ([mode (preferred-tui-output-mode)]) @@ -175,29 +202,10 @@ #f #f (make-hashtable equal-hash equal?) - (make-channel/buf 64))) - - ;; Open the encrypted message log. Passphrase comes from JERBOA_SIGNAL_DB_KEY - ;; if set (enables headless use), otherwise we prompt. A blank passphrase or a - ;; missing shim disables logging and the TUI runs normally. - (def (open-tui-message-log acct) - (ensure-tui-log-persist-default!) - (and (logdb-available?) - (let* ([env (getenv "JERBOA_SIGNAL_DB_KEY")] - [key (if (and env (not (string=? env ""))) - env - (logdb-prompt-passphrase - "jerboa-signal: passphrase for encrypted message log (blank to skip): "))]) - (and key - (not (string=? key "")) - (begin - (ensure-store-dir!) - (logdb-open (messages-store-path acct) key)))))) - - (def (ensure-tui-log-persist-default!) - (let ([v (getenv "JERBOA_SIGNAL_LOG_PERSIST")]) - (unless (and (string? v) (not (string=? v ""))) - (putenv "JERBOA_SIGNAL_LOG_PERSIST" "batch")))) + (make-channel/buf 64) + (make-channel/buf 256) + (box #f) + #f)) ;; Pull recent rows out of the encrypted log so search and scrollback cover ;; previous sessions, not just this one. Runs after contact/group seeding so @@ -423,9 +431,7 @@ (when (and (tui-state-live-capture? state) (tui-state-logdb state) (loggable-chat-event? chat-event)) - (capture-notification! (tui-state-logdb state) - (tui-state-account state) - notif)) + (enqueue-capture-event! state (list 'notification notif))) (if chat-event (apply-chat-event! state chat-event) (let ([line (notification->line notif)]) @@ -514,6 +520,66 @@ (def (start-tui-worker! thunk) (fork-thread thunk)) + (def (start-capture-worker! state) + (when (and (tui-state-live-capture? state) + (tui-state-logdb state) + (not (tui-state-capture-worker state))) + (let* ([events (tui-state-capture-events state)] + [stop-box (tui-state-capture-stop-box state)] + [account (tui-state-account state)] + [logdb (tui-state-logdb state)] + [worker + (start-tui-worker! + (lambda () + (capture-worker-loop account logdb events stop-box)))]) + (tui-state-capture-worker-set! state worker)))) + + (def (stop-capture-worker! state) + (set-box! (tui-state-capture-stop-box state) #t)) + + (def (enqueue-capture-event! state ev) + (if (and (tui-state-live-capture? state) + (tui-state-logdb state) + (tui-state-capture-worker state) + (chan-try-put! (tui-state-capture-events state) ev)) + (trace-public-event! + "tui-capture-queued" + (list (cons 'kind (if (pair? ev) (car ev) 'unknown)))) + (trace-public-event! + "tui-capture-dropped" + (list (cons 'kind (if (pair? ev) (car ev) 'unknown)))))) + + (def (capture-worker-loop account logdb events stop-box) + (let loop () + (unless (unbox stop-box) + (let ([ev (chan-try-get events)]) + (if ev + (begin + (handle-capture-worker-event! account logdb ev) + (loop)) + (begin + (sleep-ms 50) + (loop))))))) + + (def (handle-capture-worker-event! account logdb ev) + (guard (e [(condition? e) + (trace-event! "tui-capture-worker-failed-detail" + (safe-display e)) + (trace-public-event! + "tui-capture-worker-failed" + (list (cons 'kind (if (pair? ev) (car ev) 'unknown)) + (cons 'error-chars + (string-length (safe-display e)))))]) + (cond + [(and (pair? ev) (eq? (car ev) 'notification)) + (capture-notification! logdb account (cadr ev))] + [(and (pair? ev) (eq? (car ev) 'outbound)) + (capture-outbound! logdb account + (list-ref ev 1) + (list-ref ev 2) + (list-ref ev 3))] + [else (void)]))) + (def (actor-call-result actor method) (guard (e [(condition? e) (cons 'failed e)]) (cons 'ok (actor-call actor method #f)))) @@ -664,13 +730,9 @@ (conversation-unread-set! conv 0)) (when (and (tui-state-live-capture? state) (tui-state-logdb state)) - (let ([capture-start (real-time)]) - (capture-outbound! (tui-state-logdb state) - (tui-state-account state) - conv-id display-text ts) - (trace-public-event! - "tui-send-capture-done" - (list (cons 'ms (- (real-time) capture-start)))))) + (enqueue-capture-event! + state + (list 'outbound conv-id display-text ts))) (when (eq? kind 'message) (tui-state-resend-set! state #f)) (trace-public-event!