[ViewVC] Annotation of: cvs/cvsroot/AnyEvent-MCP/bin/mcp-fs

#!/opt/bin/perl

=head1 NAME

mcp-fs - filesystem and command tools with optional sandboxing

=head1 SYNOPSIS

   mcp-fs --stdio /path/to/workdir
   mcp-fs --name project --bind 127.0.0.1:31741 /path/to/workdir
   mcp-fs --stdio --host kaos --rsh rsh /root/src

=head1 DESCRIPTION

C<mcp-fs> gives an MCP client tools to read, search and change files, and
run commands. An assistant can use these tools to work on your projects
without you writing a Perl server.

Start it with one or more project directories, called workdirs. The client
connects to the server, lists its tools and makes requests. A request can
select one of these workdirs; with only one, the selection can be omitted.
Tools operate on files on disk. To work with unsaved Vim buffers, use
L<mcp-vim>.

Before starting an operation, the server checks permission rules and, when
needed, asks you for approval. Operations normally run in a bubblewrap
sandbox with the approved access. Workdirs provide the default filesystem
scope; operations needing access elsewhere require the corresponding
sandbox grants.

You can connect an MCP client directly over HTTP or stdin/stdout, or run
the server through C<mcp-multibroker>. See L<AnyEvent::MCP::Intro> for a
walkthrough from installation to a first filesystem request.

With C<--host>, the same tools operate on a remote host over SSH (or the
command selected by C<--rsh>). Only Perl 5.8.4 and the tools used by the
requested operations are needed remotely; neither mcp-fs nor its CPAN
modules must be installed there. Each server instance uses one host, with
any number of workdirs on that host.

=head1 FIRST USE

Configure your MCP client to launch the server with an existing project:

   mcp-fs --stdio --name project /home/alice/src/project

The client starts the process and speaks MCP over stdin/stdout. Do not run
another copy in a terminal. For HTTP clients, run without C<--stdio> and
use C<--print-url> with the same C<--name> and C<--bind> settings; see
L<AnyEvent::MCP::Intro/YOUR FIRST FILESYSTEM SERVER>.

To inspect the tools available with your installed utilities without
starting a listener, run C<mcp-fs --tool-help /home/alice/src/project>.

Once connected, ask the assistant:

   Show the configured workdirs and list my project's top-level files.
   Read its README if present. Do not change files or run commands.

C<workdirs> shows the available paths without a worker. Listing requests
C<inspect> permission, and reading a file requests C<read>. Allow each once
to try them. Approval is specific to the requested action and sandbox grants.
If no dialog appears, inspect the tool error and server stderr: the helper
needs a YAD display or usable terminal. See L</PERMISSIONS>.

For a separate sandbox check without MCP, change to your project directory
and run:

   mcp-fs --exec-cmd workdir-read -- ls

This uses the current directory as the workdir. It tests the sandbox,
not client connectivity or permission prompting.

=head2 Remote workdirs

To use an existing directory on another machine:

   mcp-fs --stdio --host server.example.org /srv/project
   mcp-fs --stdio -h kaos -e rsh /root/src /srv/projects

Workdir arguments are ordinary absolute paths on that host, without a
C<host:> prefix. Omitting C<--host> retains local operation, regardless of
C<--rsh>. The remote shell is started locally, outside the operation
sandbox. Its connection does not require the remote operation's C<network>
grant. Combine unrelated hosts through C<mcp-multibroker>.

Remote request cancellation and timeouts terminate the local remote-shell
process, but may leave the remote worker running. After a connection failure,
the outcome of a modifying operation may be unknown; inspect the remote
filesystem before retrying it. Reliable remote process termination is not
yet implemented.

=head1 TOOLS

The filesystem tools are:

=over

=item C<workdirs>

Report configured workdirs and available sandbox grants, without starting a worker.

=item C<list>, C<find>

Enumerate directory entries.

=item C<stat>

Return lstat metadata without following symlinks.

=item C<file-read>

Read byte ranges and return Base64 data.

=item C<read-lines>

Read LF-delimited lines with selectable UTF-8, Latin-1 or Base64 representation.

=item C<grep>

Search files using a literal pattern or PCRE.

=item C<file-write>

Write Base64 bytes at an offset without implicit truncation.

=item C<path-op>

Perform pathname mutations.

=item C<file-patch>

Apply a unified diff to a single file.

=item C<exec>

Run an argv array, not a shell command string. To use shell syntax,
explicitly invoke a shell in that array.

=back

For C<exec>, C<stdin_encoding> selects C<utf-8> (default), C<latin1>
or C<base64>. The 4 MiB limit applies to the resulting stdin bytes.
The C<argv> elements are Unicode MCP strings encoded as UTF-8 for the
operating system; they cannot represent arbitrary non-UTF-8 argv bytes.
Stdout and stderr are decoded as UTF-8, with a raw capture limit of
1 MiB per stream; use the byte-range tools for binary file contents.
Its optional C<sandbox_grants> B<replaces> the default C<workdir-read>
grant rather than adding to it. Explicitly passing an empty array
therefore asks for no grants. Command exit codes are normal tool results,
not transport errors. On timeout, output collection stops and
C<truncated> is true; C<exit> and C<signal> still describe the reaped child.

Perl is required for normal server operation; missing optional GNU utilities
can cause their tools to be omitted. The command requested by C<exec>
is resolved when the worker runs; it need not be present when the server
starts. Inspect C<tools/list> rather than assuming every tool is present.

=head2 Command output

C<exec>, C<vcs-diff>, C<vcs-status> and C<vcs-log> share three presentation options:

=over

=item grep => $pattern

Optional PCRE line filter for stdout. It runs in a separate timed GNU grep
worker after command output has been captured. It is not passed to the
original command or a shell. Stderr remains unfiltered.

=item max_lines => $integer

Maximum returned stdout lines after filtering, default 2000, maximum 100000.

=item max_bytes => $integer

Maximum returned UTF-8 bytes per stream, default 65536, maximum 1048576.
Clipping does not leave an incomplete UTF-8 character. Stderr has its own
budget, so a large stdout does not hide diagnostics.

=back

The command runs once and is drained to completion, subject to its timeout.
Raw capture is bounded to 1 MiB per stream, independently of the returned
output limits. C<capture_truncated> means bytes were omitted before filtering
or collection ended on timeout: matches in that omitted output are unknown.
C<stdout_truncated>, C<stderr_truncated> and the combined C<truncated> flag
also account for returned-output limits.

Changing presentation options does not change the command's permission
subject. C<exit>, C<signal> and C<timed_out> always describe the original
command, including a diff exit code indicating differences. A filter error
makes the tool result an error and adds C<filter_error>, while retaining that
command status. The command may already have completed; do not rerun it
merely because its output filter failed.

=head2 Version control

C<vcs-diff>, C<vcs-status> and C<vcs-log> take a required C<backend>: C<git>, C<svn>,
C<cvs> or C<hg>, a workdir, an optional C<cwd> (default C<.>), and an optional
C<files> array. C<cwd> selects a directory within the workdir; it does not
change the granted mount boundary. Files are relative to C<cwd> and must
stay within the selected workdir. The worker checks its resolved directory
after chdir and before starting the client, rejecting symlink escapes.
Backend selection is explicit. With no files, the command examines the
working copy at C<cwd>. Files must be inside the selected workdir;
they are passed as literal filenames, not options, revisions or shell code.
Git diff shows unstaged changes; SVN, CVS and Mercurial diff compare the
working copy with its base. No commit, update, fetch or push is performed.
C<vcs-log> reads revision history. CVS reports revisions separately per file
(including their commit IDs), unlike Git's repository-wide commits.
Use output limits to bound potentially long histories.

These tools have separate C<vcs-diff>, C<vcs-status> and C<vcs-log> permission actions.
They request C<workdir-read> for the selected working copy. CVS additionally
requests C<ssh-agent>, which includes network access. SVN log may contact the
repository and also requests C<ssh-agent> to support svn+ssh; SVN diff/status,
Git and Mercurial operations run without network or home access.
A saved approval can cover the fixed operation regardless of filenames or
output filters, for that workdir and backend, or all supported backends.
Configured VCS clients and their configuration are trusted, including any
helpers they invoke; these tools do not sandbox the client's own semantics.
The ordinary sandbox grants still bound its host access. In unsandboxed
mode, the normal full-authority approval requirement applies.

Clients are resolved at startup. C<executable.git>, C<executable.svn>,
C<executable.cvs> and C<executable.hg> in trusted program/instance settings
can override them. A missing client produces a tool error for that backend.

=head1 REQUIREMENTS

Bubblewrap is required by default, but can be disabled explicitly.
Perl 5.8.4 or later must run in the worker environment at startup (except
for C<--exec-cmd>). GNU find, grep, patch and sed are optional; tools
requiring an unavailable utility are omitted. Use C<tools/list> to see
which tools are available.

Remote startup resolves workdirs, HOME, required mounts, executable
locations and VCS markers once; C<workdirs> thereafter uses this snapshot.
Optional C<mount-try> paths are instead passed to bubblewrap for every
invocation. Restart mcp-fs to refresh the workdir configuration and tools.

=head1 CONNECTIONS

HTTP is the default and does not print its URL on startup. C<--print-url>
prints the credential-bearing URL; the same token works in a bearer header.
C<--stdio> or
C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio> selects stdin/stdout.
See L<AnyEvent::MCP/GLOBAL CONFIGURATION> for named HTTP settings.

=head1 OPTIONS

Shared switches are documented in
L<AnyEvent::MCP::Server::Simple/COMMON COMMAND-LINE OPTIONS>.
The following switches are specific to C<mcp-fs>.

=over

=item --exec-cmd SANDBOX-GRANT,...

Run command with specified sandbox grants, using current directory as
workdir; no MCP listener or permission rules. Supply command and arguments
after optional C<--> delimiter. Without command, run C<$SHELL> or C</bin/sh>.
C<--sandbox none> runs with normal host-user privileges.
Example: C<mcp-fs --exec-cmd workdir-read -- ls>.
C<--exec-cmd> is local-only; it cannot be combined with C<--host>.

=item --ask MODE

Permission prompts: C<helper> (default), C<tty>, C<yad>, C<mcp>, C<auto>,
or C<none>.
Local helper keeps decisions local; tty/yad force interface without fallback.
C<mcp> asks client; C<auto> prefers client elicitation when advertised,
otherwise local helper. C<none> denies unmatched permission requests without
prompting. Overrides C<PERL_ANYEVENT_MCP_PERMISSION_ASK>.

=item -h, --host HOST

Run filesystem operations on HOST instead of the local machine. Empty or
omitted HOST selects local operation. All workdirs belong to this one host.
Remote workdir paths must be absolute. Host identity qualifies permission
scopes, not workdir IDs, which use logical pathnames without following symlinks.

=item -e, --rsh COMMAND

Remote shell command, default C<ssh>. Like rsync's C<-e>, COMMAND may include
arguments. Only used with C<--host>; C<rsh> is also supported.
The command is split into arguments locally without a local shell. The
remote shell invokes a short Perl loader. The launcher source is transferred
over stdin, followed by length-prefixed binary startup frames; subsequent
worker input remains on the same stream.

=item --sandbox MODE

Worker sandbox mode: C<bwrap> (default), C<auto>, C<none>.
C<bwrap> requires working bubblewrap. C<auto> uses bubblewrap if installed,
otherwise runs unsandboxed; failing bubblewrap does not silently fall back.
C<none> runs with full host-user privileges. Unsandboxed workers require
approval for maximum authority (world-write, network, shared-tmp, host-proc)
even for reads; narrower grants cannot authorize them. Startup warns.

=item --exec-prefix COMMAND

Run workers and their executable probe through COMMAND, split into argv with
shell-style quoting. No additional shell is used locally. For example,
C<--exec-prefix 'doas -n'> can read protected files on a machine using doas
instead of sudo. Remote execution uses the existing SSH command shell and
places the prefix before the remote Perl launcher. A failed prefix never
falls back to the original credentials.

=item --sudo[=USER]

Shortcut for C<--exec-prefix 'sudo -n'>, optionally adding C<-u USER>.
Overrides C<--exec-prefix>. For example, C<--sudo> with
C<--host user@host> works when SSH must log in as an unprivileged account
but passwordless sudo is permitted. C<--sudo=mail> runs as the mail user.
Sudo must work noninteractively; no password or terminal is supplied.

=item --host-dac

Keep the host user namespace and retain C<CAP_DAC_OVERRIDE> inside
bubblewrap. For example, a root worker can inspect a 0700 directory owned
by another user within a granted workdir. Other capabilities are dropped;
the existing mount and MCP permission restrictions still apply. Requires
privileged bubblewrap; C<--sandbox none> is incompatible.

=item --bwrap PATH

Use specified bubblewrap executable. Default: C<bwrap> found in C<PATH>.
Relevant with C<--sandbox bwrap> or C<--sandbox auto>.

=back

=head2 Shared-option behavior

=over

=item --name NAME

Also selects permission profile C<fs-NAME> and its rule file,
C<rules/fs-NAME.ini>. Default instance name: C<default>.

=item --print-url[=USER]

Does not require a WORKDIR argument.

=item --tool-help

Requires normal WORKDIR arguments, since available tools depend on the
selected workdirs and installed utilities.

=item --auto-allow TOOL[,ACTION[,CAPABILITY]]

For example, combining C<--auto-allow '*,inspect,workdir-read'> with
C<--auto-allow '*,read,workdir-read'> approves only those two actions
within read-only workdir authority. C<--auto-allow '*,*,workdir-write'>
approves any action requiring at most workdir-write authority,
including reads.

=back

Rules reside in C<$XDG_CONFIG_HOME/anyevent-mcp/rules/fs-NAME.ini>,
or the corresponding C<$HOME/.config> path. The rules filename shares the
service-instance name but has an C<fs> namespace. The default instance uses
C<rules/fs-default.ini>. The rules path is printed on stderr when starting
HTTP; normal startup leaves stdout untouched.
Local and remote instances with the same C<--name> intentionally share
the same rule profile. Permission requests include a host dimension: C<local>
for local execution, or C<remote HOST> using C<--host> independently of
C<--rsh>. New persistent rules default to this host, but may match all hosts.
The workdir matcher is simply the logical path, independent of host. Existing
rules lacking C<match.host> continue to apply across local and remote hosts;
only newly saved host-specific rules restrict this.
Use different instance names or C<match.host> to separate approvals for
different hosts. Unscoped rules apply across hosts sharing the profile.

=head1 TRUSTED CONFIGURATION

In C<~/.config/anyevent-mcp/global.ini> (or the corresponding
C<XDG_CONFIG_HOME> location), C<[program NAME]> supplies defaults based
on the executable basename, while C<[instance NAME]> overrides them for
C<--name NAME>. A symlinked executable therefore has its own program defaults.

   [program mcp-fs]
   mount-try.opt = ro:/opt
   mount-try.perl = ro:/opt/perl
   prepend-path = /opt/bin:/opt/sbin
   mount.shared = rw:/srv/shared
   env.cvs = CVS_RSH=/my/cvs/rsh
   executable.perl = /opt/bin/perl

   [instance myproject]
   mount.opt =
   prepend-path =
   mount.extra = ro:/srv/project-tools

To override settings for one invocation, use the common C<-s> / C<--set>
option rather than editing the file:

   mcp-fs --stdio -s executable.perl=/opt/perl/bin/perl \
     -s prepend-path=/opt/perl/bin /srv/project

Command-line settings take precedence over program and instance settings;
repeated keys use their last value. See L<AnyEvent::MCP::Server::Simple/COMMON COMMAND-LINE OPTIONS>.

Automatic permission rules can also be configured:

   [program mcp-fs]
   auto-rule.10 = allow *,read,workdir-read
   auto-rule.20 = allow *,write,workdir-write
   auto-rule.30 = deny *,exec,*

The supported configuration entries are:

=over

=item C<auto-rule.SUFFIX>

Automatic permission rules apply to every named mcp-fs instance;
CLI auto-rules are evaluated first.

=item C<mount.SUFFIX>

A required sandbox mount. The named path must exist at startup.

=item C<mount-try.SUFFIX>

An optional sandbox mount, using bubblewrap's C<--ro-bind-try> or
C<--bind-try>. An absent path is skipped by bubblewrap at each invocation,
without a startup existence check.

Both mount kinds are applied in alphabetical key order after the private
sandbox mounts. The suffix is an arbitrary stable name; an empty instance
value suppresses an inherited entry. Paths must be absolute. A colon after
C<ro:> or C<rw:> starts the literal pathname; no separate quoting or escaping
syntax is used.

=item C<env.SUFFIX>

