lib/AnyEvent/MCP.pm

=head1 NAME

AnyEvent::MCP - Model Context Protocol client/server support

=head1 SYNOPSIS

   use AnyEvent::MCP::Server::Simple ();

   mcp_tool ...
   mcp_start;

or use the object interface directly:

   use AnyEvent::MCP::Server ();

   my $server = AnyEvent::MCP::Server->new (...);

=head1 DESCRIPTION

AnyEvent::MCP provides event-driven Model Context Protocol client and server
support.

The usual way to implement a small MCP server is
L<AnyEvent::MCP::Server::Simple>, which provides a function-based interface and
creates the underlying server objects when a transport such as stdio or HTTP is
started.

The lower-level object interfaces are intended for applications that need to
manage MCP connections, servers or reusable tool registries directly.

=head2 MODULES

=over

=item L<AnyEvent::MCP::Server::Simple>

Function-based interface for implementing ordinary MCP servers.

=item L<AnyEvent::MCP::Server>

Object-oriented MCP server interface.

=item L<AnyEvent::MCP::Client>

Object-oriented MCP client interface.

=item L<AnyEvent::MCP::Server::Toolset>

Reusable registry of MCP tool declarations.

=item L<AnyEvent::MCP::Server::Permissions>

Permission and capability handling for MCP servers.

=back

C<mcp-multibroker> combines downstream HTTP and stdio servers under tool-name
prefixes. It uses the same client, server and permission helper facilities,
including modern input forwarding and local permission prompts for legacy
callers. Run C<mcp-multibroker --help> for command-line syntax; its manual
describes authentication and configuration.

The interfaces are still being designed. The walkthrough below explains the
installed programs; module-specific POD documents their Perl APIs.

=head1 GETTING STARTED

This distribution contains an MCP client/server library and several ready-to-use
programs. You do not need to write Perl to use them.

=over

=item C<mcp-fs>

A filesystem and command server. Each operation runs in a Linux bubblewrap
sandbox with only the filesystem and other capabilities approved for that
operation. Read, write, search, patch, path operations and command execution
are exposed as MCP tools.

=item C<mcp-multibroker>

Combines several MCP servers behind one connection. Each downstream server has
a prefix, so a C<file-read> tool belonging to C<files> becomes
C<files.file-read>. Its clients may connect over HTTP or be launched over
stdio. The multibroker itself can serve HTTP or stdio.

=item C<anyevent-mcp> and C<anyevent-mcp-askpermission>

Manage shared credentials/rules and ask the local user for permission,
respectively. Normally the permission helper is started automatically.

=back

=head2 Start with one filesystem server

Install this Perl distribution first. On Debian or Ubuntu, install the
runtime sandbox and optional graphical permission helper with:

   sudo apt install bubblewrap yad

The executable is called C<bwrap>, although the package is C<bubblewrap>.
C<yad> provides graphical approval dialogs; without it, the default helper
tries C</dev/tty> and denies if no terminal is available. Unprivileged user
namespaces must be available. C<mcp-fs> also uses GNU C<find>, C<grep>,
C<patch> and C<sed>, and a compatible Perl interpreter. On a minimal
Debian installation, these can be installed with:

   sudo apt install findutils grep patch sed perl

Tools whose required programs are missing are omitted at startup.

Give the server one or more directories that you actually intend to make
available. For example:

   mcp-fs --name code --port 31741 /home/alice/src/project

This starts an authenticated HTTP MCP server. It prints a URL containing
an access cookie; keep that URL private. Its clean URL also accepts the same
credential as a bearer token. C<--port 0> selects an available port.
The permission-rule file is printed on stderr.

For a local MCP client that starts its servers as subprocesses, use stdio:

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

The MCP client, not a human terminal, should start this process: stdin and
stdout carry protocol messages. For a quick manual sandbox test without MCP
or permission prompting, run from the intended workdir:

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

C<--exec-cmd> runs the supplied command with exactly the named capabilities,
without consulting saved permission rules. It is a local debugging facility.

Within MCP, begin with the C<workdirs> tool to inspect the configured
workdirs and capabilities. Relative paths are resolved against the selected
workdir; access beyond the granted mounts needs additional permission.
Providing a workdir does not give arbitrary commands unrestricted host access.
See L<mcp-fs/CAPABILITIES> and L<mcp-fs/LIMITATIONS>.

