[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

=head1 DESCRIPTION

Uses L<AnyEvent::MCP::Server::Simple> to expose filesystem tools and arbitrary
commands, normally inside bubblewrap. GNU find, grep, patch and sed and a
compatible Perl are detected at startup; tools requiring an unavailable utility
are omitted. Bubblewrap is required by default, but can be disabled explicitly.

HTTP is the default and does not print its URL on startup. C<--print-url>
prints the cookie URL explicitly; the token also works as a bearer token.
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

=over

=item --name NAME

Selects the service-instance configuration, credentials and rules.
Defaults to C<mcp-fs>.

=item --stdio

Uses stdin/stdout instead of starting an HTTP listener.

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

Run a command with the named sandbox grants. No MCP server or permission rules
are used; the current directory is the workdir. With C<--sandbox=none> the
command runs directly with normal host-user privileges.
Defaults to C<$SHELL> or C</bin/sh> if no command is supplied.
The C<--> separator before the command is optional.

=item --bind ADDRESS[:PORT]

Overrides the named HTTP bind setting. By default binds to IPv4 loopback
on a stable port derived from the service name in 16384..32767. Port zero
requests an ephemeral port.

=item --token TOKEN

Add a URL-safe server token; may be repeated. CLI tokens replace the named
C<tokens> setting and the derived default. Every token is valid in URLs and
Authorization bearer headers; the first is used by C<--print-url>.

=item --print-url

Prints the credential-bearing URL and exits without opening a listener.
No workdir is required. Port zero cannot be used.

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 rules path is printed
on stderr when starting HTTP; normal startup leaves stdout untouched.

=item --ask $method

Selects permission prompting: C<helper> (default), C<mcp>, or C<auto>.
The default keeps approval local. C<mcp> delegates to client form elicitation;
C<auto> uses elicitation when advertised and otherwise the local helper.

=item --sandbox MODE

Select C<bwrap> (default), C<auto>, or C<none>. C<bwrap> requires a usable
bubblewrap executable. C<auto> uses bubblewrap if found, otherwise runs
unsandboxed; it does not fall back if an existing executable fails.
C<none> deliberately runs workers with full host-user privileges.

In unsandboxed mode every MCP worker (including read-only tools) requires
approval for the actual maximum execution authority: world-write, network,
shared-tmp and host-proc. Narrower approvals do not authorize execution;
the server does not pretend that workdir mounts restrict direct processes.
Startup warns prominently when there is no sandbox.

=item --bwrap PATH

Selects the bubblewrap executable. Defaults to C<bwrap> in C<PATH>.

=item --runtime-path PATH

Adds a baseline runtime mount. Repeating this option replaces the default
runtime paths. These paths supply executables and libraries inside the
sandbox, independently of requested filesystem sandbox_grants.
Defaults also include alternatives, font configuration, local timezone,
TLS configuration and certificate trust stores, NSS configuration and DNS
configuration where present. A synthetic passwd entry for the sandbox user
is supplied without exposing the host's passwd or group databases.

=item --host-export PATH

Adds a path exposed by the C<system-read> capability. Can be repeated.

=back

=head1 SANDBOX GRANTS

C<workdir-read> and C<workdir-write> expose only the selected workdir;
write implies read. C<all-workdirs-read> and C<all-workdirs-write>
expose every configured workdir. 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.
Overlapping workdirs have unspecified mount order and access effects;
do not rely on overlapping workdir boundaries for isolation.
C<home-read> and C<home-write> similarly control HOME.
C<system-read> exposes the configured C<--host-export> paths.
C<world-read> and C<world-write> expose the host filesystem, with write
implying read. C<network> and C<shared-tmp> independently enable networking
and the host's C</tmp> and C</var/tmp>. C<long-running> permits exec timeouts
over 300 seconds. C<host-proc> is unavailable with bubblewrap; direct execution has host-process access.

=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 server-defined action classes. C<inspect> groups stat/list/find;
C<read> groups file-read/read-lines/grep; C<write> groups file-write/file-patch;
C<manage> covers path-op, and C<exec> covers command execution. 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<workdir> when selected-workdir
authority is required. All-workdirs-only requests have no workdir identity.
Rules without C<workdir> can apply to any selected workdir if their sandbox
grants cover the request; dialog-generated selected-workdir rules are exact.
Requested paths are shown in the approval dialog for information only.
Exec additionally offers persistent
command/argv subjects. 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 requires
explicit selection with C<--ask mcp> or C<--ask auto>.

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> does not support cross-workdir renames, and C<mkpath>
requires a path inside the selected workdir; these are checked before
asking for permission.

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 POSIX ();
use Fcntl qw(F_SETFD);

use JSON::XS ();
use AnyEvent ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Config ();
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};

   for my $path (@path) {
      next unless -f $path and -x _;
      my $absolute = Cwd::abs_path $path;
      return $absolute if length $absolute;
   }

   undef
}