Specify C<NAME=value> to set a literal value, or C<NAME> to inherit that
variable from the server environment if present. Values may contain spaces
and equals signs; there is no shell expansion. Entries are applied in
alphabetical key order after the default environment. An empty instance
entry suppresses the corresponding program entry. C<SSH_AUTH_SOCK> is managed
exclusively by the C<ssh-agent> grant, even when listed in these settings.
Environment settings do not expose paths; custom executables outside the
runtime/workdir mounts need configured mounts.

=item C<prepend-path>

Add colon-separated directories before the bubblewrapped worker's fixed
C<PATH> of C</usr/bin:/usr/sbin:/bin:/sbin:/usr/local/bin:/usr/local/sbin>.
Trailing colons are ignored, so both C</opt/bin> and C</opt/bin:> work.
The server's C<PATH> is not inherited. An empty instance value restores the
fixed default rather than the program value. C<--sandbox=none> continues to
use the host environment. Directories outside the normal runtime mounts
still need a configured mount to be accessible.

=item C<executable.find>, C<executable.grep>, C<executable.patch>,
C<executable.perl>, C<executable.sed>, C<executable.bwrap>

Override automatic executable discovery. Explicit choices must resolve to
executable files and are trusted instead of version-probed, except for
C<executable.perl>, which must satisfy the Perl minimum version.
C<executable.perl> defaults to C<perl> in the worker's C<PATH>;
the other worker executables are discovered there too. C<--bwrap>
overrides C<executable.bwrap> and is located on the host.

=back

Configured mounts grant baseline access to every sandbox invocation
(when present for C<mount-try>), independently of tool permission grants.
With C<world-read>, only C<rw:> exceptions are applied over the read-only
host filesystem. With C<world-write>, these configured mounts are ignored.
Selecting C</> as a workdir makes C<workdir-read> and C<workdir-write>
equivalent in filesystem reach to C<world-read> and C<world-write>,
respectively, without changing saved permission identities. Host directory
mounts are applied parent-first, followed by protected private system mounts
and explicitly configured narrower exceptions.
Baseline execution paths include C</usr>, C</bin>, system libraries and
selected system configuration, but not C</opt>. Shared host temporary
directories require C<shared-tmp>, an explicit configured mount, or
C<world-write>. All other grants, including C<world-read>, use private
writable temporary directories. C<world-write> implies C<shared-tmp>.

Defaults also include alternatives, font configuration, local timezone,
TLS certificate stores, NSS configuration and DNS configuration where
present. A synthetic passwd entry is created in the private root if the
host root is not exposed. A workdir covering C</etc> will instead show the
host passwd file, without ever modifying it. A root workdir exposes the
host passwd and group databases.

The C<workdirs> result includes C<workdir_vcs>, a mapping from configured
workdir identities to arrays of backends with metadata markers directly
in that directory. Detection checks C<CVS>, C<.git>, C<.hg> and C<.svn>;
a Git metadata file is supported as well as a directory. Symlink markers
are reported without following them. This is a hint, not validation of a
repository. There is no recursive scan or parent search, multiple markers
are retained, and an empty array means no marker was found. Detection is
independent of the available clients in C<vcs_backends> and does not choose
the backend for a VCS command.

=head1 SANDBOX GRANTS

=over

=item C<workdir-read>

Read access to the selected workdir.

=item C<workdir-write>

Write access to the selected workdir; implies C<workdir-read>.

=item C<all-workdirs-read>

Read access to every configured workdir.

=item C<all-workdirs-write>

Write access to every configured workdir; implies read access.

=item C<homedir-read>

Read access to HOME.

=item C<homedir-write>

Write access to HOME; implies read access.

=item C<world-read>

Read access to the host filesystem.

=item C<world-write>

Write access to the host filesystem; implies C<world-read>.
Also implies C<shared-tmp>, so host C</tmp> and C</var/tmp> remain
writable and visible.

=item C<network>

Enable networking outside the sandbox's network namespace. Without this
grant, bubblewrap uses a separate network namespace. Loopback connections
between processes in that same sandbox work, but its C<127.0.0.1> is not
the host's C<127.0.0.1>. Connecting to a host-side loopback server requires
C<network>.

=item C<shared-tmp>

Use the host's writable C</tmp> and C</var/tmp> instead of private
writable temporary directories. Without this grant, temporary files
are isolated and disappear when their sandbox ends, even with
C<world-read>. Host temporary files are visible across invocations,
though the host may clean them up at any time. C<world-write>
automatically grants C<shared-tmp>.

=item C<long-running>

Allow C<exec> timeouts over 300 seconds.

=item C<host-proc>

Host-process access, available only without bubblewrap.

=item C<ssh-agent>

Implies C<network>. Exposes the server's C<SSH_AUTH_SOCK> at
C</run/anyevent-mcp/ssh-agent> and sets the child's variable to that path.
In remote mode it uses the remote shell's agent socket, when available
(for example through SSH agent forwarding), rather than mounting the local
socket path. SSH authentication used to reach the host is separate from
the worker's C<ssh-agent> and C<network> grants.

Also exposes C<~/.ssh/known_hosts> read-only if present, without mounting
the rest of HOME. Private key files and SSH user configuration are not exposed.
An unset or empty C<SSH_AUTH_SOCK> exposes no socket, allowing rsh-based CVS;
a configured socket must be an absolute path naming an existing socket node.
Socket replacement requires a new invocation; an existing bind mount keeps
the old node. Agent access permits authentication, not retrieval of private keys.

=back

C<all-workdirs-read> combined with C<workdir-write> mounts all workdirs
read-only except the selected one, which is writable. C<all-workdirs-write>
makes all writable. Configured workdirs are mounted using resolved absolute
paths, but their permission-rule identities are verbatim command-line
arguments.

=head2 Workdir selection