Once the client is connected, you can just ask the LLM to use the tools,
for example:

   Show me the available workdirs, find the TODO comments in my project,
   and suggest the next task. Do not modify any files.

The client can call C<workdirs> and C<grep> itself; you need not know the
MCP request format or write your own integration.

=head2 Combine servers with mcp-multibroker

Rather than configure each MCP client with every server, configure them
once behind the multibroker. For example, to expose two distinct filesystem
servers over one HTTP endpoint:

   mcp-multibroker code 'stdio:mcp-fs /home/alice/src/project' \
                   notes 'stdio:mcp-fs /home/alice/notes'

Each C<stdio:> value is a shell command; quote it as one argument.
The multibroker starts the child with the correct stdio environment
and an alias equal to its prefix. That alias is also the default
C<mcp-fs> permission profile, keeping permissions for C<code> and
C<notes> separate.

The multibroker prints its own authenticated HTTP URL. A client sees
tools such as C<code.file-read>, C<code.file-patch> and
C<notes.file-read>. The additional C<discover-brokers>, C<list-tools>
and C<call-tool> tools support explicit discovery and dispatch.
The client normally can call the prefixed tools directly.

If the LLM is still using an old tool list after a downstream server
becomes available or changes its tools, simply tell it:

   Call discover-brokers and list-tools again, then use the newly
   discovered tools.

C<discover-brokers> connects to reachable servers and retrieves their
instructions; C<list-tools> requests their current tool lists. C<call-tool>
can dispatch a newly discovered prefixed tool even when the client has not
refreshed its own direct tool list yet. If the client hides or caches the
broker's tools, reconnect or refresh the MCP connection in that client.
Changing the broker's configured prefix/URL pairs requires restarting
C<mcp-multibroker>; discovery cannot change its command-line configuration.

The same broker can mix remote HTTP servers with local subprocesses.
For example, an installation might combine office and automation tools:

   mcp-multibroker \
      office http://localhost:8766/mcp \
      homeassistant http://homeassistant.local:8123/api/mcp \
         --bearer TOKEN \
      marco http://marco.example.net:31746/COOKIE/

Or combine a custom application server, remote machines and a third-party
stdio server:

   mcp-multibroker \
      agni 'stdio:/opt/agni/bin/agni-mcp' \
      cerebro http://cerebro.example.net:31748/COOKIE/ \
      chrome 'stdio:npx -y chrome-devtools-mcp@latest --no-usage-statistics'

These are illustrative hostnames and redacted credentials, not usable
endpoints. C<--bearer> belongs immediately after the HTTP server it
authenticates. A cookie URL already carries its credential. Never publish
or check in either kind of secret. The broker does not impose the C<mcp-fs>
bubblewrap sandbox on other servers: those processes and services have their
own security boundaries. A shell wrapper can use C<exec mcp-multibroker>
to replace itself with the broker process.

To start the multibroker itself over stdio, let the client set
C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio>, or use a command like:

   PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio \
      mcp-multibroker code 'stdio:mcp-fs /home/alice/src/project'

The broker can also connect to existing HTTP MCP servers:

   mcp-multibroker files 'stdio:mcp-fs /home/alice/src/project' \
                   remote https://example.org/mcp/ --bearer TOKEN

The token is a credential; avoid exposing it in shell history or process
arguments in a real deployment. An HTTP client can instead use
C<[client PREFIX]> in the private global configuration. See
L<mcp-multibroker> and L</GLOBAL CONFIGURATION>.

=head2 Connect an AI client

These are examples for clients with MCP support. Paths are illustrative;
substitute your installed commands and real workdirs. Client interfaces
evolve independently of this module, so consult their documentation if an
option has changed.

=head3 OpenAI Codex CLI

Codex can start the broker locally over stdio:

   codex mcp add mytools --env PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio \
      -- mcp-multibroker \
      files 'stdio:mcp-fs /home/alice/src/project'
   codex mcp list

Use C</mcp> within Codex to inspect connections.
See L<Codex MCP documentation|https://learn.chatgpt.com/docs/extend/mcp>.

=head3 Anthropic Claude Code

Claude Code can start the same broker:

   claude mcp add --transport stdio --scope user mytools \
      --env PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio -- \
      mcp-multibroker files 'stdio:mcp-fs /home/alice/src/project'
   claude mcp list

