diff --git a/autolith.asd b/autolith.asd index 29399a72..fa96eb7c 100644 --- a/autolith.asd +++ b/autolith.asd @@ -361,6 +361,7 @@ (:file "acp/session") (:file "acp/observer") (:file "acp/mcp") + (:file "acp/remote") (:file "acp/runtime") (:file "acp/extensions") (:file "acp/input") @@ -561,6 +562,7 @@ (:file "acp-input-tests") (:file "acp-mcp-tests") (:file "acp-launcher-tests") + (:file "acp-remote-tests") (:file "tests") (:file "test-runner") (:file "fixture-tests") diff --git a/bin/autolith b/bin/autolith index 8e885c3a..0f0eb6f4 100755 --- a/bin/autolith +++ b/bin/autolith @@ -340,8 +340,10 @@ restore_terminal # A detached session relays its exit to the attached terminal, whose own # launcher updates, rolls back, or recovers; recovering here as well would race -# it for the conversation without a terminal to show. -if [[ "$data_requested" == true || "$localgroup_handoff_requested" == true ]]; then +# it for the conversation without a terminal to show. ACP owns standard I/O +# for its client, so its failures end the process instead of opening recovery. +if [[ "$data_requested" == true || "$acp_requested" == true || + "$localgroup_handoff_requested" == true ]]; then exit "$status" fi diff --git a/bin/autolith-active b/bin/autolith-active index 040825fe..c1a5e7dd 100755 --- a/bin/autolith-active +++ b/bin/autolith-active @@ -38,11 +38,15 @@ (asdf:load-system :autolith) (setf main (list (symbol-function (find-symbol "MAIN" "AUTOLITH")) (uiop:command-line-arguments)))))) - (if acp-p - (let ((*standard-output* *error-output*) - (*trace-output* *error-output*)) - (load-autolith) - (apply (first main) (rest main))) - (progn - (load-autolith) - (apply (first main) (rest main)))))) + ;; Ctrl-C while the system loads ends the launch like an interrupted command. + (handler-case + (if acp-p + (let ((*standard-output* *error-output*) + (*trace-output* *error-output*)) + (load-autolith) + (apply (first main) (rest main))) + (progn + (load-autolith) + (apply (first main) (rest main)))) + (sb-sys:interactive-interrupt () + (uiop:quit 130))))) diff --git a/docs/guide.org b/docs/guide.org index 2a8339ec..b964c5c8 100644 --- a/docs/guide.org +++ b/docs/guide.org @@ -293,6 +293,35 @@ redacted from server output. Cancel a prompt to stop its provider, tools, and owned jobs; close the session or disconnect to release its resources and lease. One primary prompt, setting mutation, tool invocation, or session setup runs at a time in each ACP process. Catalog reads and owned-job controls can run alongside it. +Ctrl-C ends an ACP process with status 130 after it releases its sessions. + +** Remote clients + +=autolith acp --http= serves remote clients on one endpoint, =/acp=, over the +transports of the ACP proposal "Streamable HTTP & WebSocket Transport": +Streamable HTTP over HTTP/1.1 or cleartext HTTP/2, and WebSocket. +=autolith acp --websocket= serves WebSocket alone. Both listen on +=127.0.0.1:8737= by default. Name another port, or a host and a port, to change +that: + +#+BEGIN_SRC sh +autolith acp --websocket 9000 +autolith acp --http 0.0.0.0:8737 --token "$ACP_TOKEN" +autolith acp --http [::1]:8737 +#+END_SRC + +Autolith prints the endpoint URL on stderr and serves until Ctrl-C. Each client +gets its own sessions. All clients share the process's one primary operation, so +while one client's prompt runs, another client's prompt is refused as busy. + +With =--token=, a client must send =Authorization: Bearer TOKEN= or add +=?token=TOKEN= to the URL. Other users of the machine can read the command line, +the token included. Requests from web pages, which carry an =Origin= header, are +refused. + +Any host but loopback makes the agent reachable from other machines, and +Autolith warns that the endpoint is not secure. The traffic, the token included, +is unencrypted: put a reverse proxy with TLS in front of it, and use a token. ** Typed client extensions diff --git a/nix/package.nix b/nix/package.nix index 35e797f5..be801e8c 100644 --- a/nix/package.nix +++ b/nix/package.nix @@ -51,7 +51,7 @@ let "cl-llm-provider-api" "cl-lsp" "cl-resources" "cl-rfc8252" "cl-rfc8628" "cl-skills" "cl-termdown" "cl-worktree" "clasted" "clermaid" "clifff" "clinedi" "clinker-transcript" "colordiff" "colorlisp" "daphne" "defingerprinter" "fetch-gist" - "idsmall" "image-daemon" "lambda-debugger" "ls-compat" "ls-flock" "mcparen" + "idsmall" "image-daemon" "lambda-debugger" "llh2" "ls-compat" "ls-flock" "mcparen" "org-templater" "parenchek" "sbcl-generations" "sbcl-workers" "setinka" "sexp-config" "sexp-store" "sophisticated-clipboard" "structlisp" "surgeon" "yolokuva" ]; @@ -114,12 +114,28 @@ let pname = "agentcomms"; version = qlotVersion "agentcomms"; src = qlotSource "agentcomms"; - lispLibs = [ argo ] ++ (with lispPackages; [ + lispLibs = [ argo llh2 lsCompat ] ++ (with lispPackages; [ + babel bordeaux-threads + cl-base64 + ironclad serapeum + usocket ]); }; + llh2 = pkgs.sbcl.buildASDFSystem { + pname = "llh2"; + version = qlotVersion "llh2"; + src = qlotSource "llh2"; + systems = [ "llh2" ]; + lispLibs = with lispPackages; [ + bordeaux-threads + cl-base64 + serapeum + ]; + }; + clColorist = pkgs.sbcl.buildASDFSystem { pname = "cl-colorist"; version = qlotVersion "cl-colorist"; @@ -248,10 +264,11 @@ let pname = "ls-compat"; version = qlotVersion "ls-compat"; src = qlotSource "ls-compat"; - systems = [ "ls-compat" "ls-compat/posix" "ls-compat/files" ]; + systems = [ "ls-compat" "ls-compat/posix" "ls-compat/files" "ls-compat/tcp" ]; lispLibs = with lispPackages; [ babel serapeum + usocket ]; }; diff --git a/qlfile b/qlfile index 6fcc22ce..032e4956 100644 --- a/qlfile +++ b/qlfile @@ -14,7 +14,7 @@ ql trivial-gray-streams 2026-01-01 ql winhttp 2026-01-01 ql yason 2026-01-01 -git agentcomms https://github.com/lambda-symbolics/agentcomms.git :ref 18676b8de2b773e521f3af4473e2877878ae3f22 +git agentcomms https://github.com/lambda-symbolics/agentcomms.git :ref 0bf29a654d166173420f2af82b92daaa31e2d1a3 git fetch-gist https://github.com/lambda-symbolics/fetch-gist.git :ref 082f4d45d4cf0076c0c891f00e05d71957de6009 git cl-colorist https://github.com/lambda-symbolics/cl-colorist.git :ref 90f17af4fa3d2c0433030e15fffc0328f3863e29 git cl+ssl https://github.com/cl-plus-ssl/cl-plus-ssl.git :ref d7a92f9ed0cbae10f07b1b9a9c3c5cc179798748 @@ -51,6 +51,7 @@ git sophisticated-clipboard https://github.com/lambda-symbolics/sophisticated-cl git sbcl-workers https://github.com/lambda-symbolics/sbcl-workers.git :ref cded09d0c0d2a3c889f6fbb3414342b957978d74 git surgeon https://github.com/lambda-symbolics/surgeon.git :ref b159c64231f35d2b20aedd41544f8621d16a0c29 git structlisp https://github.com/lambda-symbolics/structlisp.git :ref 987829546bd07030e25ed1b2e4d3246d11b532db +git llh2 https://github.com/lambda-symbolics/llh2.git :ref f516c92cff438d65fb42d31f4c552b39001e2edc git argo https://github.com/lambda-symbolics/argo.git :ref c8034c208f43436b19af2858bfb6112ac7e66e1f git setinka https://github.com/lambda-symbolics/setinka.git :ref ce63dce34287b20ad81f08f6d208e6e18bc3163f git lambda-debugger https://github.com/lambda-symbolics/lambda-debugger.git :ref 8299ae17be78a489321de5e035f1f6cc8ede88bc diff --git a/qlfile.lock b/qlfile.lock index c60effd4..336fe077 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -64,8 +64,8 @@ :version "ql-2025-06-22")) ("agentcomms" . (:class qlot/source/git:source-git - :initargs (:remote-url "https://github.com/lambda-symbolics/agentcomms.git" :ref "18676b8de2b773e521f3af4473e2877878ae3f22") - :version "git-18676b8de2b773e521f3af4473e2877878ae3f22")) + :initargs (:remote-url "https://github.com/lambda-symbolics/agentcomms.git" :ref "0bf29a654d166173420f2af82b92daaa31e2d1a3") + :version "git-0bf29a654d166173420f2af82b92daaa31e2d1a3")) ("fetch-gist" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lambda-symbolics/fetch-gist.git" :ref "082f4d45d4cf0076c0c891f00e05d71957de6009") @@ -210,6 +210,10 @@ (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lambda-symbolics/structlisp.git" :ref "987829546bd07030e25ed1b2e4d3246d11b532db") :version "git-987829546bd07030e25ed1b2e4d3246d11b532db")) +("llh2" . + (:class qlot/source/git:source-git + :initargs (:remote-url "https://github.com/lambda-symbolics/llh2.git" :ref "f516c92cff438d65fb42d31f4c552b39001e2edc") + :version "git-f516c92cff438d65fb42d31f4c552b39001e2edc")) ("argo" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lambda-symbolics/argo.git" :ref "c8034c208f43436b19af2858bfb6112ac7e66e1f") diff --git a/recovery/launcher.lisp b/recovery/launcher.lisp index 76786b76..327a3297 100644 --- a/recovery/launcher.lisp +++ b/recovery/launcher.lisp @@ -19,7 +19,7 @@ (unless (probe-file quicklisp-setup) (error "Recovery bootstrap needs Quicklisp at ~A." quicklisp-setup)) (load quicklisp-setup) - (uiop:symbol-call '#:ql '#:quickload :serapeum :silent t) + (uiop:symbol-call '#:ql '#:quickload '(:serapeum :sbcl-generations) :silent t) (let ((package (or (find-package "AUTOLITH") (make-package "AUTOLITH" :use '("CL"))))) (export (mapcar (lambda (name) (intern name package)) diff --git a/recovery/runtime.lisp b/recovery/runtime.lisp index e6e2268b..4cc2e475 100644 --- a/recovery/runtime.lisp +++ b/recovery/runtime.lisp @@ -1495,6 +1495,9 @@ Colocation lets older committed source use its original Git provenance code." (restart-case (handler-case (uiop:quit (recovery-run (uiop:command-line-arguments))) + ;; Ctrl-C stops recovery after its cleanup unwinds, without a backtrace. + (sb-sys:interactive-interrupt () + (uiop:quit 130)) (error (condition) (format *error-output* "Recovery could not continue: ~A~%" (recovery-sanitize-text condition)) diff --git a/script/launcher-cli.sh b/script/launcher-cli.sh index 4813fbc9..5c322645 100644 --- a/script/launcher-cli.sh +++ b/script/launcher-cli.sh @@ -69,7 +69,7 @@ autolith_launcher_parse() remaining_arguments+=("$argument") ;; --permissions|--image|-i|--site-config-root|--model|--provider|--id|--input|--output|\ - --events|--generation|--status|--capsule|--original-argument|--workspace) + --events|--generation|--status|--capsule|--original-argument|--workspace|--token) # Forward a value verbatim, even when it resembles a launcher flag. # These are arities only, not a second application option parser. take_value=true diff --git a/script/launcher.lisp b/script/launcher.lisp index faf5964c..6340a522 100644 --- a/script/launcher.lisp +++ b/script/launcher.lisp @@ -55,7 +55,7 @@ (defparameter *launcher-value-options* '("--permissions" "--image" "-i" "--localgroup-handoff" "--id" "--input" "--output" "--events" "--generation" "--status" "--capsule" "--original-argument" - "--workspace") + "--workspace" "--token") "Options whose next argument is forwarded verbatim, as script/launcher-cli.sh does.") (defparameter *launcher-terminal-statuses* '(64 76 130 143) diff --git a/src/acp/remote.lisp b/src/acp/remote.lisp new file mode 100644 index 00000000..838ba82a --- /dev/null +++ b/src/acp/remote.lisp @@ -0,0 +1,125 @@ +(in-package #:autolith) + +;;;; -- Remote ACP Endpoints -- + +(defparameter *acp-remote-default-host* "127.0.0.1" + "The address remote ACP listens on when the endpoint names no host.") + +(defclass acp-endpoint () + ((transport + :initarg :transport + :reader acp-endpoint-transport + :type (member :http :websocket) + :documentation "Streamable HTTP with WebSocket on the same endpoint, or WebSocket alone.") + (host + :initarg :host + :reader acp-endpoint-host + :type string + :documentation "The address to listen on.") + (port + :initarg :port + :reader acp-endpoint-port + :type (integer 0 65535) + :documentation "The port to listen on; 0 lets the system choose.") + (token + :initarg :token + :initform nil + :reader acp-endpoint-token + :type (or null string) + :documentation "The bearer token clients must present, or NIL for none.")) + (:documentation "Where and how a remote ACP server listens.")) + +(-> acp-endpoint-parse (keyword (or null string) &key (:token (or null string))) acp-endpoint) +(defun acp-endpoint-parse (transport text &key token) + "Return the TRANSPORT endpoint TEXT names as [HOST:]PORT. + +Without TEXT, or without a host, the endpoint is loopback only. An IPv6 +address goes in brackets, as in [::1]:8737." + (flet ((fail (control &rest arguments) + (error 'configuration-error :message (apply #'format nil control arguments)))) + (multiple-value-bind (host port-text) + (cond + ((null text) + (values *acp-remote-default-host* nil)) + ((and (plusp (length text)) (char= (char text 0) #\[)) + (let ((close (position #\] text))) + (unless (and close + (< (1+ close) (length text)) + (char= (char text (1+ close)) #\:)) + (fail "Write an IPv6 endpoint as [ADDRESS]:PORT, not ~A." text)) + (values (subseq text 1 close) (subseq text (+ close 2))))) + ((> (count #\: text) 1) + (fail "Put the IPv6 address in ~A in brackets, as in [::1]:8737." text)) + ((find #\: text) + (let ((colon (position #\: text))) + (values (subseq text 0 colon) (subseq text (1+ colon))))) + (t + (values *acp-remote-default-host* text))) + (when (zerop (length host)) + (fail "The endpoint ~A names no host before its colon." text)) + (let ((port (cond + ((null port-text) + agentcomms:*acp-remote-default-port*) + ((and (plusp (length port-text)) + (<= (length port-text) 5) + (every #'digit-char-p port-text) + (<= (parse-integer port-text) 65535)) + (parse-integer port-text)) + (t + (fail "The endpoint ~A has no port from 0 to 65535." text))))) + (when (and token (zerop (length token))) + (fail "The token is empty.")) + (make-instance 'acp-endpoint :transport transport + :host host + :port port + :token token))))) + +(-> acp-endpoint-loopback-p (acp-endpoint) boolean) +(defun acp-endpoint-loopback-p (endpoint) + "Return whether ENDPOINT listens only on this machine's loopback interface." + (let ((host (string-downcase (acp-endpoint-host endpoint)))) + (and (or (string= host "localhost") + (string= host "::1") + (eql 0 (search "127." host))) + t))) + +(-> acp-endpoint-warning (acp-endpoint string) (or null string)) +(defun acp-endpoint-warning (endpoint url) + "Return the warning for serving ENDPOINT at URL beyond loopback, or NIL on loopback." + (unless (acp-endpoint-loopback-p endpoint) + (if (acp-endpoint-token endpoint) + (format nil "Warning: ~A is not secure. The token and all traffic cross the network ~ + unencrypted. Put a TLS proxy in front of it." + url) + (format nil "Warning: ~A is not secure. Anyone who can reach it controls an agent that ~ + runs commands as you, and the traffic is unencrypted. Pass --token and put a ~ + TLS proxy in front of it." + url)))) + +(-> acp-serve-remote (acp-endpoint function) null) +(defun acp-serve-remote (endpoint serve-function) + "Serve remote clients at ENDPOINT, calling SERVE-FUNCTION with each client's channel, until interrupted. + +Stopping waits until every client released its sessions." + (let* ((http-p (eq (acp-endpoint-transport endpoint) ':http)) + (server (handler-case + (agentcomms:acp-remote-server-start + serve-function + :host (acp-endpoint-host endpoint) + :port (acp-endpoint-port endpoint) + :token (acp-endpoint-token endpoint) + :transports (if http-p '(:http :websocket) '(:websocket)) + :log-function #'agentcomms:acp-standard-error-log) + (agentcomms:acp-error (condition) + (error 'configuration-error :message (agentcomms:acp-error-message condition)))))) + (unwind-protect + (let ((url (agentcomms:acp-remote-server-url server :scheme (if http-p "http" "ws")))) + (format *error-output* "Autolith ACP is listening at ~A~:[~; and ~A~]~%" + url http-p (agentcomms:acp-remote-server-url server :scheme "ws")) + (let ((warning (acp-endpoint-warning endpoint url))) + (when warning + (format *error-output* "~A~%" warning))) + (finish-output *error-output*) + (loop (sleep 3600))) + (agentcomms:acp-remote-server-stop server))) + nil) diff --git a/src/acp/runtime.lisp b/src/acp/runtime.lisp index 8ad919b6..f16dc16c 100644 --- a/src/acp/runtime.lisp +++ b/src/acp/runtime.lisp @@ -409,7 +409,6 @@ (remhash (acp-session-identifier session) (acp-service-sessions service)))) (serious-condition () (setf failed-p t)))) - (telemetry--call-safely #'telemetry-shutdown) (when failed-p (error 'agentcomms:acp-state-error :message "ACP session cleanup failed."))) nil) @@ -424,10 +423,17 @@ (agentcomms:channel-close channel))) nil) -(-> acp-run (configuration &key (:permission-mode keyword) (:pristine-p boolean)) null) -(defun acp-run (configuration &key (permission-mode ':ask) pristine-p) - "Bootstrap a headless ACP endpoint and serve UTF-8 standard I/O until disconnect." - (let* ((channel (agentcomms:acp-standard-io-channel)) +(-> acp-run (configuration &key (:permission-mode keyword) (:pristine-p boolean) + (:endpoint (or null acp-endpoint))) + null) +(defun acp-run (configuration &key (permission-mode ':ask) pristine-p endpoint) + "Bootstrap a headless ACP process and serve its clients until they leave or Ctrl-C. + +Without ENDPOINT, the one client is the editor on UTF-8 standard I/O. With +ENDPOINT, remote clients connect over the network. Every client gets its own +service, and all of them share the process's one primary operation." + (let* ((channel (and (null endpoint) (agentcomms:acp-standard-io-channel))) + (gate (make-instance 'acp-operation-gate)) (*standard-output* *error-output*) (*trace-output* *error-output*) (*standard-input* (make-string-input-stream "")) @@ -435,7 +441,6 @@ (*query-io* *terminal-io*) (*debug-io* *terminal-io*)) (unwind-protect - ;; Client declarations can contain credentials for the service lifetime. (call-with-secret-use (lambda () (configuration-ensure-directories configuration) @@ -445,9 +450,19 @@ (image-state-load configuration :pristine-p pristine-p) (application--load-extension-configuration configuration :pristine-p pristine-p) (setf configuration (provider-bootstrap-configuration configuration)) - (with-slynk-endpoint (configuration) - (acp-service-serve (make-instance 'acp-service :configuration configuration - :permission-mode permission-mode) - channel)))) - (agentcomms:channel-close channel))) + (flet ((serve (client-channel) + ;; Client declarations can contain credentials for the client's lifetime. + (call-with-secret-use + (lambda () + (acp-service-serve (make-instance 'acp-service :configuration configuration + :permission-mode permission-mode + :gate gate) + client-channel))))) + (with-slynk-endpoint (configuration) + (if endpoint + (acp-serve-remote endpoint #'serve) + (serve channel)))))) + (when channel + (agentcomms:channel-close channel)) + (telemetry--call-safely #'telemetry-shutdown))) nil) diff --git a/src/acp/session.lisp b/src/acp/session.lisp index c403e6e7..da8e1279 100644 --- a/src/acp/session.lisp +++ b/src/acp/session.lisp @@ -8,6 +8,17 @@ (defparameter *acp-session-close-seconds* 10 "Maximum cooperative shutdown wait before reporting an active session.") +(defclass acp-operation-gate () + ((owner + :initform nil + :accessor acp-operation-gate-owner + :documentation "The session or setup operation owning the primary runtime, or NIL.") + (lock + :initform (make-lock "Autolith ACP operation gate") + :reader acp-operation-gate-lock + :documentation "The lock protecting the owner; taken after a service lock, never before.")) + (:documentation "The one primary operation of an ACP process, shared by every client it serves.")) + (defclass acp-service (agentcomms:acp-agent) ((configuration :initarg :configuration :accessor acp-service-configuration :type configuration @@ -22,9 +33,9 @@ (lock :initform (make-lock "Autolith ACP service") :reader acp-service-lock :documentation "The lock protecting session admission and process ownership.") - (busy-owner - :initform nil :accessor acp-service-busy-owner - :documentation "The session or setup operation owning the primary runtime.") + (gate + :initarg :gate :initform (make-instance 'acp-operation-gate) :reader acp-service-gate + :documentation "The primary operation gate this service shares with the process's other clients.") (closed-p :initform nil :accessor acp-service-closed-p :type boolean :documentation "Whether disconnect has stopped further session admission.")) @@ -107,6 +118,13 @@ (or (gethash identifier (acp-service-sessions service)) (agentcomms:acp-invalid-params "Unknown session ~A." identifier)))) +(-> acp-service-busy-owner (acp-service) t) +(defun acp-service-busy-owner (service) + "Return the operation owning the primary runtime of SERVICE's process, or NIL." + (let ((gate (acp-service-gate service))) + (with-lock-held ((acp-operation-gate-lock gate)) + (acp-operation-gate-owner gate)))) + (define-condition acp-operation-busy (agentcomms:acp-method-error) () (:default-initargs :code -32603 :message "Another primary operation is active.") @@ -114,21 +132,23 @@ (-> acp-service--call-with-operation (acp-service t function) t) (defun acp-service--call-with-operation (service owner function) - "Run FUNCTION as the sole primary operation, rejecting overlapping work." - (let ((claimed-p nil)) + "Run FUNCTION as the sole primary operation of the process, rejecting overlapping work." + (let ((gate (acp-service-gate service)) + (claimed-p nil)) (unwind-protect (progn (with-lock-held ((acp-service-lock service)) (when (acp-service-closed-p service) (error 'agentcomms:acp-connection-closed)) - (when (acp-service-busy-owner service) - (error 'acp-operation-busy)) - (setf (acp-service-busy-owner service) owner - claimed-p t)) + (with-lock-held ((acp-operation-gate-lock gate)) + (when (acp-operation-gate-owner gate) + (error 'acp-operation-busy)) + (setf (acp-operation-gate-owner gate) owner + claimed-p t))) (funcall function)) (when claimed-p - (with-lock-held ((acp-service-lock service)) - (setf (acp-service-busy-owner service) nil)))))) + (with-lock-held ((acp-operation-gate-lock gate)) + (setf (acp-operation-gate-owner gate) nil)))))) (defvar *acp-extension-invocation-p* nil "Whether an explicit extension invocation owns this thread's cancellation boundary.") diff --git a/src/startup/main.lisp b/src/startup/main.lisp index e55fca62..9aab742c 100644 --- a/src/startup/main.lisp +++ b/src/startup/main.lisp @@ -1343,18 +1343,60 @@ Lisp starts; on Windows it prints the folders to delete." (cons "update" (when tail '("--help")))) arguments)) +(-> main--acp-endpoint (clingon:command) (or null acp-endpoint)) +(defun main--acp-endpoint (command) + "Return the remote endpoint the acp COMMAND selects, or NIL for standard I/O." + (let ((http-p (getopt* command ':http)) + (websocket-p (getopt* command ':websocket)) + (token (getopt* command ':token)) + (arguments (command-arguments command))) + (cond + ((and http-p websocket-p) + (error 'configuration-error :message "Choose --http or --websocket, not both.")) + ((or http-p websocket-p) + (when (rest arguments) + (error 'configuration-error :message "ACP takes at most one [HOST:]PORT.")) + (acp-endpoint-parse (if http-p ':http ':websocket) (first arguments) :token token)) + (arguments + (error 'configuration-error :message "A [HOST:]PORT needs --http or --websocket.")) + (token + (error 'configuration-error :message "--token needs --http or --websocket.")) + (t + nil)))) + (-> main--acp-command () clingon:command) (defun main--acp-command () "Return the Agent Client Protocol server sub-command definition." (make-command :name "acp" - :description "serve the Agent Client Protocol on standard input and output" + :description "serve the Agent Client Protocol on standard I/O, HTTP, or WebSocket" + :usage "[--http | --websocket [HOST:]PORT [--token TOKEN]]" + :long-description + "Without options, ACP runs on standard input and output for the editor that +started it. --http serves remote clients over Streamable HTTP and WebSocket on +one endpoint, /acp; --websocket serves WebSocket alone. Both listen on +127.0.0.1:8737 unless HOST:PORT or PORT says otherwise. With --token, clients +must send the token as an Authorization: Bearer header or a token query +parameter. Anything but loopback is reachable from other machines and is not +secure: traffic is unencrypted, so put a TLS proxy in front." + :options + (list (make-option ':flag + :long-name "http" + :key ':http + :description "serve Streamable HTTP and WebSocket clients") + (make-option ':flag + :long-name "websocket" + :key ':websocket + :description "serve WebSocket clients") + (make-option ':string + :long-name "token" + :key ':token + :parameter "TOKEN" + :description "the bearer token remote clients must present")) :handler (lambda (command) - (when (command-arguments command) - (error 'configuration-error - :message "ACP accepts no positional arguments.")) - (let* ((pristine-p (not (null (getopt* command ':pristine)))) + (let* ((endpoint (main--acp-endpoint command)) + (pristine-p (not (null (getopt* command ':pristine)))) (configuration (configuration-create :immutable-p pristine-p @@ -1362,7 +1404,8 @@ Lisp starts; on Windows it prints the folders to delete." (permission-mode (or (getopt* command ':permissions) ':ask))) (acp-run configuration :permission-mode permission-mode - :pristine-p pristine-p))))) + :pristine-p pristine-p + :endpoint endpoint))))) (-> main--top-level-command () clingon:command) (defun main--top-level-command () @@ -1433,5 +1476,9 @@ autolith uninstall removes the installation and keeps user data." (main-dispatch arguments) ((or autolith-error cl-llm-provider-api:provider-api-error) (condition) (format *error-output* "Autolith could not start: ~A~%" condition) - (uiop:quit 64))) + (uiop:quit 64)) + ;; Ctrl-C outside the raw-mode terminal interface ends the command, after + ;; unwinding its cleanup, with the shell's interrupt status. + (sb-sys:interactive-interrupt () + (uiop:quit 130))) nil) diff --git a/tests/acp-launcher-tests.lisp b/tests/acp-launcher-tests.lisp index 275442a5..ad4405eb 100644 --- a/tests/acp-launcher-tests.lisp +++ b/tests/acp-launcher-tests.lisp @@ -173,6 +173,75 @@ (test-assert (plusp (length diagnostics)) "startup diagnostics are on stderr"))))) nil) +(-> test-acp-launcher-failure-skips-recovery () null) +(defun test-acp-launcher-failure-skips-recovery () + "The stable shell launcher keeps a failed ACP status and starts no recovery." + (with-test-fixture (':posix-shell "the stable launcher's ACP status") + (with-test-configuration (configuration root) + (declare (ignore configuration)) + (let ((fake-sbcl (merge-pathnames "bin/fake-sbcl" root)) + (log (merge-pathnames "calls.log" root))) + (recovery-tests--write-executable + fake-sbcl + "#!/bin/sh +printf 'call\\n' >> \"$AUTOLITH_TEST_LOG\" +exit 1 +") + (multiple-value-bind (output diagnostics status) + (uiop:run-program + (list "env" + (format nil "AUTOLITH_SBCL=~A" (namestring fake-sbcl)) + (format nil "AUTOLITH_TEST_LOG=~A" (namestring log)) + (format nil "XDG_DATA_HOME=~A" (namestring (merge-pathnames "data/" root))) + (format nil "XDG_STATE_HOME=~A" (namestring (merge-pathnames "state/" root))) + (namestring (asdf:system-relative-pathname :autolith "bin/autolith")) + "--from-source" "acp") + :directory root + :input nil + :output ':string + :error-output ':string + :ignore-error-status t) + (test-assert (= status 1) "the launcher keeps the ACP status") + (test-assert (zerop (length output)) "the launcher writes nothing to ACP's stdout") + (test-assert (not (search "RECOVERY" diagnostics)) "no recovery banner follows")) + (test-assert (equal (uiop:read-file-lines log) '("call")) + "the launcher runs SBCL once, for ACP only")))) + nil) + +(-> test-acp-launcher-interrupt-exits-quietly () null) +(defun test-acp-launcher-interrupt-exits-quietly () + "Ctrl-C ends a serving ACP launcher with status 130 and no failure report." + (with-test-fixture (':posix-shell "process-group interrupts") + (with-test-configuration (configuration root) + (declare (ignore configuration)) + (acp-launcher-tests--call-with-roots + root + (lambda () + (with-test-environment (("AUTOLITH_ACTIVE_CORE" (uiop:getenv "AUTOLITH_TEST_ACTIVE_CORE"))) + (let* ((channel (agentcomms:acp-launch-agent + (namestring (asdf:system-relative-pathname :autolith "bin/autolith")) + :arguments '("acp") + :directory root)) + (process (agentcomms:acp-process-channel-process channel)) + (client (make-instance 'agentcomms:acp-client))) + (unwind-protect + (progn + (agentcomms:acp-client-connect client channel) + (agentcomms:client-initialize client :timeout 180) + ;; The launcher leads its own process group, as a shell job does. + (uiop:run-program (list "kill" "-INT" "--" + (format nil "-~D" (uiop:process-info-pid process)))) + (uiop:wait-process process)) + (agentcomms:channel-close channel)) + (let ((diagnostics (agentcomms:acp-process-channel-stderr-text channel))) + (test-assert (eql 130 (agentcomms:acp-process-channel-exit-code channel)) + "the interrupted launcher exits with status 130") + (test-assert (not (search "failed" diagnostics)) + "the interrupt reports no failure") + (test-assert (not (search "RECOVERY" diagnostics)) + "the interrupt starts no recovery")))))))) + nil) + (-> test-acp-launcher-failure-diagnostics () null) (defun test-acp-launcher-failure-diagnostics () "Retain the original transport failure, child status, and drained stderr." diff --git a/tests/acp-remote-tests.lisp b/tests/acp-remote-tests.lisp new file mode 100644 index 00000000..61e714c8 --- /dev/null +++ b/tests/acp-remote-tests.lisp @@ -0,0 +1,146 @@ +(in-package #:autolith) + +;;;; -- Remote ACP Endpoints -- + +(-> test-acp-endpoint-parse () null) +(defun test-acp-endpoint-parse () + "Parse [HOST:]PORT endpoints, defaulting to loopback and the default port." + (dolist (case '((nil "127.0.0.1" 8737 t) + ("9000" "127.0.0.1" 9000 t) + ("0" "127.0.0.1" 0 t) + ("localhost:8080" "localhost" 8080 t) + ("127.0.0.2:8080" "127.0.0.2" 8080 t) + ("[::1]:8080" "::1" 8080 t) + ("0.0.0.0:8737" "0.0.0.0" 8737 nil) + ("[::]:8737" "::" 8737 nil) + ("192.168.1.20:65535" "192.168.1.20" 65535 nil))) + (destructuring-bind (text host port loopback-p) case + (let ((endpoint (acp-endpoint-parse ':websocket text))) + (test-assert (equal host (acp-endpoint-host endpoint)) "the endpoint host is parsed") + (test-assert (eql port (acp-endpoint-port endpoint)) "the endpoint port is parsed") + (test-assert (eq loopback-p (acp-endpoint-loopback-p endpoint)) + "loopback endpoints are told apart from reachable ones") + (test-assert (eq (not loopback-p) + (not (null (acp-endpoint-warning endpoint "http://example/acp")))) + "only endpoints beyond loopback carry a warning")))) + (dolist (text '("" ":8080" "host:" "host:port" "host:65536" "host:123456" "::1:8080" "[::1]" "[::1]8080" + "[::1:8080")) + (test-assert (handler-case (progn (acp-endpoint-parse ':http text) nil) + (configuration-error () t)) + "a malformed endpoint is a configuration error")) + (test-assert (handler-case (progn (acp-endpoint-parse ':http "8080" :token "") nil) + (configuration-error () t)) + "an empty token is a configuration error") + (test-assert (search "--token" + (acp-endpoint-warning (acp-endpoint-parse ':http "0.0.0.0:1") "http://0.0.0.0:1/acp")) + "a reachable endpoint without a token suggests one") + (test-assert (not (search "--token" + (acp-endpoint-warning (acp-endpoint-parse ':http "0.0.0.0:1" :token "t") + "http://0.0.0.0:1/acp"))) + "a reachable endpoint with a token warns about the cleartext token") + nil) + +(-> test-acp-command-rejects-endpoint-combinations () null) +(defun test-acp-command-rejects-endpoint-combinations () + "Reject endpoint options that do not form one remote transport before any bootstrap." + (dolist (arguments '(("acp" "--http" "--websocket") + ("acp" "8080") + ("acp" "--token" "secret") + ("acp" "--http" "1" "2") + ("acp" "--websocket" "host:"))) + (test-assert (handler-case (progn (main-dispatch arguments) nil) + (configuration-error () t)) + "an invalid ACP endpoint request is a configuration error")) + nil) + + +;;;; -- Remote ACP Processes -- + +(-> acp-remote-tests--call-with-server (pathname list function) t) +(defun acp-remote-tests--call-with-server (root arguments function) + "Run bin/autolith acp with ARGUMENTS under ROOT, call FUNCTION with its URL, then interrupt it. + +Return what FUNCTION returns." + (let* ((process (uiop:launch-program + (append (list (namestring (asdf:system-relative-pathname :autolith "bin/autolith")) "acp") + arguments) + :directory root + :input nil + :output nil + :error-output ':stream)) + (errors (uiop:process-info-error-output process)) + (result nil)) + (unwind-protect + (let ((url (loop for line = (read-line errors nil nil) + while line + do (let ((start (search "listening at " line))) + (when start + (return (subseq line (+ start 13) + (or (search " and " line) (length line))))))))) + (test-assert url "the server announces its endpoint") + (setf result (funcall function url))) + (uiop:run-program (list "kill" "-INT" "--" (format nil "-~D" (uiop:process-info-pid process))) + :ignore-error-status t) + (let ((status (uiop:wait-process process))) + (test-assert (eql 130 status) "an interrupted remote ACP server exits with status 130"))) + result)) + +(-> acp-remote-tests--initialize (agentcomms:acp-channel) hash-table) +(defun acp-remote-tests--initialize (channel) + "Initialize an ACP client over CHANNEL and return the agent's answer." + (let ((client (make-instance 'agentcomms:acp-client))) + (agentcomms:acp-client-connect client channel) + (unwind-protect (agentcomms:client-initialize client :timeout 60) + (agentcomms:connection-close (agentcomms:acp-client-connection client))))) + +(-> test-acp-remote-websocket-process () null) +(defun test-acp-remote-websocket-process () + "Serve ACP over WebSocket from a real process and end it with Ctrl-C." + (with-test-fixture (':posix-shell "process-group interrupts") + (with-test-configuration (configuration root) + (declare (ignore configuration)) + (acp-launcher-tests--call-with-roots + root + (lambda () + (with-test-environment (("AUTOLITH_ACTIVE_CORE" (uiop:getenv "AUTOLITH_TEST_ACTIVE_CORE"))) + (acp-remote-tests--call-with-server + root '("--websocket" "127.0.0.1:0" "--token" "s3cret") + (lambda (url) + (test-assert (eql 0 (search "ws://127.0.0.1:" url)) "the endpoint is a WebSocket URL") + (test-assert (handler-case (progn (agentcomms:acp-websocket-connect url) nil) + (agentcomms:websocket-handshake-error () t)) + "a client without the token is refused") + (test-assert + (equal "autolith" + (agentcomms:json-get + (agentcomms:json-get + (acp-remote-tests--initialize + (agentcomms:acp-websocket-connect (format nil "~A?token=s3cret" url))) + "agentInfo") + "name")) + "a client with the token reaches the agent")))))))) + nil) + +(-> test-acp-remote-http-process () null) +(defun test-acp-remote-http-process () + "Serve ACP over Streamable HTTP from a real process." + (with-test-fixture (':posix-shell "process-group interrupts") + (with-test-configuration (configuration root) + (declare (ignore configuration)) + (acp-launcher-tests--call-with-roots + root + (lambda () + (with-test-environment (("AUTOLITH_ACTIVE_CORE" (uiop:getenv "AUTOLITH_TEST_ACTIVE_CORE"))) + (acp-remote-tests--call-with-server + root '("--http" "0") + (lambda (url) + (multiple-value-bind (body status headers) + (dexador:post url + :headers '(("Content-Type" . "application/json")) + :content "{\"jsonrpc\":\"2.0\",\"id\":0,\"method\":\"initialize\",\"params\":{\"protocolVersion\":1}}" + :force-string t + :keep-alive nil) + (test-assert (eql 200 status) "initialize answers 200") + (test-assert (gethash "acp-connection-id" headers) "initialize names the connection") + (test-assert (search "\"autolith\"" body) "the agent answers initialize"))))))))) + nil) diff --git a/tests/test-suites.lisp b/tests/test-suites.lisp index 91ff21d8..5e11f341 100644 --- a/tests/test-suites.lisp +++ b/tests/test-suites.lisp @@ -1538,8 +1538,16 @@ test-acp-launcher-detects-command-not-option-values test-acp-launcher-source-stdio-roundtrip test-acp-launcher-failure-keeps-stdout-clean + test-acp-launcher-failure-skips-recovery + test-acp-launcher-interrupt-exits-quietly test-acp-launcher-failure-diagnostics) +(define-test-suite acp-remote + test-acp-endpoint-parse + test-acp-command-rejects-endpoint-combinations + test-acp-remote-websocket-process + test-acp-remote-http-process) + (define-test-suite lisp-values test-application-lisp-value-roundtrips test-application-lisp-value-layout