Persistent permission rules default to the selected workdir, with an explicit
option to match any configured workdir, including future additions. This
controls reuse of the rule, not the workdirs accessible in one operation.
The multibroker alias is shown in permission prompts, without changing the rule file.
Tools accept C<workdir> as a persistent positive integer ID, a numeric
string containing that ID, or an exact configured or resolved workdir path.
C<workdirs> returns C<workdirs> and C<resolved_workdirs> objects keyed by ID,
not arrays indexed by argument position. IDs are shared across server
instances in C<$XDG_CONFIG_HOME/anyevent-mcp/fs-workdir-ids.json>, or under
C<$HOME/.config> when XDG_CONFIG_HOME is unset. IDs use the logical
absolute pathname, without resolving symlinks (relative local arguments
are made absolute against the server's working directory). The same logical
pathname on local and remote servers receives the same ID, even when it
resolves to different physical directories. Permission-rule identities
remain the verbatim arguments; each server interprets IDs in its own workdirs.

The registry stores C<ID =E<gt> [workdir, last_use]> pairs, with C<last_use>
as a Unix timestamp. Starting
a server resolves its IDs once and reserves any new allocations under the
file lock. An AnyEvent timer runs immediately and every 5.25 days, rereading
the registry and overwriting those fixed assignments with fresh timestamps.
Other entries expire after seven days without refresh;
their IDs can be reused. Restart servers after manually changing the registry.
Numeric IDs therefore survive restarts and argument reordering while retained,
but are not permanent references to paths that have expired.

Non-numeric strings are matched only against configured workdirs, never
interpreted as arbitrary filesystem paths. Unknown or ambiguous selectors
fail. With only one workdir, the field may be omitted.
Overlapping workdirs have unspecified mount order and access effects;
do not rely on overlapping workdir boundaries for isolation.

=head1 LIMITATIONS

With bubblewrap, regardless of granted sandbox grants, the sandbox mounts procfs at
C</proc>. Its process entries are restricted by the PID namespace, but
kernel-wide and hardware information (including C</proc/irq> and
C</proc/bus>) remains visible. This is a limitation of bubblewrap's
C<--proc> option, which does not support C<subset=pid>.

=head1 PERMISSIONS

L<AnyEvent::MCP::Server::Permissions> applies ordered allow, deny and ask
decisions to these action classes:

=over

=item C<inspect>

C<stat>, C<list>, C<find>.

=item C<read>

C<file-read>, C<read-lines>, C<grep>.

=item C<write>

C<file-write>, C<file-patch>.

=item C<manage>

C<path-op>.

=item C<exec>

Command execution.

=back

C<file-write> may create files despite being in the write class; manage
refers specifically to pathname operations rather than an exclusive right
to create files.
Filesystem operations have no path-based persistent subjects: their rules
match C<action>, C<sandbox-grants>, and C<match.workdir> when selected-workdir
authority is required. All-workdirs-only requests have no workdir identity.
Rules without C<match.workdir> can apply to any selected workdir if their sandbox
grants cover the request; dialog-generated workdir rules select exact or any.
The independent C<match.host> dimension matches C<local>, a remote host,
or all hosts, independently of the remote transport.
Instances with the same name share a rule file, including broad unscoped rules.
Requested paths are shown in the approval dialog for information only.
Exec additionally offers persistent
command/argv scopes as C<match.subject>. When stdin is provided, exec attaches display-only
details to the permission request: Unicode text for UTF-8 input, or a
bounded escaped-byte preview for Latin-1/Base64 input. The YAD helper offers
a separate C<View stdin...> window; the preview shows input size and
truncation. This does not change authorization: persistent exec rules match
argv, not stdin, and later runs may supply different scripts or bytes.
Conversion takes place before approval and the worker receives the exact
resulting bytes.
C<file-patch> supplies C<View patch> details with the target and supplied diff.
Base64 patches are decoded for display: valid UTF-8 is shown as Unicode,
otherwise non-printable bytes and backslashes are escaped in a byte view.
The UI chooses whether to show a separate viewer or an inline preview.
Each tool checks permissions before starting its worker. Approval
defaults to the local helper selected by C<PERL_ANYEVENT_MCP_PERMISSION_HELPER>,
which tries YAD, then a terminal, then denies once. Client elicitation is
selected with C<--ask mcp>, C<--ask auto>, or the corresponding
C<PERL_ANYEVENT_MCP_PERMISSION_ASK> value.

You can edit the rule file at any time. It is reread on permission checks,
so changes apply without restarting the server. Keep it owned by your user
and private (mode 0600). See L<AnyEvent::MCP::Server::Permissions> for the
rule syntax and ordering.

Permission retries retain earlier one-time approvals within the same call.
For one worker accessing several paths, the required sandbox-grant set combines
the authority needed for all paths and is approved once. An insufficient reduction fails before
the worker starts.
Multi-path C<stat> requires all paths inside its selected workdir.
C<path-op> can attempt cross-workdir renames after approving the sandbox
grants required for both paths. The sandboxed C<rename(2)> may fail with
C<EXDEV> across mounts; no copy/delete fallback is attempted.
C<mkpath> requires a path inside the selected workdir.
C<path-op> performs requested operations in this fixed order:
C<unlink>, C<rmdir>, C<mkpath>, C<mkdir>, C<symlink>, C<truncate>,
C<chmod>, C<rename>. C<mkpath> includes each missing component in the
combined permission check before starting the worker.
The first failure stops subsequent operations; successful earlier mutations
remain in place. There is no rollback or all-or-nothing transaction.

Exec defaults to a 30-second timeout and permits up to 300 seconds without
additional timeout authority. A larger explicit C<timeout>, up to 21600
seconds (six hours), also requires C<long-running>. This capability is added
to the requested permissions automatically. Cancellation still terminates
the worker, regardless of its allowed timeout.

The C<host-proc> grant is unavailable with bubblewrap. Runtime mounts
provide sandbox machinery. Symlinks resolve within granted mounts.
Without bubblewrap, workers operate in the host mount and process namespaces.

=head1 PATCHES

C<file-patch> uses L<AnyEvent::MCP/PATCH UTILITIES> for normalization and
validation. GNU patch runs inside the granted sandbox with fuzz zero.
Successful output replaces the original by rename after checking its
identity, size, timestamps, metadata and link count. These stat checks
do not detect every concurrent edit; they are not a filesystem transaction.

=cut

use common::sense;

use MIME::Base64 ();
use Getopt::Long ();
use Cwd ();
use File::Basename ();
use File::Spec::Unix ();
use Text::ParseWords ();
use IPC::Open2 ();
use POSIX ();
use Fcntl qw(F_SETFD);
use Scalar::Util qw(weaken);

use JSON::XS ();
use AnyEvent ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Config ();
use AnyEvent::MCP::Workdirs ();
use AnyEvent::MCP::Server::Permissions ();
use AnyEvent::Handle ();
use AnyEvent::Log ();
use AnyEvent::Util ();

use AnyEvent::MCP::Server::Simple;

# resolve an executable name or path to an absolute executable file.
sub find_executable {
   my ($name) = @_;

   !ref $name and length $name and $name !~ /\0/
      or return;

   my @path = $name =~ m{/}
      ? ($name)
      : map { (length $_ ? $_ : ".") . "/$name" } split /:/, $ENV{PATH};
   my $cwd = Cwd::getcwd;

   for my $path (@path) {
      next unless -f $path and -x _;
      return $path =~ m{\A/} ? $path : "$cwd/$path";
   }

   undef
}

Getopt::Long::Configure qw(bundling no_ignore_case require_order);

my $sandbox_mode = "bwrap";
my $usage = "Usage: $0 [OPTION]... WORKDIR [WORKDIR]...\n"
   . "       $0 --exec-cmd GRANT,... [--] [COMMAND [ARG]...]\n";

my $server_options = mcp_getoptions
   {
      usage          => $usage,
      description    => "Expose filesystem tools and command execution over MCP.\n"
         . "Operations require permission and normally run inside bubblewrap.",
      option_heading => "Filesystem options:",
      options        => [
         ["-h, --host HOST", "Run on one remote host (default: local)"],
         ["-e, --rsh COMMAND", "Remote shell command (default: ssh)"],
         ["--sandbox MODE", "Use bwrap (default), auto, or none (unsandboxed)"],
         ["--host-dac", "Allow root workers to read other users' protected files inside sandbox mounts"],
         ["--exec-prefix COMMAND", "Prefix worker commands (e.g. sudo -n), locally or remotely"],
         ["--sudo[=USER]", "Run workers through sudo -n, optionally as USER; overrides --exec-prefix"],
         ["--bwrap PATH", "Path to the bubblewrap executable"],
         ["--exec-cmd GRANT,...", "Run a command directly with the named grants"],
      ],
      examples       => "  $0 --stdio /home/alice/src/project\n"
         . "  $0 --name project --print-url\n"
         . "  $0 --sandbox bwrap /home/alice/src/project\n"
         . "  $0 --auto-allow '*,inspect,workdir-read' --auto-allow '*,read,workdir-read' /project\n"
         . "  $0 --auto-allow '*,*,workdir-write' /project",
   },
   "sandbox=s"  => \$sandbox_mode,
   "host|h=s"   => \my $host,
   "rsh|e=s"    => \my $rsh,
   "exec-cmd=s" => \my $exec_cmd,
   "bwrap=s"    => \my $bwrap,
   "host-dac!"  => \my $host_dac,
   "exec-prefix=s" => \my $exec_prefix,
   "sudo:s"     => \my $sudo,
;

my $name = $server_options->{name};
my $stdio = delete $server_options->{stdio};

(defined $exec_cmd or @ARGV)
   or die $usage;

$sandbox_mode =~ /\A(?:bwrap|auto|none)\z/
   or die "--sandbox must be bwrap, auto, or none\n";
$host_dac && $sandbox_mode eq "none" and die "--host-dac requires bubblewrap\n";

$host //= "";
$host !~ m{[\s/\0]} && $host !~ /\A-/
   or die "invalid remote host\n";
$rsh //= "ssh";
my @rsh = Text::ParseWords::shellwords ($rsh);
@rsh or die "empty remote shell command\n";
my @exec_prefix = defined $sudo
   ? ("sudo", "-n", (length $sudo ? ("-u", $sudo) : ()), "--")
   : defined $exec_prefix ? Text::ParseWords::shellwords ($exec_prefix) : ();
defined $exec_prefix && !defined $sudo && !@exec_prefix
   and die "empty --exec-prefix\n";
my $remote = length $host;
!($remote && defined $exec_cmd)
   or die "--host cannot be combined with --exec-cmd\n";

my $program_name = AnyEvent::MCP::Config::program_name ();
my $config_file = AnyEvent::MCP::Config::_file ();
my $config = -e $config_file ? AnyEvent::MCP::Config::global_config () : undef;
my %settings = $config ? (
   %{ $config->{section}{"program $program_name"} },
   %{ $config->{section}{"instance $name"} },
) : ();

# executable names from the UTF-8 config are text; process argv needs bytes.
my %executable = map {
   (my $name = $_) =~ s/\Aexecutable\.//;
   ($name => AnyEvent::MCP::utf8enc $settings{$_})
} grep /\Aexecutable\./, keys %settings;

my $sandbox_path = "/usr/bin:/usr/sbin:/bin:/sbin:/usr/local/bin:/usr/local/sbin";
(my $prepend = $settings{"prepend-path"} // "") =~ s/:+\z//;
$sandbox_path = "$prepend:$sandbox_path" if length $prepend;
$sandbox_path = AnyEvent::MCP::utf8enc $sandbox_path;

my @mount;
for my $key (sort grep /\Amount(?:-try)?\./, keys %settings) {
   my $value = $settings{$key};
   next unless length $value;
   my ($mode, $path) = $value =~ /\A(ro|rw):(\/.*)\z/
      or die "invalid $key mount '$value'\n";
   -e (AnyEvent::MCP::utf8enc $path) or die "invalid $key mount path '$path'\n"
      unless $remote || $key =~ /\Amount-try\./;
   push @mount, [$key, $mode, $path];
}

my @environment;
for my $key (sort grep /\Aenv\./, keys %settings) {
   my $value = $settings{$key};
   next unless length $value;
   my ($name, $text) = $value =~ /\A([A-Za-z_][A-Za-z_0-9]*)(?:=(.*))?\z/s
      or die "invalid $key environment entry '$value'\n";
   push @environment, [$name, $text];
}

# SSH and rsh execute their command through a remote shell. Only this fixed
# launcher goes through that shell; all executable arguments are framed on stdin.
my $remote_launcher = q{#perl
   use 5.008004;
   use POSIX ();
   use Fcntl qw(F_SETFD);
   binmode STDIN;
   my $read = sub {
      my ($length) = @_;
      my $data = "";
      while (length $data < $length) {
         my $got = sysread STDIN, my $part, $length - length $data;
         defined $got or die "remote stdin: $!\n";
         $got or die "short remote startup frame\n";
         $data .= $part;
      }
      $data
   };
   my $length = unpack "N", $read->(4);
   $length <= 1048576 or die "remote startup frame too large\n";
   my ($home, @command) = unpack "(w/a*)*", $read->($length);
   @command or die "empty remote command\n";
   my $agent_index;
   if (length $home) {
      for my $i (1 .. $#command - 1) {
         last if $command[$i] eq "--";
         if ($command[$i - 1] eq "--ro-bind"
             && $command[$i] eq "__MCP_REMOTE_AGENT__"
             && $command[$i + 1] eq "/run/anyevent-mcp/ssh-agent") {
            $agent_index = $i;
            last;
         }
      }
   }
   if (defined $agent_index) {
      my $source = $ENV{SSH_AUTH_SOCK};
      if (length $source) {
         $source =~ m{\A/} && -S $source
            or die "remote SSH_AUTH_SOCK must name an absolute socket\n";
         $command[$agent_index] = $source;
      } else {
         splice @command, $agent_index - 1, 3;
         for (my $i = 0; $i < @command; ++$i) {
            last if $command[$i] eq "--";
            if ($command[$i] eq "--setenv" && $command[$i + 1] eq "SSH_AUTH_SOCK") {
               splice @command, $i, 3;
               last;
            }
         }
      }
   }
   my $passwd_fd;
   if (length $home) {
      pipe (my $rd, my $wr) or die "passwd pipe: $!\n";
      print {$wr} "sandbox:x:$<:" . POSIX::getgid () . ":Sandbox:$home:/bin/sh\n"
         or die "passwd pipe: $!\n";
      close $wr or die "passwd pipe: $!\n";
      if (fileno ($rd) != 3) {
         POSIX::dup2 (fileno ($rd), 3) == 3 or die "passwd dup2: $!\n";
         close $rd;
         open $rd, "<&=3" or die "passwd fd: $!\n";
      }
      defined fcntl ($rd, F_SETFD, 0) or die "passwd fcntl: $!\n";
      $passwd_fd = $rd;
   }
   exec {$command[0]} @command;
   die "remote exec $command[0]: $!\n";
};

sub shell_quote {
   my ($text) = @_;
   $text =~ s/'/'"'"'/g;
   "'$text'"
}

# Keep the remote command short (rsh limits its size). The tiny loader reads
# exactly the launcher source; unlike parsing a script from stdin, it cannot
# buffer bytes intended for the eventual exec'd worker.
my $remote_loader = sprintf q{binmode STDIN;
while (length $s < %1$d) {
        sysread STDIN, $s, %1$d - length $s, length $s or die "read\n";
}
eval $s; die $@ if $@;
}, length $remote_launcher;
my $remote_command = "exec " . join " ", map shell_quote ($_),
   @exec_prefix, ($executable{perl} || "perl"), "-e", $remote_loader;

# all fields here are already octets, including encoded filenames and argv.
sub fs_remote_frame {
   my @arg = @_;
   utf8::downgrade $_ for @arg; # enforce octets, not an external encoding
   pack "N/a*", pack "(w/a*)*", @arg
}

my ($find, $grep, $patch, $perl, $sed);
my %vcs_program;

$bwrap //= $executable{bwrap} || "bwrap";

if ($sandbox_mode ne "none" && !$remote) {
   my $name = $bwrap;
   $bwrap = find_executable $name;
   die "bubblewrap executable not found: $name\n"
      if !$bwrap && $sandbox_mode eq "bwrap";
} elsif ($sandbox_mode eq "none") {
   undef $bwrap;
}

if ($host_dac && !$remote) {
   $bwrap or die "--host-dac requires bubblewrap\n";
   if (@exec_prefix) {
      my @check = (@exec_prefix, $^X, "-e", 'exit $> ? 1 : 0');
      system {$check[0]} @check;
      $? == 0 or die "--host-dac requires a root worker\n";
   } else {
      $> == 0 or die "--host-dac requires a root worker\n";
   }
}

my @runtime_path = qw(
   /usr
   /bin
   /sbin
   /lib
   /lib64
   /etc/ld.so.cache
   /etc/alternatives
   /etc/fonts
   /etc/localtime
   /etc/ssl/openssl.cnf
   /etc/ssl/certs
   /etc/pki/tls/openssl.cnf
   /etc/pki/tls/certs
   /etc/pki/ca-trust
   /etc/nsswitch.conf
   /etc/hosts
   /etc/resolv.conf
);
@runtime_path = grep -e, @runtime_path unless $remote;

my (@workdir, @workdir_identity);
if (defined $exec_cmd) {
   @workdir = Cwd::abs_path ".";
   @workdir or die "cannot resolve current directory\n";
   utf8::decode $workdir[0] or die "workdir is not UTF-8\n";
   @workdir_identity = @workdir;
} else {
   for my $path (@ARGV) {
      my $workdir;
      if ($remote) {
         $path =~ m{\A/} or die "remote workdirs must be absolute paths\n";
         $workdir = $path;
      } else {
         $workdir = Cwd::abs_path $path;
         -d $workdir or die "invalid workdir '$path'\n";
      }
      utf8::decode $workdir or die "workdir is not UTF-8\n";
      my $identity = $path;
      utf8::decode $identity or die "workdir identity is not UTF-8\n";
      push @workdir, $workdir;
      push @workdir_identity, $identity;
   }
}

my $home = $ENV{HOME};
$home =~ m{\A/} and -d $home
   or die "HOME must name an absolute existing directory\n";
$home = Cwd::abs_path $home
   // die "cannot resolve HOME\n";
utf8::decode $home
   or die "HOME is not a valid UTF-8 path\n";

my $config_home;
unless (defined $exec_cmd) {
   $config_home = $ENV{XDG_CONFIG_HOME};
   if (length $config_home) {
      $config_home =~ m{\A/}
         or die "permission config directory must be absolute\n";
      utf8::decode $config_home
         or die "permission config directory is not UTF-8\n";
   } else {
      $config_home = "$home/.config";
   }
}

my (%remote_program, @remote_vcs_marker, $remote_umask);
my @tmp_realpath = map { Cwd::abs_path $_ || $_ } qw(/tmp /var/tmp);
if ($remote) {
   # probe once per startup; the local MCP frontend keeps the result.
   # no remote package beyond core Perl, nor a remote installed mcp-fs.
   my $probe = q{#perl
      use 5.008004;
      use Cwd ();
      binmode STDOUT;

      my ($path, $mode, $bwrap_name, $nwork) = splice @ARGV, 0, 4;
      my @work = splice @ARGV, 0, $nwork;
      my $nmount = shift @ARGV;
      my @mount = splice @ARGV, 0, $nmount;
      my $nrun = shift @ARGV;
      my @runtime = splice @ARGV, 0, $nrun;
      $ENV{PATH} = $path;

      my $find_executable = sub {
         my ($name) = @_;
         my @path = $name =~ m{/} ? ($name)
            : map { (length $_ ? $_ : ".") . "/$name" } split /:/, $ENV{PATH}, -1;
         for (@path) {
            next unless -f $_ && -x _;
            return m{\A/} ? $_ : Cwd::getcwd () . "/$_";
         }
         ""
      };

      my $home = $ENV{HOME} || (getpwuid $<)[7];
      $home =~ m{\A/} && -d $home or die "remote HOME is not an absolute directory\n";
      $home = Cwd::abs_path $home or die "cannot resolve remote HOME\n";
      my @resolved = map {
         my $path = Cwd::abs_path $_;
         -d $path or die "invalid remote workdir '$_'\n";
         $path
      } @work;
      -e $_ or die "invalid remote mount '$_'\n" for @mount;

      my $bwrap = $mode eq "none" ? "" : $find_executable->($bwrap_name);
      $bwrap or die "remote bubblewrap executable not found: $bwrap_name\n"
         if $mode eq "bwrap";

      my %marker = (cvs => "CVS", git => ".git", hg => ".hg", svn => ".svn");
      my @markers = map {
         my $dir = $_;
         join ",", grep {
            lstat "$dir/$marker{$_}" && (-d _ || -l _ || ($_ eq "git" && -f _))
         } sort keys %marker
      } @resolved;

      my %test = (
         find  => [[qw(--version)], qr/^find \(GNU findutils\)/m],
         grep  => [[qw(--version)], qr/^grep \(GNU grep\)/m],
         patch => [[qw(--version)], qr/^GNU patch /m],
         sed   => [[qw(--version)], qr/\(GNU sed\)/],
      );
      my @program;
      while (@ARGV) {
         my ($name, $wanted, $explicit) = splice @ARGV, 0, 3;
         my $found = $find_executable->($wanted);
         if ($found && !$explicit && $test{$name}) {
            my ($args, $match) = @{$test{$name}};
            my $ok = open my $fh, "-|", $found, @$args;
            if ($ok) {
               my $output = do { local $/; <$fh> };
               $ok = close $fh && $output =~ $match;
            }
            $found = "" unless $ok;
         }
         push @program, $found;
      }

      print pack "N/a*", pack "(w/a*)*",
         $home, $bwrap, scalar umask, $>, @resolved, @markers,
         (map { -e $_ ? $_ : "" } @runtime), @program,
         (map { Cwd::abs_path $_ || $_ } qw(/tmp /var/tmp));
   };

   my @names = qw(perl find grep patch sed git svn cvs hg);
   my @args = (
      $sandbox_path, $sandbox_mode, $bwrap, scalar @workdir,
      (map { AnyEvent::MCP::utf8enc $_ } @workdir),
      scalar (grep $_->[0] =~ /\Amount\./, @mount), (map { AnyEvent::MCP::utf8enc $_->[2] } grep $_->[0] =~ /\Amount\./, @mount),
      scalar @runtime_path, @runtime_path,
      (map { ($_, $executable{$_} || $_, length $settings{"executable.$_"} ? 1 : 0) } @names),
   );
   my @command = ($executable{perl} || "perl", "-e", $probe, @args);
   my $pid = IPC::Open2::open2 (my $out, my $in, @rsh, $host, $remote_command);
   binmode $in;
   binmode $out;
   print {$in} $remote_launcher, fs_remote_frame ("", @command) or die "remote probe input: $!\n";
   close $in or die "remote probe input: $!\n";
   my $output = do { local $/; <$out> };
   close $out;
   waitpid $pid, 0;
   $? == 0 or die "remote probe failed (wait status $?)\n";
   my $declared = unpack "N", substr $output, 0, 4;
   length ($output) >= 4 && length ($output) == $declared + 4
      or die "invalid remote probe frame (received " . length ($output)
         . " bytes, declared $declared, first bytes " . unpack ("H*", substr ($output, 0, 16)) . ")\n";
   my @values = unpack "(w/a*)*", substr $output, 4;
   my $expected = 6 + 2 * @workdir + @runtime_path + @names;
   @values == $expected or die "invalid remote probe result\n";
   $home = shift @values;
   $bwrap = shift @values;
   $remote_umask = shift @values;
   my $worker_uid = shift @values;
   $host_dac && $worker_uid != 0
      and die "--host-dac needs root privileges on the remote host\n";
   @workdir = splice @values, 0, @workdir;
   @remote_vcs_marker = map { [length $_ ? split /,/, $_ : ()] } splice @values, 0, @workdir;
   @runtime_path = grep length, splice @values, 0, @runtime_path;
   @remote_program{@names} = splice @values, 0, @names;
   @tmp_realpath = splice @values, 0, 2;
   for ($home, @workdir, @runtime_path, @tmp_realpath) {
      utf8::decode $_ or die "remote path is not UTF-8\n";
   }
   # remote executable names and the bwrap path are OS bytes, like local discovery.
}

$host_dac && !$bwrap and die "--host-dac requires bubblewrap\n";
my ($workdir_ids, $workdir_refresh);

unless (defined $exec_cmd) {
   # IDs represent logical pathnames, not physical symlink destinations.
   $workdir_ids = AnyEvent::MCP::Workdirs->new (
      file => "$config_home/anyevent-mcp/fs-workdir-ids.json",
      paths => [map File::Spec::Unix->rel2abs ($_), @workdir_identity],
   );

   my $interval = .75 * $workdir_ids->{expiry};
   $workdir_refresh = AE::timer 0, $interval, sub {
      $workdir_ids->refresh;
   };
}

my %sandbox_grant = (
   "workdir-read"  => [],
   "workdir-write" => ["workdir-read"],
   "all-workdirs-read" => ["workdir-read"],
   "all-workdirs-write" => [qw(all-workdirs-read workdir-write)],
   "homedir-read"     => [],
   "homedir-write"    => ["homedir-read"],
   "world-read"    => [qw(all-workdirs-read homedir-read)],
   "world-write"   => [qw(world-read all-workdirs-write homedir-write shared-tmp)],
   "network"       => [],
   "ssh-agent"     => ["network"],
   "long-running"  => [],
   "shared-tmp"    => [],
   "host-proc"     => [],
);

my %sandbox_grant_description = (
   "workdir-read"  => "Read files in the selected workdir",
   "workdir-write" => "Change files in the selected workdir",
   "all-workdirs-read" => "Read files in all configured workdirs",
   "all-workdirs-write" => "Change files in all configured workdirs",
   "homedir-read"     => "Read files in your home directory",
   "homedir-write"    => "Change files in your home directory",
   "world-read"    => "Read the host filesystem",
   "world-write"   => "Change the host filesystem",
   "network"       => "Use network connections",
   "ssh-agent"     => "Use your SSH agent to authenticate, read known_hosts and use network connections",
   "long-running"  => "Run commands longer than five minutes",
   "shared-tmp"    => "Access host temporary directories",
   "host-proc"     => $bwrap ? "Host process access (unavailable with bubblewrap)"
                             : "Full access to host processes",
);

my @exec_default_sandbox_grants = ("workdir-read");

my $umask = $remote ? $remote_umask : umask;

my $permissions;
$permissions = AnyEvent::MCP::Server::Permissions->new (
   sandbox_grants             => \%sandbox_grant,
   sandbox_grant_descriptions => sub {
      my ($request) = @_;

      my %description = %sandbox_grant_description;
      if (defined $request->{selected_workdir}) {
         my $name = JSON::XS->new->utf8 (0)->allow_nonref
            ->encode ($request->{selected_workdir});
         $description{"workdir-read"} = "Read files in selected workdir $name";
         $description{"workdir-write"} = "Change files in selected workdir $name";
      }
      \%description
   },
   sandbox_implementation => $bwrap ? "bubblewrap" : "NONE - UNSANDBOXED (full host-user privileges)",
   actions => {
      inspect => "Inspect resource metadata and enumerate names",
      read    => "Read resource contents",
      write   => "Modify resource contents",
      manage  => "Rename, remove, and manage filesystem paths",
      exec    => "Run arbitrary commands",
      "vcs-diff"   => "Read working-copy differences using a VCS client",
      "vcs-status" => "Read working-copy status using a VCS client",
      "vcs-log"    => "Read revision history using a VCS client",
   },
   name         => $name,
   file         => "$config_home/anyevent-mcp/rules/fs-$name.ini",
) unless defined $exec_cmd;

mcp_permissions $permissions;

# permissions group tools by their kind of access, not by MCP tool name.
my %tool_action = (
   stat => "inspect", list => "inspect", find => "inspect",
   "file-read" => "read", "read-lines" => "read", grep => "read",
   "file-write" => "write", "file-patch" => "write",
   "path-op" => "manage", exec => "exec",
);

# normalize an API pathname lexically against its selected workdir.
sub fs_path {
   my ($workdir, $path) = @_;

   !ref $path and length $path and $path !~ /\0/
      or die "path must be a nonempty string without NUL\n";
   $path = "$workdir/$path" unless $path =~ m{\A/};

   my @part;

   for (split m{/+}, $path) {
      next if !length or $_ eq ".";
      if ($_ eq "..") {
         pop @part;
      } else {
         push @part, $_;
      }
   }

   "/" . join "/", @part
}

# test pathname containment without resolving symlinks.
sub fs_inside {
   my ($path, $directory) = @_;

   $directory eq "/" or $path eq $directory or (index $path, "$directory/") == 0
}

# classify relative to the selected workdir, not any configured workdir.
sub fs_path_capability {
   my ($workdir, $path, $mode) = @_;

   return "workdir-$mode"
      if fs_inside $path, $workdir;
   return "all-workdirs-$mode"
      if grep { fs_inside $path, $_ } @workdir;
   return "homedir-$mode" if fs_inside $path, $home;
   return "shared-tmp" if (fs_inside $path, "/tmp") or (fs_inside $path, "/var/tmp");

   "world-$mode"
}

# persist selected-workdir identities only where the requested authority
# actually depends on that selection. Broad all-workdirs grants are unscoped.
sub fs_grant_workdir {
   my ($identity, $grants) = @_;

   my $have = $permissions->closure ($grants);
   return $identity if $have->{"workdir-write"} && !$have->{"all-workdirs-write"};
   return $identity if $have->{"workdir-read"} && !$have->{"all-workdirs-read"};
   undef
}

# permission prompts display the selected, verbatim configured workdir next
# to workdir-specific grant choices. This is information, not a rule scope.
sub fs_require_permission {
   my ($req, $identity, $request) = @_;

   $request->{selected_workdir} = $identity;
   $req->require_permission ($request)
}

# direct execution has no filesystem, network or process isolation. Request
# every grant the process effectively receives, regardless of client wishes.
my @unsandboxed_grants = qw(world-write network shared-tmp host-proc);
sub fs_effective_grants {
   return @_ if $bwrap;
   (@unsandboxed_grants, grep $_ eq "long-running", @_)
}

# one worker needs the combined sandbox authority for every path it will access.
sub fs_permission_dimensions {
   my ($workdir, $subject, $choices) = @_;
   my %dimensions;

   my $host_id = $remote ? "remote $host" : "local";
   $dimensions{host} = {
      label => "Host", value => $host_id,
      choices => [
         { label => "This host: " . ($remote ? $host : "local"), match => $host_id },
         { label => "All hosts", match => "^" },
      ],
   };

   $dimensions{workdir} = {
      label => "Workdir", value => $workdir,
      choices => [
         { label => "This workdir: $workdir", match => $workdir },
         { label => "Any configured workdir, including future ones", match => "^" },
      ],
   } if defined $workdir;
   $dimensions{subject} = {
      label => "Subject", value => $subject, choices => $choices,
   } if defined $subject;

   \%dimensions
}

sub fs_require_paths {
   my ($req, $workdir, $identity, $paths, $mode, $reason, $details) = @_;

   my %seen;
   $paths = [grep !$seen{$_}++, @$paths];
   my %need = map { (fs_path_capability $workdir, $_, $mode) => 1 } @$paths;
   %need = map { $_ => 1 } fs_effective_grants (keys %need);
   my @grants = sort keys %need;
   my $grant = fs_require_permission ($req, $identity, {
      tool           => $req->{tool},
      action         => $tool_action{$req->{tool}},
      dimensions     => fs_permission_dimensions (fs_grant_workdir ($identity, \@grants)),
      paths          => $paths,
      sandbox_grants => \@grants,
      reason         => $reason // "$req->{tool} " . join (", ", @$paths),
      (defined $details ? (details => $details) : ()),
   });

   my $have = $permissions->closure ($grant);
   for my $capability (sort keys %need) {
      $have->{$capability}
         or die "permission reduced below $capability for $req->{tool}\n";
   }

   [sort keys %$have]
}

# test whether the granted capability set makes this pathname writable.
sub fs_writable {
   my ($workdir, $path, $have) = @_;

   $have->{"world-write"}
      or ($have->{"all-workdirs-write"} and (grep { fs_inside $path, $_ } @workdir))
      or ($have->{"workdir-write"} and fs_inside $path, $workdir)
      or ($have->{"homedir-write"} and (fs_inside $path, $home))
      or ($have->{"shared-tmp"} and ((fs_inside $path, "/tmp") or (fs_inside $path, "/var/tmp")))
}

# build the bubblewrap argv implementing the granted sandbox authority.
sub fs_sandbox {
   my ($workdir, $sandbox_grants) = @_;

   my $have = {};
   my @todo = @$sandbox_grants;
   while (@todo) {
      my $capability = pop @todo;
      exists $sandbox_grant{$capability} or die "Unknown permission capability '$capability'\n";
      next if $have->{$capability}++;
      push @todo, @{$sandbox_grant{$capability}};
   }

   unless ($bwrap) {
      unless (defined $exec_cmd) {
         $have->{$_} or die "unsandboxed execution needs $_ grant\n"
            for @unsandboxed_grants;
      }
      return ();
   }

   die "host-proc sandbox authority is unresolved and unavailable in v1\n"
      if $have->{"host-proc"};

   my $workdir_bytes = AnyEvent::MCP::utf8enc $workdir;
   my $home_bytes = AnyEvent::MCP::utf8enc $home;
   my $configured_root = grep $_->[2] eq "/", @mount;
   my $configured_root_write = grep $_->[2] eq "/" && $_->[1] eq "rw", @mount;
   my $root_read = $configured_root || $have->{"world-read"}
      || ($have->{"workdir-read"} && $workdir eq "/")
      || ($have->{"all-workdirs-read"} && grep $_ eq "/", @workdir);
   my $root_write = $configured_root_write || $have->{"world-write"}
      || ($have->{"workdir-write"} && $workdir eq "/")
      || ($have->{"all-workdirs-write"} && grep $_ eq "/", @workdir);
   $root_read ||= $root_write;


   my @command = ($bwrap, qw(
      --die-with-parent
      --unshare-pid --unshare-ipc --unshare-uts --unshare-cgroup-try
   ));
   push @command, "--unshare-user", "--disable-userns" unless $host_dac;
   push @command, "--cap-drop", "ALL";
   push @command, "--cap-add", "CAP_DAC_OVERRIDE" if $host_dac;
   push @command, "--new-session" unless defined $exec_cmd;

   push @command, "--unshare-net" unless $have->{network};

   # Prepare the private root before any host bind; never write to host passwd.
   push @command, "--file", 3, "/etc/passwd"
      unless $root_read || (@exec_prefix && !$remote);
   push @command, "--ro-bind", "/etc/passwd", "/etc/passwd" if @exec_prefix && !$remote && !$root_read;
   push @command, $root_write ? "--bind-try" : "--ro-bind-try", "/", "/"
      if $root_read;

   my @scope_mount;

   unless ($root_read) {
      for my $path (@runtime_path) {
         my $mount = (fs_writable $workdir, $path, $have) ? "--bind-try" : "--ro-bind-try";
         my $bytes = AnyEvent::MCP::utf8enc $path;
         push @scope_mount, [$mount, $bytes, $bytes];
      }
   }

   if ($have->{"homedir-read"}
       and (!$root_read or ($have->{"homedir-write"} and !$root_write))) {
      my $mount = (fs_writable $workdir, $home, $have) ? "--bind-try" : "--ro-bind-try";
      push @scope_mount, [$mount, $home_bytes, $home_bytes];
   }

   if ($have->{"all-workdirs-read"}) {
      for my $path (@workdir) {
         next if $path eq "/";
         my $mount = ($have->{"all-workdirs-write"}
            or ($path eq $workdir && $have->{"workdir-write"}))
               ? "--bind" : "--ro-bind";
         my $bytes = AnyEvent::MCP::utf8enc $path;
         push @scope_mount, [$mount, $bytes, $bytes];
      }
   } elsif ($have->{"workdir-read"} && $workdir ne "/") {
      my $mount = $have->{"workdir-write"} ? "--bind" : "--ro-bind";
      push @scope_mount, [$mount, $workdir_bytes, $workdir_bytes];
   }

   # Host binds go parent-first so broader mounts cannot hide narrower grants.
   # Skip a nested read that is already covered by an equally strong mount.
   my @visible;
   for my $entry (sort { length $a->[2] <=> length $b->[2] } @scope_mount) {
      my ($mode, undef, $path) = @$entry;
      my $write = $mode =~ /\A--bind/;
      next if $root_write || ($root_read && !$write);
      next if grep {
         fs_inside ($path, $_->[2]) && (!$write || $_->[0] =~ /\A--bind/)
      } @visible;
      push @command, @$entry;
      push @visible, $entry;
   }

   # Avoid remounting DNS files already visible through a granted parent,
   # which could itself expose symlinked destinations.
   for my $path (qw(/etc/resolv.conf /etc/hosts)) {
      next if $root_read || grep { fs_inside $path, $_->[2] } @visible;
      my $mount = fs_writable ($workdir, $path, $have) ? "--bind-try" : "--ro-bind-try";
      push @command, $mount, $path, $path;
   }

   # Configured mounts are explicit exceptions. Apply an ancestor of a
   # private mount first; the narrow exception itself may follow afterward.
   my @configured_after;
   unless ($have->{"world-write"}) {
      for my $entry (@mount) {
         my ($key, $mode, $path) = @$entry;
         next if $path eq "/";
         next if $mode eq "ro" && ($root_read || fs_writable $workdir, $path, $have);
         my $bytes = AnyEvent::MCP::utf8enc $path;
         my @bind = (($mode eq "rw" ? "--bind" : "--ro-bind")
            . ($key =~ /\Amount-try\./ ? "-try" : ""), $bytes, $bytes);
         if (grep { $_ ne $path && fs_inside $_, $path } qw(/sys /run /dev /proc /tmp /var/tmp)) {
            push @command, @bind;
         } else {
            push @configured_after, @bind;
         }
      }
   }

   # Private facilities override broad host mounts.
   push @command, qw(--tmpfs /sys --tmpfs /run --dev /dev);
   push @command, "--proc", "/proc";

   my @tmp = qw(/tmp /var/tmp);
   for my $i (0 .. $#tmp) {
      my $tmp = $tmp[$i];
      next if $root_write;
      # Explicit access to the temporary directory itself takes precedence.
      next if (grep $_->[2] eq $tmp, @mount)
         || ($have->{"workdir-read"} && $workdir eq $tmp)
         || ($have->{"all-workdirs-read"} && grep $_ eq $tmp, @workdir);

      # If the host symlink is visible, bwrap must mount on its real target,
      # not the symlink. The remote probe supplies remote, not local, paths.
      my $visible = $root_read
         || (grep { fs_inside $tmp, $_->[2] } @visible)
         || (grep { fs_inside $tmp, $_->[2] } @mount);
      my $destination = $visible ? AnyEvent::MCP::utf8enc $tmp_realpath[$i] : $tmp;
      if ($have->{"shared-tmp"}) {
         push @command, "--bind-try", $tmp, $destination;
      } else {
         push @command, "--perms", "1777", "--tmpfs", $destination;
      }
   }

   # Narrow explicit exceptions are allowed to override the private baseline.
   push @command, @configured_after;

   my $agent_socket;
   if ($have->{"ssh-agent"}) {
      if ($remote) {
         $agent_socket = "/run/anyevent-mcp/ssh-agent";
         push @command, "--ro-bind", "__MCP_REMOTE_AGENT__", $agent_socket;
      } elsif (length $ENV{SSH_AUTH_SOCK}) {
         $ENV{SSH_AUTH_SOCK} =~ m{\A/} && -S $ENV{SSH_AUTH_SOCK}
            or die "SSH_AUTH_SOCK must name an absolute existing socket\n";
         my $source = $ENV{SSH_AUTH_SOCK};
         $agent_socket = "/run/anyevent-mcp/ssh-agent";
         push @command, "--ro-bind", $source, $agent_socket;
      }
      push @command, "--ro-bind-try", "$home_bytes/.ssh/known_hosts", "$home_bytes/.ssh/known_hosts"
         unless $have->{"homedir-read"} || $have->{"world-read"};
   }

   push @command, "--remount-ro", "/"
      unless $root_write;

   push @command,
      "--clearenv",
      "--setenv", "PATH", $sandbox_path,
      "--setenv", "LC_ALL", "C.UTF-8",
      "--setenv", "PERL_BADLANG", "0",
      "--setenv", "HOME", $home_bytes;

   for my $name (qw(TERM COLORTERM TERMINFO TERMINFO_DIRS NO_COLOR CLICOLOR CLICOLOR_FORCE LINES COLUMNS)) {
      push @command, "--setenv", $name, $ENV{$name} if defined $ENV{$name};
   }

   for my $entry (@environment) {
      my ($name, $value) = @$entry;
      next if $name eq "SSH_AUTH_SOCK";
      $value = defined $value ? AnyEvent::MCP::utf8enc $value : $ENV{$name};
      push @command, "--setenv", $name, $value if defined $value;
   }
   push @command, "--setenv", "SSH_AUTH_SOCK", $agent_socket if defined $agent_socket;

   push @command,
      "--chdir", defined $exec_cmd ? $workdir_bytes : $have->{"workdir-read"} ? $workdir_bytes : "/tmp",
      "--";

   @command
}

# pass a private synthetic user entry to bubblewrap without a host passwd mount.
sub fs_passwd_fd {
   my ($read, $write) = AnyEvent::Util::portable_pipe
      or die "passwd pipe: $!\n";
   print {$write} "sandbox:x:$<:" . POSIX::getgid () . ":Sandbox:" . (AnyEvent::MCP::utf8enc $home) . ":/bin/sh\n"
      or die "passwd pipe: $!\n";
   close $write or die "passwd pipe: $!\n";

   if (fileno ($read) != 3) {
      POSIX::dup2 (fileno ($read), 3) == 3 or die "passwd dup2: $!\n";
      close $read;
      open $read, "<&=3" or die "passwd fd: $!\n";
   }

   defined fcntl ($read, F_SETFD, 0) or die "passwd fcntl: $!\n";
   $read
}

if (defined $exec_cmd) {
   my @sandbox_grants = length $exec_cmd ? split /,/, $exec_cmd, -1 : ();
   my @command = (@exec_prefix, (fs_sandbox $workdir[0], \@sandbox_grants),
      (@ARGV ? @ARGV : ($ENV{SHELL} || "/bin/sh")));
   my $passwd_fd = fs_passwd_fd () if $bwrap && !@exec_prefix;

   exec {$command[0]} @command;
   die "exec $command[0]: $!\n";
}

# Perl is required in the worker namespace; discover the other tools there too.
my $probe = q{#perl
   use 5.008004;
   use Cwd ();

   my %test = (
      find => [[qw(--version)], qr/^find \(GNU findutils\)/m],
      grep => [[qw(--version)], qr/^grep \(GNU grep\)/m],
      patch => [[qw(--version)], qr/^GNU patch /m],
      sed => [[qw(--version)], qr/\(GNU sed\)/],
   );

   sub find_executable {
      my ($name) = @_;

      return unless length $name && $name !~ /\0/;
      my @path = $name =~ m{/} ? ($name)
         : map { (length $_ ? $_ : ".") . "/$name" } split /:/, $ENV{PATH}, -1;
      for (@path) {
         next unless -f $_ && -x _;
         return m{\A/} ? $_ : Cwd::getcwd () . "/$_";
      }
      undef
   }

   while (@ARGV) {
      my ($name, $wanted, $explicit) = splice @ARGV, 0, 3;
      my $path = find_executable $wanted;
      if ($path && !$explicit && $test{$name}) {
         my ($args, $match) = @{$test{$name}};
         my $ok = open my $fh, "-|", $path, @$args;
         if ($ok) {
            my $output = do { local $/; <$fh> };
            $ok = close $fh && $output =~ $match;
         }
         undef $path unless $ok;
      }
      $path ||= "";
      print "$path\0";
   }
};

my @names = qw(perl find grep patch sed git svn cvs hg);
my $perl_name = $executable{perl} || "perl";
my %program = %remote_program;
unless ($remote) {
   my @command = (@exec_prefix, $bwrap ? (fs_sandbox $workdir[0], []) : (),
      $perl_name, "-e", $probe,
      map { ($_, $executable{$_} || $_, length $settings{"executable.$_"} ? 1 : 0) } @names);
   my $pid = open my $fh, "-|";
   defined $pid or die "Perl probe fork: $!\n";

   unless ($pid) {
      my $passwd_fd = fs_passwd_fd () if $bwrap && !@exec_prefix;
      exec {$command[0]} @command;
      warn "exec $command[0]: $!\n";
      POSIX::_exit 126;
   }

   my $output = do { local $/; <$fh> };
   close $fh or die "Perl '$perl_name' cannot run in the worker environment\n";
   my @paths = split /\0/, $output, -1;
   @paths == @names + 1 && pop @paths eq ""
      or die "invalid Perl executable probe response\n";
   @program{@names} = @paths;
}
$program{perl} or die "Perl interpreter not found inside the sandbox\n";
($find, $grep, $patch, $perl, $sed) = @program{qw(find grep patch perl sed)};
warn "$_: not detected or wrong version\n"
   for grep !$program{$_}, qw(find grep patch sed);
%vcs_program = map { ($_ => $program{$_}) } qw(git svn cvs hg);

AE::log warn => "bubblewrap unavailable, running without sandbox"
   if $sandbox_mode eq "auto" && !$bwrap;

AnyEvent::detect; # proc_spawn creates child watchers after they might have died

# spawn stdin/stdout and stderr handles; proc_destroy closes them and terminates the child.
# the independent child watcher remains alive until the child is reaped.
sub proc_spawn {
   my ($program, @argv) = @_;

   my $remote_input;
   if ($remote) {
      $remote_input = $remote_launcher . fs_remote_frame ($bwrap ? AnyEvent::MCP::utf8enc $home : "", $program, @argv);
      ($program, @argv) = (@rsh, $host, $remote_command);
   } elsif (@exec_prefix) {
      ($program, @argv) = (@exec_prefix, $program, @argv);
   }

   my ($parent, $child) = AnyEvent::Util::portable_socketpair
      or die "socketpair: $!\n";
   my ($error, $child_error) = AnyEvent::Util::portable_pipe
      or die "pipe: $!\n";

   my $pid = fork;
   defined $pid or die "fork: $!\n";

   unless ($pid) {
      open STDIN,  "<&", $child       or POSIX::_exit 126;
      open STDOUT, ">&", $child       or POSIX::_exit 126;
      open STDERR, ">&", $child_error or POSIX::_exit 126;

      close $parent;
      close $error;
      close $child;
      close $child_error;

      my $passwd_fd = fs_passwd_fd () if $bwrap && !$remote && !@exec_prefix;
      AnyEvent::Util::close_all_fds_except (0, 1, 2, ($bwrap && !$remote && !@exec_prefix ? 3 : ()));

      exec {$program} $program, @argv;
      print STDERR "exec $program: $!\n";
      POSIX::_exit 126;
   }

   close $child;
   close $child_error;

   my $io  = AnyEvent::Handle->new (fh => $parent);
   my $err = AnyEvent::Handle->new (fh => $error);
   my $proc = { pid => $pid };

   # keep the watcher alive independently so a fatal I/O error still reaps.
   $proc->{child} = AE::child $pid, sub {
      $proc->{status} = $_[1];
      delete $proc->{pid};
      delete $proc->{child};
      (delete $proc->{done})->($proc->{status}) if $proc->{done};
   };

   $io->{proc}     = $proc;
   $io->{proc_err} = $err;
   $io->push_write ($remote_input) if $remote;

   $io
}

# signal a spawned process while its pid is still owned by us.
sub proc_kill {
   my ($proc, $signal) = @_;

   my $pid = $proc->{pid} or return;

   $signal //= "KILL";
   kill $signal => $pid
}

# abandon a process and release its streams; repeated cleanup is harmless.
sub proc_destroy {
   my ($io) = @_;

   proc_kill (delete $io->{proc}) if $io->{proc};
   (delete $io->{proc_err})->destroy if $io->{proc_err};
   $io->destroy;
}

# register the process's exit callback, or call it immediately if reaped.
sub proc_on_exit {
   my ($proc, $done) = @_;

   return $done->($proc->{status})
      if defined $proc->{status};

   $proc->{done} = $done;
}

# run a one-shot subprocess, leaving output interpretation to the caller.
# the stream callbacks consume rbuf and may return true to terminate the child.
sub proc_run {
   my ($req, $command, $input, $timeout, $on_stdout, $on_stderr, $done) = @_;

   my $io = proc_spawn @$command;
   my $err = $io->{proc_err};
   my $proc = $io->{proc};
   my ($open, $timed_out, $failure, $timer) = (2);

   my $complete = sub {
      return if $open || !defined $proc->{status};
      my $cb = $done or return;
      undef $done;
      undef $timer;
      proc_destroy $io;
      return if $req->{finished};
      delete $req->{on_cancel};
      $cb->($proc->{status}, $timed_out, $failure);
   };

   my $stop = sub {
      undef $timer;
      delete $req->{on_cancel};
      $open = 0;
      proc_destroy $io;
      $complete->();
   };
   $req->{on_cancel} = $stop;

   for my $stream ([$io, $on_stdout], [$err, $on_stderr]) {
      my ($handle, $consume) = @$stream;
      my $closed;
      my $finish = sub {
         return if $closed++;
         --$open;
         $complete->();
      };
      my $read = sub {
         my ($handle, $eof) = @_;
         my $stop = eval { $consume->($handle, $eof) };
         if ($@) {
            $failure ||= $@;
            $stop = 1;
         }
         proc_kill $proc if $stop;
      };
      $handle->on_read (sub { $read->($_[0], 0) });
      $handle->on_eof (sub {
         $read->($_[0], 1);
         $finish->();
      });
      $handle->on_error (sub {
         return unless $_[1];
         $read->($_[0], 0);
         $failure ||= "subprocess I/O: $_[2]\n" unless $timed_out;
         proc_kill $proc;
         $finish->();
      });
   }

   my $ok = eval {
      $io->push_write ($input) if length $input;
      $io->push_shutdown;
      1
   };
   unless ($ok) {
      my $error = $@;
      proc_destroy $io;
      die $error;
   }

   $timer = AE::timer $timeout, 0, sub {
      $timed_out = 1;
      $stop->();
   };

   proc_on_exit $proc, $complete;
}

# run a subprocess and collect bounded output.
sub fs_run {
   my ($req, $command, $input, $timeout, $byte_limit, $line_limit, $done) = @_;

   my ($truncated, $line_truncated);
   my ($stdout, $stderr) = ("", "");

   my $capture = sub {
      my ($target, $data, $lines) = @_;

      return if $lines and $line_truncated;
      return unless length $data;
      my $remaining = $byte_limit - (length $stdout) - (length $stderr);
      $truncated = 1 if length $data > $remaining;
      $$target .= substr $data, 0, $remaining
         if $remaining > 0;

      if ($lines and $line_limit and ($$target =~ tr/\n//) > $line_limit) {
         my $end = -1;
         $end = index $$target, "\n", $end + 1
            for 1 .. $line_limit;
         substr $$target, $end + 1, length $$target, "";
         $truncated = $line_truncated = 1;
         return 1
      }

      0
   };

   proc_run $req, $command, $input, $timeout,
      sub {
         my ($handle) = @_;
         my $stop = $capture->(\$stdout, $handle->{rbuf}, 1);
         $handle->{rbuf} = "";
         $stop
      },
      sub {
         my ($handle) = @_;
         $capture->(\$stderr, $handle->{rbuf}, 0);
         $handle->{rbuf} = "";
         0
      },
      sub {
         my ($status, $timed_out, $failure) = @_;
         return $done->(0, $failure) if $failure;
         $done->(1, +{
            stdout    => $stdout,
            stderr    => $stderr,
            exit      => $status >> 8,
            signal    => $status & 127,
            timed_out => $timed_out ? JSON::XS::true : JSON::XS::false,
            truncated => $truncated || $timed_out ? JSON::XS::true : JSON::XS::false,
         });
      };
}

my $perl_slave = q{#perl
   binmode STDIN;
   binmode STDOUT;
   $SIG{PIPE} = "IGNORE";
   $| = 1;

   for (;;) {
      4 == read STDIN, my $buf, 4
         or last;
      my $len = unpack "N", $buf;
      $len == read STDIN, $buf, $len
         or die "short perl frame\n";

      my @result = do {
         (my $source, local @ARGV) = unpack "(w/a*)*", $buf;
         ("+", eval $source)
      };

      @result = ("-", $@)
         if $@;

      print pack "N/a*", pack "(w/a*)*", @result
         or die "stdout: $!\n"
   }
};

sub perl_frame {
   pack "N/a*", pack "(w/a*)*", @_
}

my $perl_worker;

sub perl_eval {
   my ($req, $workdir, $sandbox_grants, $source, $args, $timeout, $done) = @_;

   my @command = ((fs_sandbox $workdir, $sandbox_grants), $perl, "-e", $perl_slave);
   my $key = pack "(w/a*)*", @command;
   my $io = $perl_worker;
   undef $perl_worker;

   if ($io && ($io->{perl_key} ne $key || !$io->{proc}{pid})) {
      proc_destroy $io;
      undef $io;
   }

   unless ($io) {
      $io = proc_spawn @command;
      $io->{rbuf_max} = (1 << 20) + 4096;
      $io->{perl_key} = $key;
      weaken (my $this = $io);

      my $idle_destroy = sub {
         my $io = $this or return;

         undef $perl_worker if $perl_worker && $perl_worker == $io;
         proc_destroy $io;
      };
      my $idle_stderr = sub { $_[0]{rbuf} = "" };

      $io->{perl_idle} = sub {
         my ($io) = @_;
         my $err = $io->{proc_err};

         $io ->on_eof   ($idle_destroy);
         $io ->on_error ($idle_destroy);
         $err->on_eof   ($idle_destroy);
         $err->on_error ($idle_destroy);
         $err->on_read  ($idle_stderr );
         $io ->on_read  ($idle_destroy);
      };

      proc_on_exit $io->{proc}, sub {
         my $io = $this or return;

         $io->{perl_on_exit}->($_[0]) if $io->{perl_on_exit};
         $idle_destroy->() if $perl_worker && $perl_worker == $io;
      };
   }

   my $err = $io->{proc_err};
   my $timer;
   my $stderr = "";

   my $finish = sub {
      my ($failure, $payload) = @_;
      my $cb = $done or return;
      undef $done;
      undef $timer;
      delete $req->{on_cancel};
      delete $io->{perl_on_exit};

      if ($failure || defined $io->{proc}{status}) {
         my $status = $io->{proc}{status};
         my $reason = $failure || "exited (exit " . ($status >> 8)
            . ", signal " . ($status & 127) . ")";
         AE::log warn => "sandbox perl worker: $reason"
            unless $failure && $failure =~ /\Asandbox perl (?:cancelled|timed out)\n\z/;
         proc_destroy $io;
         return $cb->(0, $failure || "sandbox perl exited\n")
            unless $req->{finished};
         return;
      }

      my (@response, $error);
      my $ok = eval {
         @response = unpack "(w/a*)*", $payload;
         my $status = shift @response;
         defined $status or die "missing perl response status\n";
         if ($status eq "-") {
            $error = AnyEvent::MCP::utf8dec $response[0];
         } elsif ($status ne "+") {
            die "invalid perl response status\n";
         }
         1
      };

      unless ($ok) {
         my $error = $@;
         AE::log warn => "sandbox perl worker: $error";
         proc_destroy $io;
         return $cb->(0, $error) unless $req->{finished};
         return;
      }

      # the response completes the request; the interpreter remains idle.
      proc_destroy $perl_worker if $perl_worker;
      $perl_worker = $io;
      $io->{perl_idle}->($io);
      return if $req->{finished};
      return $cb->(0, $error) if defined $error;
      $cb->(1, \@response);
   };

   $io->{perl_on_exit} = sub {
      my ($status) = @_;
      $finish->("sandbox perl failed (exit " . ($status >> 8)
         . ", signal " . ($status & 127) . "): $stderr\n");
   };

   $req->{on_cancel} = sub { $finish->("sandbox perl cancelled\n") };
   $io->on_eof (sub { $finish->("short perl response\n") });
   $io->on_error (sub { $finish->("sandbox perl stdout: $_[2]\n") if $_[1] });
   $err->on_read (sub {
      $stderr .= substr $_[0]{rbuf}, 0, 65536 - length $stderr
         if length $stderr < 65536;
      $_[0]{rbuf} = "";
   });
   $err->on_eof (sub { $finish->("sandbox perl stderr closed\n") });
   $err->on_error (sub { $finish->("sandbox perl stderr: $_[2]\n") if $_[1] });

   $timer = AE::timer $timeout, 0, sub { $finish->("sandbox perl timed out\n") };
   my $ok = eval {
      $io->push_read (packstring => "N", sub {
         my ($io, $payload) = @_;

         return $finish->("unexpected sandbox perl output\n")
            if length $io->{rbuf};
         $finish->(undef, $payload);
      });
      $io->push_write (perl_frame $source, @$args);
      1
   };
   $finish->($@) unless $ok;
}

# resolve a configured workdir by persistent ID or exact path.
sub fs_workdir {
   my ($id) = @_;

   $id = $workdir_ids->{ids}[0] if !defined $id and @workdir == 1;

   defined $id && !ref $id
      or die "select a configured workdir by ID or exact path\n";

   my $i;
   if ($id =~ /\A[0-9]+\z/) {
      ($i) = grep $workdir_ids->{ids}[$_] == $id, 0 .. $#workdir;
      defined $i or die "Unknown workdir ID '$id'\n";
   } else {
      my @match = grep { $id eq $workdir_identity[$_] || $id eq $workdir[$_] } 0 .. $#workdir;
      @match == 1 or die @match
         ? "Ambiguous configured workdir '$id'\n"
         : "Unknown configured workdir '$id'\n";
      $i = $match[0];
   }

   wantarray ? ($workdir[$i], $workdir_identity[$i]) : $workdir[$i]
}

my $workdir_schema = {
   description => "Workdir ID or configured absolute path. Get IDs/paths from cerebro-fs.workdirs. IDs are persistent.",
   anyOf => [
      { type => "integer", minimum => 1 },
      { type => "string", minLength => 1 },
   ],
};

sub fs_result;

# command output options affect presentation, never argv or permission scope.
my %output_schema = (
   grep => { type => "string", description => "Optional PCRE stdout line filter after capture; no shell." },
   max_lines => { type => "integer", minimum => 1, maximum => 100000, default => 2000,
      description => "Max stdout lines after filtering." },
   max_bytes => { type => "integer", minimum => 1, maximum => 1048576, default => 65536,
      description => "Max returned UTF-8 bytes per stream; stderr unfiltered." },
);

sub fs_output_options {
   my ($args) = @_;

   my %options = (max_lines => $args->{max_lines} // 2000, max_bytes => $args->{max_bytes} // 65536);
   for my $name (qw(max_lines max_bytes)) {
      $options{$name} =~ /\A[0-9]+\z/ && $options{$name} >= 1
         && $options{$name} <= $output_schema{$name}{maximum}
         or die "invalid $name\n";
   }

   if (exists $args->{grep}) {
      defined $args->{grep} && !ref $args->{grep} && $args->{grep} !~ /\0/
         && length $args->{grep} <= 65536
         or die "grep must be a string without NUL, at most 65536 characters\n";
      $grep or die "output filtering needs GNU grep\n";
      $options{grep} = AnyEvent::MCP::utf8enc $args->{grep};
   }

   \%options
}

# clipping a UTF-8 stream may leave at most three bytes of an incomplete character.
sub fs_output_text {
   my ($bytes, $cut) = @_;

   for (0 .. ($cut ? 3 : 0)) {
      my $text = $bytes;
      return $text if utf8::decode $text;
      chop $bytes;
   }

   die "command output is not UTF-8\n";
}

# preserve child status while bounding capture and, separately, returned output.
sub fs_command {
   my ($req, $workdir, $grants, $argv, $input, $timeout, $options, $cwd) = @_;

   # argv and input are octets; workdir and cwd are Unicode paths.
   my $workdir_bytes = AnyEvent::MCP::utf8enc $workdir;

   # check the actual directory inside the worker, after resolving symlinks.
   $argv = [$perl, "-MCwd", "-e", q{
      my $workdir = shift;
      chdir shift or die "VCS chdir: $!\n";
      my $cwd = Cwd::getcwd ();
      defined $cwd && ($workdir eq "/" || $cwd eq $workdir || (index $cwd, "$workdir/") == 0)
         or die "VCS cwd must resolve within the selected workdir\n";
      exec {$ARGV[0]} @ARGV;
      die "VCS exec: $!\n";
   }, $workdir_bytes, (AnyEvent::MCP::utf8enc $cwd), @$argv] if defined $cwd;

   my @command = ((fs_sandbox $workdir, $grants),
      $bwrap ? @$argv
         : ($remote ? $perl : $^X, "-e", 'chdir shift or die "chdir: $!"; exec @ARGV; die "exec: $!";', $workdir_bytes, @$argv));
   my ($stdout, $stderr) = ("", "");
   my ($stdout_cut, $stderr_cut);

   my $capture = sub {
      my ($handle, $out, $cut) = @_;
      my $remaining = 1048576 - length $$out;
      $$cut = 1 if length $handle->{rbuf} > $remaining;
      $$out .= substr $handle->{rbuf}, 0, $remaining if $remaining > 0;
      $handle->{rbuf} = "";
      0
   };

   proc_run $req, \@command, $input, $timeout,
      sub { $capture->($_[0], \$stdout, \$stdout_cut) },
      sub { $capture->($_[0], \$stderr, \$stderr_cut) },
      sub {
         my ($status, $timed_out, $failure) = @_;
         return $req->error ($failure) if $failure;

         my $result = {
            exit => $status >> 8, signal => $status & 127,
            timed_out => $timed_out ? JSON::XS::true : JSON::XS::false,
            capture_truncated => $stdout_cut || $stderr_cut || $timed_out ? JSON::XS::true : JSON::XS::false,
         };

         my $finish = sub {
            my $ok = eval {
               $stdout_cut = 1 if length $stdout > $options->{max_bytes};
               $stderr_cut = 1 if length $stderr > $options->{max_bytes};
               my $out = fs_output_text (substr ($stdout, 0, $options->{max_bytes}), $stdout_cut);
               my $err = fs_output_text (substr ($stderr, 0, $options->{max_bytes}), $stderr_cut);
               my @lines = split /(?<=\n)/, $out;
               if (@lines > $options->{max_lines}) {
                  splice @lines, $options->{max_lines};
                  $out = join "", @lines;
                  $stdout_cut = 1;
               }
               @$result{qw(stdout stderr)} = ($out, $err);
               $result->{stdout_truncated} = $stdout_cut || $timed_out ? JSON::XS::true : JSON::XS::false;
               $result->{stderr_truncated} = $stderr_cut || $timed_out ? JSON::XS::true : JSON::XS::false;
               $result->{truncated} = $stdout_cut || $stderr_cut || $timed_out ? JSON::XS::true : JSON::XS::false;
               1
            };
            return $req->error ($@) unless $ok;
            $req->reply (fs_result $result, exists $result->{filter_error});
         };

         return $finish->() unless exists $options->{grep};

         {
            my $ok = eval { $stdout = AnyEvent::MCP::utf8enc (fs_output_text $stdout, $stdout_cut); 1 };
            return $req->error ($@) unless $ok;
         }

         # regex execution stays in a timed worker, outside the broker's event loop.
         my @filter = ((fs_sandbox $workdir, $grants), $grep, "-aP", "--", $options->{grep});
         fs_run $req, \@filter, $stdout, 5, 1048576, 0, sub {
            my ($success, $filtered) = @_;
            if (!$success || $filtered->{exit} > 1 || $filtered->{signal} || $filtered->{timed_out}) {
               my $error = $success ? $filtered->{stderr} : $filtered;
               $error = eval { fs_output_text (substr ($error, 0, 4096), 1) } || "no diagnostic";
               $result->{filter_error} = "stdout filter failed: $error";
               $stdout = "";
               $stdout_cut = 1;
            } else {
               $stdout = $filtered->{stdout};
               $stdout_cut ||= $filtered->{truncated};
            }
            $finish->();
         };
      };
}

# wrap raw text as an MCP text result.
sub fs_text_result {
   my ($text, $failed) = @_;

   my $response = {
      content => [{
         type => "text",
         text => $text,
      }],
   };

   $response->{isError} = JSON::XS::true if $failed;

   $response
}

# wrap a Perl value as an MCP text result.
sub fs_result {
   my ($result, $failed) = @_;

   my $response = fs_text_result (JSON::XS->new->encode ($result), $failed);
   $response->{structuredContent} = $result;

   $response
}

mcp_tool workdirs =>
   "List workdirs, VCS markers (remote snapshot at startup), available VCS clients, sandbox grants, trusted mounts, runtime paths.",
   {
      type                 => "object",
      properties           => {},
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      AE::log debug => "fs workdirs";

      # report metadata markers, not an inferred repository for the tree.
      my %marker = (cvs => "CVS", git => ".git", hg => ".hg", svn => ".svn");
      my %workdir_vcs = map {
         my $i = $_;
         ($workdir_identity[$i] => $remote ? $remote_vcs_marker[$i] : [grep {
            lstat "$workdir[$i]/$marker{$_}" && (-d _ || -l _ || ($_ eq "git" && -f _))
         } sort keys %marker])
      } 0 .. $#workdir;

      $req->reply (fs_result +{
         ($remote ? (host => $host, rsh => $rsh) : ()),
         workdirs                   => { map { $workdir_ids->{ids}[$_] => $workdir_identity[$_] } reverse 0 .. $#workdir },
         resolved_workdirs          => { map { $workdir_ids->{ids}[$_] => $workdir[$_] } 0 .. $#workdir },
         workdir_vcs                => \%workdir_vcs,
         vcs_backends               => [sort grep defined $vcs_program{$_}, keys %vcs_program],
         umask                      => (sprintf "%04o", $umask),
         runtime_paths              => \@runtime_path,
         mounts                     => \@mount,
         sandbox_grants             => \%sandbox_grant,
         exec_default_sandbox_grants => \@exec_default_sandbox_grants,
         unavailable_sandbox_grants  => ["host-proc"],
      });
   }
;

# escape a pathname for compact line-oriented text output.
sub escape_path {
   my ($text) = @_;

   $text =~ s/\\/\\\\/g;
   $text =~ s/\n/\\n/g;
   $text
}

sub format_iec_number {
   my ($number) = @_;

   for my $suffix ("", qw(k M G T P)) {
      return "$number$suffix" if $number < 1024 or $suffix eq "P";
      $number = int (($number + 512) / 1024);
   }
}

sub fs_find_relative {
   my ($base, $path) = @_;

   return "" if $path eq $base;
   substr $path, (length $base) + ($base eq "/" ? 0 : 1)
}

sub format_path_listing {
   my ($base, $record, $truncated) = @_;

   my (@line, $directory);

   for my $record (sort { $a->[2] cmp $b->[2] } @$record) {
      my ($type, $size, $full_path) = @$record;
      my $relative = fs_find_relative $base, $full_path;

      if ($type eq "d") {
         push @line, "/" . (escape_path $relative);
         $directory = $relative;
         next;
      }

      my ($dir, $name);

      if (!length $relative) {
         ($name) = $full_path =~ m{([^/]*)\z};
      } else {
         ($dir, $name) = $relative =~ m{\A(?:(.*)/)?([^/]*)\z};
         $dir //= "";

         if (!defined $directory or $directory ne $dir) {
            push @line, "/" . (escape_path $dir);
            $directory = $dir;
         }
      }

      $name = escape_path $name;
      push @line, $type eq "f"
         ? (join "\t", $type, (format_iec_number $size), $name)
         : (join "\t", $type, $name);
   }

   push @line, "!truncated" if $truncated;

   join "", map "$_\n", @line
}

sub fs_list_find {
   my ($req, $args, $recurse) = @_;

   my $tool = $recurse ? "find" : "list";

   my ($workdir, $identity) = fs_workdir $args->{workdir};
   my $path = fs_path $workdir, length $args->{path} ? $args->{path} : ".";
   my $limit = $args->{limit} // 200;
   $limit <= 1000
      or die "invalid limit\n";

   my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "read",
      $args->{reason} // "$tool $path");

   if ($recurse) {
      AE::log debug => join " ", "fs", $tool, $path, (substr $args->{name}, 0, 40);
   } else {
      AE::log debug => "fs $tool $path";
   }

   my $find_path = AnyEvent::MCP::utf8enc $path;
   my @command = ((fs_sandbox $workdir, $granted), $find, $find_path);

   if ($recurse) {
      my $needle = AnyEvent::MCP::utf8enc $args->{name};
      $needle =~ s/([\\*?\[])/\\$1/g;
      push @command, "!", "-type", "d", "-name", "*$needle*";
   } else {
      push @command, "-maxdepth", "1";
   }

   push @command, "-printf", q{%y\0%s\0%p\0};

   my (@record, $seen, $truncated, $failure);
   my $stderr = "";

   proc_run $req, \@command, "", 30,
      sub {
         my ($handle, $eof) = @_;

         while (!$failure and !$truncated
                and $handle->{rbuf} =~ s/\A([^\0]*)\0([^\0]*)\0([^\0]*)\0//s) {
            my ($type, $size, $raw_path) = ($1, $2, $3);
            my $full_path = eval { AnyEvent::MCP::utf8dec $raw_path };

            if ($@) {
               $failure = "$tool returned a non-UTF-8 pathname\n";
               last;
            }

            if (++$seen > $limit) {
               $truncated = 1;
               last;
            }

            push @record, [$type, $size, $full_path];
         }

         $failure ||= "incomplete $tool output\n"
            if $eof && length $handle->{rbuf} && !$truncated;
         $handle->{rbuf} = "" if $failure or $truncated;
         $failure || $truncated
      },
      sub {
         my ($handle) = @_;
         my $remaining = 65536 - length $stderr;
         $stderr .= substr $handle->{rbuf}, 0, $remaining if $remaining > 0;
         $handle->{rbuf} = "";
         0
      },
      sub {
         my ($status, $timed_out, $io_failure) = @_;
         return if $req->{finished};

         my $result;
         my $ok = eval {
            die "$tool timed out\n" if $timed_out;
            die $failure || $io_failure if $failure || $io_failure;

            if (($status >> 8 or $status & 127) and !$truncated) {
               my $error = eval { AnyEvent::MCP::utf8dec $stderr };
               $error = "non-UTF-8 error output" if $@;
               die "$tool failed (exit " . ($status >> 8) . ", signal " . ($status & 127) . "): $error\n";
            }

            $result = fs_text_result (format_path_listing $path, \@record, $truncated);
            1
         };

         if ($ok) {
            $req->reply ($result);
         } else {
            $req->error ($@);
         }
      };
}

$find && mcp_tool list =>
   "List immediate entries; no symlink following. "
   . "Text format: /relative-directory headers; f<TAB>approx-size<TAB>name for files; "
   . "TYPE<TAB>name for l/p/s/b/c/? nodes. "
   . "Size suffixes k/M/G/T/P use IEC powers (1024); "
   . "!truncated means limit exceeded. Names escape backslash/newline.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type        => "string",
            description => "Directory; omitted/empty = .",
         },
         limit  => {
            type    => "integer",
            minimum => 1,
            maximum => 1000,
            default => 200,
         },
         workdir => $workdir_schema,
         reason => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      additionalProperties => JSON::XS::false,
   },
   sub {
      fs_list_find $_[0], $_[1], 0
   }
;

$find && mcp_tool find =>
   "Find non-directory entries recursively by literal basename substring; no symlink following. Output as list.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type        => "string",
            description => "Search root; omitted/empty = .",
         },
         name   => {
            type        => "string",
            minLength   => 1,
            description => "Literal basename substring.",
         },
         limit  => {
            type    => "integer",
            minimum => 1,
            maximum => 1000,
            default => 200,
         },
         workdir => $workdir_schema,
         reason => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["name"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      fs_list_find $_[0], $_[1], 1
   }
;

my $file_read = q{#perl
   my ($path, $offset, $length) = @ARGV;

   open my $fh, "<:raw", $path     or return 0, "open: $!";
   defined sysseek $fh, $offset, 0 or return 0, "seek: $!";
   my $n = sysread $fh, my $data, $length;
   defined $n                      or return 0, "read: $!";

   (1, $data)
};

$perl && mcp_tool file_read =>
   "Read up to 1 MiB at byte offset. Returns {data: BASE64}, even for text; {error: STRING} on filesystem failure. Prefer read-lines for source/text.",
   {
      type                 => "object",
      properties           => {
         path     => {
            type => "string",
         },
         offset   => {
            type    => "integer",
            minimum => 0,
            default => 0,
         },
         length   => {
            type    => "integer",
            minimum => 1,
            maximum => 1<<20,
            default => 1<<16,
         },
         workdir => $workdir_schema,
         reason   => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["path"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $offset = $args->{offset} // 0;
      my $length = $args->{length} // 65536;
      $length <= 1<<20
         or die "invalid read range\n";
      my $path = fs_path $workdir, $args->{path};

      my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "read",
         $args->{reason} // "read $path");

      AE::log debug => join " ", "fs file-read", $path, $offset, $length;

      perl_eval $req, $workdir, $granted, $file_read,
         [AnyEvent::MCP::utf8enc $path, $offset, $length], 30, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         @$result == 2
            or return $req->error ("invalid file-read response\n");
         my ($ok, $value) = @$result;
         if ($ok eq "1") {
            $req->reply (fs_result {
               data => MIME::Base64::encode_base64 ($value, ""),
            });
         } elsif ($ok eq "0") {
            $req->reply (fs_result {
               error => AnyEvent::MCP::utf8dec $value,
            });
         } else {
            $req->error ("invalid file-read status\n");
         }
      };
   }
;

$sed && mcp_tool read_lines =>
   "Read byte-LF (0x0A) lines by positive line ranges. "
   . "encoding: strict utf-8 (default), latin1 (raw bytes as text), base64 (exact range bytes). "
   . "linenums=true prefixes absolute line number plus colon (before base64 encoding). "
   . "Per range: two MCP text items, [range=N,M] metadata (truncated=1 if cut), then lines without added newlines. Preserves order, overlaps, duplicates; max 1 MiB raw output.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type => "string",
         },
         ranges => {
            type     => "array",
            description => 'Inclusive line ranges as strings, e.g. ["1,60", "80"]. Comma, not dash.',
            items    => {
               type    => "string",
               pattern => q{^[1-9][0-9]*(?:,[1-9][0-9]*)?$},
            },
            minItems => 1,
            maxItems => 20,
         },
         encoding => {
            type        => "string",
            description => "Range format: strict utf-8 (default), latin1, base64. Lines split at byte LF (0x0A).",
            enum        => ["utf-8", "latin1", "base64"],
            default     => "utf-8",
         },
         linenums => {
            type        => "boolean",
            description => "Prefix all lines, including blanks, with absolute number and colon.",
            default     => JSON::XS::false,
         },
         workdir => $workdir_schema,
         reason => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["path", "ranges"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my $encoding = $args->{encoding} // "utf-8";
      $encoding =~ /\A(?:utf-8|latin1|base64)\z/ or die "invalid read-lines encoding\n";

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $path = fs_path $workdir, $args->{path};
      my @range = map {
         my ($start, $end) = /\A([1-9]\d*)(?:,([1-9]\d*))?\z/
            or die "invalid line range\n";
         $end //= $start;
         $start <= $end
            or die "invalid line range\n";
         [$_, $start, $end]
      } @{$args->{ranges}};

      my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "read",
         $args->{reason} // "read lines $path");

      AE::log debug => join " ", "fs read-lines", $path, map $_->[0], @range;

      my (@result, $truncated);
      my $remaining = 1 << 20;
      my $next;
      $next = sub {
         unless (@range) {
            undef $next;
            my @content;
            for my $i (0 .. $#result) {
               my ($range, $body) = @{$result[$i]};
               my $header = "[range=$range";
               $header .= " truncated=1" if $truncated && $i == $#result;
               push @content,
                  { type => "text", text => "$header]" },
                  { type => "text", text => $body };
            }
            push @content, { type => "text", text => "[truncated=1]" }
               if $truncated && !@content;
            return $req->reply ({ content => \@content });
         }

         my ($range, $start, $end) = @{shift @range};
         my @command = (
            (fs_sandbox $workdir, $granted),
            $sed, "-n",
            "-e", ($start == $end ? "${start}p" : "${start},${end}p"),
            "-e", "${end}Q", # Preserve unterminated final line (GNU sed).
            AnyEvent::MCP::utf8enc $path,
         );

         fs_run $req, \@command, "", 30, $remaining, 0, sub {
            my ($success, $value) = @_;

            return $req->error ($value)
               unless $success;

            my $body;
            my $ok = eval {
               die "read-lines timed out\n" if $value->{timed_out};
               if ($value->{exit} or $value->{signal}) {
                  my $stderr = AnyEvent::MCP::utf8dec $value->{stderr};
                  die "read-lines failed (exit $value->{exit}, signal $value->{signal}): $stderr\n";
               }
               if ($args->{linenums} && length $value->{stdout}) {
                  my $line = $start;
                  $value->{stdout} =~ s/^/$line++ . ":"/gme;
                  if (length $value->{stdout} > $remaining) {
                     substr ($value->{stdout}, $remaining) = "";
                     $value->{truncated} = 1;
                  }
               }
               $body = $encoding eq "utf-8" ? AnyEvent::MCP::utf8dec $value->{stdout}
                     : $encoding eq "base64" ? MIME::Base64::encode_base64 ($value->{stdout}, "")
                     : $value->{stdout}; # Unflagged byte strings are Latin-1 to Perl/JSON::XS.
               1
            };
            return $req->error ($@)
               unless $ok;

            push @result, [$range, $body];
            $remaining -= length $value->{stdout};
            if ($value->{truncated} or ($remaining <= 0 and @range)) {
               $truncated = 1;
               @range = ();
            }
            $next->();
         };
      };

      $next->();
   }
;

my $file_write = q{#perl
   my ($path, $offset, $data) = @ARGV;

   use Fcntl qw(O_WRONLY O_CREAT);
   sysopen my $fh, $path, O_WRONLY | O_CREAT, 0666 or return 0, "open: $!";

   binmode $fh;
   defined sysseek $fh, $offset, 0 or return 0, "seek: $!";
   my $n = syswrite $fh, $data;
   defined $n or return 0, "write: $!";

   (1, "$n")
};

$perl && mcp_tool file_write =>
   "Write up to 1 MiB Base64-decoded bytes at offset; no truncation. Returns {bytes: INTEGER} or {error: STRING} on filesystem failure.",
   {
      type                 => "object",
      properties           => {
         path    => {
            type => "string",
         },
         offset  => {
            type    => "integer",
            minimum => 0,
            default => 0,
         },
         data    => {
            type => "string",
         },
         workdir => $workdir_schema,
         reason  => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["path", "data"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $offset = $args->{offset} // 0;
      my $data = MIME::Base64::decode_base64 $args->{data};
      MIME::Base64::encode_base64 ($data, "") eq $args->{data}
         or die "invalid base64 data\n";
      length $data <= 1048576
         or die "write data exceeds 1 MiB\n";
      my $path = fs_path $workdir, $args->{path};

      my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "write",
         $args->{reason} // "write $path");

      AE::log debug => join " ", "fs file-write", $path, $offset, length ($data);

      perl_eval $req, $workdir, $granted, $file_write,
         [AnyEvent::MCP::utf8enc $path, $offset, $data], 30, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         @$result == 2
            or return $req->error ("invalid file-write response\n");
         my ($ok, $value) = @$result;
         if ($ok eq "1") {
            $value =~ /\A[0-9]+\z/
               or return $req->error ("invalid file-write byte count\n");
            $req->reply (fs_result {
               bytes => 0 + $value,
            });
         } elsif ($ok eq "0") {
            $req->reply (fs_result {
               error => AnyEvent::MCP::utf8dec $value,
            });
         } else {
            $req->error ("invalid file-write status\n");
         }
      };
   }
;

my $path_op = q{#perl
   while (@ARGV) {
      my $op = shift;

      if ($op eq "unlink") {
         my $path = shift;

         unlink $path
            or die "unlink $path: $!\n";
      } elsif ($op eq "rmdir") {
         my $path = shift;

         rmdir $path
            or die "rmdir $path: $!\n";
      } elsif ($op eq "mkdir") {
         my ($path, $mode) = splice @ARGV, 0, 2;
         $mode = oct $mode;
         mkdir $path, $mode
            or die "mkdir $path: $!\n";
         chmod $mode, $path
            or die "chmod $path: $!\n";
      } elsif ($op eq "mkpath") {
         my ($path, $mode) = splice @ARGV, 0, 2;
         $mode = oct $mode;
         my $prefix = "";

         for (split m{/}, $path) {
            next unless length;
            $prefix .= "/$_";
            next if -d $prefix;
            mkdir $prefix, $mode
               or die "mkdir $prefix: $!\n";
            chmod $mode, $prefix
               or die "chmod $prefix: $!\n";
         }
      } elsif ($op eq "symlink") {
         my ($target, $path) = splice @ARGV, 0, 2;
         symlink $target, $path
            or die "symlink $path: $!\n";
      } elsif ($op eq "truncate") {
         my ($path, $size) = splice @ARGV, 0, 2;
         truncate $path, $size
            or die "truncate $path: $!\n";
      } elsif ($op eq "chmod") {
         my ($path, $mode) = splice @ARGV, 0, 2;
         $mode = oct $mode;
         chmod $mode, $path
            or die "chmod $path: $!\n";
      } elsif ($op eq "rename") {
         my ($path, $to) = splice @ARGV, 0, 2;
         rename $path, $to
            or die "rename $path -> $to: $!\n";
      } else {
         die "invalid path operation '$op'\n";
      }
   }

   1
};

$perl && mcp_tool path_op =>
   "Mutate paths in fixed order: unlink, rmdir, mkpath, mkdir, symlink, truncate, chmod, rename. "
   . "Stop at first failure; earlier changes remain (no rollback). "
   . "mkpath creates missing components in worker; symlink target is link text, not sandbox authority.",
   {
      type                 => "object",
      properties           => {
         path     => {
            type => "string",
         },
         unlink   => {
            type => "boolean",
         },
         rmdir    => {
            type => "boolean",
         },
         mkdir    => {
            description => "Create directory with final mode (ignores umask).",
            anyOf       => [
               { type => "string", pattern => q{^[0-7]+$} },
               { type => "integer", minimum => 0 },
            ],
         },
         mkpath   => {
            description => "Create missing directories with final mode (ignores umask).",
            anyOf       => [
               { type => "string", pattern => q{^[0-7]+$} },
               { type => "integer", minimum => 0 },
            ],
         },
         symlink  => {
            type        => "string",
            minLength   => 1,
            description => "Create symlink; value is link target.",
         },
         truncate => {
            type    => "integer",
            minimum => 0,
         },
         chmod     => {
            anyOf => [
               { type => "string", pattern => q{^[0-7]+$} },
               { type => "integer", minimum => 0 },
            ],
         },
         rename    => {
            type        => "string",
            minLength   => 1,
            description => "Rename destination.",
         },
         workdir => $workdir_schema,
         reason    => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["path"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      ($args->{unlink} or $args->{rmdir}
       or grep { exists $args->{$_} } qw(mkdir mkpath symlink truncate chmod rename))
         or die "no path operation requested\n";

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $path = fs_path $workdir, $args->{path};
      my $rename = exists $args->{rename}
         ? fs_path $workdir, $args->{rename}
         : undef;
      die "mkpath requires a path in the selected workdir\n"
         if exists $args->{mkpath} && !fs_inside ($path, $workdir);

      my $json = JSON::XS->new;
      my @log = map {
         ($_ eq "unlink" or $_ eq "rmdir")
            ? ($args->{$_} ? $_ : ())
            : (exists $args->{$_}
               ? "$_: " . $json->encode ($_ eq "rename" ? $rename : $args->{$_}) : ())
      } qw(unlink rmdir mkpath mkdir symlink truncate chmod rename);
      my $reason = join "\n",
         (defined $args->{reason} ? $args->{reason} : ()),
         "Path: " . $json->encode ($path), "Operations (in order):", map "  $_", @log;

      my $granted = fs_require_paths $req, $workdir, $identity,
         [$path, (defined $rename ? $rename : ())], "write", $reason;

      AE::log debug => join " ", "fs path-op", $path, @log;

      my @operation;
      my $raw_path = AnyEvent::MCP::utf8enc $path;

      push @operation, unlink => $raw_path
         if $args->{unlink};
      push @operation, rmdir => $raw_path
         if $args->{rmdir};
      push @operation, mkpath => $raw_path, $args->{mkpath}
         if exists $args->{mkpath};
      push @operation, mkdir => $raw_path, $args->{mkdir}
         if exists $args->{mkdir};
      push @operation, symlink => (AnyEvent::MCP::utf8enc $args->{symlink}), $raw_path
         if exists $args->{symlink};
      push @operation, truncate => $raw_path, $args->{truncate}
         if exists $args->{truncate};
      push @operation, chmod => $raw_path, $args->{chmod}
         if exists $args->{chmod};
      push @operation, rename => $raw_path, (AnyEvent::MCP::utf8enc $rename)
         if defined $rename;

      perl_eval $req, $workdir, $granted, $path_op,
         \@operation, 30, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         @$result == 1 and $result->[0] eq "1"
            or return $req->error ("invalid path-op response\n");
         $req->reply (fs_text_result "ok\n");
      };
   }
;

my $file_patch = q{#perl
   use Fcntl qw(O_RDWR O_CREAT O_EXCL);
   use Errno qw(EEXIST ENAMETOOLONG);

   my ($patch, $path, $diff, @max_offset) = @ARGV;

   my $create_tempfile = sub {
      my ($name) = @_;
      utf8::decode $name
         or return undef, "invalid UTF-8 tempfile name";

      my $slash = rindex $name, "/";
      my $dir = $slash < 0 ? "" : substr $name, 0, $slash + 1;
      my $file = substr $name, $slash + 1;

      for (;;) {
         my $pathname = "$dir$file";
         utf8::encode $pathname;

         if (sysopen my $fh, $pathname, O_RDWR | O_CREAT | O_EXCL, 0600) {
            binmode $fh;
            return $fh, $pathname
         }

         if ($! == EEXIST) {
            $file .= "~";
         } elsif ($! == ENAMETOOLONG) {
            substr $file, (length $file) * .75, 2, "~";
         } else {
            return undef, "open tempfile: $!"
         }
      }
   };

   # deliberately self-contained: patch validation must not load host modules.
   my $check_patch_output = sub {
      my ($status, $output, @max_offset) = @_;
      my (@hunks, @unparsed);

      for (split /\n/, $output) {
         if (/^Hunk #(\d+) (succeeded|FAILED|ignored) at (-?\d+)(?: with fuzz (\d+))?(?: \(offset (-?\d+) lines?\))?\.\z/) {
            push @hunks, [0 + $1, $2 eq "succeeded", 0 + $4, 0 + $5];
         } elsif (!length
            || /^Hmm\.\.\. +Looks like a unified diff to me\.\.\.\z/
            || /^The text leading up to this was:\z/
            || /^-+\z/ || /^\|/
            || /^patching file / || /^checking file /
            || /^Using Plan [AB]\.\.\.\z/ || /^done\z/) {
            # GNU patch --verbose framing.
         } else {
            push @unparsed, $_;
         }
      }

      $status == 0
         or die "patch failed (wait status $status):\n$output";
      @unparsed == 0
         or die "patch: unrecognized output:\n" . (join "\n", @unparsed) . "\n";
      @hunks == @max_offset && @hunks
         or die "patch: expected " . @max_offset . " hunks, got " . @hunks . "\n";

      for my $i (0 .. $#hunks) {
         my ($number, $success, $fuzz, $offset) = @{$hunks[$i]};

         $number == $i + 1
            or die "patch: unexpected hunk number $number\n";
         $success
            or die "patch: hunk $number failed\n";
         !$fuzz
            or die "patch: hunk $number used fuzz $fuzz\n";
         abs ($offset) <= $max_offset[$i]
            or die "patch: hunk $number offset $offset exceeds $max_offset[$i]\n";
      }
   };

   my $run_patch = sub {
      my ($newname, $path, $diff) = @_;

      my ($errfh, $errname) = $create_tempfile->("/tmp/mcp-fs~~patch~~");
      $errfh
         or return undef, $errname;

      local $ENV{LC_ALL} = "C";
      open my $write, "|-", "sh", "-c",
         q{exec "$4" --unified --verbose --binary --batch --forward --get=0 --fuzz=0 --reject-file=- --no-backup-if-mismatch -o "$2" "$1" >"$3" 2>&1},
         "--", $path, $newname, $errname, $patch
         or return undef, "open patch pipe: $!";

      my $write_error;
      {
         print $write $diff
            or $write_error = "write patch: $!";
         close $write;
      }

      my $status = $?;

      unlink $errname
         or return undef, "unlink patch stderr: $!";
      defined sysseek $errfh, 0, 0
         or return undef, "seek patch stderr: $!";
      my $output = do { local $/; <$errfh> };
      $output = "" unless defined $output;
      $output =~ s/\s+\z//;

      return undef, $write_error
         if $write_error and !$status;

      $status, $output
   };

   my $replace_file = sub {
      my ($path, $before, $newfh, $newname) = @_;

      chown $before->[4], $before->[5], $newfh;
      chmod $before->[2], $newfh;

      my @after = lstat $path;
      @after
         or return undef, "lstat: $!";
      (join "\0", @$before[0, 1, 2, 3, 4, 5, 7, 9, 10])
         eq (join "\0", @after[0, 1, 2, 3, 4, 5, 7, 9, 10])
         or return undef, "file changed while applying patch";
      my @new = stat $newfh;
      $after[3] == 1
         or return undef, "refusing to replace multiply-linked file";
      (join "\0", @after[2, 4, 5]) eq (join "\0", @new[2, 4, 5])
         or return undef, "cannot preserve file metadata";

      rename $newname, $path
         or return undef, "rename: $!";

      $new[7], undef
   };

   my @before = lstat $path;
   @before
      or return 0, "lstat: $!";
   -f _
      or return 0, "not a regular file";

   my ($newfh, $newname) = $create_tempfile->("$path~~new~~");
   $newfh
      or return 0, $newname;

   my ($status, $output) = $run_patch->($newname, $path, $diff);
   unless (defined $status) {
      unlink $newname;
      return 0, $output
   }

   unless (eval { $check_patch_output->($status, $output, @max_offset); 1 }) {
      my $error = $@;
      unlink $newname;
      return 0, $error
   }

   my ($bytes, $error) = $replace_file->($path, \@before, $newfh, $newname);
   unlink $newname unless defined $bytes;
   defined $bytes
      ? (1, "$bytes")
      : (0, $error)
};

$perl && $patch && mcp_tool file_patch =>
   "Patch one regular file via unified diff. Recompute hunk counts; no fuzz. "
   . "Whole-hunk relocation bounded per hunk by distinct old-side lines. "
   . "Pure insertion only at file start; elsewhere include old-side context. "
   . "diff: Unicode text (encoded UTF-8) "
   . "or Base64 raw bytes; autodetect by @ hunk markers ("
   . "Base64 cannot contain @).",
   {
      type                 => "object",
      properties           => {
         path    => { type => "string" },
         diff    => { type => "string", minLength => 1 },
         workdir => $workdir_schema,
         reason  => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["path", "diff"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $path = fs_path $workdir, $args->{path};
      my $diff = $args->{diff};
      my $detail = $diff;

      if ((index $diff, "@") >= 0) {
         $diff = AnyEvent::MCP::utf8enc $diff;
      } else {
         my $bytes = MIME::Base64::decode_base64 $diff;
         MIME::Base64::encode_base64 ($bytes, "") eq $diff
            or die "invalid base64 diff\n";
         $diff = $bytes;
         $detail = eval { AnyEvent::MCP::utf8dec $bytes };

         unless (defined $detail) {
            $detail = $bytes;
            $detail =~ s/([^\x09\x0a\x20-\x5b\x5d-\x7e])/sprintf "\\x{%02X}", ord $1/ge;
            $detail = "Raw patch: " . length ($bytes) . " bytes (escaped byte view)\n\n" . $detail;
         }
      }

      my $max_offset;
      ($diff, $max_offset) = AnyEvent::MCP::normalize_udiff $diff;
      length $diff <= 4<<20
         or die "patch exceeds 4 MiB\n";

      my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "write",
         $args->{reason} // "patch $path", { "View patch" => "File: $path\n\n$detail" });

      AE::log debug => join " ", "fs file-patch", $path, scalar (@$max_offset), "hunks", length ($diff), "bytes";

      perl_eval $req, $workdir, $granted, $file_patch,
         [$patch, AnyEvent::MCP::utf8enc $path, $diff, @$max_offset], 30, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         @$result == 2
            or return $req->error ("invalid file-patch response\n");
         my ($ok, $value) = @$result;

         if ($ok eq "1") {
            $value =~ /\A[0-9]+\z/
               or return $req->error ("invalid file-patch byte count\n");
            $req->reply (fs_result {
               bytes => 0 + $value,
            });
         } elsif ($ok eq "0") {
            $req->reply (fs_result {
               error => AnyEvent::MCP::utf8dec $value,
            });
         } else {
            $req->error ("invalid file-patch status\n");
         }
      };
   }
;

$find && $grep && mcp_tool grep =>
   "Search regular files up to 1 MiB recursively; skip symlinks and .git. "
   . "Literal match default; mode=pcre uses GNU grep -P. "
   . "Stop at limit; report truncation and timeout separately.",
   {
      type                 => "object",
      properties           => {
         path    => {
            type        => "string",
            description => "Search root; omitted/empty = .",
         },
         pattern => {
            type      => "string",
            minLength => 1,
         },
         mode    => {
            type    => "string",
            enum    => ["fixed", "pcre"],
            default => "fixed",
         },
         limit   => {
            type        => "integer",
            minimum     => 1,
            maximum     => 1000,
            default     => 200,
            description => "Max matching lines.",
         },
         workdir => $workdir_schema,
         reason  => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["pattern"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $path = fs_path $workdir, length $args->{path} ? $args->{path} : ".";
      my $mode = $args->{mode} // "fixed";
      $mode eq "fixed" or $mode eq "pcre"
         or die "invalid grep mode\n";
      my $limit = $args->{limit} // 200;
      $limit <= 1000
         or die "invalid limit\n";
      my $granted = fs_require_paths ($req, $workdir, $identity, [$path], "read",
         $args->{reason} // "grep $path");

      AE::log debug => join " ", "fs grep", $path, $mode, (substr $args->{pattern}, 0, 40);

      my $find_path = AnyEvent::MCP::utf8enc $path;
      my $pattern = AnyEvent::MCP::utf8enc $args->{pattern};
      my @command = (
         (fs_sandbox $workdir, $granted),
         $find, $find_path,
         "-name", ".git", "-prune", "-o",
         "-type", "f",
         "-size", "-1048577c",
         "-exec",
         # GNU find treats any nonzero -exec ... + batch as failure.
         # grep uses 1 for no matches, which is a successful empty search;
         # preserve all other errors (including find traversal failures).
         "/bin/sh", "-c", q{"$@" || [ "$?" -eq 1 ]}, "sh",
         $grep, ($mode eq "pcre" ? "-P" : "-F"),
         "-I", "-H", "-n", "--color=never", "-e", $pattern,
         "{}", "+",
      );

      fs_run $req, \@command, "", 30, 1024 * 1024, $limit, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         my $response;
         my $ok = eval {
            my $stdout = AnyEvent::MCP::utf8dec $result->{stdout};
            my $stderr = AnyEvent::MCP::utf8dec $result->{stderr};

            if (($result->{exit} or $result->{signal})
                and !$result->{truncated} and !$result->{timed_out}) {
               die "grep failed (exit $result->{exit}, signal $result->{signal}): $stderr\n";
            }

            $response = {
               stdout    => $stdout,
               stderr    => $stderr,
               timed_out => $result->{timed_out},
               truncated => $result->{truncated},
            };
            1
         };
         return $req->error ($@)
            unless $ok;

         $req->reply (fs_result $response);
      };
   }
;

my $stat = q{#perl
   map {
      my @s = lstat $_;

      pack "(w/a*)*", (@s
         ? (1, (-l _ ? "link" : -d _ ? "directory" : -f _ ? "file" : "other"), @s)
         : (0, "lstat: $!"))
   } @ARGV
};

$perl && mcp_tool stat =>
   "lstat up to 100 paths; no symlink following.",
   {
      type                 => "object",
      properties           => {
         paths  => {
            type     => "array",
            items    => {
               type => "string",
            },
            minItems => 1,
            maxItems => 100,
         },
         workdir => $workdir_schema,
         reason => {
            type        => "string",
            description => "Why access needed.",
         },
      },
      required             => ["paths"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      ARRAY:: eq ref $args->{paths} and @{$args->{paths}} and @{$args->{paths}} <= 100
         or die "stat needs 1..100 paths\n";
      my @paths = map { fs_path $workdir, $_ } @{$args->{paths}};
      die "stat paths must be inside the selected workdir\n"
         if grep { !fs_inside ($_, $workdir) } @paths;

      my $granted = fs_require_paths $req, $workdir, $identity, \@paths, "read", $args->{reason};

      my @log = @paths;
      splice @log, 3, @log - 3, "..." if @log > 3;
      AE::log debug => join " ", "fs stat", @log;

      perl_eval $req, $workdir, $granted, $stat, [map { AnyEvent::MCP::utf8enc $_ } @paths],
         30, sub {
         my ($success, $result) = @_;

         return $req->error ($result)
            unless $success;

         @$result == @paths
            or return $req->error ("invalid stat response\n");

         my @result;
         for my $i (0 .. $#paths) {
            my ($ok, @s) = unpack "(w/a*)*", $result->[$i];

            if ($ok) {
               my $type = shift @s;
               push @result, +{
                  path  => $paths[$i],
                  type  => $type,
                  size  => 0 + $s[7],
                  mode  => (sprintf "%04o", $s[2] & 07777),
                  uid   => 0 + $s[4],
                  gid   => 0 + $s[5],
                  mtime => 0 + $s[9],
               };
            } else {
               push @result, +{
                  path  => $paths[$i],
                  error => AnyEvent::MCP::utf8dec $s[0],
               };
            }
         }

         $req->reply (fs_result { result => \@result });
      };
   }
;

mcp_tool exec =>
   "Run argv " . ($bwrap ? "in bubblewrap. " : "UNSANDBOXED with full host-user privileges. ")
   . ($bwrap ? "Private /tmp by default (gone after exec); use for temp files/IPC. shared-tmp exposes HOST /tmp (sockets/services). Request ONLY for HOST /tmp, NOT ordinary temp/IPC. " : "")
   . "stdin_encoding: utf-8 (default), latin1 or base64; max 4 MiB decoded. "
   . "stdout/stderr UTF-8, captured to 1 MiB each; max_lines/max_bytes bound response. Optional grep: PCRE stdout filter after capture; stderr unfiltered. Reports capture truncation. "
   . "Explicit sandbox_grants replace default workdir-read. Exit/signal/timeout are normal results, not tool errors. No command-prefix safety classification. Timeout >300 s requires "
   . "long-running grant; max six hours.",
   {
      type       => "object",
      properties => {
         %output_schema,
         workdir => $workdir_schema,
         argv => {
            type     => "array",
            items    => { type => "string" },
            minItems => 1,
         },
         sandbox_grants => {
            type        => "array",
            description => "Providing sandbox_grants (even []) replaces this default entirely; otherwise workdir-read under bubblewrap. Without bubblewrap: full host authority. host-proc unavailable under bubblewrap.",
            items       => {
               type => "string",
               enum => [sort keys %sandbox_grant],
            },
         },
         reason => {
            type        => "string",
            description => "Why command needs authority.",
         },
         stdin  => { type => "string" },
         stdin_encoding => {
            type => "string",
            default => "utf-8",
            enum => [qw(utf-8 latin1 base64)],
            description => "stdin bytes: UTF-8 (default), Latin-1 code points U+0000..U+00FF, or canonical Base64; max 4 MiB decoded.",
         },
         timeout => {
            type    => "integer",
            minimum => 1,
            maximum => 21600,
            default => 30,
            description => "Timeout seconds; >300 also requires long-running grant.",
         },
      },
      required             => [qw(argv reason)],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my $output = fs_output_options $args;

      ARRAY:: eq ref $args->{argv} and @{$args->{argv}}
         or die "exec needs argv strings without NUL\n";
      for my $arg (@{$args->{argv}}) {
         defined $arg and !ref $arg and $arg !~ /\0/
            or die "exec needs argv strings without NUL\n";
      }
      length $args->{argv}[0] or die "exec needs an executable\n";

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $timeout = $args->{timeout} // 30;
      $timeout >= 1 && $timeout <= 21600 && $timeout == int $timeout
         or die "invalid timeout\n";

      my $sandbox_grants = [exists $args->{sandbox_grants} ? @{$args->{sandbox_grants}} : @exec_default_sandbox_grants];
      push @$sandbox_grants, "long-running" if $timeout > 300;
      $sandbox_grants = [fs_effective_grants @$sandbox_grants];
      my $requested = $permissions->closure ($sandbox_grants);
      die "host-proc sandbox authority is unresolved and unavailable in v1\n"
         if $bwrap && $requested->{"host-proc"};

      my $stdin_text = $args->{stdin} // "";
      my $stdin_encoding = $args->{stdin_encoding} // "utf-8";
      $stdin_encoding =~ /\A(?:utf-8|latin1|base64)\z/
         or die "invalid stdin_encoding\n";
      my $input;
      if ($stdin_encoding eq "utf-8") {
         $input = AnyEvent::MCP::utf8enc $stdin_text;
      } elsif ($stdin_encoding eq "latin1") {
         $stdin_text !~ /[^\x00-\xff]/
            or die "latin1 stdin contains code points above U+00FF\n";
         $input = pack "C*", unpack "U*", $stdin_text;
      } else {
         $input = MIME::Base64::decode_base64 $stdin_text;
         MIME::Base64::encode_base64 ($input, "") eq $stdin_text
            or die "invalid base64 stdin\n";
      }
      length $input <= 4 * 1024 * 1024 or die "stdin exceeds 4 MiB\n";
      my $stdin_detail = $stdin_text;
      if (length $input && $stdin_encoding ne "utf-8") {
         my $preview = substr $input, 0, 4096;
         $preview =~ s/([^\x20-\x5b\x5d-\x7e])/sprintf "\\x{%02X}", ord $1/ge;
         $stdin_detail = "$stdin_encoding stdin: " . length ($input) . " bytes (escaped preview)\n\n" . $preview;
         $stdin_detail .= "\n... (preview limited to 4096 bytes)"
            if length $input > 4096;
      }

      my $coder = JSON::XS->new->canonical;
      my $subject = $coder->encode ($args->{argv});
      my $executable = $coder->encode ($args->{argv}[0]);
      my $command_label = length $subject > 100 ? substr ($subject, 0, 97) . "..." : $subject;
      my $executable_label = $args->{argv}[0];
      $executable_label = substr ($executable_label, 0, 97) . "..."
         if length $executable_label > 100;
      my $granted = fs_require_permission ($req, $identity, {
         tool           => "exec",
         action         => "exec",
         dimensions     => fs_permission_dimensions (fs_grant_workdir ($identity, $sandbox_grants),
            $subject, [
               { label => "Exact command: $command_label", match => $subject },
               { label => "This executable: $executable_label (any arguments)",
                  match => "^\\[\Q$executable\E(?:,.*)?\\]\\z" },
               { label => "any command", match => "^" },
            ]),
         reason         => $args->{reason},
         sandbox_grants => $sandbox_grants,
         (length $input ? (details => { "View stdin" => $stdin_detail }) : ()),
      });

      $timeout <= 300 || $permissions->closure ($granted)->{"long-running"}
         or die "permission reduced below long-running for exec\n";

      AE::log debug => "fs exec "
         . (substr $subject, 0, 200)
         . (length $subject > 200 ? "..." : "")
         . (length $input ? " stdin=" . length ($input) : "");

      fs_command $req, $workdir, $granted, [map { AnyEvent::MCP::utf8enc $_ } @{$args->{argv}}], $input, $timeout, $output;
   }
;

# fixed operations accept filenames, never caller-supplied VCS options or shell code.
for my $operation (qw(diff status log)) {
   mcp_tool "vcs-$operation" =>
      "Run $operation via Git, SVN, CVS or Mercurial in workdir. "
      . "Explicit backend; cwd within workdir (default .). "
      . "files relative to cwd; must stay in workdir; never options. "
      . "Dedicated permission plus workdir-read; CVS and SVN log also need ssh-agent/network. "
      . "Returns exit/signal, bounded stdout/stderr, truncation flags. "
      . "grep filters stdout via PCRE after 1 MiB capture; max_lines/max_bytes bound output. "
      . "Trusts VCS client/config; sandbox enforces approved filesystem/network grants.",
      {
         type => "object",
         properties => {
            workdir => $workdir_schema,
            cwd => { type => "string", default => ".",
               description => "cwd relative to workdir; empty = .; must stay inside. Mount boundary unchanged." },
            backend => { type => "string", enum => [qw(git svn cvs hg)] },
            files => { type => "array", items => { type => "string" }, default => [] },
            %output_schema,
         },
         required => ["backend"],
         additionalProperties => JSON::XS::false,
      },
      sub {
         my ($req, $args) = @_;

         my $backend = $args->{backend};
         defined $backend && !ref $backend && $backend =~ /\A(?:git|svn|cvs|hg)\z/
            or die "backend must be git, svn, cvs or hg\n";
         my $program = $vcs_program{$backend}
            or die "$backend executable is unavailable\n";
         my $output = fs_output_options $args;
         my ($workdir, $identity) = fs_workdir $args->{workdir};
         my $cwd = fs_path $workdir, length $args->{cwd} ? $args->{cwd} : ".";
         fs_inside $cwd, $workdir or die "VCS cwd must stay within the selected workdir\n";
         my $files = $args->{files} // [];
         ref $files eq "ARRAY" or die "files must be an array of filenames\n";
         my @files;
         my @paths = ($cwd);
         for my $file (@$files) {
            my $path = fs_path $cwd, $file;
            fs_inside $path, $workdir or die "VCS files must stay within the selected workdir\n";
            push @paths, $path;
            my $relative = File::Spec::Unix->abs2rel ($path, $cwd);
            push @files, (AnyEvent::MCP::utf8enc "./$relative");
         }

         my @argv = $backend eq "git"
            ? ($program, "--no-pager", "--no-optional-locks", "--literal-pathspecs", "-c", "core.fsmonitor=false",
               $operation, ($operation eq "diff" ? qw(--no-ext-diff --no-textconv --no-color --ignore-submodules)
                         : $operation eq "status" ? qw(--short --untracked-files=normal --ignore-submodules)
                                                  : qw(--no-decorate)),
               "--", @files)
            : $backend eq "svn"
            ? ($program, "--non-interactive", "--no-auth-cache", $operation,
               ($operation eq "diff" ? ("--internal-diff") : ()), "--", map "$_\@", @files)
            : $backend eq "cvs"
            ? ($program, "-f", $operation,
               ($operation eq "diff" ? ("-u") : $operation eq "log" ? ("-N") : ()),
               "--", @files)
            : ($program, "--noninteractive", "--config", "ui.paginate=never", $operation, "--", @files);

         my @need = fs_effective_grants ("workdir-read",
            ($backend eq "cvs" || $backend eq "svn" && $operation eq "log" ? ("ssh-agent") : ()));
         my $granted = fs_require_permission ($req, $identity, {
            tool => $req->{tool}, action => "vcs-$operation",
            dimensions => fs_permission_dimensions (fs_grant_workdir ($identity, \@need),
               $backend, [
                  { label => "$backend working copies", match => $backend },
                  { label => "all supported VCS clients", match => "^" },
               ]),
            sandbox_grants => \@need, paths => \@paths,
            reason => "$backend $operation in $cwd (workdir $identity)"
               . (@files ? ": " . join (", ", @files) : " (entire working copy)"),
         });
         my $have = $permissions->closure ($granted);
         $have->{$_} or die "permission reduced below $_ for $req->{tool}\n" for @need;

         AE::log debug => join " ", "fs vcs-$operation", $backend, $cwd, @files;

         fs_command $req, $workdir, $granted, \@argv, "", 30, $output, $cwd;
      };
}

mcp_config
   name        => $name,
   idle_exit   => 300,
   server_name    => "mcp-fs",
   server_version => 0,
   on_error    => sub { AE::log info => "mcp-tool $_[1]{tool}: $_[2]" },
   on_start    => sub {
      print STDERR "Permission rules: $permissions->{file}\n"
         if $_[0]->isa ("AnyEvent::MCP::Server::HTTP");
   },
   short_instructions => "Filesystem access: read/edit files, run sandboxed commands, inspect VCS in configured workdirs. Discover tools when working with files.",
   instructions =>
      "Start with workdirs: IDs/paths, mounts, sandbox_grants. "
      . "Select persistent integer ID (listing key, not array position) or configured/resolved path. "
      . "Inactive mappings expire after seven days; IDs may be reused; stale paths fail. "
      . "Paths relative to selected workdir. "
      . "workdir-read/write grant only selected workdir; all-workdirs-read/write grant every workdir. "
      . "all-workdirs-read + workdir-write: read all, write selected only. "
      . "Absolute paths in other workdirs need all-workdirs grants; other absolute paths need home/world grants or shared-tmp for host tmp. "
      . "Multi-path stat stays in selected workdir; rename across paths needs combined grants and may fail EXDEV at mount boundary. "
      . "Symlinks resolve inside granted mounts; overlapping workdir access unspecified. "
      . "Trusted mounts add baseline authority; world-read keeps writable exceptions, world-write ignores them. "
      . "exec requires useful reason and explicit sandbox_grants when needed. "
      . "Prefer vcs-diff/vcs-status/vcs-log for working copies: explicit backend, fixed argv, automatic grants. "
      . "exec/VCS: grep filters stdout via PCRE after capture; max_lines/max_bytes bound output; stderr unfiltered. "
      . "capture_truncated means possible unseen matches.\n";

mcp_start %$server_options, (stdio => $stdio);

Revision:	1.103
Committed:	Thu Nov 12 03:58:20 2026 UTC (30 hours, 10 minutes ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.102:	+71 -13 lines
Log Message:	* empty log message *