Use C</mcp> within Claude Code for connection status. See
L<Claude Code MCP documentation|https://code.claude.com/docs/en/mcp>.

=head3 Google Gemini CLI

Add a local broker to C<~/.gemini/settings.json> (merge with any existing
settings):

   {
     "mcpServers": {
       "mytools": {
         "command": "mcp-multibroker",
         "args": [
           "files", "stdio:mcp-fs /home/alice/src/project"
         ],
         "env": {
           "PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL": "stdio"
         }
       }
     }
   }

Use C</mcp> in Gemini CLI to inspect the connection.
See L<Gemini CLI MCP documentation|https://geminicli.com/docs/tools/mcp-server/>.

=head3 ChatGPT web

ChatGPT is a hosted client and cannot spawn a local stdio process or
connect directly to a local loopback server. Start C<mcp-multibroker> in
HTTP mode and connect it through ChatGPT's custom MCP plugin setup.
For a private local server, use an appropriately configured Secure MCP
Tunnel rather than making the machine publicly accessible. The connection
is subject to the client's plan, workspace and feature permissions.
See L<ChatGPT custom MCP servers|https://developers.openai.com/api/docs/guides/custom-mcp-server>
and L<Secure MCP Tunnel|https://developers.openai.com/blog/connect-private-mcp-servers-to-openai-products>.

=head2 Permissions and approval dialogs

C<mcp-fs> does not treat a connected model as fully trusted. Each tool
asks for the authority it needs; you can allow or deny the request once,
or save a rule for subsequent matching requests. Its default prompting
mode is C<--ask helper>, using C<anyevent-mcp-askpermission> on the
server's machine (YAD or C</dev/tty>). Closing the prompt denies once.

For a client that supports the newer MCP form-elicitation protocol, try:

   mcp-fs --ask auto --stdio /home/alice/src/project

C<--ask auto> uses MCP elicitation when the client advertises the necessary
support, otherwise the local helper. C<--ask mcp> requires elicitation and
fails if it is unavailable; it does not silently fall back. Not all MCP
clients or versions support the required input/continuation flow, even if
they support ordinary tool calls. For an ordinary stdio broker configuration,
put the chosen option in the child command:

   mcp-multibroker files \
      'stdio:mcp-fs --ask auto /home/alice/src/project'

Permission profiles are stored under C<~/.config/anyevent-mcp/> (or
C<$XDG_CONFIG_HOME/anyevent-mcp/>). A child launched by the broker
normally uses its prefix as the profile name; use C<--profile NAME>
to override it. Review persistent rules rather than granting
C<world-write> casually. Run C<anyevent-mcp --help> for the credential
and rule-management commands; see
L<AnyEvent::MCP::Server::Permissions> for rule syntax and ordering.

=head2 Further documentation

   perldoc mcp-fs
   perldoc mcp-multibroker
   perldoc anyevent-mcp
   perldoc AnyEvent::MCP::Server::Simple
   perldoc AnyEvent::MCP::Server::Permissions

The programs describe their own command-line options. If a client reports
no tools, first check that the selected program starts and that its required
utilities are detected. Stdio servers must not print diagnostics or banners
to stdout. For HTTP, check that the client can reach the configured URL and
has the correct authentication credentials.

=head1 GLOBAL CONFIGURATION

The shared per-user configuration is C<$XDG_CONFIG_HOME/anyevent-mcp/global.ini>,
or C<$HOME/.config/anyevent-mcp/global.ini> when XDG_CONFIG_HOME is unset.
L<AnyEvent::MCP::Config> loads and holds it; loading this module does not access
configuration files.

The file is UTF-8 and uses sections with single-line C<key = value> pairs.
Values are unquoted strings. Blank lines and whole-line comments beginning
with C<#> or C<;> are ignored; inline comment characters remain part of the
value. Later occurrences of a key replace earlier ones in the same section.

   [global]
   secret = ...128 hexadecimal digits...

   [server example]
   port = 31740
   url = https://example.net:31740/{cookie}/

   [mcp-fs]
   utility = /path/to/utility

Section names are unrestricted. Application-specific sections, including
exports, utility paths and user settings, are documented by their applications.

C<[global]> holds C<secret>, a 64-byte master key encoded as 128 hexadecimal
digits. The file must be owned by the current user, with no group or other
permissions. A missing secret is generated automatically on first configuration
access and saved when possible. Existing secrets are never replaced implicitly.
An invalid secret is an error.