my %program_test = (
   find => [[qw(--version)], qr/^find \(GNU findutils\)/m],
   grep => [[qw(--version)], qr/^grep \(GNU grep\)/m],
   patch => [[qw(--version)], qr/^GNU patch /m],
   perl => [["-e", "use 5.008004"], qr/\A\z/],
   sed => [["-n", "1p", "/dev/null"], qr/\A\z/],
);

my %program;
for my $name (sort keys %program_test) {
   my ($args, $match) = @{$program_test{$name}};
   my $path = find_executable $name;
   my $output = "";
   my $ok;

   if ($path and open my $fh, "-|", $path, @$args) {
      local $/;
      $output = <$fh>;
      $ok = close $fh;
   }

   $program{$name} = $path
      if $ok and $output =~ $match;
   warn "$name: not detected or wrong version\n"
      unless $program{$name};
}

my ($find, $grep, $patch, $perl, $sed) = @program{qw(find grep patch perl sed)};

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

my $bwrap = "bwrap";
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 => [
      ["--ask MODE", "Ask for permission via helper (default), mcp, or auto"],
      ["--sandbox MODE", "Use bwrap (default), auto, or none (unsandboxed)"],
      ["--bwrap PATH", "Path to the bubblewrap executable"],
      ["--runtime-path PATH", "Add a runtime mount; first use replaces defaults"],
      ["--host-export PATH", "Expose a path through the system-read grant"],
      ["--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",
},
   "sandbox=s"       => \$sandbox_mode,
   "ask=s"           => \my $ask,
   "exec-cmd=s"      => \my $exec_cmd,
   "bwrap=s"         => \$bwrap,
   "runtime-path=s@" => \my @runtime_path,
   "host-export=s@"  => \my @host_export,
);

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

die "--ask must be helper, mcp, or auto\n"
   if defined $ask && $ask !~ /\A(?:helper|mcp|auto)\z/;

(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";

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

@runtime_path = grep -e, qw(
   /usr /bin /sbin /lib /lib64 /opt
   /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
)
   unless @runtime_path;
for my $path (@runtime_path) {
   $path =~ m{\A/} and -e $path or die "invalid runtime path '$path'\n";
}
for my $path (@host_export) {
   $path =~ m{\A/} and -e $path or die "invalid host export '$path'\n";
}

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 = 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 %sandbox_grant = (
   "workdir-read"  => [],
   "workdir-write" => ["workdir-read"],
   "all-workdirs-read" => ["workdir-read"],
   "all-workdirs-write" => [qw(all-workdirs-read workdir-write)],
   "system-read"   => [],
   "home-read"     => [],
   "home-write"    => ["home-read"],
   "world-read"    => [qw(all-workdirs-read system-read home-read)],
   "world-write"   => [qw(world-read all-workdirs-write home-write)],
   "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",
   "system-read"   => "Read exported system paths",
   "home-read"     => "Read files in your home directory",
   "home-write"    => "Change files in your home directory",
   "world-read"    => "Read the host filesystem",
   "world-write"   => "Change the host filesystem",
   "network"       => "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 = umask;

my $permissions;
$permissions = AnyEvent::MCP::Server::Permissions->new (
   sandbox_grants            => \%sandbox_grant,
   sandbox_grant_descriptions => \%sandbox_grant_description,
   (defined $ask ? (ask => $ask) : ()),
   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",
   },
   name         => $name,
   file         => "$config_home/anyevent-mcp/rules-fs-$name.ini",
) unless defined $exec_cmd;

# 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 "home-$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
}

