From 129f1645a6a6ac587fde96304085f121e501a760 Mon Sep 17 00:00:00 2001 From: Thanos Apollo Date: Mon, 5 Oct 2026 13:01:13 +0300 Subject: [PATCH 1/2] feat(mcp): add a local MCP endpoint for agent access to the editor neomacs-mcp-start serves the Model Context Protocol on an owner-private Unix socket, separate from server-start. Built-in tools report the editor identity, evaluate Lisp and read buffers; packages can add tools with neomacs-mcp-register-tool. Requests run one at a time from a timer while no input is pending. Eval is enabled by default and disabled by setting neomacs-mcp-full-access to nil. The neomacs-mcp crate is a std-only relay between an MCP client's stdio and that socket. --- Cargo.lock | 4 + Cargo.toml | 2 + crates/neomacs-mcp/Cargo.toml | 15 + crates/neomacs-mcp/src/main.rs | 16 + crates/neomacs-mcp/src/relay.rs | 258 ++++++++++ crates/neomacs-mcp/tests/relay.rs | 218 +++++++++ docs/neomacs-mcp.md | 189 ++++++++ lisp/neomacs-mcp.el | 762 ++++++++++++++++++++++++++++++ test/neomacs/neomacs-mcp-test.el | 673 ++++++++++++++++++++++++++ 9 files changed, 2137 insertions(+) create mode 100644 crates/neomacs-mcp/Cargo.toml create mode 100644 crates/neomacs-mcp/src/main.rs create mode 100644 crates/neomacs-mcp/src/relay.rs create mode 100644 crates/neomacs-mcp/tests/relay.rs create mode 100644 docs/neomacs-mcp.md create mode 100644 lisp/neomacs-mcp.el create mode 100644 test/neomacs/neomacs-mcp-test.el diff --git a/Cargo.lock b/Cargo.lock index 4b895e97c4..9c6a9e52b5 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -3911,6 +3911,10 @@ dependencies = [ "yeslogic-fontconfig-sys", ] +[[package]] +name = "neomacs-mcp" +version = "0.0.19" + [[package]] name = "neomacs-melpa-test-support" version = "0.0.19" diff --git a/Cargo.toml b/Cargo.toml index c53131b682..8f9a32a1cc 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -1,6 +1,7 @@ [workspace] members = [ "crates/neomacs", + "crates/neomacs-mcp", "crates/neomacs-terminfo", "crates/neomacs-allocator", "crates/neomacs-diagnostics", @@ -29,6 +30,7 @@ members = [ ] default-members = [ "crates/neomacs", + "crates/neomacs-mcp", "crates/xtask", ] resolver = "2" diff --git a/crates/neomacs-mcp/Cargo.toml b/crates/neomacs-mcp/Cargo.toml new file mode 100644 index 0000000000..acc77f613b --- /dev/null +++ b/crates/neomacs-mcp/Cargo.toml @@ -0,0 +1,15 @@ +[package] +name = "neomacs-mcp" +version.workspace = true +edition.workspace = true +authors.workspace = true +license.workspace = true +repository.workspace = true +description = "Stdio relay from MCP clients to the editor's local MCP socket" + +[[bin]] +name = "neomacs-mcp" +path = "src/main.rs" + +[lints] +workspace = true diff --git a/crates/neomacs-mcp/src/main.rs b/crates/neomacs-mcp/src/main.rs new file mode 100644 index 0000000000..97deba0d49 --- /dev/null +++ b/crates/neomacs-mcp/src/main.rs @@ -0,0 +1,16 @@ +//! `neomacs-mcp --socket PATH`: let a stdio MCP client talk to the editor +//! endpoint started by `neomacs-mcp-start` (lisp/neomacs-mcp.el). +#![forbid(unsafe_code)] + +#[cfg(unix)] +mod relay; + +fn main() { + #[cfg(unix)] + relay::main(); + #[cfg(not(unix))] + { + eprintln!("neomacs-mcp: Unix sockets are unsupported on this platform"); + std::process::exit(1); + } +} diff --git a/crates/neomacs-mcp/src/relay.rs b/crates/neomacs-mcp/src/relay.rs new file mode 100644 index 0000000000..7fa5850f57 --- /dev/null +++ b/crates/neomacs-mcp/src/relay.rs @@ -0,0 +1,258 @@ +//! Copy bytes between stdio and one explicitly named Unix socket. +//! +//! The relay does not parse MCP, retry, reconnect, or start an editor. +//! Blocking stdio workers are deliberately not joined: this executable owns +//! the process, and the bounded supervisor exits it after closing its socket. +//! Process exit is the cancellation boundary for an inherited blocked pipe. + +use std::io::{self, Read, Write}; +use std::net::Shutdown; +use std::os::unix::net::UnixStream; +use std::path::PathBuf; +use std::sync::mpsc::{self, Receiver, SyncSender}; +use std::thread; +use std::time::{Duration, Instant}; + +const CHUNK: usize = 16 * 1024; +const USAGE: &str = "usage: neomacs-mcp --socket ABSOLUTE-PATH [--timeout-ms 1..60000]"; + +struct Config { + socket: PathBuf, + timeout: Duration, +} + +impl Config { + fn parse(args: impl Iterator) -> Result { + let mut args = args; + let mut socket = None; + let mut timeout = None; + while let Some(arg) = args.next() { + match arg.to_str() { + Some("--socket") if socket.is_none() => { + socket = Some(PathBuf::from(args.next().ok_or(USAGE)?)); + } + Some("--timeout-ms") if timeout.is_none() => { + let value = args.next().ok_or(USAGE)?; + let millis = value + .to_str() + .and_then(|s| s.parse::().ok()) + .filter(|n| (1..=60_000).contains(n)) + .ok_or(USAGE)?; + timeout = Some(Duration::from_millis(millis)); + } + _ => return Err(USAGE.into()), + } + } + let socket = socket.filter(|s| s.is_absolute()).ok_or(USAGE)?; + Ok(Self { + socket, + timeout: timeout.unwrap_or(Duration::from_secs(2)), + }) + } +} + +#[derive(Clone, Copy)] +enum Direction { + Upstream, + Stdout, +} + +enum Event { + Writing(Direction), + Wrote(Direction), + InputEof, + PeerEof, + Error(String), +} + +// Two fixed-size buffers plus four small control events. No payload queues. +fn copy_chunks( + mut read: impl Read, + mut write: impl Write, + direction: Direction, + events: &SyncSender, +) -> io::Result<()> { + let mut bytes = [0; CHUNK]; + loop { + let size = match read.read(&mut bytes) { + Err(e) if e.kind() == io::ErrorKind::Interrupted => continue, + other => other?, + }; + if size == 0 { + return Ok(()); + } + events + .send(Event::Writing(direction)) + .map_err(|_| io::ErrorKind::BrokenPipe)?; + write.write_all(&bytes[..size])?; + write.flush()?; + events + .send(Event::Wrote(direction)) + .map_err(|_| io::ErrorKind::BrokenPipe)?; + } +} + +struct Connection(UnixStream); +impl Drop for Connection { + fn drop(&mut self) { + let _ = self.0.shutdown(Shutdown::Both); + } +} + +fn supervise(events: Receiver, timeout: Duration) -> Result<(), String> { + let mut upstream = None; + let mut stdout = None; + let mut drain = None; + loop { + let now = Instant::now(); + for (deadline, label) in [ + (upstream, "upstream write"), + (stdout, "stdout write"), + (drain, "stdin EOF drain"), + ] { + if deadline.is_some_and(|d| now >= d) { + return Err(format!( + "{label} deadline expired; connection retired (delivery may be incomplete)" + )); + } + } + let wait = [upstream, stdout, drain] + .into_iter() + .flatten() + .min() + .map(|d| d.saturating_duration_since(now)) + .unwrap_or(Duration::from_secs(60)); + match events.recv_timeout(wait) { + Ok(Event::Writing(d)) => { + let deadline = Some(Instant::now() + timeout); + match d { + Direction::Upstream => upstream = deadline, + Direction::Stdout => stdout = deadline, + } + } + Ok(Event::Wrote(d)) => match d { + Direction::Upstream => upstream = None, + Direction::Stdout => stdout = None, + }, + Ok(Event::InputEof) => drain = Some(Instant::now() + timeout), + Ok(Event::PeerEof) => return Ok(()), + Ok(Event::Error(e)) => return Err(e), + Err(mpsc::RecvTimeoutError::Timeout) => (), + Err(mpsc::RecvTimeoutError::Disconnected) => { + return Err("transport workers disconnected".into()); + } + } + } +} + +fn relay(config: Config) -> Result<(), String> { + // Even connect can block on a full Unix listener backlog. Bound it without + // FFI or changing inherited descriptors' flags (which affect their owners). + let (connected_tx, connected_rx) = mpsc::sync_channel(1); + thread::Builder::new() + .name("mcp-connect".into()) + .spawn(move || { + let _ = connected_tx.send(UnixStream::connect(config.socket)); + }) + .map_err(|e| format!("connect worker: {e}"))?; + let stream = connected_rx + .recv_timeout(config.timeout) + .map_err(|e| format!("connect deadline/worker: {e}"))? + .map_err(|e| format!("connect: {e}"))?; + let connection = Connection(stream); + let inbound = connection + .0 + .try_clone() + .map_err(|e| format!("clone inbound socket: {e}"))?; + let outbound = connection + .0 + .try_clone() + .map_err(|e| format!("clone outbound socket: {e}"))?; + let (tx, rx) = mpsc::sync_channel(4); + let input_tx = tx.clone(); + thread::Builder::new() + .name("mcp-input".into()) + .spawn(move || { + match copy_chunks(io::stdin().lock(), &inbound, Direction::Upstream, &input_tx) { + Ok(()) => { + let _ = input_tx.send(Event::InputEof); + if let Err(e) = inbound.shutdown(Shutdown::Write) { + let _ = input_tx.send(Event::Error(format!("stdin EOF half-close: {e}"))); + } + } + Err(e) => { + let _ = input_tx.send(Event::Error(format!("stdin to socket: {e}"))); + } + } + }) + .map_err(|e| format!("stdin worker: {e}"))?; + thread::Builder::new() + .name("mcp-output".into()) + .spawn(move || { + let event = match copy_chunks(&outbound, io::stdout().lock(), Direction::Stdout, &tx) { + Ok(()) => Event::PeerEof, + Err(e) => Event::Error(format!("socket to stdout: {e}")), + }; + let _ = tx.send(event); + }) + .map_err(|e| format!("stdout worker: {e}"))?; + supervise(rx, config.timeout) +} + +pub(crate) fn main() { + let result = Config::parse(std::env::args_os().skip(1)).and_then(relay); + let code = if let Err(error) = result { + // Diagnostics must not hang retirement when stderr is itself a full pipe. + // Best effort: give the small message 20ms, then terminate every worker. + let (tx, rx) = mpsc::sync_channel(1); + if thread::Builder::new() + .name("mcp-diagnostic".into()) + .spawn(move || { + let _ = writeln!(io::stderr().lock(), "neomacs-mcp: {error}"); + let _ = tx.send(()); + }) + .is_ok() + { + let _ = rx.recv_timeout(Duration::from_millis(20)); + } + 1 + } else { + 0 + }; + std::process::exit(code); +} + +#[cfg(test)] +mod tests { + use super::*; + + fn parse(args: &[&str]) -> Result { + Config::parse(args.iter().map(std::ffi::OsString::from)) + } + + #[test] + fn requires_one_absolute_socket() { + let config = parse(&["--socket", "/tmp/mcp"]).unwrap(); + assert_eq!(config.socket, PathBuf::from("/tmp/mcp")); + assert_eq!(config.timeout, Duration::from_secs(2)); + for args in [ + &[][..], + &["--socket"][..], + &["--socket", "relative"][..], + &["--socket", "/a", "--socket", "/b"][..], + &["/tmp/mcp"][..], + &["--socket", "/tmp/mcp", "--extra"][..], + ] { + assert_eq!(parse(args).err().as_deref(), Some(USAGE), "{args:?}"); + } + } + + #[test] + fn bounds_timeout() { + let config = parse(&["--timeout-ms", "250", "--socket", "/tmp/mcp"]).unwrap(); + assert_eq!(config.timeout, Duration::from_millis(250)); + for value in ["0", "60001", "-1", "x"] { + assert!(parse(&["--socket", "/tmp/mcp", "--timeout-ms", value]).is_err()); + } + } +} diff --git a/crates/neomacs-mcp/tests/relay.rs b/crates/neomacs-mcp/tests/relay.rs new file mode 100644 index 0000000000..d4e6e300ec --- /dev/null +++ b/crates/neomacs-mcp/tests/relay.rs @@ -0,0 +1,218 @@ +//! Process-level tests of the `neomacs-mcp` relay against a fixture +//! Unix listener. The fixture is transport-only; it does not speak MCP. +#![cfg(unix)] + +use std::io::{Read, Write}; +use std::os::unix::net::{UnixListener, UnixStream}; +use std::path::{Path, PathBuf}; +use std::process::{Child, Command, ExitStatus, Stdio}; +use std::thread; +use std::time::{Duration, Instant}; + +const TIMEOUT_MS: &str = "300"; + +struct Fixture { + dir: PathBuf, + socket: PathBuf, + listener: UnixListener, +} + +impl Fixture { + fn new(name: &str) -> Self { + let dir = std::env::temp_dir().join(format!("neomacs-mcp-{}-{name}", std::process::id())); + let _ = std::fs::remove_dir_all(&dir); + std::fs::create_dir_all(&dir).unwrap(); + let socket = dir.join("mcp"); + let listener = UnixListener::bind(&socket).unwrap(); + Self { + dir, + socket, + listener, + } + } + + fn accept(&self) -> UnixStream { + let (stream, _) = self.listener.accept().unwrap(); + stream + .set_read_timeout(Some(Duration::from_secs(5))) + .unwrap(); + stream + } +} + +impl Drop for Fixture { + fn drop(&mut self) { + let _ = std::fs::remove_dir_all(&self.dir); + } +} + +fn relay(socket: &Path) -> Child { + Command::new(env!("CARGO_BIN_EXE_neomacs-mcp")) + .arg("--socket") + .arg(socket) + .args(["--timeout-ms", TIMEOUT_MS]) + .stdin(Stdio::piped()) + .stdout(Stdio::piped()) + .stderr(Stdio::piped()) + .spawn() + .unwrap() +} + +fn wait(child: &mut Child, limit: Duration) -> ExitStatus { + let deadline = Instant::now() + limit; + loop { + if let Some(status) = child.try_wait().unwrap() { + return status; + } + if Instant::now() >= deadline { + child.kill().unwrap(); + panic!("relay did not exit within {limit:?}"); + } + thread::sleep(Duration::from_millis(10)); + } +} + +fn read_exact(reader: &mut impl Read, len: usize) -> Vec { + let mut bytes = vec![0; len]; + reader.read_exact(&mut bytes).unwrap(); + bytes +} + +fn stderr(child: &mut Child) -> String { + let mut text = String::new(); + child + .stderr + .take() + .unwrap() + .read_to_string(&mut text) + .unwrap(); + text +} + +#[test] +fn copies_bytes_both_ways_without_framing() { + let fixture = Fixture::new("duplex"); + let mut child = relay(&fixture.socket); + let mut peer = fixture.accept(); + let mut stdin = child.stdin.take().unwrap(); + let mut stdout = child.stdout.take().unwrap(); + + // A UTF-8 character split across writes and two messages in one write. + let message = "{\"text\":\"Ελλάδα\"}\n{\"id\":2}\n".as_bytes(); + stdin.write_all(&message[..12]).unwrap(); + stdin.flush().unwrap(); + thread::sleep(Duration::from_millis(20)); + stdin.write_all(&message[12..]).unwrap(); + stdin.flush().unwrap(); + assert_eq!(read_exact(&mut peer, message.len()), message); + + // Large binary payloads arrive unchanged in both directions. + let large: Vec = (0..300_000u32).map(|n| (n % 251) as u8).collect(); + let writer = { + let large = large.clone(); + thread::spawn(move || { + stdin.write_all(&large).unwrap(); + stdin + }) + }; + assert_eq!(read_exact(&mut peer, large.len()), large); + let stdin = writer.join().unwrap(); + let echo = thread::spawn({ + let mut peer = peer.try_clone().unwrap(); + let large = large.clone(); + move || peer.write_all(&large).unwrap() + }); + assert_eq!(read_exact(&mut stdout, large.len()), large); + echo.join().unwrap(); + + drop(stdin); + drop(peer); + assert!(wait(&mut child, Duration::from_secs(5)).success()); +} + +#[test] +fn stdin_eof_half_closes_and_delivers_late_response() { + let fixture = Fixture::new("eof"); + let mut child = relay(&fixture.socket); + let mut peer = fixture.accept(); + let mut stdin = child.stdin.take().unwrap(); + stdin.write_all(b"request\n").unwrap(); + drop(stdin); + + let mut received = Vec::new(); + peer.read_to_end(&mut received).unwrap(); + assert_eq!(received, b"request\n"); + peer.write_all(b"response\n").unwrap(); + drop(peer); + + let mut stdout = child.stdout.take().unwrap(); + let mut output = Vec::new(); + stdout.read_to_end(&mut output).unwrap(); + assert_eq!(output, b"response\n"); + assert!(wait(&mut child, Duration::from_secs(5)).success()); + // The relay never removes or replaces the editor's socket. + assert!(fixture.socket.exists()); +} + +#[test] +fn stdin_eof_without_peer_close_times_out() { + let fixture = Fixture::new("drain"); + let mut child = relay(&fixture.socket); + let _peer = fixture.accept(); + drop(child.stdin.take()); + let status = wait(&mut child, Duration::from_secs(5)); + assert_eq!(status.code(), Some(1)); + assert!(stderr(&mut child).contains("stdin EOF drain deadline expired")); +} + +#[test] +fn peer_close_exits_while_stdin_is_open() { + let fixture = Fixture::new("peer-close"); + let mut child = relay(&fixture.socket); + drop(fixture.accept()); + let _stdin = child.stdin.take(); + assert!(wait(&mut child, Duration::from_secs(5)).success()); +} + +#[test] +fn unread_socket_write_is_bounded() { + let fixture = Fixture::new("unread"); + let mut child = relay(&fixture.socket); + let _peer = fixture.accept(); + let mut stdin = child.stdin.take().unwrap(); + // The peer never reads, so the relay's socket write blocks. + let writer = thread::spawn(move || { + let chunk = vec![b'x'; 64 * 1024]; + for _ in 0..256 { + if stdin.write_all(&chunk).is_err() { + break; + } + } + }); + let status = wait(&mut child, Duration::from_secs(10)); + assert_eq!(status.code(), Some(1)); + assert!(stderr(&mut child).contains("upstream write deadline expired")); + writer.join().unwrap(); +} + +#[test] +fn missing_socket_fails_without_fallback() { + let fixture = Fixture::new("missing"); + let mut child = relay(&fixture.dir.join("absent")); + let status = wait(&mut child, Duration::from_secs(5)); + assert_eq!(status.code(), Some(1)); + assert!(stderr(&mut child).contains("connect")); +} + +#[test] +fn rejects_invalid_arguments() { + for args in [&[][..], &["--socket", "relative"][..]] { + let output = Command::new(env!("CARGO_BIN_EXE_neomacs-mcp")) + .args(args) + .stdin(Stdio::null()) + .output() + .unwrap(); + assert_eq!(output.status.code(), Some(1)); + assert!(String::from_utf8_lossy(&output.stderr).contains("usage: neomacs-mcp")); + } +} diff --git a/docs/neomacs-mcp.md b/docs/neomacs-mcp.md new file mode 100644 index 0000000000..050dbc3367 --- /dev/null +++ b/docs/neomacs-mcp.md @@ -0,0 +1,189 @@ +# Neomacs MCP + +Neomacs can expose the running editor to a local agent through the +[Model Context Protocol](https://modelcontextprotocol.io) (MCP). Agents +such as Claude Code, Codex or Hermes connect to it like any other stdio MCP +server and can then inspect buffers and evaluate Emacs Lisp in the editor +you are using. + +Nothing starts by default. Loading the library does not open a socket; +`neomacs-mcp-start` does. + +```elisp +(require 'neomacs-mcp) +(neomacs-mcp-start (expand-file-name "neomacs/mcp" (or (getenv "XDG_RUNTIME_DIR") "/tmp"))) +;; Later: +(neomacs-mcp-stop) +``` + +The socket's directory must be owned by you and not accessible to other +users; `neomacs-mcp-start` checks this with `server-ensure-safe-dir`, the +same check `server-start` uses, and creates the directory if needed. An +existing file at the socket path is refused rather than replaced. Keep the +path short: Unix socket paths are limited to about 100 bytes. + +Build the relay with `cargo build --release -p neomacs-mcp` (release packages +do not include it yet) and configure the MCP client to launch it: + +```sh +neomacs-mcp --socket /run/user/1000/neomacs/mcp +``` + +For example, in a client that uses the common `mcpServers` JSON format: + +```json +{"mcpServers": {"neomacs": {"command": "neomacs-mcp", + "args": ["--socket", "/run/user/1000/neomacs/mcp"]}}} +``` + +The relay copies bytes between its stdin/stdout and the socket. It does not +start an editor, guess a socket, parse MCP or retry. When the client closes +the relay, the editor keeps running. + +## Tools + +| Tool | Arguments | Purpose | +| --- | --- | --- | +| `neomacs_identity` | none | `instance`, `pid`, `runtime`, `serverName`, `endpointGeneration` | +| `neomacs_eval` | `instance`, `code` | Evaluate Lisp; return the printed value | +| `neomacs_buffer_list` | `instance`, `offset`, `limit` (1-32) | Buffer names and metadata, one page at a time | +| `neomacs_buffer_read` | `instance`, `name`, `start`, `maxChars` (1-4096), optional `expectedTick` | Text from a buffer | + +Every tool except `neomacs_identity` requires the `instance` string returned +by `neomacs_identity`. It is different for every editor process, so a client +cannot silently act on a different editor after a restart. It is not a +secret or a credential. + +`neomacs_eval` reads all forms in `code` as one `progn`, evaluates them with +lexical binding and returns the result printed with `prin1`. A printed value +over 64 KiB is reported as an error after evaluation. Errors are returned as +tool results with `isError` set. In every error case, including the response +errors described under limits, effects of the evaluation are not undone. + +`neomacs_buffer_list` and `neomacs_buffer_read` only read. They report +`name`, `tick` (`buffer-modified-tick`), `sizeChars`, `point`, `mode`, +`modified` and `readOnly`, never file names. Reads use widened, 1-based, +end-exclusive character positions and preserve the current buffer, point and +narrowing. Results are capped at 32 KiB of encoded JSON; a longer read is +shortened and reports `truncated` and `nextStart`. Pagination offsets count +entries of `buffer-list`, which can change between calls. Minibuffers and +buffers whose name or file name looks like `authinfo`, `netrc` or +`password-store` are skipped by these two tools. That is a lexical filter, +not a sandbox. + +## Full access and security + +With the default settings, an MCP client connected to the socket has **full +access** to the editor: `neomacs_eval` runs arbitrary Lisp with the same +privileges as your user account. It can read and write any buffer or file +you can, start processes, use the network, change your configuration or exit +the editor. There is no sandbox, rollback or per-call confirmation. This is +the same capability `emacsclient --eval` gives after `server-start`, and +what MCP integrations in other editors typically provide: an agent that can +drive the editor the way you do. + +To turn it off: + +```elisp +(setq neomacs-mcp-full-access nil) +``` + +When `neomacs-mcp-full-access` is nil, `neomacs_eval` is neither listed nor +callable; the remaining built-in tools only read buffers. The option is +checked on every request, so changing it affects connected clients +immediately. Tools registered by other packages are not affected. + +The transport boundary: + +- The endpoint listens only on a Unix domain socket. There is no TCP or other + network listener. +- The socket's directory must belong to you and be inaccessible to other users, + so only processes running as you can connect. +- Nothing is started by loading the library, by opening a file or by + directory-local or project settings; only an explicit `neomacs-mcp-start` + call creates the socket. + +Any process that can connect to the socket already runs as your user, and can +therefore run arbitrary code in your account without MCP (and in the editor +through `emacsclient` if the server is running). The endpoint does not add a +capability for a malicious local process. What it changes is who you hand +control to: an agent you connect can do anything you can. Connect only agents +you would let type into your editor, and set `neomacs-mcp-full-access` to nil +when read-only access is enough. + +## GNU Emacs + +`neomacs-mcp.el` is plain Emacs Lisp: it uses `make-network-process`, the +native JSON functions and `server-ensure-safe-dir`, and does not depend on +Neomacs internals, so it also runs on GNU Emacs; the test suite below runs +on both. The `neomacs-mcp` relay is an independent program and +works with any editor that serves the socket. GNU Emacs users who want this +outside Neomacs currently need to load the file themselves. + +## Protocol + +Messages are UTF-8 JSON-RPC 2.0, one per line, as in the MCP stdio transport. +The endpoint supports: + +- **2026-07-28:** no handshake; each request carries + `params._meta["io.modelcontextprotocol/protocolVersion"]` and + `["io.modelcontextprotocol/clientCapabilities"]`. `server/discover` is + implemented. An unsupported version receives error `-32022` listing the + supported versions. +- **2025-11-25 and 2025-06-18:** `initialize`, then + `notifications/initialized`. A supported version offer is echoed; any other + offer receives 2025-11-25. + +Only `ping`, `server/discover`, `tools/list` and `tools/call` are +implemented; resources, prompts and subscriptions are not advertised. +`notifications/cancelled` drops a queued request and suppresses the reply to a +running one; it cannot interrupt Lisp that is already running. + +## Scheduling and limits + +Process filters only split and queue messages; tools never run inside a +filter. A timer runs at most one queued request at a time, and only while +`(input-pending-p)` is nil, so typing takes priority over agent requests. +Continuous input can therefore delay requests indefinitely. A tool runs +synchronously in the editor's command loop: long-running Lisp blocks the +editor just as it would from `M-:`. + +Limits: 8 connections, 64 queued requests (16 per connection), 128 KiB per +incoming message and per response. A response over the limit, or one that +cannot be encoded as JSON (for example text containing raw bytes), is +replaced by error `-32603`. Exceeding any other limit, or reusing an +outstanding request ID, closes that connection. A response send that does +not complete within `neomacs-mcp-send-timeout` seconds closes the connection. + +## Adding tools + +```elisp +(neomacs-mcp-register-tool + "my_tool" "Describe what it does." + (json-parse-string + "{\"type\": \"object\", \"properties\": {\"name\": {\"type\": \"string\"}}, + \"required\": [\"name\"], \"additionalProperties\": false}") + (lambda (arguments) (format "Hello %s" (gethash "name" arguments))) + (json-parse-string "{\"readOnlyHint\": true}")) +``` + +The handler receives the arguments as a hash table and returns a JSON value; +a string becomes the text content. Arguments are checked for required +fields, primitive types and unknown properties before the handler runs. +Annotations are hints for the client, not permissions. + +## Tests + +```sh +# Lisp endpoint, with Neomacs or GNU Emacs: +neomacs -Q --batch -L lisp -l test/neomacs/neomacs-mcp-test.el \ + -f ert-run-tests-batch-and-exit + +# Relay: +cargo nextest run -p neomacs-mcp + +# Both, through a real relay process: +cargo build -p neomacs-mcp +NEOMACS_MCP_RELAY=target/debug/neomacs-mcp neomacs -Q --batch -L lisp \ + -l test/neomacs/neomacs-mcp-test.el -f ert-run-tests-batch-and-exit +``` diff --git a/lisp/neomacs-mcp.el b/lisp/neomacs-mcp.el new file mode 100644 index 0000000000..bedef4e671 --- /dev/null +++ b/lisp/neomacs-mcp.el @@ -0,0 +1,762 @@ +;;; neomacs-mcp.el --- Local MCP endpoint for agent access -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; Author: Neomacs Contributors +;; Keywords: tools, processes + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; A Model Context Protocol (MCP) endpoint that gives a local agent +;; access to the running editor. It listens on an explicitly named, +;; owner-private Unix socket, separate from server.el; loading this +;; library starts nothing. Messages are UTF-8 JSON-RPC 2.0, one per +;; line. Standard stdio MCP clients reach the socket through the +;; protocol-blind `neomacs-mcp' relay program. +;; +;; (require 'neomacs-mcp) +;; (neomacs-mcp-start "/run/user/1000/neomacs/mcp") +;; +;; Built-in tools: `neomacs_identity', `neomacs_buffer_list', +;; `neomacs_buffer_read' and, while `neomacs-mcp-full-access' is +;; non-nil (the default), `neomacs_eval', which evaluates arbitrary Lisp +;; with the user's privileges. +;; +;; Process filters only frame and enqueue requests. A timer admits at +;; most one request at a time, and only while no user input is pending. +;; This library is plain Emacs Lisp and also runs on GNU Emacs. See +;; docs/neomacs-mcp.md. + +;;; Code: + +(require 'cl-lib) +(require 'json) +(require 'rx) +(require 'server) + +(defgroup neomacs-mcp nil + "Local Model Context Protocol endpoint." + :group 'external) + +(defcustom neomacs-mcp-full-access t + "Non-nil means MCP clients may evaluate arbitrary Lisp in this editor. +When non-nil, the `neomacs_eval' tool is listed and callable. It runs +code with the same privileges as the user running the editor, without +a sandbox or confirmation prompt. When nil, that tool is neither +listed nor callable; the other built-in tools only read buffer text and +metadata. Tools registered by other libraries are not affected." + :type 'boolean + :group 'neomacs-mcp) + +(defcustom neomacs-mcp-send-timeout 0.25 + "Seconds before closing a client whose response send has not returned." + :type 'number + :group 'neomacs-mcp) + +(defconst neomacs-mcp--frame-limit 131072) +(defconst neomacs-mcp--output-limit 131072) +(defconst neomacs-mcp--queue-limit 64) +(defconst neomacs-mcp--peer-queue-limit 16) +(defconst neomacs-mcp--peer-limit 8) +(defconst neomacs-mcp--scan-limit 8) +(defconst neomacs-mcp--modern "2026-07-28") +(defconst neomacs-mcp--legacy "2025-11-25") +(defconst neomacs-mcp--legacy-versions '("2025-11-25" "2025-06-18") + "Supported handshake versions, newest first; both use legacy envelopes.") +(defconst neomacs-mcp--full-access-tools '("neomacs_eval") + "Tools available only while `neomacs-mcp-full-access' is non-nil.") + +(defvar neomacs-mcp--boot nil) +(defvar neomacs-mcp--generation 0) +(defvar neomacs-mcp--listener nil) +(defvar neomacs-mcp--socket nil) +(defvar neomacs-mcp--socket-identity nil) +(defvar neomacs-mcp--peers nil) +(defvar neomacs-mcp--queue nil) +(defvar neomacs-mcp--active nil) +(defvar neomacs-mcp--timer nil) +(defvar neomacs-mcp-tools nil + "Alist of tool NAME and tool plist. +Each plist has :description, :schema, :handler and optional +:annotations. Use `neomacs-mcp-register-tool' to add or replace an +entry. Changes are visible on the next list request.") + +(define-error 'neomacs-mcp-protocol-error "MCP protocol error") + +(defun neomacs-mcp--object (&rest pairs) + "Return a JSON object populated by alternating key/value PAIRS." + (let ((object (make-hash-table :test #'equal))) + (while pairs (puthash (pop pairs) (pop pairs) object)) + object)) + +(defun neomacs-mcp--fail (code message &optional data) + "Signal protocol CODE with MESSAGE and optional DATA." + (signal 'neomacs-mcp-protocol-error (list code message data))) + +(defun neomacs-mcp-identity () + "Return this editor process's identity as a JSON object. +The `instance' string stays the same across endpoint restarts and +differs for every editor process. Tools that act on the editor require +it, so a client cannot silently act on a different editor." + (unless neomacs-mcp--boot + (setq neomacs-mcp--boot + (format "%s:%s:%s" (emacs-pid) (float-time) (random)))) + (neomacs-mcp--object "instance" neomacs-mcp--boot "pid" (emacs-pid) + "runtime" emacs-version "serverName" server-name + "endpointGeneration" neomacs-mcp--generation)) + +(defun neomacs-mcp--instance (arguments) + "Refuse unless ARGUMENTS name this editor process's instance." + (unless (equal (gethash "instance" arguments) + (gethash "instance" (neomacs-mcp-identity))) + (user-error "Editor instance mismatch"))) + +(defun neomacs-mcp-register-tool (name description schema handler &optional annotations) + "Register tool NAME with DESCRIPTION, input SCHEMA and HANDLER. +SCHEMA is a JSON object schema as a hash table. HANDLER receives the +arguments as a hash table and returns a JSON value; a string is used +directly as text content. Optional ANNOTATIONS are descriptive hints, +not permissions. Registering an existing NAME replaces it." + (unless (and (stringp name) (string-match-p "\\`[A-Za-z0-9_.-]+\\'" name) + (<= (length name) 128) (stringp description) + (hash-table-p schema) (equal (gethash "type" schema) "object") + (functionp handler)) + (error "Invalid MCP tool registration")) + (setf (alist-get name neomacs-mcp-tools nil nil #'equal) + (list :description description :schema schema :handler handler + :annotations annotations))) + +(defun neomacs-mcp--available-tools () + "Return the registered tools that clients may currently list and call." + (if neomacs-mcp-full-access + neomacs-mcp-tools + (cl-remove-if (lambda (entry) (member (car entry) neomacs-mcp--full-access-tools)) + neomacs-mcp-tools))) + +(defun neomacs-mcp--schema (properties required) + "Return a closed object schema from PROPERTIES and REQUIRED field names." + (neomacs-mcp--object + "type" "object" "properties" + (apply #'neomacs-mcp--object + (cl-loop for (name . type) in properties + append (list name (neomacs-mcp--object "type" type)))) + "required" (vconcat required) "additionalProperties" :false)) + +(defun neomacs-mcp--arguments (schema arguments) + "Validate ARGUMENTS against the supported subset of SCHEMA. +Check required fields, primitive types and closed properties. Handlers +own any further constraints." + (unless (hash-table-p arguments) + (neomacs-mcp--fail -32602 "Arguments must be an object")) + (mapc (lambda (key) + (when (eq (gethash key arguments :absent) :absent) + (neomacs-mcp--fail -32602 (concat "Missing argument: " key)))) + (gethash "required" schema)) + (maphash + (lambda (key value) + (let* ((property (gethash key (gethash "properties" schema))) + (type (and property (gethash "type" property)))) + (when (and (not property) (eq (gethash "additionalProperties" schema) :false)) + (neomacs-mcp--fail -32602 (concat "Unknown argument: " key))) + (unless (pcase type + ("string" (stringp value)) ("integer" (integerp value)) + ("number" (numberp value)) ("object" (hash-table-p value)) + ("array" (vectorp value)) + ("boolean" (memq value '(t :false))) (_ t)) + (neomacs-mcp--fail -32602 (concat "Wrong argument type: " key))))) + arguments) + arguments) + +(defun neomacs-mcp--eval (arguments) + "Evaluate the Lisp forms in ARGUMENTS after checking the instance. +Return the printed value. Effects are not rolled back on failure." + (neomacs-mcp--instance arguments) + (let* ((code (gethash "code" arguments)) + (wrapped (concat "(progn\n" code "\n)")) + (parsed (read-from-string wrapped)) + (_complete + (unless (= (cdr parsed) (length wrapped)) + (error "Malformed Lisp input: unbalanced forms"))) + (value (eval (car parsed) t)) + (print-length 64) (print-level 16) (print-circle t) + (print-escape-newlines t) + (text (prin1-to-string value))) + (if (> (string-bytes text) 65536) + (error "Eval result exceeds the output limit; effects may have occurred") + text))) + +;;;; Read-only buffer tools + +(defconst neomacs-mcp-buffer-output-limit 32768 + "Maximum encoded tool-result bytes for the buffer tools.") +(defconst neomacs-mcp-buffer-scan-limit 128 + "Maximum `buffer-list' entries examined per `neomacs_buffer_list' call.") +(defconst neomacs-mcp--buffer-name-limit 256) + +(defun neomacs-mcp--credential-name-p (name) + "Return non-nil if NAME looks like an authinfo, netrc or password-store file." + (and (stringp name) + (let ((case-fold-search t)) + (string-match-p + (rx (or string-start "/") + (or (seq (optional (any "._")) (or "authinfo" "netrc") + (or string-end "." "~" "<")) + (seq (optional ".") "password-store" (or string-end "/")))) + name)))) + +(defun neomacs-mcp--buffer-hidden-p (buffer) + "Return non-nil if the buffer tools must not expose BUFFER. +Hide minibuffers and buffers whose name or file name looks like a +credential store, including indirect buffers of those. This is a +lexical filter for the read-only tools, not a sandbox." + (with-current-buffer buffer + (or (minibufferp buffer) + (cl-some #'neomacs-mcp--credential-name-p + (list (buffer-name) buffer-file-name buffer-file-truename)) + (when-let* ((base (buffer-base-buffer))) + (neomacs-mcp--buffer-hidden-p base))))) + +(defun neomacs-mcp--integer (arguments key minimum maximum) + "Return ARGUMENTS' integer KEY within MINIMUM and MAXIMUM, or refuse." + (let ((value (gethash key arguments))) + (unless (and (integerp value) (<= minimum value maximum)) + (user-error "Invalid bounded integer: %s" key)) + value)) + +(defun neomacs-mcp--result-bytes (value) + "Return the encoded size in bytes of a tool result carrying VALUE." + (string-bytes + (json-serialize + (neomacs-mcp--object + "resultType" "complete" "isError" :false + "content" (vector + (neomacs-mcp--object + "type" "text" "text" + (decode-coding-string + (json-serialize value :false-object :false :null-object :null) 'utf-8)))) + :false-object :false :null-object :null))) + +(defun neomacs-mcp--buffer-entry (buffer) + "Return metadata for BUFFER without scanning lines or running hooks." + (with-current-buffer buffer + (let ((mode (symbol-name major-mode))) + (neomacs-mcp--object + "name" (buffer-name) "tick" (buffer-modified-tick) + "sizeChars" (buffer-size) "point" (point) + "mode" (substring mode 0 (min 128 (length mode))) + "modeTruncated" (if (> (length mode) 128) t :false) + "modified" (if (buffer-modified-p) t :false) + "readOnly" (if buffer-read-only t :false))))) + +(defun neomacs-mcp--buffer-list (arguments) + "Return a page of buffer metadata for ARGUMENTS. +OFFSET counts `buffer-list' entries, including skipped ones. Internal, +hidden and overlong names are skipped, so a page can be empty." + (neomacs-mcp--instance arguments) + (let* ((offset (neomacs-mcp--integer arguments "offset" 0 most-positive-fixnum)) + (limit (neomacs-mcp--integer arguments "limit" 1 32)) + (remaining (nthcdr offset (buffer-list))) + (scanned 0) (entries nil) (full nil) + (result (neomacs-mcp--object + "instance" (gethash "instance" arguments) "offset" offset + "buffers" [] "scanned" 0 "truncated" :false "nextOffset" :null + "encodedOutputLimit" neomacs-mcp-buffer-output-limit))) + (while (and remaining (not full) (< (length entries) limit) + (< scanned neomacs-mcp-buffer-scan-limit)) + (let* ((buffer (car remaining)) (name (buffer-name buffer)) + (entry (and (buffer-live-p buffer) name + (> (length name) 0) (not (eq (aref name 0) ?\s)) + (<= (length name) neomacs-mcp--buffer-name-limit) + (not (neomacs-mcp--buffer-hidden-p buffer)) + (neomacs-mcp--buffer-entry buffer)))) + (when entry + ;; Measure with the final pagination fields before accepting it. + (puthash "buffers" (vconcat (reverse (cons entry entries))) result) + (puthash "scanned" (1+ scanned) result) + (puthash "nextOffset" (+ offset scanned 1) result) + (puthash "truncated" t result) + (if (> (neomacs-mcp--result-bytes result) neomacs-mcp-buffer-output-limit) + (setq full t) + (push entry entries))) + (unless full + (setq remaining (cdr remaining)) + (cl-incf scanned)))) + (puthash "buffers" (vconcat (reverse entries)) result) + (puthash "scanned" scanned result) + (puthash "truncated" (if remaining t :false) result) + (puthash "nextOffset" (if remaining (+ offset scanned) :null) result) + (when (or (and full (= scanned 0)) + (> (neomacs-mcp--result-bytes result) neomacs-mcp-buffer-output-limit)) + (user-error "Buffer metadata exceeds the output limit")) + result)) + +(defun neomacs-mcp--buffer-read (arguments) + "Return a range of text from the buffer named in ARGUMENTS. +Positions are widened, 1-based and end-exclusive. Preserve the +current buffer, point and narrowing. When EXPECTEDTICK is supplied, +refuse unless it equals the buffer's modification tick." + (neomacs-mcp--instance arguments) + (let* ((name (gethash "name" arguments)) + (count (neomacs-mcp--integer arguments "maxChars" 1 4096)) + (expected (gethash "expectedTick" arguments :absent)) + (buffer (and (stringp name) (> (length name) 0) + (<= (length name) neomacs-mcp--buffer-name-limit) + (get-buffer name)))) + (unless (and (buffer-live-p buffer) (not (neomacs-mcp--buffer-hidden-p buffer))) + (user-error "Named buffer is unavailable")) + (unless (or (eq expected :absent) (and (integerp expected) (>= expected 0))) + (user-error "Invalid expected modification tick")) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (let* ((tick (buffer-modified-tick)) + (start (neomacs-mcp--integer arguments "start" 1 (point-max))) + (end (min (point-max) (+ start count))) + (result (neomacs-mcp--object + "instance" (gethash "instance" arguments) "name" (buffer-name) + "tick" tick "start" start "end" end "text" "" + "truncated" :false "nextStart" :null + "encodedOutputLimit" neomacs-mcp-buffer-output-limit))) + (unless (or (eq expected :absent) (= expected tick)) + (user-error "Buffer modification tick is stale")) + ;; Halve the range until the encoded result fits. + (while + (progn + (puthash "text" (buffer-substring-no-properties start end) result) + (puthash "end" end result) + (puthash "truncated" (if (< end (point-max)) t :false) result) + (puthash "nextStart" (if (< end (point-max)) end :null) result) + (> (neomacs-mcp--result-bytes result) neomacs-mcp-buffer-output-limit)) + (when (= end start) + (user-error "Read metadata exceeds the output limit")) + (setq end (+ start (/ (- end start) 2)))) + (when (and (= end start) (< start (point-max))) + (user-error "No character fits in the output limit")) + result)))))) + +;;;; Protocol + +(defun neomacs-mcp--tool-list () + "Return sorted descriptors for the available tools." + (vconcat + (mapcar (lambda (entry) + (let* ((tool (cdr entry)) + (object (neomacs-mcp--object + "name" (car entry) "description" (plist-get tool :description) + "inputSchema" (plist-get tool :schema)))) + (when (plist-get tool :annotations) + (puthash "annotations" (plist-get tool :annotations) object)) + object)) + (sort (copy-sequence (neomacs-mcp--available-tools)) + (lambda (a b) (string-lessp (car a) (car b))))))) + +(defun neomacs-mcp--call (params modern) + "Call the tool named by PARAMS and return the MODERN or legacy envelope." + (let* ((tool (alist-get (gethash "name" params) (neomacs-mcp--available-tools) + nil nil #'equal)) + (arguments (gethash "arguments" params (neomacs-mcp--object)))) + (unless tool (neomacs-mcp--fail -32602 "Unknown tool")) + (let* ((failed nil) + (value (condition-case failure + (progn + (neomacs-mcp--arguments (plist-get tool :schema) arguments) + (with-local-quit (funcall (plist-get tool :handler) arguments))) + (neomacs-mcp-protocol-error + (setq failed t) + (nth 2 failure)) + ((error quit) + (setq failed t) + (error-message-string failure)))) + (text (if (stringp value) value + (decode-coding-string + (json-serialize value :false-object :false :null-object :null) + 'utf-8))) + (result (neomacs-mcp--object + "content" (vector (neomacs-mcp--object "type" "text" "text" text)) + "isError" (if failed t :false)))) + (when modern (puthash "resultType" "complete" result)) + result))) + +(defun neomacs-mcp--modern-p (params) + "Validate per-request protocol metadata in PARAMS and return non-nil." + (let* ((meta (gethash "_meta" params)) + (version (and (hash-table-p meta) + (gethash "io.modelcontextprotocol/protocolVersion" meta)))) + (unless (and (stringp version) + (hash-table-p (gethash "io.modelcontextprotocol/clientCapabilities" meta))) + (neomacs-mcp--fail -32602 "Required protocol metadata is missing")) + (unless (equal version neomacs-mcp--modern) + (neomacs-mcp--fail -32022 "Unsupported protocol version" + (neomacs-mcp--object + "supported" (vconcat (list neomacs-mcp--modern) + neomacs-mcp--legacy-versions) + "requested" version))) + t)) + +(defun neomacs-mcp--dispatch (peer message) + "Dispatch MESSAGE from PEER outside process filters." + (let* ((method (gethash "method" message)) + (params (gethash "params" message (neomacs-mcp--object))) + (meta (gethash "_meta" params)) + ;; Progress tokens and extension metadata do not select an era. + (modern (and (not (equal method "initialize")) + (or (and (hash-table-p meta) + (cl-some + (lambda (key) (not (eq (gethash key meta :absent) :absent))) + '("io.modelcontextprotocol/protocolVersion" + "io.modelcontextprotocol/clientCapabilities" + "io.modelcontextprotocol/clientInfo"))) + (not (process-get peer 'legacy))) + (neomacs-mcp--modern-p params)))) + (pcase method + ("initialize" + (let ((version (gethash "protocolVersion" params))) + (unless (and (stringp version) (> (length version) 0) + (hash-table-p (gethash "capabilities" params)) + (hash-table-p (gethash "clientInfo" params)) + (not (process-get peer 'legacy))) + (neomacs-mcp--fail -32602 "Expected fresh initialization")) + (process-put peer 'legacy 'initializing) + ;; Echo a supported offer; otherwise propose the newest one. + (neomacs-mcp--object + "protocolVersion" (if (member version neomacs-mcp--legacy-versions) + version neomacs-mcp--legacy) + "capabilities" (neomacs-mcp--object "tools" (neomacs-mcp--object)) + "serverInfo" (neomacs-mcp--object "name" "Neomacs" "version" "1")))) + ("notifications/initialized" + (unless (eq (process-get peer 'legacy) 'initializing) + (neomacs-mcp--fail -32600 "Unexpected initialized notification")) + (process-put peer 'legacy 'ready) nil) + (_ + (unless (or modern (eq (process-get peer 'legacy) 'ready) + (and (equal method "ping") (process-get peer 'legacy))) + (neomacs-mcp--fail -32600 "Initialization is incomplete")) + (pcase method + ("ping" (if modern (neomacs-mcp--object "resultType" "complete") + (neomacs-mcp--object))) + ("server/discover" + (unless modern (neomacs-mcp--fail -32601 "Method not found")) + (neomacs-mcp--object + "resultType" "complete" "supportedVersions" + (vconcat (list neomacs-mcp--modern) neomacs-mcp--legacy-versions) + "capabilities" (neomacs-mcp--object "tools" (neomacs-mcp--object)) + "_meta" (neomacs-mcp--object "io.modelcontextprotocol/serverInfo" + (neomacs-mcp--object "name" "Neomacs" "version" "1")) + "ttlMs" 0 "cacheScope" "private")) + ("tools/list" + (when (gethash "cursor" params) + (neomacs-mcp--fail -32602 "No pagination cursor is supported")) + (let ((result (neomacs-mcp--object "tools" (neomacs-mcp--tool-list)))) + (when modern + (puthash "resultType" "complete" result) + (puthash "ttlMs" 0 result) (puthash "cacheScope" "private" result)) + result)) + ("tools/call" (neomacs-mcp--call params modern)) + (_ (neomacs-mcp--fail -32601 "Method not found"))))))) + +;;;; Transport and scheduling + +(defun neomacs-mcp--live-p (peer generation) + "Return non-nil if PEER still belongs to endpoint GENERATION." + (and (= generation neomacs-mcp--generation) + (memq peer neomacs-mcp--peers) (process-live-p peer))) + +(defun neomacs-mcp--close (peer) + "Close PEER and drop its queued requests and send timer." + (setq neomacs-mcp--peers (delq peer neomacs-mcp--peers) + neomacs-mcp--queue + (cl-remove peer neomacs-mcp--queue :key (lambda (request) (plist-get request :peer)))) + (when-let* ((timer (process-get peer 'send-timer))) + (cancel-timer timer) (process-put peer 'send-timer nil)) + (when (and neomacs-mcp--active (eq peer (plist-get neomacs-mcp--active :peer))) + (setf (plist-get neomacs-mcp--active :cancelled) t)) + (when (process-live-p peer) (delete-process peer))) + +(defun neomacs-mcp--sentinel (peer _event) + "Close PEER once its connection is gone." + (unless (process-live-p peer) (neomacs-mcp--close peer))) + +(defun neomacs-mcp--wire (response) + "Return RESPONSE as one line of JSON. +If RESPONSE cannot be encoded, for example because it contains raw +bytes, or exceeds the output limit, return an error for its ID instead." + (let* ((json (condition-case nil + (json-serialize response :false-object :false :null-object :null) + (error nil))) + (message (cond ((null json) "Response cannot be encoded as JSON") + ((>= (string-bytes json) neomacs-mcp--output-limit) + "Response exceeds the output limit")))) + (concat (if message + (json-serialize + (neomacs-mcp--object + "jsonrpc" "2.0" "id" (gethash "id" response :null) + "error" (neomacs-mcp--object "code" -32603 "message" message))) + json) + "\n"))) + +(defun neomacs-mcp--send (request response) + "Send RESPONSE to the client of REQUEST unless it was abandoned. +A response over the output limit is replaced by an error. Close the +client if the send does not return within `neomacs-mcp-send-timeout' +seconds." + (let* ((peer (plist-get request :peer)) + (generation (plist-get request :generation)) + (wire (neomacs-mcp--wire response))) + (when (and (not (plist-get request :cancelled)) (neomacs-mcp--live-p peer generation)) + (let ((timer (run-at-time + neomacs-mcp-send-timeout nil + (lambda () + (when (neomacs-mcp--live-p peer generation) + (neomacs-mcp--close peer)))))) + (process-put peer 'send-timer timer) + (unwind-protect + (condition-case nil + (process-send-string peer wire) + (error (neomacs-mcp--close peer))) + (cancel-timer timer) + (when (eq timer (process-get peer 'send-timer)) + (process-put peer 'send-timer nil))))))) + +(defun neomacs-mcp--schedule () + "Schedule a queue drain unless one is already pending or running." + (when (and neomacs-mcp--queue (not neomacs-mcp--active) (not neomacs-mcp--timer)) + (setq neomacs-mcp--timer (run-at-time 0.01 nil #'neomacs-mcp--drain)))) + +(defun neomacs-mcp--drain () + "Run at most one queued request, unless user input is pending. +Before that, drop at most `neomacs-mcp--scan-limit' abandoned requests." + (setq neomacs-mcp--timer nil) + (unless neomacs-mcp--active + ;; Guard against reentry from input polling and from the handler. + (setq neomacs-mcp--active (list :admission t)) + (unwind-protect + (unless (input-pending-p nil) + (let ((scanned 0)) + (while (and neomacs-mcp--queue (< scanned neomacs-mcp--scan-limit) + (let ((request (car neomacs-mcp--queue))) + (or (plist-get request :cancelled) + (not (neomacs-mcp--live-p + (plist-get request :peer) + (plist-get request :generation)))))) + (pop neomacs-mcp--queue) + (cl-incf scanned)) + (when (and neomacs-mcp--queue (< scanned neomacs-mcp--scan-limit)) + (let* ((request (pop neomacs-mcp--queue)) + (peer (plist-get request :peer)) + (message (plist-get request :message)) + (id (and message (gethash "id" message :notification))) + (response nil)) + (setq neomacs-mcp--active request) + (condition-case failure + (if (plist-get request :error) + (signal 'neomacs-mcp-protocol-error (plist-get request :error)) + (setq response (neomacs-mcp--object + "jsonrpc" "2.0" "id" id "result" + (neomacs-mcp--dispatch peer message)))) + (neomacs-mcp-protocol-error + (setq response + (neomacs-mcp--object + "jsonrpc" "2.0" "id" (if (eq id :notification) :null (or id :null)) + "error" (neomacs-mcp--object "code" (nth 1 failure) + "message" (nth 2 failure)))) + (when (nth 3 failure) + (puthash "data" (nth 3 failure) (gethash "error" response)))) + ((error quit) + (setq response (neomacs-mcp--object + "jsonrpc" "2.0" "id" (or id :null) "error" + (neomacs-mcp--object "code" -32603 + "message" "Internal error"))))) + (unless (eq id :notification) (neomacs-mcp--send request response)))))) + (setq neomacs-mcp--active nil) + (neomacs-mcp--schedule)))) + +(defun neomacs-mcp--enqueue (peer message &optional failure) + "Queue MESSAGE or framing FAILURE from PEER, closing PEER on overflow." + (if (or (>= (length neomacs-mcp--queue) neomacs-mcp--queue-limit) + (>= (cl-count peer neomacs-mcp--queue :key (lambda (r) (plist-get r :peer))) + neomacs-mcp--peer-queue-limit)) + (neomacs-mcp--close peer) + (setq neomacs-mcp--queue + (nconc neomacs-mcp--queue + (list (list :peer peer :generation neomacs-mcp--generation + :message message :error failure :cancelled nil)))) + (neomacs-mcp--schedule))) + +(defun neomacs-mcp--cancel (peer id) + "Mark the queued or running request ID from PEER as abandoned." + (dolist (request (cons neomacs-mcp--active neomacs-mcp--queue)) + (when (and request (eq peer (plist-get request :peer)) + (hash-table-p (plist-get request :message)) + (equal id (gethash "id" (plist-get request :message) :absent))) + (setf (plist-get request :cancelled) t)))) + +(defun neomacs-mcp--frame (peer line) + "Parse LINE from PEER, then queue it or record a cancellation." + (condition-case nil + (let* ((decoded (decode-coding-string line 'utf-8)) + (_valid-utf8 + (unless (equal line (encode-coding-string decoded 'utf-8)) + (error "Invalid UTF-8"))) + (message (json-parse-string decoded :object-type 'hash-table :array-type 'array + :null-object :null :false-object :false)) + (id (and (hash-table-p message) (gethash "id" message :absent))) + (method (and (hash-table-p message) (gethash "method" message))) + (params (and (hash-table-p message) + (gethash "params" message (neomacs-mcp--object))))) + (cond + ((not (and (hash-table-p message) (equal (gethash "jsonrpc" message) "2.0") + (stringp method) (hash-table-p params) + (or (eq id :absent) (stringp id) (integerp id)))) + (neomacs-mcp--enqueue + peer (and (or (stringp id) (integerp id)) (neomacs-mcp--object "id" id)) + '(-32600 "Invalid request"))) + ((and (eq id :absent) (equal method "notifications/cancelled")) + (neomacs-mcp--cancel peer (gethash "requestId" params :absent))) + ((and (eq id :absent) (not (equal method "notifications/initialized"))) + nil) + ((and (not (eq id :absent)) (string-prefix-p "notifications/" method)) + (neomacs-mcp--enqueue peer message '(-32600 "Notification must not have an ID"))) + ((and (not (eq id :absent)) + (cl-some (lambda (r) + (and r (eq peer (plist-get r :peer)) + (hash-table-p (plist-get r :message)) + (equal id (gethash "id" (plist-get r :message) :absent)))) + (cons neomacs-mcp--active neomacs-mcp--queue))) + ;; Reusing an outstanding request ID closes the connection. + (neomacs-mcp--close peer)) + (t (neomacs-mcp--enqueue peer message)))) + (error (neomacs-mcp--enqueue peer nil '(-32700 "Parse error"))))) + +(defun neomacs-mcp--filter (peer chunk) + "Split CHUNK from PEER into lines and queue them; never run a tool here." + (when (neomacs-mcp--live-p peer (process-get peer 'generation)) + (let ((text (concat (process-get peer 'input) chunk)) (frames 0)) + (if (> (string-bytes text) neomacs-mcp--frame-limit) + (neomacs-mcp--close peer) + (while (and (process-live-p peer) (string-match "\n" text) + (< frames neomacs-mcp--peer-queue-limit)) + (let ((end (match-beginning 0))) + (neomacs-mcp--frame peer (substring text 0 end)) + (setq text (substring text (1+ end)) frames (1+ frames)))) + (if (string-match-p "\n" text) (neomacs-mcp--close peer) + (process-put peer 'input text)))))) + +(defun neomacs-mcp--accept (listener peer _message) + "Accept PEER on LISTENER unless the connection limit is reached." + (if (or (not (eq listener neomacs-mcp--listener)) + (>= (length neomacs-mcp--peers) neomacs-mcp--peer-limit)) + (delete-process peer) + (push peer neomacs-mcp--peers) + (process-put peer 'generation neomacs-mcp--generation) + (process-put peer 'input (encode-coding-string "" 'no-conversion)) + (set-process-query-on-exit-flag peer nil) + (set-process-coding-system peer 'no-conversion 'no-conversion) + (set-process-filter peer #'neomacs-mcp--filter) + (set-process-sentinel peer #'neomacs-mcp--sentinel))) + +(defun neomacs-mcp--socket-id (socket) + "Return the inode and device of SOCKET, or nil if it does not exist." + (when-let* ((attributes (file-attributes socket 'integer))) + (list (file-attribute-inode-number attributes) + (file-attribute-device-number attributes)))) + +;;;###autoload +(defun neomacs-mcp-start (socket) + "Start the MCP endpoint on the Unix socket SOCKET. +SOCKET must be an absolute local file name in a directory that is owned +by the user and not accessible to others, as for `server-start'. An +existing file at SOCKET is never replaced." + (interactive "FMCP socket: ") + (unless (and (stringp socket) (file-name-absolute-p socket) + (not (file-remote-p socket))) + (user-error "MCP requires an absolute local socket file name")) + (when neomacs-mcp--listener (user-error "MCP endpoint is already started")) + (server-ensure-safe-dir (file-name-directory socket)) + (when (or (file-exists-p socket) (file-symlink-p socket)) + (user-error "MCP socket already exists: %s" socket)) + (cl-incf neomacs-mcp--generation) + (let ((listener (make-network-process + :name "neomacs-mcp" :family 'local :service socket + :server t :noquery t :coding 'no-conversion + :log #'neomacs-mcp--accept))) + (setq neomacs-mcp--listener listener neomacs-mcp--socket socket + neomacs-mcp--socket-identity (neomacs-mcp--socket-id socket)) + (add-hook 'kill-emacs-hook #'neomacs-mcp-stop) + (neomacs-mcp-identity))) + +;;;###autoload +(defun neomacs-mcp-stop () + "Stop the MCP endpoint, close its connections and remove its socket. +A file that replaced the socket is left alone." + (interactive) + (cl-incf neomacs-mcp--generation) + (when neomacs-mcp--timer (cancel-timer neomacs-mcp--timer)) + (setq neomacs-mcp--timer nil neomacs-mcp--queue nil) + (mapc #'neomacs-mcp--close (copy-sequence neomacs-mcp--peers)) + (when (process-live-p neomacs-mcp--listener) (delete-process neomacs-mcp--listener)) + (when (and neomacs-mcp--socket + (equal (neomacs-mcp--socket-id neomacs-mcp--socket) neomacs-mcp--socket-identity) + (file-exists-p neomacs-mcp--socket)) + (delete-file neomacs-mcp--socket)) + (setq neomacs-mcp--listener nil neomacs-mcp--socket nil neomacs-mcp--socket-identity nil) + (remove-hook 'kill-emacs-hook #'neomacs-mcp-stop)) + +;;;; Built-in tools + +(neomacs-mcp-register-tool + "neomacs_identity" "Return this editor's instance, PID and runtime. Pass instance to other tools." + (neomacs-mcp--schema nil nil) (lambda (_) (neomacs-mcp-identity)) + (neomacs-mcp--object "readOnlyHint" t)) + +(neomacs-mcp-register-tool + "neomacs_eval" + "Evaluate Emacs Lisp forms in the running editor and return the printed value. Full access: no sandbox, effects are not rolled back." + (neomacs-mcp--schema '(("instance" . "string") ("code" . "string")) '("instance" "code")) + #'neomacs-mcp--eval) + +(let* ((instance '("instance" . "string")) + (list-schema (neomacs-mcp--schema + (list instance '("offset" . "integer") '("limit" . "integer")) + '("instance" "offset" "limit"))) + (read-schema (neomacs-mcp--schema + (list instance '("name" . "string") '("start" . "integer") + '("maxChars" . "integer") '("expectedTick" . "integer")) + '("instance" "name" "start" "maxChars")))) + (dolist (spec (list (list list-schema "offset" 0 most-positive-fixnum) + (list list-schema "limit" 1 32) + (list read-schema "start" 1 most-positive-fixnum) + (list read-schema "maxChars" 1 4096) + (list read-schema "expectedTick" 0 most-positive-fixnum))) + (let ((property (gethash (nth 1 spec) (gethash "properties" (car spec))))) + (puthash "minimum" (nth 2 spec) property) + (when (< (nth 3 spec) most-positive-fixnum) + (puthash "maximum" (nth 3 spec) property)))) + (puthash "maxLength" neomacs-mcp--buffer-name-limit + (gethash "name" (gethash "properties" read-schema))) + (neomacs-mcp-register-tool + "neomacs_buffer_list" + "List buffer names and metadata, a page at a time. Names are not stable handles." + list-schema #'neomacs-mcp--buffer-list (neomacs-mcp--object "readOnlyHint" t)) + (neomacs-mcp-register-tool + "neomacs_buffer_read" + "Read text from a named buffer in widened 1-based character positions; optional expectedTick." + read-schema #'neomacs-mcp--buffer-read (neomacs-mcp--object "readOnlyHint" t))) + +(provide 'neomacs-mcp) +;;; neomacs-mcp.el ends here diff --git a/test/neomacs/neomacs-mcp-test.el b/test/neomacs/neomacs-mcp-test.el new file mode 100644 index 0000000000..2eec4dfcf3 --- /dev/null +++ b/test/neomacs/neomacs-mcp-test.el @@ -0,0 +1,673 @@ +;;; neomacs-mcp-test.el --- Tests for neomacs-mcp.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Run with Neomacs or GNU Emacs from the repository root: +;; +;; neomacs -Q --batch -L lisp -l test/neomacs/neomacs-mcp-test.el \ +;; -f ert-run-tests-batch-and-exit +;; +;; Set NEOMACS_MCP_RELAY to a built `neomacs-mcp' relay to also run the +;; stdio relay round trip. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'neomacs-mcp) + +(defvar neomacs-mcp-test-effect nil) + +;;;; Helpers + +(defun neomacs-mcp-test--instance () + (gethash "instance" (neomacs-mcp-identity))) + +(defun neomacs-mcp-test--args (&rest pairs) + "Return tool arguments with the current instance and PAIRS." + (apply #'neomacs-mcp--object "instance" (neomacs-mcp-test--instance) pairs)) + +(defun neomacs-mcp-test--request (peer id &optional generation) + "Return a queued request for PEER and ID, built by the real constructor." + (let ((neomacs-mcp--queue nil) + (neomacs-mcp--generation (or generation neomacs-mcp--generation))) + (cl-letf (((symbol-function 'neomacs-mcp--schedule) #'ignore)) + (neomacs-mcp--enqueue peer (neomacs-mcp--object "id" id "method" "fixture"))) + (car neomacs-mcp--queue))) + +(defmacro neomacs-mcp-test--with-peer (&rest body) + "Run BODY with `peer' bound to a live process for process properties." + (declare (indent 0) (debug t)) + `(let ((peer (make-pipe-process :name "neomacs-mcp-test-peer" :noquery t))) + (unwind-protect (progn ,@body) + (delete-process peer)))) + +(defun neomacs-mcp-test--initialize (peer version) + (neomacs-mcp--dispatch + peer (neomacs-mcp--object + "method" "initialize" "params" + (neomacs-mcp--object "protocolVersion" version + "capabilities" (neomacs-mcp--object) + "clientInfo" (neomacs-mcp--object "name" "test" + "version" "1"))))) + +(defun neomacs-mcp-test--modern-params (&rest pairs) + (apply #'neomacs-mcp--object + "_meta" (neomacs-mcp--object + "io.modelcontextprotocol/protocolVersion" neomacs-mcp--modern + "io.modelcontextprotocol/clientCapabilities" (neomacs-mcp--object)) + pairs)) + +(defun neomacs-mcp-test--tool-names (result) + (mapcar (lambda (tool) (gethash "name" tool)) (gethash "tools" result))) + +;;;; Tools and registry + +(ert-deftest neomacs-mcp-test-default-tools () + (let ((neomacs-mcp-full-access t)) + (should (equal '("neomacs_buffer_list" "neomacs_buffer_read" + "neomacs_eval" "neomacs_identity") + (neomacs-mcp-test--tool-names + (neomacs-mcp--object "tools" (neomacs-mcp--tool-list))))) + (should (gethash "readOnlyHint" + (plist-get (alist-get "neomacs_buffer_read" neomacs-mcp-tools + nil nil #'equal) + :annotations))) + (should-not (plist-get (alist-get "neomacs_eval" neomacs-mcp-tools nil nil #'equal) + :annotations)))) + +(ert-deftest neomacs-mcp-test-full-access-default-and-off () + (should (eq t (default-value 'neomacs-mcp-full-access))) + (should (custom-variable-p 'neomacs-mcp-full-access)) + (neomacs-mcp-test--with-peer + (process-put peer 'legacy 'ready) + (let ((neomacs-mcp-full-access nil) + (neomacs-mcp-test-effect nil)) + (let ((names (neomacs-mcp-test--tool-names + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "tools/list"))))) + (should-not (member "neomacs_eval" names)) + (should (member "neomacs_identity" names)) + (should (member "neomacs_buffer_read" names))) + (let ((failure + (should-error + (neomacs-mcp--dispatch + peer (neomacs-mcp--object + "method" "tools/call" "params" + (neomacs-mcp--object + "name" "neomacs_eval" "arguments" + (neomacs-mcp-test--args "code" "(setq neomacs-mcp-test-effect t)")))) + :type 'neomacs-mcp-protocol-error))) + (should (= -32602 (nth 1 failure)))) + (should-not neomacs-mcp-test-effect)) + (let ((neomacs-mcp-full-access t)) + (should (member "neomacs_eval" + (neomacs-mcp-test--tool-names + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "tools/list")))))))) + +(ert-deftest neomacs-mcp-test-instance-checked-before-eval () + (let ((neomacs-mcp-test-effect nil)) + (should-error + (neomacs-mcp--eval + (neomacs-mcp--object "instance" "wrong" + "code" "(setq neomacs-mcp-test-effect t)"))) + (should-not neomacs-mcp-test-effect))) + +(ert-deftest neomacs-mcp-test-eval-all-forms-and-unicode () + (should (equal "\"Ελληνικά\\n42\"" + (neomacs-mcp--eval + (neomacs-mcp-test--args + "code" "(setq neomacs-mcp-test-effect 42) (format \"Ελληνικά\\n%s\" neomacs-mcp-test-effect)"))))) + +(ert-deftest neomacs-mcp-test-eval-rejects-unbalanced-code () + (let ((neomacs-mcp-test-effect nil)) + (should-error + (neomacs-mcp--eval + (neomacs-mcp-test--args "code" ") (setq neomacs-mcp-test-effect t)"))) + (should-not neomacs-mcp-test-effect))) + +(ert-deftest neomacs-mcp-test-registry-validation () + (let ((neomacs-mcp-tools (copy-sequence neomacs-mcp-tools))) + (should-error (neomacs-mcp-register-tool "" "Bad" (neomacs-mcp--schema nil nil) #'ignore)) + (should-error (neomacs-mcp-register-tool "bad" "Bad" (neomacs-mcp--object "type" "object") nil)) + (neomacs-mcp-register-tool "x" "One" (neomacs-mcp--schema nil nil) #'ignore) + (neomacs-mcp-register-tool "x" "Two" (neomacs-mcp--schema nil nil) #'ignore) + (should (= 1 (cl-count "x" neomacs-mcp-tools :key #'car :test #'equal))) + (should (equal "Two" (plist-get (alist-get "x" neomacs-mcp-tools nil nil #'equal) + :description))))) + +(ert-deftest neomacs-mcp-test-argument-validation () + (let ((schema (neomacs-mcp--schema '(("code" . "string")) '("code")))) + (should-error (neomacs-mcp--arguments schema (neomacs-mcp--object "code" 7))) + (should-error (neomacs-mcp--arguments schema (neomacs-mcp--object))) + (should-error (neomacs-mcp--arguments schema (neomacs-mcp--object "code" "ok" "extra" 1))))) + +(ert-deftest neomacs-mcp-test-nested-json-unicode () + (let ((neomacs-mcp-tools nil)) + (neomacs-mcp-register-tool + "unicode" "Fixture" (neomacs-mcp--schema nil nil) + (lambda (_) (neomacs-mcp--object "text" "Ελλάδα\n"))) + (let ((result (neomacs-mcp--call (neomacs-mcp--object "name" "unicode") t))) + (should (equal "Ελλάδα\n" + (gethash "text" (json-parse-string + (gethash "text" (aref (gethash "content" result) 0))))))))) + +(ert-deftest neomacs-mcp-test-tool-error-is-result () + (let ((neomacs-mcp-tools nil)) + (neomacs-mcp-register-tool "boom" "Fixture" (neomacs-mcp--schema nil nil) + (lambda (_) (error "Boom"))) + (neomacs-mcp-register-tool "typed" "Fixture" + (neomacs-mcp--schema '(("n" . "integer")) '("n")) + (lambda (_) (ert-fail "Ran with invalid arguments"))) + (let ((result (neomacs-mcp--call (neomacs-mcp--object "name" "boom") nil))) + (should (eq t (gethash "isError" result))) + (should (equal "Boom" (gethash "text" (aref (gethash "content" result) 0))))) + ;; Invalid arguments are a tool execution error, not a protocol error. + (let ((result (neomacs-mcp--call + (neomacs-mcp--object "name" "typed" "arguments" + (neomacs-mcp--object "n" "x")) + nil))) + (should (eq t (gethash "isError" result))) + (should (equal "Wrong argument type: n" + (gethash "text" (aref (gethash "content" result) 0))))) + (should-error (neomacs-mcp--call (neomacs-mcp--object "name" "absent") nil) + :type 'neomacs-mcp-protocol-error))) + +;;;; Protocol versions + +(ert-deftest neomacs-mcp-test-supported-handshake-versions () + (dolist (version '("2025-06-18" "2025-11-25")) + (neomacs-mcp-test--with-peer + (let ((result (neomacs-mcp-test--initialize peer version))) + (should (equal version (gethash "protocolVersion" result))) + (should (hash-table-p (gethash "tools" (gethash "capabilities" result)))) + (should-not (gethash "resultType" result)) + (should (eq 'initializing (process-get peer 'legacy))))))) + +(ert-deftest neomacs-mcp-test-unsupported-handshake-counterproposal () + (dolist (version '("2024-11-05" "1900-01-01" "2026-07-28")) + (neomacs-mcp-test--with-peer + (should (equal "2025-11-25" + (gethash "protocolVersion" + (neomacs-mcp-test--initialize peer version))))))) + +(ert-deftest neomacs-mcp-test-malformed-initialize () + (dolist (params + (list (neomacs-mcp--object "protocolVersion" "" + "capabilities" (neomacs-mcp--object) + "clientInfo" (neomacs-mcp--object)) + (neomacs-mcp--object "protocolVersion" 20250618 + "capabilities" (neomacs-mcp--object) + "clientInfo" (neomacs-mcp--object)) + (neomacs-mcp--object "protocolVersion" "2025-06-18" + "capabilities" :null + "clientInfo" (neomacs-mcp--object)) + (neomacs-mcp--object))) + (neomacs-mcp-test--with-peer + (let ((failure + (should-error + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "initialize" "params" params)) + :type 'neomacs-mcp-protocol-error))) + (should (= -32602 (nth 1 failure))) + (should-not (process-get peer 'legacy)) + ;; A malformed offer does not prevent a later valid handshake. + (should (equal "2025-06-18" + (gethash "protocolVersion" + (neomacs-mcp-test--initialize peer "2025-06-18")))))))) + +(ert-deftest neomacs-mcp-test-handshake-readiness () + (neomacs-mcp-test--with-peer + (should-error + (neomacs-mcp--dispatch peer (neomacs-mcp--object "method" "notifications/initialized")) + :type 'neomacs-mcp-protocol-error) + (neomacs-mcp-test--initialize peer "2025-06-18") + (should (= -32600 (nth 1 (should-error + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "tools/list")) + :type 'neomacs-mcp-protocol-error)))) + ;; Ping is allowed while initialization is in progress. + (should (= 0 (hash-table-count + (neomacs-mcp--dispatch peer (neomacs-mcp--object "method" "ping"))))) + (should-error (neomacs-mcp-test--initialize peer "2025-06-18") + :type 'neomacs-mcp-protocol-error) + (neomacs-mcp--dispatch peer (neomacs-mcp--object "method" "notifications/initialized")) + (should (eq 'ready (process-get peer 'legacy))) + (should (= 0 (hash-table-count + (neomacs-mcp--dispatch peer (neomacs-mcp--object "method" "ping"))))))) + +(ert-deftest neomacs-mcp-test-legacy-metadata-keeps-era () + (neomacs-mcp-test--with-peer + (process-put peer 'legacy 'ready) + (dolist (meta (list (neomacs-mcp--object) + (neomacs-mcp--object "progressToken" "token") + (neomacs-mcp--object "example.com/context" "fixture"))) + (should (= 0 (hash-table-count + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "ping" "params" + (neomacs-mcp--object "_meta" meta))))))) + (dolist (key '("io.modelcontextprotocol/protocolVersion" + "io.modelcontextprotocol/clientCapabilities" + "io.modelcontextprotocol/clientInfo")) + (should-error + (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "ping" "params" + (neomacs-mcp--object + "_meta" (neomacs-mcp--object key :null)))) + :type 'neomacs-mcp-protocol-error)))) + +(ert-deftest neomacs-mcp-test-modern-requests () + (neomacs-mcp-test--with-peer + (let ((discover (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "server/discover" + "params" (neomacs-mcp-test--modern-params)))) + (ping (neomacs-mcp--dispatch + peer (neomacs-mcp--object "method" "ping" + "params" (neomacs-mcp-test--modern-params))))) + (should (equal ["2026-07-28" "2025-11-25" "2025-06-18"] + (gethash "supportedVersions" discover))) + (should (equal "complete" (gethash "resultType" discover))) + (should (equal "complete" (gethash "resultType" ping))) + (should-not (process-get peer 'legacy))) + (let* ((failure + (should-error + (neomacs-mcp--modern-p + (neomacs-mcp--object + "_meta" (neomacs-mcp--object + "io.modelcontextprotocol/protocolVersion" "1900-01-01" + "io.modelcontextprotocol/clientCapabilities" (neomacs-mcp--object)))) + :type 'neomacs-mcp-protocol-error)) + (data (nth 3 failure))) + (should (= -32022 (nth 1 failure))) + (should (equal "1900-01-01" (gethash "requested" data)))))) + +;;;; Framing and scheduling + +(ert-deftest neomacs-mcp-test-filter-never-runs-tools () + (let ((calls nil)) + (cl-letf (((symbol-function 'neomacs-mcp--enqueue) + (lambda (_peer message &optional failure) (push (or failure message) calls))) + ((symbol-function 'neomacs-mcp--dispatch) + (lambda (&rest _) (ert-fail "Filter ran a tool")))) + (neomacs-mcp--frame nil (encode-coding-string + "{\"jsonrpc\":\"2.0\",\"id\":7,\"method\":\"tools/list\"}" 'utf-8)) + (neomacs-mcp--frame nil "{bad}") + ;; An invalid request keeps a readable ID for its error reply. + (neomacs-mcp--frame nil "{\"jsonrpc\":\"2.0\",\"id\":5}") + ;; Notifications other than initialized are ignored. + (neomacs-mcp--frame nil "{\"jsonrpc\":\"2.0\",\"method\":\"tools/call\",\"params\":{}}") + (should (= 3 (length calls))) + (should (equal '(-32600 "Invalid request") (car calls))) + (should (= -32700 (car (nth 1 calls))))))) + +(ert-deftest neomacs-mcp-test-drain-one-request-and-reentry-guard () + (let* ((neomacs-mcp--active nil) (neomacs-mcp--timer nil) + (neomacs-mcp--queue (mapcar (lambda (id) (neomacs-mcp-test--request 'peer id)) + '(1 2 3))) + (calls 0) (scheduled 0)) + (cl-letf (((symbol-function 'neomacs-mcp--live-p) (lambda (&rest _) t)) + ((symbol-function 'input-pending-p) (lambda (&optional _) nil)) + ((symbol-function 'neomacs-mcp--send) #'ignore) + ((symbol-function 'neomacs-mcp--schedule) (lambda () (cl-incf scheduled))) + ((symbol-function 'neomacs-mcp--dispatch) + (lambda (&rest _) + (cl-incf calls) + (neomacs-mcp--drain) ; Reentry must not run another request. + (neomacs-mcp--object)))) + (neomacs-mcp--drain) + (should (= 1 calls)) + (should (= 2 (length neomacs-mcp--queue))) + (should (= 1 scheduled)) + (should-not neomacs-mcp--active)))) + +(ert-deftest neomacs-mcp-test-pending-input-defers-requests () + (let* ((neomacs-mcp--active nil) (neomacs-mcp--timer nil) + (neomacs-mcp--queue (list (neomacs-mcp-test--request 'a 1))) + (unread-command-events '(?x)) (calls 0) (timers nil)) + (cl-letf (((symbol-function 'run-at-time) + (lambda (&rest args) (push args timers) 'fixture-timer)) + ((symbol-function 'neomacs-mcp--live-p) (lambda (&rest _) t)) + ((symbol-function 'neomacs-mcp--send) #'ignore) + ((symbol-function 'neomacs-mcp--dispatch) + (lambda (&rest _) (cl-incf calls) (neomacs-mcp--object)))) + (neomacs-mcp--drain) + (should (= calls 0)) + (should (equal unread-command-events '(?x))) + (should (equal timers '((0.01 nil neomacs-mcp--drain)))) + (setq unread-command-events nil neomacs-mcp--timer nil) + (neomacs-mcp--drain) + (should (= calls 1)) + (should-not neomacs-mcp--queue)))) + +(ert-deftest neomacs-mcp-test-cancelled-and-stale-requests-skipped () + (let* ((neomacs-mcp--active nil) (neomacs-mcp--timer nil) + (neomacs-mcp--generation 7) (neomacs-mcp--peers '(a b)) + (neomacs-mcp--queue (list (neomacs-mcp-test--request 'a 1) + (neomacs-mcp-test--request 'a 2 6) + (neomacs-mcp-test--request 'dead 3) + (neomacs-mcp-test--request 'b 1))) + (calls nil)) + (cl-letf (((symbol-function 'process-live-p) (lambda (_) t)) + ((symbol-function 'input-pending-p) + (lambda (&optional _) + (neomacs-mcp--frame + 'a "{\"jsonrpc\":\"2.0\",\"method\":\"notifications/cancelled\",\"params\":{\"requestId\":1}}") + nil)) + ((symbol-function 'neomacs-mcp--schedule) #'ignore) + ((symbol-function 'neomacs-mcp--send) #'ignore) + ((symbol-function 'neomacs-mcp--dispatch) + (lambda (peer _) (push peer calls) (neomacs-mcp--object)))) + (neomacs-mcp--drain) + (should (equal calls '(b))) + (should-not neomacs-mcp--queue)))) + +(ert-deftest neomacs-mcp-test-queue-limits () + (let ((neomacs-mcp--queue (make-list neomacs-mcp--peer-queue-limit (list :peer 'peer))) + (closed nil)) + (cl-letf (((symbol-function 'neomacs-mcp--close) (lambda (peer) (setq closed peer)))) + (neomacs-mcp--enqueue 'peer (neomacs-mcp--object)) + (should (eq closed 'peer)) + (should (= neomacs-mcp--peer-queue-limit (length neomacs-mcp--queue)))))) + +;;;; Endpoint lifecycle + +(defmacro neomacs-mcp-test--with-root (&rest body) + "Run BODY with `root' bound to a fresh private directory." + (declare (indent 0) (debug t)) + `(let ((root (make-temp-file "neomacs-mcp-test-" t))) + (unwind-protect (progn (set-file-modes root #o700) ,@body) + (neomacs-mcp-stop) + (delete-directory root t)))) + +(ert-deftest neomacs-mcp-test-start-stop-and-owned-socket () + (neomacs-mcp-test--with-root + (let ((socket (expand-file-name "mcp" root)) + (boot (neomacs-mcp-test--instance))) + (neomacs-mcp-start socket) + (should (file-exists-p socket)) + (should-error (neomacs-mcp-start socket)) + (neomacs-mcp-stop) + (should-not (file-exists-p socket)) + (neomacs-mcp-start socket) + (should (equal boot (neomacs-mcp-test--instance))) + ;; A file that replaced the socket is not removed on stop. + (delete-file socket) + (with-temp-file socket (insert "successor")) + (neomacs-mcp-stop) + (should (file-exists-p socket))))) + +(ert-deftest neomacs-mcp-test-refuse-existing-node-and-unsafe-dir () + (neomacs-mcp-test--with-root + (let ((socket (expand-file-name "mcp" root))) + (with-temp-file socket (insert "not a socket")) + (should-error (neomacs-mcp-start socket)) + (delete-file socket) + (make-symbolic-link (expand-file-name "absent" root) socket) + (should-error (neomacs-mcp-start socket)) + (delete-file socket) + (should-error (neomacs-mcp-start "relative/mcp")) + (set-file-modes root #o777) + (should-error (neomacs-mcp-start socket)) + (should-not neomacs-mcp--listener)))) + +(defun neomacs-mcp-test--exchange (process output messages) + "Send MESSAGES to PROCESS and return the responses parsed from OUTPUT. +OUTPUT is a cons whose car accumulates received text. Notifications +receive no response." + (dolist (message messages) + (process-send-string process (concat (json-serialize message) "\n"))) + (let ((expected (cl-count-if (lambda (m) (gethash "id" m)) messages)) + (deadline (+ (float-time) 10))) + (while (and (< (cl-count ?\n (car output)) expected) + (< (float-time) deadline)) + (accept-process-output nil 0.05)) + (prog1 (mapcar (lambda (line) + (json-parse-string line :false-object :false :null-object :null)) + (split-string (car output) "\n" t)) + (setcar output "")))) + +(defun neomacs-mcp-test--session (process output) + "Exercise a full legacy MCP session over PROCESS reading OUTPUT." + (let* ((instance (neomacs-mcp-test--instance)) + (init (neomacs-mcp-test--exchange + process output + (list (neomacs-mcp--object + "jsonrpc" "2.0" "id" 1 "method" "initialize" "params" + (neomacs-mcp--object "protocolVersion" "2025-06-18" + "capabilities" (neomacs-mcp--object) + "clientInfo" (neomacs-mcp--object + "name" "test" "version" "1")))))) + (rest (neomacs-mcp-test--exchange + process output + (list (neomacs-mcp--object "jsonrpc" "2.0" + "method" "notifications/initialized") + (neomacs-mcp--object "jsonrpc" "2.0" "id" 2 "method" "tools/list") + (neomacs-mcp--object + "jsonrpc" "2.0" "id" "three" "method" "tools/call" "params" + (neomacs-mcp--object + "name" "neomacs_eval" "arguments" + (neomacs-mcp--object "instance" instance + "code" "(setq neomacs-mcp-test-effect 'ok) (* 6 7)"))))))) + (should (equal "2025-06-18" + (gethash "protocolVersion" (gethash "result" (car init))))) + (should (= 2 (length rest))) + (should (equal 2 (gethash "id" (nth 0 rest)))) + (should (member "neomacs_eval" + (neomacs-mcp-test--tool-names (gethash "result" (nth 0 rest))))) + (should (equal "three" (gethash "id" (nth 1 rest)))) + (let ((result (gethash "result" (nth 1 rest)))) + (should (eq :false (gethash "isError" result))) + (should (equal "42" (gethash "text" (aref (gethash "content" result) 0))))) + (should (eq neomacs-mcp-test-effect 'ok)))) + +(ert-deftest neomacs-mcp-test-socket-round-trip () + (neomacs-mcp-test--with-root + (let* ((socket (expand-file-name "mcp" root)) + (neomacs-mcp-test-effect nil) + (output (list "")) + client) + (neomacs-mcp-start socket) + (should (= #o700 (logand #o777 (file-modes root)))) + (setq client (make-network-process + :name "neomacs-mcp-test-client" :family 'local :service socket + :coding 'utf-8 :noquery t + :filter (lambda (_ chunk) (setcar output (concat (car output) chunk))))) + (unwind-protect + (neomacs-mcp-test--session client output) + (delete-process client))))) + +(ert-deftest neomacs-mcp-test-unsendable-response-is-error-reply () + ;; Control characters are escaped twice: 30000 of them print to about + ;; 30 KB but encode to well over the 128 KiB response limit. A raw + ;; byte, as in undecodable process output, cannot be encoded at all. + (neomacs-mcp-test--with-root + (let* ((socket (expand-file-name "mcp" root)) + (output (list "")) + (instance (neomacs-mcp-test--instance)) + (neomacs-mcp-tools (copy-sequence neomacs-mcp-tools)) + client) + (neomacs-mcp-register-tool + "raw" "Fixture" (neomacs-mcp--schema '(("instance" . "string")) nil) + (lambda (_) (string ?a (unibyte-char-to-multibyte 200) ?b))) + (neomacs-mcp-start socket) + (setq client (make-network-process + :name "neomacs-mcp-test-client" :family 'local :service socket + :coding 'utf-8 :noquery t + :filter (lambda (_ chunk) (setcar output (concat (car output) chunk))))) + (unwind-protect + (let* ((call (lambda (id name arguments) + (puthash "instance" instance arguments) + (neomacs-mcp--object + "jsonrpc" "2.0" "id" id "method" "tools/call" "params" + (neomacs-mcp-test--modern-params + "name" name "arguments" arguments)))) + (eval (lambda (id code) + (funcall call id "neomacs_eval" (neomacs-mcp--object "code" code))))) + (dolist (case (list (funcall eval 1 "(make-string 30000 27)") + (funcall call 2 "raw" (neomacs-mcp--object)))) + (let ((replies (neomacs-mcp-test--exchange client output (list case)))) + (should (= 1 (length replies))) + (should (equal (gethash "id" case) (gethash "id" (car replies)))) + (should (= -32603 (gethash "code" (gethash "error" (car replies))))))) + ;; The connection stays usable. + (let ((next (neomacs-mcp-test--exchange + client output (list (funcall eval 3 "(* 6 7)"))))) + (should (= 1 (length next))) + (should (equal "42" (gethash "text" (aref (gethash "content" + (gethash "result" (car next))) + 0)))))) + (delete-process client))))) + +(ert-deftest neomacs-mcp-test-relay-round-trip () + (let ((relay (getenv "NEOMACS_MCP_RELAY"))) + (skip-unless (and relay (file-executable-p relay))) + (neomacs-mcp-test--with-root + (let* ((socket (expand-file-name "mcp" root)) + (neomacs-mcp-test-effect nil) + (output (list "")) + process) + (neomacs-mcp-start socket) + (setq process (make-process + :name "neomacs-mcp-test-relay" :command (list relay "--socket" socket) + :connection-type 'pipe :coding 'utf-8 :noquery t + :stderr (get-buffer-create " *neomacs-mcp-test-relay*") + :filter (lambda (_ chunk) (setcar output (concat (car output) chunk))))) + (unwind-protect + (progn + (neomacs-mcp-test--session process output) + ;; Closing the relay's stdin ends the relay, not the editor. + (process-send-eof process) + (let ((deadline (+ (float-time) 10))) + (while (and (process-live-p process) (< (float-time) deadline)) + (accept-process-output nil 0.05))) + (should-not (process-live-p process)) + (should (file-exists-p socket))) + (when (process-live-p process) (delete-process process))))))) + +;;;; Buffer tools + +(ert-deftest neomacs-mcp-test-buffer-read-range-and-preserved-state () + (let ((buffer (generate-new-buffer "mcp-read-fixture")) + (current (current-buffer))) + (unwind-protect + (with-current-buffer buffer + (insert (propertize "α\n\"\\β終🙂text" 'face 'bold)) + (buffer-enable-undo) + (goto-char 5) + (narrow-to-region 3 9) + (let* ((point (point)) (minimum (point-min)) (maximum (point-max)) + (undo buffer-undo-list) (tick (buffer-modified-tick)) + (value (neomacs-mcp--buffer-read + (neomacs-mcp-test--args "name" (buffer-name) "start" 1 + "maxChars" 5 "expectedTick" tick)))) + (should (equal (gethash "text" value) "α\n\"\\β")) + (should-not (text-properties-at 0 (gethash "text" value))) + (should (= (gethash "end" value) 6)) + (should (= (gethash "nextStart" value) 6)) + (should (eq (gethash "truncated" value) t)) + (should (= point (point))) + (should (= minimum (point-min))) + (should (= maximum (point-max))) + (should (eq undo buffer-undo-list)) + (should (= tick (buffer-modified-tick))))) + (kill-buffer buffer)) + (should (eq current (current-buffer))))) + +(ert-deftest neomacs-mcp-test-buffer-read-validation-tick-and-eob () + (with-temp-buffer + (rename-buffer "mcp-validation-fixture" t) + (insert "abc") + (let ((args (neomacs-mcp-test--args "name" (buffer-name) "start" 1 "maxChars" 4))) + (dolist (pair '(("instance" . "wrong") ("name" . "absent-mcp-fixture") + ("start" . 0) ("start" . 5) ("maxChars" . 0) + ("maxChars" . 4097) ("expectedTick" . -1))) + (let ((bad (copy-hash-table args))) + (puthash (car pair) (cdr pair) bad) + (should-error (neomacs-mcp--buffer-read bad)))) + (puthash "expectedTick" (buffer-modified-tick) args) + (insert "d") + (should-error (neomacs-mcp--buffer-read args)) + (remhash "expectedTick" args) + (puthash "start" (point-max) args) + (let ((value (neomacs-mcp--buffer-read args))) + (should (equal "" (gethash "text" value))) + (should (eq :false (gethash "truncated" value))) + (should (eq :null (gethash "nextStart" value))))))) + +(ert-deftest neomacs-mcp-test-buffer-read-output-limit () + (with-temp-buffer + (rename-buffer "mcp-output-fixture" t) + ;; Control characters expand to six bytes each when JSON-escaped twice. + (insert (make-string 100000 ?x) (make-string 4096 1) "🙂") + (let* ((neomacs-mcp-buffer-output-limit 2048) + (value (neomacs-mcp--buffer-read + (neomacs-mcp-test--args "name" (buffer-name) "start" 100001 + "maxChars" 4096))) + (text (gethash "text" value))) + (should (< 0 (length text) 4096)) + (should (<= (neomacs-mcp--result-bytes value) neomacs-mcp-buffer-output-limit)) + (should (= (gethash "end" value) (+ 100001 (length text)))) + (should (equal text (make-string (length text) 1)))))) + +(ert-deftest neomacs-mcp-test-buffer-list-pages () + (let ((buffers (cl-loop for n below 40 + collect (generate-new-buffer (format "mcp-list-%s" n))))) + (unwind-protect + (cl-letf (((symbol-function 'buffer-list) (lambda (&rest _) buffers))) + (let* ((value (neomacs-mcp--buffer-list + (neomacs-mcp-test--args "offset" 0 "limit" 2))) + (entries (gethash "buffers" value))) + (should (= 2 (length entries))) + (should (= 2 (gethash "nextOffset" value))) + (should (eq t (gethash "truncated" value))) + (should (equal (gethash "name" (aref entries 0)) (buffer-name (car buffers))))) + (let ((value (neomacs-mcp--buffer-list + (neomacs-mcp-test--args "offset" 38 "limit" 32)))) + (should (= 2 (length (gethash "buffers" value)))) + (should (eq :null (gethash "nextOffset" value)))) + (dolist (pair '(("offset" . -1) ("limit" . 0) ("limit" . 33))) + (let ((args (neomacs-mcp-test--args "offset" 0 "limit" 1))) + (puthash (car pair) (cdr pair) args) + (should-error (neomacs-mcp--buffer-list args))))) + (mapc #'kill-buffer buffers)))) + +(ert-deftest neomacs-mcp-test-buffer-tools-hide-credentials-and-minibuffers () + (let* ((secret (generate-new-buffer "mcp-secret-fixture")) + (alias (make-indirect-buffer secret "mcp-secret-alias" nil))) + (unwind-protect + (progn + (with-current-buffer secret (setq buffer-file-name "/fixture/.authinfo.gpg")) + (dolist (buffer (list secret alias (window-buffer (minibuffer-window)))) + (should (neomacs-mcp--buffer-hidden-p buffer)) + (should-error (neomacs-mcp--buffer-read + (neomacs-mcp-test--args "name" (buffer-name buffer) + "start" 1 "maxChars" 1)))) + (cl-letf (((symbol-function 'buffer-list) (lambda (&rest _) (make-list 200 secret)))) + (let ((value (neomacs-mcp--buffer-list + (neomacs-mcp-test--args "offset" 0 "limit" 1)))) + (should (= 0 (length (gethash "buffers" value)))) + (should (= neomacs-mcp-buffer-scan-limit (gethash "scanned" value)))))) + (kill-buffer alias) + (with-current-buffer secret (setq buffer-file-name nil)) + (kill-buffer secret)))) + +(provide 'neomacs-mcp-test) +;;; neomacs-mcp-test.el ends here From c9542d36e0fccf81bf864ff249ef59f9f5329e1d Mon Sep 17 00:00:00 2001 From: Thanos Apollo Date: Tue, 6 Oct 2026 08:56:38 +0300 Subject: [PATCH 2/2] fix(mcp): keep every reply within the output limit A request ID is echoed in its reply, so a request just under the 128 KiB input limit whose ID fills it produced an error reply of about 131 KB, over the 128 KiB output limit. Reject IDs longer than 1024 bytes once encoded with a single -32600 error carrying a null ID, and make the encoder fall back to a null-ID error if even the fixed-size replacement for an oversized or unencodable response would not fit. Document the ID limit and the -32602 refusal of neomacs_eval when full access is off, and state that the input limit counts the input buffered per connection. Give each relay test fixture its own temporary directory. --- Cargo.lock | 3 + crates/neomacs-mcp/Cargo.toml | 3 + crates/neomacs-mcp/tests/relay.rs | 19 ++--- docs/neomacs-mcp.md | 19 +++-- lisp/neomacs-mcp.el | 53 ++++++++++---- test/neomacs/neomacs-mcp-test.el | 117 +++++++++++++++++++++++++++++- 6 files changed, 177 insertions(+), 37 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index 9c6a9e52b5..187df90785 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -3914,6 +3914,9 @@ dependencies = [ [[package]] name = "neomacs-mcp" version = "0.0.19" +dependencies = [ + "tempfile", +] [[package]] name = "neomacs-melpa-test-support" diff --git a/crates/neomacs-mcp/Cargo.toml b/crates/neomacs-mcp/Cargo.toml index acc77f613b..363c4a5c5e 100644 --- a/crates/neomacs-mcp/Cargo.toml +++ b/crates/neomacs-mcp/Cargo.toml @@ -11,5 +11,8 @@ description = "Stdio relay from MCP clients to the editor's local MCP socket" name = "neomacs-mcp" path = "src/main.rs" +[dev-dependencies] +tempfile.workspace = true + [lints] workspace = true diff --git a/crates/neomacs-mcp/tests/relay.rs b/crates/neomacs-mcp/tests/relay.rs index d4e6e300ec..3cac542e0e 100644 --- a/crates/neomacs-mcp/tests/relay.rs +++ b/crates/neomacs-mcp/tests/relay.rs @@ -12,17 +12,18 @@ use std::time::{Duration, Instant}; const TIMEOUT_MS: &str = "300"; struct Fixture { - dir: PathBuf, + dir: tempfile::TempDir, socket: PathBuf, listener: UnixListener, } impl Fixture { fn new(name: &str) -> Self { - let dir = std::env::temp_dir().join(format!("neomacs-mcp-{}-{name}", std::process::id())); - let _ = std::fs::remove_dir_all(&dir); - std::fs::create_dir_all(&dir).unwrap(); - let socket = dir.join("mcp"); + let dir = tempfile::Builder::new() + .prefix(&format!("mcp-{name}-")) + .tempdir() + .unwrap(); + let socket = dir.path().join("mcp"); let listener = UnixListener::bind(&socket).unwrap(); Self { dir, @@ -40,12 +41,6 @@ impl Fixture { } } -impl Drop for Fixture { - fn drop(&mut self) { - let _ = std::fs::remove_dir_all(&self.dir); - } -} - fn relay(socket: &Path) -> Child { Command::new(env!("CARGO_BIN_EXE_neomacs-mcp")) .arg("--socket") @@ -198,7 +193,7 @@ fn unread_socket_write_is_bounded() { #[test] fn missing_socket_fails_without_fallback() { let fixture = Fixture::new("missing"); - let mut child = relay(&fixture.dir.join("absent")); + let mut child = relay(&fixture.dir.path().join("absent")); let status = wait(&mut child, Duration::from_secs(5)); assert_eq!(status.code(), Some(1)); assert!(stderr(&mut child).contains("connect")); diff --git a/docs/neomacs-mcp.md b/docs/neomacs-mcp.md index 050dbc3367..270ae91890 100644 --- a/docs/neomacs-mcp.md +++ b/docs/neomacs-mcp.md @@ -89,7 +89,8 @@ To turn it off: ``` When `neomacs-mcp-full-access` is nil, `neomacs_eval` is neither listed nor -callable; the remaining built-in tools only read buffers. The option is +callable: a call to it gets error `-32602` (Unknown tool). The remaining +built-in tools only read buffers. The option is checked on every request, so changing it affects connected clients immediately. Tools registered by other packages are not affected. @@ -148,12 +149,16 @@ Continuous input can therefore delay requests indefinitely. A tool runs synchronously in the editor's command loop: long-running Lisp blocks the editor just as it would from `M-:`. -Limits: 8 connections, 64 queued requests (16 per connection), 128 KiB per -incoming message and per response. A response over the limit, or one that -cannot be encoded as JSON (for example text containing raw bytes), is -replaced by error `-32603`. Exceeding any other limit, or reusing an -outstanding request ID, closes that connection. A response send that does -not complete within `neomacs-mcp-send-timeout` seconds closes the connection. +Limits: 8 connections, 64 queued requests (16 per connection), 128 KiB of +buffered input per connection (any incomplete message plus newly received +data) and 128 KiB per response line. A request ID longer than 1024 bytes when +encoded as JSON is not echoed: the request gets one `-32600` error with a null +ID. A response over the limit, or one that cannot be encoded as JSON (for +example text containing raw bytes), is replaced by a fixed-size `-32603` error +for the same request; the connection stays open. Exceeding any other limit, +or reusing an outstanding request ID, closes that connection. A response send +that does not complete within `neomacs-mcp-send-timeout` seconds closes the +connection. ## Adding tools diff --git a/lisp/neomacs-mcp.el b/lisp/neomacs-mcp.el index bedef4e671..2a2345aa4d 100644 --- a/lisp/neomacs-mcp.el +++ b/lisp/neomacs-mcp.el @@ -68,8 +68,14 @@ metadata. Tools registered by other libraries are not affected." :type 'number :group 'neomacs-mcp) -(defconst neomacs-mcp--frame-limit 131072) -(defconst neomacs-mcp--output-limit 131072) +(defconst neomacs-mcp--frame-limit 131072 + "Maximum bytes of buffered input per connection. +This counts any incomplete message plus newly received data.") +(defconst neomacs-mcp--output-limit 131072 + "Maximum bytes of one response line, including its newline.") +(defconst neomacs-mcp--id-limit 1024 + "Maximum bytes of a JSON-encoded request ID. +Replies echo the ID, so bounding it keeps every error reply bounded.") (defconst neomacs-mcp--queue-limit 64) (defconst neomacs-mcp--peer-queue-limit 16) (defconst neomacs-mcp--peer-limit 8) @@ -492,23 +498,32 @@ refuse unless it equals the buffer's modification tick." "Close PEER once its connection is gone." (unless (process-live-p peer) (neomacs-mcp--close peer))) +(defun neomacs-mcp--encode (response) + "Return RESPONSE encoded as JSON, or nil if it cannot be encoded." + (condition-case nil + (json-serialize response :false-object :false :null-object :null) + (error nil))) + (defun neomacs-mcp--wire (response) - "Return RESPONSE as one line of JSON. + "Return RESPONSE as one line of JSON within `neomacs-mcp--output-limit'. If RESPONSE cannot be encoded, for example because it contains raw -bytes, or exceeds the output limit, return an error for its ID instead." - (let* ((json (condition-case nil - (json-serialize response :false-object :false :null-object :null) - (error nil))) +bytes, or exceeds the limit, return a fixed-size error for its ID +instead, or for a null ID if even that error would not fit." + (let* ((json (neomacs-mcp--encode response)) (message (cond ((null json) "Response cannot be encoded as JSON") ((>= (string-bytes json) neomacs-mcp--output-limit) "Response exceeds the output limit")))) - (concat (if message - (json-serialize - (neomacs-mcp--object - "jsonrpc" "2.0" "id" (gethash "id" response :null) - "error" (neomacs-mcp--object "code" -32603 "message" message))) - json) - "\n"))) + (when message + (setq json (neomacs-mcp--encode + (neomacs-mcp--object + "jsonrpc" "2.0" "id" (gethash "id" response :null) + "error" (neomacs-mcp--object "code" -32603 "message" message)))) + (unless (and json (< (string-bytes json) neomacs-mcp--output-limit)) + (setq json (json-serialize + (neomacs-mcp--object + "jsonrpc" "2.0" "id" :null + "error" (neomacs-mcp--object "code" -32603 "message" message)))))) + (concat json "\n"))) (defun neomacs-mcp--send (request response) "Send RESPONSE to the client of REQUEST unless it was abandoned. @@ -606,6 +621,10 @@ Before that, drop at most `neomacs-mcp--scan-limit' abandoned requests." (equal id (gethash "id" (plist-get request :message) :absent))) (setf (plist-get request :cancelled) t)))) +(defun neomacs-mcp--id-fits-p (id) + "Return non-nil if request ID encodes within `neomacs-mcp--id-limit' bytes." + (<= (string-bytes (json-serialize id)) neomacs-mcp--id-limit)) + (defun neomacs-mcp--frame (peer line) "Parse LINE from PEER, then queue it or record a cancellation." (condition-case nil @@ -624,8 +643,12 @@ Before that, drop at most `neomacs-mcp--scan-limit' abandoned requests." (stringp method) (hash-table-p params) (or (eq id :absent) (stringp id) (integerp id)))) (neomacs-mcp--enqueue - peer (and (or (stringp id) (integerp id)) (neomacs-mcp--object "id" id)) + peer (and (or (stringp id) (integerp id)) (neomacs-mcp--id-fits-p id) + (neomacs-mcp--object "id" id)) '(-32600 "Invalid request"))) + ((and (not (eq id :absent)) (not (neomacs-mcp--id-fits-p id))) + ;; Over-long IDs are not echoed: reply once with a null ID. + (neomacs-mcp--enqueue peer nil '(-32600 "Request ID is too long"))) ((and (eq id :absent) (equal method "notifications/cancelled")) (neomacs-mcp--cancel peer (gethash "requestId" params :absent))) ((and (eq id :absent) (not (equal method "notifications/initialized"))) diff --git a/test/neomacs/neomacs-mcp-test.el b/test/neomacs/neomacs-mcp-test.el index 2eec4dfcf3..e4b3511ab7 100644 --- a/test/neomacs/neomacs-mcp-test.el +++ b/test/neomacs/neomacs-mcp-test.el @@ -495,9 +495,9 @@ receive no response." (delete-process client))))) (ert-deftest neomacs-mcp-test-unsendable-response-is-error-reply () - ;; Control characters are escaped twice: 30000 of them print to about - ;; 30 KB but encode to well over the 128 KiB response limit. A raw - ;; byte, as in undecodable process output, cannot be encoded at all. + ;; ESC prints raw but JSON-escapes to 6 bytes: 30000 of them print to + ;; about 30 KB but encode to about 180 KB, over the response limit. A + ;; raw byte, as in undecodable process output, cannot be encoded at all. (neomacs-mcp-test--with-root (let* ((socket (expand-file-name "mcp" root)) (output (list "")) @@ -536,6 +536,117 @@ receive no response." 0)))))) (delete-process client))))) +(defun neomacs-mcp-test--raw-replies (process output line barrier) + "Send LINE to PROCESS, then after its first reply a ping with ID BARRIER. +Return every reply line in OUTPUT up to and including the ping's reply, +without newlines, or nil if that reply does not arrive. Requests run +in order, so the lines before the last are the replies to LINE. The +ping is sent separately because LINE alone may fill the input limit. +Clear OUTPUT afterwards." + (let ((ping (neomacs-mcp--object "jsonrpc" "2.0" "id" barrier "method" "ping")) + (done (concat "\"id\":" (json-serialize barrier))) + (deadline (+ (float-time) 10))) + (process-send-string process line) + (while (and (not (string-search "\n" (car output))) + (process-live-p process) + (< (float-time) deadline)) + (accept-process-output nil 0.05)) + (when (string-search "\n" (car output)) + (process-send-string process (concat (json-serialize ping) "\n")) + (while (and (not (and (string-search done (car output)) + (string-suffix-p "\n" (car output)))) + (process-live-p process) + (< (float-time) deadline)) + (accept-process-output nil 0.05))) + (prog1 (and (string-search done (car output)) + (string-suffix-p "\n" (car output)) + (split-string (car output) "\n" t)) + (setcar output "")))) + +(ert-deftest neomacs-mcp-test-near-limit-id-reply-stays-bounded () + ;; A request just under the input limit whose ID alone is near that + ;; limit must not produce a reply over the output limit. The ID is + ;; not echoed, and the connection stays usable. + (neomacs-mcp-test--with-root + (let* ((socket (expand-file-name "mcp" root)) + (output (list "")) + client) + (neomacs-mcp-start socket) + (setq client (make-network-process + :name "neomacs-mcp-test-client" :family 'local :service socket + :coding 'utf-8 :noquery t + :filter (lambda (_ chunk) (setcar output (concat (car output) chunk))))) + (unwind-protect + (progn + (neomacs-mcp-test--exchange + client output + (list (neomacs-mcp--object + "jsonrpc" "2.0" "id" 1 "method" "initialize" "params" + (neomacs-mcp--object "protocolVersion" "2025-06-18" + "capabilities" (neomacs-mcp--object) + "clientInfo" (neomacs-mcp--object + "name" "test" "version" "1"))) + (neomacs-mcp--object "jsonrpc" "2.0" + "method" "notifications/initialized"))) + (let ((barrier 0)) + (dolist (id (list (make-string 131000 ?x) + (json-parse-string (make-string 131000 ?9)))) + ;; A valid request, and one rejected as invalid (no method). + (dolist (message (list (neomacs-mcp--object + "jsonrpc" "2.0" "id" id "method" "tools/list") + (neomacs-mcp--object "jsonrpc" "2.0" "id" id))) + (let* ((line (concat (json-serialize message) "\n")) + (lines (progn + (should (<= (string-bytes line) neomacs-mcp--frame-limit)) + (neomacs-mcp-test--raw-replies + client output line + (format "barrier-%d" (cl-incf barrier))))) + (raw (car lines)) + (reply (and raw (json-parse-string raw :null-object :null)))) + ;; Exactly one reply, then the barrier's. + (should (= 2 (length lines))) + (should (<= (1+ (string-bytes raw)) neomacs-mcp--output-limit)) + (should (eq :null (gethash "id" reply))) + (should (= -32600 (gethash "code" (gethash "error" reply)))))))) + (let ((next (neomacs-mcp-test--exchange + client output + (list (neomacs-mcp--object + "jsonrpc" "2.0" "id" 2 "method" "tools/list"))))) + (should (= 1 (length next))) + (should (equal 2 (gethash "id" (car next)))) + (should (gethash "tools" (gethash "result" (car next)))))) + (delete-process client))))) + +(ert-deftest neomacs-mcp-test-id-limit-boundary () + ;; The quotes count: a 1022-character string ID encodes to 1024 bytes. + (should (neomacs-mcp--id-fits-p (make-string 1022 ?x))) + (should-not (neomacs-mcp--id-fits-p (make-string 1023 ?x))) + (should (neomacs-mcp--id-fits-p (json-parse-string (make-string 1024 ?9)))) + (should-not (neomacs-mcp--id-fits-p (json-parse-string (make-string 1025 ?9))))) + +(ert-deftest neomacs-mcp-test-wire-never-exceeds-the-output-limit () + ;; Admission bounds IDs, but the encoder must hold the limit on its + ;; own: an oversized or unencodable response with an oversized ID + ;; still yields one bounded error line. + (let ((id (make-string neomacs-mcp--output-limit ?x))) + (dolist (result (list (make-string neomacs-mcp--output-limit ?y) + (string ?a (unibyte-char-to-multibyte 200)))) + (let* ((wire (neomacs-mcp--wire + (neomacs-mcp--object "jsonrpc" "2.0" "id" id "result" result))) + (reply (json-parse-string wire :null-object :null))) + (should (<= (string-bytes wire) neomacs-mcp--output-limit)) + (should (string-suffix-p "\n" wire)) + (should (eq :null (gethash "id" reply))) + (should (= -32603 (gethash "code" (gethash "error" reply)))))) + ;; A short ID is still echoed in the replacement error. + (let ((reply (json-parse-string + (neomacs-mcp--wire + (neomacs-mcp--object + "jsonrpc" "2.0" "id" 7 + "result" (make-string neomacs-mcp--output-limit ?y)))))) + (should (equal 7 (gethash "id" reply))) + (should (= -32603 (gethash "code" (gethash "error" reply))))))) + (ert-deftest neomacs-mcp-test-relay-round-trip () (let ((relay (getenv "NEOMACS_MCP_RELAY"))) (skip-unless (and relay (file-executable-p relay)))