If saving fails, Config warns and retains the secret in memory. Credentials
then remain stable only for that process; other processes cannot derive the
same credentials. If randomness is unavailable, supply a securely generated
secret in the file.

C<[server NAME]> holds named-server settings. Its C<url> is a complete template;
C<{cookie}> is replaced with the cookie derived for that server and optional
username. Scheme, host, port and cookie placement are explicit in the template.
HTTP servers with an explicit C<name> load C<host>, C<port>, C<path>,
C<url_host>, C<url_scheme>, C<cookie>, C<bearer> and C<users> from this section
as defaults. C<users> is a comma-separated allowlist whose Basic passwords
are derived for the named server. An explicit password hash can instead be
passed to the constructor. C<url> is a template for the utility program; it
does not set the listener's address.

C<mcp_start> chooses an application name and supplies cookie/bearer
authentication by default. Explicit authentication settings replace this
default. Stdio startup does not access global configuration.

C<[client NAME]> supplies HTTP client defaults: C<url>, C<bearer>, C<username>,
C<password> and C<timeout>. Clients consult it only when explicitly given a
C<name>. An unnamed client or HTTP server does not read global configuration.
Explicit constructor arguments take precedence over named defaults.

=head1 ENVIRONMENT

Project-specific environment variables use the C<PERL_ANYEVENT_MCP_> prefix.
C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio> selects stdio in Simple.
C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS> supplies the default application name.
C<PERL_ANYEVENT_MCP_PERMISSION_HELPER> selects the external asking executable.
Standard C<HOME> and C<XDG_CONFIG_HOME> keep their standard names.

=head1 FUNCTIONS

=over

=item $bytes = AnyEvent::MCP::utf8enc $text

Return a UTF-8 byte string for C<$text>, leaving the argument unchanged.

=item $text = AnyEvent::MCP::utf8dec $bytes

Decode a UTF-8 byte string into characters, dying on invalid UTF-8.
The argument is left unchanged. For intentional in-place conversions,
use Perl's C<utf8::encode> or C<utf8::decode> directly.

=item $bytes = AnyEvent::MCP::random_bytes $length

Returns exactly C<$length> random bytes. Tries C</dev/urandom>, then an external
C<openssl rand> command. No additional random-number module is required.
Dies if neither source supplies the requested bytes successfully.
C<$length> must be a nonnegative integer; zero returns an empty string.

=back

=head2 PATCH UTILITIES

Since applying patches to files is a common task for MCP servers, the
following utility functions can be used to ease that job. Together, they
define a common patch format (unified diff or a simplified version of it,
with fewer requirements to make it easier for the LLM to generate), helpers
to apply the patch and a helper to verify if the patch was applied
with sufficient precision.

Use C<apply_udiff> to normalize, apply and validate a patch in one operation.
It writes a separate output file; the caller checks freshness and metadata
and commits the result.

For an application-specific applier, the workflow is:

=over

=item 1. AnyEvent::MCP::normalize_udiff

Returns a unified diff for GNU patch and the permitted hunk offsets.

=item 2. Apply the normalized diff

Run GNU patch with fuzz zero and capture its verbose output.

=item 3. AnyEvent::MCP::check_patch_output

Checks the process status and output against the permitted offsets.
C<parse_patch_output> is available separately when only parsing is needed.

=back

=head3 Input format

The patch format accepted by normalize_udiff is an extension to the
(essentially undocumented) unified diff format.

In a hunk header, only the old start C<-N> matters. It is the old-file line
of the first hunk body line, including context, not necessarily the first
changed line. Counts and the new-file position are ignored and recomputed.
Both ordinary headers and the abbreviated form are accepted:

   @@ -42,99 +123,99 @@
   @@ -42 @@

Optional text after the closing C<@@> is preserved. File headers and other
text before the first hunk are preserved; a diff must describe one file.

Hunk body lines use the usual prefixes: a space for unchanged context,
C<-> for removed lines and C<+> for added lines. The
C<\ No newline at end of file> marker is preserved and counts neither side.
Trailing empty lines outside the final hunk are discarded.

Pure insertion is permitted only at the beginning, using old start C<0>.
For example, C<@@ -0 @@> with one added line becomes C<@@ -0,0 +1,1 @@>.
An empty old-side range names the line before the insertion: C<-0,0>
means before line 1, whereas C<-1,0> would mean after line 1 and is rejected
here. Nonempty ranges use one-based line numbers.