# 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_require_paths {
   my ($req, $workdir, $identity, $paths, $mode, $reason) = @_;

   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 = $req->require_permission ({
      tool           => $req->{tool},
      action         => $tool_action{$req->{tool}},
      workdir        => fs_grant_workdir ($identity, \@grants),
      paths          => $paths,
      sandbox_grants => \@grants,
      reason         => $reason // "$req->{tool} " . join (", ", @$paths),
   });

   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->{"home-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 @command = ($bwrap, qw(
      --die-with-parent
      --unshare-user --unshare-pid --unshare-ipc --unshare-uts
      --unshare-cgroup-try --disable-userns --cap-drop ALL
   ));
   push @command, "--new-session" unless defined $exec_cmd;

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

   push @command, $have->{"world-write"} ? "--bind-try" : "--ro-bind-try", "/", "/"
      if $have->{"world-read"};

   my @scope_mount;

   for my $path (@runtime_path) {
      my $mount = (fs_writable $workdir, $path, $have) ? "--bind-try" : "--ro-bind-try";
      push @scope_mount, $mount, $path, $path;
   }

   if ($have->{"system-read"}) {
      for my $path (@host_export) {
         my $mount = (fs_writable $workdir, $path, $have) ? "--bind-try" : "--ro-bind-try";
         push @scope_mount, $mount, $path, $path;
      }
   }

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

   if ($have->{"all-workdirs-read"}) {
      for my $path (@workdir) {
         my $mount = ($have->{"all-workdirs-write"}
            or ($path eq $workdir && $have->{"workdir-write"}))
               ? "--bind" : "--ro-bind";
         push @scope_mount, $mount, $path, $path;
      }
   } elsif ($have->{"workdir-read"}) {
      my $mount = $have->{"workdir-write"} ? "--bind" : "--ro-bind";
      push @scope_mount, $mount, $workdir, $workdir;
   }

   # Replace special host mounts even when broad filesystem authority was asked.
   push @command, qw(--tmpfs /sys --tmpfs /run --dev /dev);
   push @command, "--proc", "/proc";

   for my $tmp (qw(/tmp /var/tmp)) {
      if ($have->{"shared-tmp"}) {
         push @command, "--bind-try", $tmp, $tmp;
      } else {
         push @command, "--tmpfs", $tmp;
      }
   }

   # Explicit mounts override the private baseline where bwrap/kernel permit it.
   push @command, @scope_mount;
   for my $path (qw(/etc/resolv.conf /etc/hosts)) {
      my $mount = (fs_writable $workdir, $path, $have) ? "--bind-try" : "--ro-bind-try";
      push @command, $mount, $path, $path;
   }

   push @command, "--file", 3, "/etc/passwd";

   push @command, "--remount-ro", "/"
      unless $have->{"world-write"};

   my $sandbox_path = $ENV{PATH} // "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin";

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

   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};
   }

   push @command,
      "--chdir", defined $exec_cmd ? $workdir : $have->{"workdir-read"} ? $workdir : "/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:$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 = ((fs_sandbox $workdir[0], \@sandbox_grants),
      (@ARGV ? @ARGV : ($ENV{SHELL} || "/bin/sh")));
   my $passwd_fd = fs_passwd_fd () if $bwrap;

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

warn "mcp-fs: SANDBOX NONE - workers run with full host-user privileges\n"
   unless $bwrap || defined $exec_cmd;

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

# Spawn one process with a bidirectional stdin/stdout handle and separate stderr.
sub proc_spawn {
   my ($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;
      AnyEvent::Util::close_all_fds_except ($bwrap ? (0, 1, 2, 3) : (0, 1, 2));

      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, done => [] };

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

      $proc->{status} = $status;
      delete $proc->{pid};
      delete $proc->{child};
      $_->($status) for @{delete $proc->{done}};
   };

   ($io, $err, $proc)
}

# Wrap proc_spawn in one self-owned AnyEvent::Handle. destroy releases all
# attached process state, including the self-reference that keeps it alive.
sub proc_handle {
   my (@command) = @_;

   my ($io, $err, $proc) = proc_spawn @command;

   $io->{proc}      = $proc;
   $io->{proc_err}  = $err;
   $io->{proc_self} = $io;

   $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
}

# Run a callback once a spawned process has been reaped.
sub proc_on_exit {
   my ($proc, $done) = @_;

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

   push @{$proc->{done}}, $done;
}