An insertion elsewhere needs old-side context. Empty hunks are rejected.
New positions include the cumulative line-count changes of preceding hunks.

=head3 Applying the result

The C<normalize_udiff> function does not apply the patch, check file
contents or guard against concurrent edits. The caller must supply those
checks, if required.

Context must match exactly: apply with fuzz zero. For each hunk,
C<$max_offset> permits relocation by at most the number of distinct old-side
lines minus one, or zero for a pure insertion. Repeated old-side lines do
not increase this allowance. The applier must enforce these limits; an
unrestricted search for matching context can select the wrong occurrence.

For live Vim buffers, also require the expected changedtick to match.
File-based users need an equivalent check before replacing the file.

To work around GNU patch's handling of asymmetric context, the
first context line of each hunk is rewritten as an identity
removal/addition. The line contents and old/new line counts are
unchanged. This is normalization for the patch applier, not a relaxation
of context matching.

=over

=item ($diff, $max_offset) = AnyEvent::MCP::normalize_udiff $diff

Normalizes a relaxed, single-file unified diff into ordinary unified diff
syntax. Returns the normalized C<$diff> and an array reference C<$max_offset>
containing the permitted whole-hunk relocation for each hunk, in order.
Dies on malformed hunks or when no hunks are found.

Here is a suitable description for the diff format, e.g. in a tool
definition:

   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.

=item $cv = AnyEvent::MCP::apply_udiff $input, $output, $diff

Asynchronously applies the relaxed C<$diff> to the input file C<$input>,
writing a separate output file C<$output>. C<$diff> must contain bytes;
callers working with characters must encode them for the file themselves.

Normalizes the diff, runs GNU patch using C<AnyEvent::Util::run_cmd>, and
validates its verbose output with C<check_patch_output>. The command uses
batch/forward mode, binary mode and fuzz zero. No shell is involved.

C<$output> must not exist. It is reserved with mode 0600; patch runs in its
directory so incidental temporary files stay there. Input and output paths
are made absolute before starting the command. These must be trusted paths
in a directory controlled by the caller.

Returns a condition variable. Its C<recv> returns the validated hunk array
reference, or throws on command/application failure. Setup failures throw
synchronously. Failed or partial output is removed. C<$input> is unchanged.

The caller owns committing the successful output and removing it when no
longer needed. Freshness checks, metadata preservation, atomic replacement
and application-specific permissions also belong to the caller.

For your reference, the exact options used are:

   --verbose --batch --forward --binary --fuzz=0
   --no-backup-if-mismatch
   --reject-file=- --output=... -- <inputfile>

=item $parsed = AnyEvent::MCP::parse_patch_output $output

Parses C<LC_ALL=C> GNU patch C<--verbose> output without judging whether
the application is acceptable. C<$parsed> has two fields:

=over

=item hunks => [$hunk...]

Hunk records in output order. Each record contains C<hunk> (the one-based
number), C<success>, C<line> (the reported application line), C<fuzz> and
the signed C<offset>. Omitted fuzz and offset are zero. Failed and ignored
hunks have false C<success>.

=item unparsed => [$line...]

Lines not recognized as hunk results or GNU patch's verbose framing.
The parser preserves them for callers to interpret or reject.

=back

Use verbose output: ordinary patch output omits exact-position successes,
so it cannot account for every hunk.

=item $hunks = AnyEvent::MCP::check_patch_output $status, $output, [$max_offset...]

Parses C<$output> and validates a complete application. C<$status> is the
raw process wait status, as returned by C<waitpid> or
C<AnyEvent::Util::run_cmd>, not just the exit code.

Requires status zero, no unrecognized output, exactly the expected hunks
in numbered order, successful application, fuzz zero and each signed offset
within its corresponding absolute limit. C<[$max_offset...]> is the array
reference returned by C<normalize_udiff>. At least one hunk is required.

Returns the parsed hunk array reference on success; otherwise dies with a
diagnostic. This is also suitable for callers running patch inside their
own sandbox.

=back

=cut

package AnyEvent::MCP;

use common::sense;
use Digest::SHA ();

our $VERSION = '0.0';

sub utf8enc($) {
   my $text = shift;

   utf8::encode $text;
   $text
}