# Run one subprocess with bounded capture, timeout and sandbox teardown.
sub fs_run {
   my ($req, $command, $input, $timeout, $byte_limit, $line_limit, $done) = @_;

   my ($truncated, $line_truncated, $timed_out);
   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
   };

   my $io = proc_handle @$command;
   my $err = $io->{proc_err};
   my $proc = $io->{proc};
   $req->{on_cancel} = sub { proc_kill $proc };
   my $open = 2;
   my ($status, $finished, $timer);

   my $complete = sub {
      return
         if $finished or $open or !defined $status;
      $finished = 1;
      undef $timer;
      $io->destroy;
      return if $req->{finished};
      delete $req->{on_cancel};

      $done->(1, +{
         stdout    => $stdout,
         stderr    => $stderr,
         exit      => $status >> 8,
         signal    => $status & 127,
         timed_out => $timed_out ? JSON::XS::true : JSON::XS::false,
         truncated => $truncated ? JSON::XS::true : JSON::XS::false,
      });
   };

   for my $stream ([$io, \$stdout, 1], [$err, \$stderr, 0]) {
      my ($handle, $target, $lines) = @$stream;
      my $stream_done;
      my $finish = sub {
         return if $stream_done++;
         --$open;
         $complete->();
      };

      $handle->on_read (sub {
         proc_kill $proc
            if $capture->($target, $_[0]{rbuf}, $lines);
         $_[0]{rbuf} = "";
      });
      $handle->on_eof (sub {
         $finish->();
      });
      $handle->on_error (sub {
         return unless $_[1];
         proc_kill $proc;
         $capture->($target, $_[0]{rbuf}, $lines);
         $_[0]{rbuf} = "";
         $finish->();
      });
   }

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

   $timer = AE::timer $timeout, 0, sub {
      $timed_out = 1;
      proc_kill $proc;
   };

   proc_on_exit $proc, sub {
      $status = $_[0];
      $complete->();
   };
}

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*)*", @_
}

sub perl_unframe {
   my ($data) = @_;
   length $data >= 4
      or die "short perl response\n";
   my $len = unpack "N", $data;
   length $data == 4 + $len
      or die "invalid perl response length\n";

   unpack "x4 (w/a*)*", $data
}

sub perl_eval {
   my ($req, $workdir, $sandbox_grants, $source, $args, $timeout, $limit, $done) = @_;
   my @command = ((fs_sandbox $workdir, $sandbox_grants), $perl, "-e", $perl_slave);

   fs_run $req, \@command, (perl_frame $source, @$args), $timeout, $limit, 0, sub {
      my ($success, $result) = @_;
      return $done->(0, $result)
         unless $success;

      my (@response, $error);
      my $ok = eval {
         die "sandbox perl timed out\n" if $result->{timed_out};
         die "sandbox perl output exceeded limit\n" if $result->{truncated};
         if ($result->{exit} or $result->{signal}) {
            my $stderr = AnyEvent::MCP::utf8dec $result->{stderr};
            die "sandbox perl failed (exit $result->{exit}, signal $result->{signal}): $stderr\n";
         }

         @response = perl_unframe $result->{stdout};
         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
      };

      return $done->(0, $@) unless $ok;
      return $done->(0, $error) if defined $error;
      $done->(1, \@response);
   };
}

# Resolve the optional workdir index to one configured workdir.
sub fs_workdir {
   my ($i) = @_;

   $i = 0 if !defined $i and @workdir == 1;

   !ref $i and $i =~ /\A[0-9]+\z/ and $i < @workdir
      or die "select a configured workdir by its zero-based index\n";

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

# 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 $text = JSON::XS->new->encode ($result);
   my $response = fs_text_result $text, $failed;
   $response->{structuredContent} = $result;
   $response
}