sub utf8dec($) {
   my $bytes = shift;

   utf8::decode $bytes
      or die "invalid UTF-8\n";
   $bytes
}

sub random_bytes($) {
   my ($length) = @_;

   die "Invalid random byte count\n"
      unless defined $length && $length =~ /\A[0-9]+\z/;
   return "" unless $length;

   my $bytes = "";

   if (open my $fh, "<", "/dev/urandom") {
      binmode $fh;
      while (length $bytes < $length) {
         read ($fh, $bytes, $length - length ($bytes), length $bytes)
            or last;
      }
      close $fh;

      return $bytes if length $bytes == $length;
   }

   if (open my $fh, "-|", "openssl", "rand", $length) {
      binmode $fh;
      local $/;
      $bytes = <$fh>;
      my $success = close $fh;

      return $bytes
         if $success && defined $bytes && length $bytes == $length;
   }

   die "Cannot obtain $length random bytes from /dev/urandom or openssl rand\n";
}

sub hkdf_sha512_expand($$$) {
   my ($prk, $info, $l) = @_;

   64 == length $prk
      or die "hkdf_sha512_expand: prk length mist be 64 octets";

   my $t   = "";
   my $okm = "";
   my $i   = 0;

   do {
      $t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
      $okm .= $t;
   } while $l > length $okm;

   substr $okm, 0, $l
}

sub normalize_udiff {
   my $diff = shift;
   my @line = split /\n/, $diff, -1;
   my $delta = 0;
   my $hunks = 0;
   my @max_offset;

   pop @line while @line and !length $line[-1];

   for (my $i = 0; $i < @line; ++$i) {
      next unless $line[$i] =~ /^@@ /;

      $line[$i] =~ /^@@ -(\d+)(?:,\d+)?(?: \+\d+(?:,\d+)?)? @@(.*)$/
         or die "normalize_udiff: bad hunk header '$line[$i]'\n";

      my ($old_start, $suffix) = ($1, $2);
      my ($old_count, $new_count) = (0, 0);
      my %old_line;
      my $j = $i + 1;

      # GNU patch mishandles hunks with more prefix than suffix context.
      # Make the first context line an identity change without losing it.
      # see https://unix.stackexchange.com/questions/414542/does-patch-work-with-asymmetric-context
      splice @line, $i + 1, 1, "-$1", "+$1"
         if $line[$i + 1] =~ /^ (.*)\z/;

      for (; $j < @line; ++$j) {
         last if $line[$j] =~ /^@@ /;

         my $tag = substr $line[$j], 0, 1;

         if ($tag eq " ") {
            ++$old_count;
            ++$new_count;
            $old_line{substr $line[$j], 1} = 1;
         } elsif ($tag eq "-") {
            ++$old_count;
            $old_line{substr $line[$j], 1} = 1;
         } elsif ($tag eq "+") {
            ++$new_count;
         } elsif ($line[$j] eq "\\ No newline at end of file") {
            # Marker belongs to the preceding body line and counts neither side.
         } else {
            die "normalize_udiff: bad hunk line '$line[$j]'\n";
         }
      }

      $old_count or $new_count
         or die "normalize_udiff: empty hunk at old line $old_start\n";

      $old_count or !$old_start
         or die "normalize_udiff: hunk " . ($hunks + 1)
              . " needs old-side context for insertion after old line $old_start\n";

      my $new_start = $old_start + $delta;
      ++$new_start unless $old_count;
      --$new_start unless $new_count;

      $new_start >= 0
         or die "normalize_udiff: invalid new line $new_start\n";

      $line[$i] = sprintf "@@ -%d,%d +%d,%d @@%s",
         $old_start, $old_count, $new_start, $new_count, $suffix;

      $delta += $new_count - $old_count;
      ++$hunks;
      my $max_offset = keys %old_line;
      --$max_offset
         if $max_offset;
      push @max_offset, $max_offset;
      $i = $j - 1;
   }

   $hunks
      or die "normalize_udiff: no hunks\n";

   (join ("\n", @line, ""), \@max_offset)
}