mcp_tool workdirs =>
   "List configured workdirs and capability/runtime configuration.",
   {
      type                 => "object",
      properties           => {},
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      AE::log debug => "workdirs";

      $req->reply (fs_result +{
         workdirs                  => \@workdir_identity,
         resolved_workdirs         => \@workdir,
         umask                     => sprintf ("%04o", $umask),
         runtime_paths             => \@runtime_path,
         host_exports              => \@host_export,
         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) = @_;
   my @suffix = ("", qw(k M G T P));

   for my $suffix (@suffix) {
      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 =~ s{.*/}{}r;
      } 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;

   my $text = join "\n", @line;
   $text .= "\n" if @line;
   $text
}

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, $args->{path} // ".";
   my $limit = $args->{limit} // 200;
   $limit <= 1000
      or die "invalid limit\n";

   my $capability = fs_path_capability $workdir, $path, "read";

   my $granted = $req->require_permission ({
      tool         => $tool,
      action       => "inspect",
      paths        => [$path],
      workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
      sandbox_grants => [fs_effective_grants $capability],
      reason       => $args->{reason} // "$tool $path",
   });

   if ($recurse) {
      AE::log debug => join " ", $tool, $path, (substr $args->{name}, 0, 40);
   } else {
      AE::log debug => "$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, $timed_out, $failure);
   my $stderr = "";
   my $io = proc_handle @command;
   my $err = $io->{proc_err};
   my $proc = $io->{proc};
   $req->{on_cancel} = sub { proc_kill $proc };
   my $open = 2;
   my ($stdout_done, $stderr_done, $status, $finished, $timer);

   my $complete = sub {
      return
         if $finished or $open or !defined $status;
      $finished = 1;
      undef $timer;
      $io->destroy;
      return if $req->{finished};
      delete $req->{on_cancel};

      my $result;
      my $ok = eval {
         die "$tool timed out\n" if $timed_out;
         die $failure if $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 ($@);
      }
   };

   my $finish = sub {
      my ($stream_done) = @_;
      return if $$stream_done++;
      --$open;
      $complete->();
   };

   my $parse = sub {
      my ($handle) = @_;

      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";
            proc_kill $proc;
            last;
         }

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

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

      $handle->{rbuf} = "" if $failure or $truncated;
   };

   $io->on_read (sub {
      $parse->($_[0]);
   });
   $io->on_eof (sub {
      $parse->($_[0]);
      $failure ||= "incomplete $tool output\n"
         if length $_[0]{rbuf} and !$truncated;
      $finish->(\$stdout_done);
   });
   $io->on_error (sub {
      return unless $_[1];
      $failure ||= "$tool stdout: $_[2]\n"
         unless $truncated or $timed_out;
      proc_kill $proc;
      $finish->(\$stdout_done);
   });

   my $capture_stderr = sub {
      my ($handle) = @_;
      my $remaining = 65536 - length $stderr;
      $stderr .= substr $handle->{rbuf}, 0, $remaining if $remaining > 0;
      $handle->{rbuf} = "";
   };

   $err->on_read (sub {
      $capture_stderr->($_[0]);
   });
   $err->on_eof (sub {
      $capture_stderr->($_[0]);
      $finish->(\$stderr_done);
   });
   $err->on_error (sub {
      return unless $_[1];
      $capture_stderr->($_[0]);
      $failure ||= "$tool stderr: $_[2]\n"
         unless $truncated or $timed_out;
      proc_kill $proc;
      $finish->(\$stderr_done);
   });

   my $ok = eval { $io->push_shutdown; 1 };
   unless ($ok) {
      my $error = $@;
      proc_kill $proc;
      $io->destroy;
      die $error;
   }

   $timer = AE::timer 30, 0, sub {
      $timed_out = 1;
      proc_kill $proc;
   };

   proc_on_exit $proc, sub {
      $status = $_[0];
      $complete->();
   };
}

$find && mcp_tool list =>
   "List immediate filesystem entries without following symlinks. "
   . "Compact text output uses /relative-directory headers for directories, f<TAB>approx-size<TAB>name "
   . "for regular files, TYPE<TAB>name for l/p/s/b/c/? nodes, "
   . "with compact size suffixes k/M/G/T/P using IEC powers of 1024, "
   . "and !truncated when the result limit was exceeded. Backslash and newline are escaped in names.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type        => "string",
            description => "Directory to list; defaults to the selected workdir.",
         },
         limit  => {
            type    => "integer",
            minimum => 1,
            maximum => 1000,
            default => 200,
         },
         workdir   => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      additionalProperties => JSON::XS::false,
   },
   sub {
      fs_list_find $_[0], $_[1], 0
   }
;