sub parse_patch_output {
   my ($output) = @_;
   my (@hunks, @unparsed);

   for (split /\n/, $output) {
      if (/^Hunk #(\d+) (succeeded|FAILED|ignored) at (-?\d+)(?: with fuzz (\d+))?(?: \(offset (-?\d+) lines?\))?\.\z/) {
         push @hunks, {
            hunk    => 0 + $1,
            success => $2 eq "succeeded",
            line    => 0 + $3,
            fuzz    => 0 + $4,
            offset  => 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, not hunk results.
      } else {
         push @unparsed, $_;
      }
   }

   { hunks => \@hunks, unparsed => \@unparsed }
}

sub check_patch_output {
   my ($status, $output, $max_offset) = @_;
   my $parsed = parse_patch_output $output;
   my $hunks = $parsed->{hunks};

   die "patch failed (wait status $status):\n$output"
      if $status;
   die "patch: unrecognized output:\n" . (join "\n", @{$parsed->{unparsed}}) . "\n"
      if @{$parsed->{unparsed}};
   die "patch: expected " . @$max_offset . " hunks, got " . @$hunks . "\n"
      unless @$hunks == @$max_offset && @$hunks;

   for my $i (0 .. $#$hunks) {
      my $hunk = $hunks->[$i];

      die "patch: unexpected hunk number $hunk->{hunk}\n"
         unless $hunk->{hunk} == $i + 1;
      die "patch: hunk $hunk->{hunk} failed\n"
         unless $hunk->{success};
      die "patch: hunk $hunk->{hunk} used fuzz $hunk->{fuzz}\n"
         if $hunk->{fuzz};
      die "patch: hunk $hunk->{hunk} offset $hunk->{offset} exceeds $max_offset->[$i]\n"
         if abs $hunk->{offset} > $max_offset->[$i];
   }

   $hunks
}

sub apply_udiff {
   my ($input, $output, $diff) = @_;
   my ($normalized, $max_offset) = normalize_udiff $diff;

   require AnyEvent::Util;
   require File::Spec;
   require File::Basename;
   require Fcntl;

   $input  = File::Spec->rel2abs ($input);
   $output = File::Spec->rel2abs ($output);
   my $directory = File::Basename::dirname ($output);

   sysopen my $fh, $output, Fcntl::O_WRONLY () | Fcntl::O_CREAT () | Fcntl::O_EXCL (), 0600
      or die "$output: $!\n";
   close $fh or do { my $error = $!; unlink $output; die "$output: $error\n" };

   my $cv = AE::cv ();
   my $log;
   my $process = eval {
      AnyEvent::Util::run_cmd ([
         "patch", "--verbose", "--batch", "--forward", "--binary", "--fuzz=0",
         "--no-backup-if-mismatch", "--reject-file=-", "--output=$output", "--", $input,
      ],
         "<" => \$normalized,
         ">" => \$log,
         close_all => 1,
         on_prepare => sub {
            $ENV{LC_ALL} = "C";
            chdir $directory or die "$directory: $!\n";
            defined POSIX::dup2 (1, 2) or die "dup2: $!\n";
         },
      );
   };

   if ($@) {
      my $error = $@;
      unlink $output;
      die $error;
   }

   $process->cb (sub {
      my $hunks;
      eval { $hunks = check_patch_output $_[0]->recv, $log, $max_offset; 1 } or do {
         my $error = $@;
         unlink $output;
         $cv->croak ($error);
         return;
      };

      $cv->send ($hunks);
   });

   $cv
}

sub _clean_text($) {
   my ($text) = @_;

   my ($prefix) = (join "\n", grep /\S/, split /\n/, $text)
      =~ /\A([ \t]*)[^\n]*(?:\n\1[^\n]*)*\z/;

   $text =~ s/^\Q$prefix\E//mg;
   $text =~ s/\A\s+//;
   $text =~ s/\s+\z//;
   $text
}

package AnyEvent::MCP::Base;

sub new {
   my ($class, %kv) = @_;
   bless \%kv, $class
}

sub event {
   my ($self, $event, @args) = @_;
   ($self->{"on_$event"} or return)->($self, @args)
}

=head1 SEE ALSO

L<AnyEvent>, L<https://modelcontextprotocol.io/>

=head1 AUTHOR

The main author of this module is OpenAI ChatGPT.

Additional guidance received by:

   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/

=cut

1

Revision:	1.9
Committed:	Fri Oct 9 07:59:23 2026 UTC (5 weeks, 1 day ago) by root
Branch:	MAIN
Changes since 1.8:	+270 -2 lines
Log Message:	* empty log message *