$find && mcp_tool find =>
   "Find non-directory filesystem entries recursively by literal basename substring without following symlinks. Same output format as list.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type        => "string",
            description => "Path to search recursively; defaults to the selected workdir.",
         },
         name   => {
            type        => "string",
            minLength   => 1,
            description => "Literal substring of the basename to find.",
         },
         limit  => {
            type    => "integer",
            minimum => 1,
            maximum => 1000,
            default => 200,
         },
         workdir   => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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 by byte offset; returns either base64 data or an errno string.",
   {
      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     => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason   => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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 $capability = fs_path_capability $workdir, $path, "read";

      my $granted = $req->require_permission ({
         tool         => "file-read",
         action       => "read",
         paths        => [$path],
         workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
         sandbox_grants => [fs_effective_grants $capability],
         reason       => $args->{reason} // "read $path",
      });

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

      perl_eval $req, $workdir, $granted, $file_read,
         [AnyEvent::MCP::utf8enc $path, $offset, $length], 30, $length + 4096, 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 UTF-8 text by positive line-number ranges. "
   . "Ranges are returned separately in request order; overlaps and duplicates are preserved.",
   {
      type                 => "object",
      properties           => {
         path   => {
            type => "string",
         },
         ranges => {
            type     => "array",
            description => "Inclusive line ranges, each N or N,M.",
            items    => {
               type    => "string",
               pattern => q{^[1-9][0-9]*(?:,[1-9][0-9]*)?$},
            },
            minItems => 1,
            maxItems => 20,
         },
         workdir => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      required             => ["path", "ranges"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      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 $capability = fs_path_capability $workdir, $path, "read";
      my $granted = $req->require_permission ({
         tool         => "read-lines",
         action       => "read",
         paths        => [$path],
         workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
         sandbox_grants => [fs_effective_grants $capability],
         reason       => $args->{reason} // "read lines $path",
      });

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

      my (@result, $truncated);
      my $remaining = 1 << 20;
      my $next;
      $next = sub {
         unless (@range) {
            undef $next;
            my $text = "";
            for (@result) {
               my ($range, $body) = @$_;
               $text .= "[$range]\n$body";
               $text .= "\n"
                  if length $body and substr ($body, -1) ne "\n";
            }
            $text .= "!truncated\n" if $truncated;
            return $req->reply (fs_text_result $text);
         }

         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",
            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";
               }
               $body = AnyEvent::MCP::utf8dec $value->{stdout};
               1
            };
            return $req->error ($@)
               unless $ok;

            push @result, [$range, $body];
            $remaining -= length $value->{stdout};
            if ($value->{truncated}) {
               $truncated = 1;
               @range = ();
            } elsif ($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 of base64 data at a byte offset without truncating; returns bytes written or an errno string.",
   {
      type                 => "object",
      properties           => {
         path    => {
            type => "string",
         },
         offset  => {
            type    => "integer",
            minimum => 0,
            default => 0,
         },
         data    => {
            type => "string",
         },
         workdir    => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason  => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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 $capability = fs_path_capability $workdir, $path, "write";

      my $granted = $req->require_permission ({
         tool         => "file-write",
         action       => "write",
         paths        => [$path],
         workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
         sandbox_grants => [fs_effective_grants $capability],
         reason       => $args->{reason} // "write $path",
      });
      $permissions->closure ($granted)->{$capability}
         or die "permission reduced below $capability for $path\n";

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

      perl_eval $req, $workdir, $granted, $file_write,
         [AnyEvent::MCP::utf8enc $path, $offset, $data], 30, 4096, 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 "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 =>
   "Perform pathname mutations in fixed order: unlink, rmdir, mkpath, mkdir, symlink, truncate, chmod, rename. "
   . "mkpath permission-checks each missing component separately; symlink targets are link contents, not authority.",
   {
      type                 => "object",
      properties           => {
         path     => {
            type => "string",
         },
         unlink   => {
            type => "boolean",
         },
         rmdir    => {
            type => "boolean",
         },
         mkdir    => {
            description => "Create path as a directory with this final mode, overriding umask.",
            anyOf       => [
               { type => "string", pattern => q{^[0-7]+$} },
               { type => "integer", minimum => 0 },
            ],
         },
         mkpath   => {
            description => "Create missing path components with this final mode, overriding umask.",
            anyOf       => [
               { type => "string", pattern => q{^[0-7]+$} },
               { type => "integer", minimum => 0 },
            ],
         },
         symlink  => {
            type        => "string",
            minLength   => 1,
            description => "Create path as a symlink containing this 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 path to this destination.",
         },
         workdir   => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason    => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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 "rename requires both paths in the selected workdir\n"
         if defined $rename && (!fs_inside ($path, $workdir) || !fs_inside ($rename, $workdir));
      die "mkpath requires a path in the selected workdir\n"
         if exists $args->{mkpath} && !fs_inside ($path, $workdir);

      my @mkpath;
      if (exists $args->{mkpath}) {
         my $prefix = "";
         for (split m{/}, substr $path, 1) {
            $prefix .= "/$_";
            push @mkpath, $prefix
               unless -d AnyEvent::MCP::utf8enc $prefix;
         }
      }

      my $granted = fs_require_paths $req, $workdir, $identity,
         [@mkpath, $path, (defined $rename ? $rename : ())], "write", $args->{reason};

      my @log = map {
         ($_ eq "unlink" or $_ eq "rmdir")
            ? ($args->{$_} ? $_ : ())
            : (exists $args->{$_} ? "$_=$args->{$_}" : ())
      } qw(unlink rmdir mkpath mkdir symlink truncate chmod rename);

      AE::log debug => join " ", "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, mkdir => (AnyEvent::MCP::utf8enc $_), $args->{mkpath}
         for @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, 4096, 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 =>
   "Apply a unified diff to one regular file. Hunk counts are recomputed, fuzz is disabled, "
   . "whole-hunk relocation is limited per hunk by distinct old-side lines. "
   . "Pure insertion is allowed only at the beginning; elsewhere include old-side context. "
   . "The diff argument is Unicode text (converted to UTF-8 bytes for patch), "
   . "or base64 of raw patch bytes (autodetected: text has @ hunk markers; "
   . "base64 cannot contain @).",
   {
      type                 => "object",
      properties           => {
         path    => { type => "string" },
         diff    => { type => "string", minLength => 1 },
         workdir => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason  => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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};

      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;
      }

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

      my $capability = fs_path_capability $workdir, $path, "write";
      my $granted = $req->require_permission ({
         tool         => "file-patch",
         action       => "write",
         paths        => [$path],
         workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
         sandbox_grants => [fs_effective_grants $capability],
         reason       => $args->{reason} // "patch $path",
      });
      $permissions->closure ($granted)->{$capability}
         or die "permission reduced below $capability for $path\n";

      AE::log debug => join " ", "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, 65536, 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 of at most 1 MiB recursively without following symlinks or descending .git. "
   . "Fixed-string matching by default; mode=pcre uses GNU grep -P. "
   . "Stops after the result limit; reports truncation and timeout separately.",
   {
      type                 => "object",
      properties           => {
         path    => {
            type        => "string",
            description => "Path to search; defaults to the selected workdir.",
         },
         pattern => {
            type      => "string",
            minLength => 1,
         },
         mode    => {
            type    => "string",
            enum    => ["fixed", "pcre"],
            default => "fixed",
         },
         limit   => {
            type        => "integer",
            minimum     => 1,
            maximum     => 1000,
            default     => 200,
            description => "Maximum number of matching lines to return.",
         },
         workdir    => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason  => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      required             => ["pattern"],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $args) = @_;

      my ($workdir, $identity) = fs_workdir $args->{workdir};
      my $path = fs_path $workdir, $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 $capability = fs_path_capability $workdir, $path, "read";

      my $granted = $req->require_permission ({
         tool         => "grep",
         action       => "read",
         paths        => [$path],
         workdir      => fs_grant_workdir ($identity, [fs_effective_grants $capability]),
         sandbox_grants => [fs_effective_grants $capability],
         reason       => $args->{reason} // "grep $path",
      });

      AE::log debug => join " ", "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",
         $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 =>
   "Get lstat metadata for up to 100 paths; symlinks are not followed.",
   {
      type                 => "object",
      properties           => {
         paths  => {
            type     => "array",
            items    => {
               type => "string",
            },
            minItems => 1,
            maxItems => 100,
         },
         workdir   => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         reason => {
            type        => "string",
            description => "Reason for requesting permission.",
         },
      },
      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 " ", "stat", @log;

      perl_eval $req, $workdir, $granted, $stat, [map { AnyEvent::MCP::utf8enc $_ } @paths],
         30, 65536, 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 arbitrary argv " . ($bwrap ? "in bubblewrap" : "UNSANDBOXED with full host-user privileges") . "; UTF-8 stdin is limited to 4 MiB, "
   . "stdout/stderr are decoded as UTF-8 and captured to 1 MiB combined. Sandbox grants are optional; "
   . "there is no command-prefix safety classification. Timeouts above 300 seconds require "
   . "long-running permission; the maximum is six hours.",
   {
      type       => "object",
      properties => {
         workdir => {
            type        => "integer",
            minimum     => 0,
            description => "Configured workdir index; required when more than one workdir is configured.",
         },
         argv => {
            type     => "array",
            items    => { type => "string" },
            minItems => 1,
         },
         sandbox_grants => {
            type        => "array",
            description => "Sandbox grants, default workdir-read under bubblewrap. Without bubblewrap effective grants are always maximum host authority. host-proc is unavailable with bubblewrap.",
            items       => {
               type => "string",
               enum => [sort keys %sandbox_grant],
            },
         },
         reason => {
            type        => "string",
            description => "Useful reason for requesting arbitrary command authority.",
         },
         stdin  => { type => "string" },
         timeout => {
            type    => "integer",
            minimum => 1,
            maximum => 21600,
            default => 30,
            description => "Seconds; values above 300 also request long-running permission.",
         },
      },
      required             => [qw(argv reason)],
      additionalProperties => JSON::XS::false,
   },
   sub {
      my ($req, $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 $input = $args->{stdin} // "";
      $input = AnyEvent::MCP::utf8enc $input;
      length $input <= 4 * 1024 * 1024 or die "stdin exceeds 4 MiB\n";

      my $coder = JSON::XS->new->canonical;
      my $subject = $coder->encode ($args->{argv});
      my $executable = $coder->encode ($args->{argv}[0]);
      my $granted = $req->require_permission ({
         tool         => "exec",
         action       => "exec",
         workdir      => fs_grant_workdir ($identity, $sandbox_grants),
         subject      => $subject,
         reason       => $args->{reason},
         sandbox_grants => $sandbox_grants,
         subjects     => [
            {
               label   => "exact executable and argv",
               subject => $subject,
            },
            {
               label   => "this executable, arbitrary argv",
               subject => "^\\[\Q$executable\E(?:,.*)?\\]\\z",
            },
            {
               label   => "any command",
               subject => "^",
            },
         ],
      });

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

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

      my @command = ((fs_sandbox $workdir, $granted), @{$args->{argv}});
      fs_run $req, \@command, $input, $timeout, 1024 * 1024, 0, sub {
         my ($success, $result) = @_;
         return $req->error ($result)
            unless $success;

         my $response;
         my $ok = eval {
            $result->{$_} = AnyEvent::MCP::utf8dec $result->{$_} for qw(stdout stderr);
            $response = fs_result $result,
               $result->{exit} || $result->{signal} || $result->{timed_out};
            1
         };

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

mcp_config
   name => $name,
   server_info => { name => "mcp-fs", version => "0" },
   permissions => $permissions,
   on_error => sub { AE::log debug => "mcp-tool $_[1]{tool}: $_[2]" },
   on_start => sub {
      print STDERR "Permission rules: $permissions->{file}\n"
         if $_[0]->isa ("AnyEvent::MCP::Server::HTTP");
   },
   instructions => "Use workdirs to inspect configured workdirs and sandbox_grants. Paths are relative to the selected workdir; workdir-read/write expose only that workdir. all-workdirs-read/write expose every configured workdir; all-workdirs-read plus workdir-write allows writing only the selected workdir. Absolute paths in another configured workdir require all-workdirs authority; other absolute paths request home/world authority or shared-tmp for host tmp. Rename and multi-path stat must stay within the selected workdir. Symlinks resolve inside the granted sandbox mounts; overlapping workdirs have unspecified access behavior. Runtime paths are baseline sandbox machinery; system-read exposes configured host exports. Exec supports explicit sandbox_grants and requires a useful reason.\n";

$stdio ? mcp_stdio : mcp_start %server_options;

Revision:	1.16
Committed:	Sun Oct 11 05:16:41 2026 UTC (7 days, 8 hours ago) by root
Branch:	MAIN
Changes since 1.15:	+100 -49 lines
Log Message:	* empty log message *