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; this documentation is intentionally
only an overview for now.

=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::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 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.7
Committed:	Thu Oct 8 03:54:32 2026 UTC (3 weeks, 3 days ago) by root
Branch:	MAIN
Changes since 1.6:	+23 -12 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP - Model Context Protocol client/server support
4
5			=head1 SYNOPSIS
6
7	root	1.6	use AnyEvent::MCP::Server::Simple ();
8	root	1.1
9			mcp_tool ...
10	root	1.3	mcp_start;
11	root	1.1
12			or use the object interface directly:
13
14	root	1.6	use AnyEvent::MCP::Server ();
15	root	1.1
16			my $server = AnyEvent::MCP::Server->new (...);
17
18			=head1 DESCRIPTION
19
20			AnyEvent::MCP provides event-driven Model Context Protocol client and server
21			support.
22
23			The usual way to implement a small MCP server is
24			L<AnyEvent::MCP::Server::Simple>, which provides a function-based interface and
25			creates the underlying server objects when a transport such as stdio or HTTP is
26			started.
27
28			The lower-level object interfaces are intended for applications that need to
29			manage MCP connections, servers or reusable tool registries directly.
30
31			=head2 MODULES
32
33	root	1.7	=over
34	root	1.1
35			=item L<AnyEvent::MCP::Server::Simple>
36
37			Function-based interface for implementing ordinary MCP servers.
38
39			=item L<AnyEvent::MCP::Server>
40
41			Object-oriented MCP server interface.
42
43			=item L<AnyEvent::MCP::Client>
44
45			Object-oriented MCP client interface.
46
47			=item L<AnyEvent::MCP::Server::Toolset>
48
49			Reusable registry of MCP tool declarations.
50
51			=item L<AnyEvent::MCP::Server::Permissions>
52
53			Permission and capability handling for MCP servers.
54
55			=back
56
57	root	1.4	C<mcp-multibroker> combines downstream HTTP and stdio servers under tool-name
58			prefixes. It uses the same client, server and permission helper facilities,
59			including modern input forwarding and local permission prompts for legacy
60			callers. Run C<mcp-multibroker --help> for command-line syntax; its manual
61			describes authentication and configuration.
62
63	root	1.1	The interfaces are still being designed; this documentation is intentionally
64			only an overview for now.
65
66	root	1.2	=head1 GLOBAL CONFIGURATION
67
68			The shared per-user configuration is C<$XDG_CONFIG_HOME/anyevent-mcp/global.ini>,
69			or C<$HOME/.config/anyevent-mcp/global.ini> when XDG_CONFIG_HOME is unset.
70			L<AnyEvent::MCP::Config> loads and holds it; loading this module does not access
71			configuration files.
72
73			The file is UTF-8 and uses sections with single-line C<key = value> pairs.
74			Values are unquoted strings. Blank lines and whole-line comments beginning
75			with C<#> or C<;> are ignored; inline comment characters remain part of the
76			value. Later occurrences of a key replace earlier ones in the same section.
77
78			[global]
79			secret = ...128 hexadecimal digits...
80
81			[server example]
82	root	1.3	port = 31740
83			url = https://example.net:31740/{cookie}/
84	root	1.2
85			[mcp-fs]
86			utility = /path/to/utility
87
88			Section names are unrestricted. Application-specific sections, including
89			exports, utility paths and user settings, are documented by their applications.
90
91			C<[global]> holds C<secret>, a 64-byte master key encoded as 128 hexadecimal
92			digits. The file must be owned by the current user, with no group or other
93			permissions. A missing secret is generated automatically on first configuration
94			access and saved when possible. Existing secrets are never replaced implicitly.
95			An invalid secret is an error.
96
97			If saving fails, Config warns and retains the secret in memory. Credentials
98			then remain stable only for that process; other processes cannot derive the
99			same credentials. If randomness is unavailable, supply a securely generated
100			secret in the file.
101
102			C<[server NAME]> holds named-server settings. Its C<url> is a complete template;
103			C<{cookie}> is replaced with the cookie derived for that server and optional
104			username. Scheme, host, port and cookie placement are explicit in the template.
105	root	1.3	HTTP servers with an explicit C<name> load C<host>, C<port>, C<path>,
106			C<url_host>, C<url_scheme>, C<cookie>, C<bearer> and C<users> from this section
107			as defaults. C<users> is a comma-separated allowlist whose Basic passwords
108			are derived for the named server. An explicit password hash can instead be
109			passed to the constructor. C<url> is a template for the utility program; it
110			does not set the listener's address.
111
112			C<mcp_start> chooses an application name and supplies cookie/bearer
113			authentication by default. Explicit authentication settings replace this
114			default. Stdio startup does not access global configuration.
115
116			C<[client NAME]> supplies HTTP client defaults: C<url>, C<bearer>, C<username>,
117			C<password> and C<timeout>. Clients consult it only when explicitly given a
118			C<name>. An unnamed client or HTTP server does not read global configuration.
119			Explicit constructor arguments take precedence over named defaults.
120
121			=head1 ENVIRONMENT
122
123			Project-specific environment variables use the C<PERL_ANYEVENT_MCP_> prefix.
124			C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio> selects stdio in Simple.
125			C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS> supplies the default application name.
126			C<PERL_ANYEVENT_MCP_PERMISSION_HELPER> selects the external asking executable.
127			Standard C<HOME> and C<XDG_CONFIG_HOME> keep their standard names.
128	root	1.2
129			=head1 FUNCTIONS
130
131	root	1.6	=over
132
133			=item $bytes = AnyEvent::MCP::random_bytes $length
134	root	1.2
135			Returns exactly C<$length> random bytes. Tries C</dev/urandom>, then an external
136			C<openssl rand> command. No additional random-number module is required.
137			Dies if neither source supplies the requested bytes successfully.
138			C<$length> must be a nonnegative integer; zero returns an empty string.
139
140	root	1.6	=back
141
142			=head2 PATCH UTILITIES
143
144	root	1.7	Since applying patches to files is a common task for MCP servers, the
145	root	1.6	following utility functions can be used to ease that job. Together, they
146	root	1.7	define a common patch format (unified diff or a simplified version of it,
147			with fewer requirements to make it easier for the LLM to generate), helpers
148	root	1.6	to apply the patch and a helper to verify if the patch was applied
149			with sufficient precision.
150
151	root	1.7	Use C<apply_udiff> to normalize, apply and validate a patch in one operation.
152			It writes a separate output file; the caller checks freshness and metadata
153			and commits the result.
154
155			For an application-specific applier, the workflow is:
156	root	1.6
157			=over
158
159			=item 1. AnyEvent::MCP::normalize_udiff
160
161	root	1.7	Returns a unified diff for GNU patch and the permitted hunk offsets.
162
163			=item 2. Apply the normalized diff
164	root	1.6
165	root	1.7	Run GNU patch with fuzz zero and capture its verbose output.
166	root	1.6
167	root	1.7	=item 3. AnyEvent::MCP::check_patch_output
168
169			Checks the process status and output against the permitted offsets.
170			C<parse_patch_output> is available separately when only parsing is needed.
171	root	1.5
172	root	1.6	=back
173
174	root	1.5	=head3 Input format
175
176	root	1.6	The patch format accepted by normalize_udiff is an extension to the
177			(essentially undocumented) unified diff format.
178
179	root	1.5	In a hunk header, only the old start C<-N> matters. It is the old-file line
180			of the first hunk body line, including context, not necessarily the first
181			changed line. Counts and the new-file position are ignored and recomputed.
182			Both ordinary headers and the abbreviated form are accepted:
183
184			@@ -42,99 +123,99 @@
185			@@ -42 @@
186
187			Optional text after the closing C<@@> is preserved. File headers and other
188			text before the first hunk are preserved; a diff must describe one file.
189
190			Hunk body lines use the usual prefixes: a space for unchanged context,
191			C<-> for removed lines and C<+> for added lines. The
192			C<\ No newline at end of file> marker is preserved and counts neither side.
193			Trailing empty lines outside the final hunk are discarded.
194
195	root	1.7	Pure insertion is permitted only at the beginning, using old start C<0>.
196			For example, C<@@ -0 @@> with one added line becomes C<@@ -0,0 +1,1 @@>.
197			An empty old-side range names the line before the insertion: C<-0,0>
198			means before line 1, whereas C<-1,0> would mean after line 1 and is rejected
199			here. Nonempty ranges use one-based line numbers.
200
201	root	1.5	An insertion elsewhere needs old-side context. Empty hunks are rejected.
202			New positions include the cumulative line-count changes of preceding hunks.
203
204			=head3 Applying the result
205
206	root	1.6	The C<normalize_udiff> function does not apply the patch, check file
207			contents or guard against concurrent edits. The caller must supply those
208			checks, if required.
209	root	1.5
210			Context must match exactly: apply with fuzz zero. For each hunk,
211			C<$max_offset> permits relocation by at most the number of distinct old-side
212			lines minus one, or zero for a pure insertion. Repeated old-side lines do
213			not increase this allowance. The applier must enforce these limits; an
214			unrestricted search for matching context can select the wrong occurrence.
215
216			For live Vim buffers, also require the expected changedtick to match.
217			File-based users need an equivalent check before replacing the file.
218
219	root	1.6	To work around GNU patch's handling of asymmetric context, the
220			first context line of each hunk is rewritten as an identity
221			removal/addition. The line contents and old/new line counts are
222			unchanged. This is normalization for the patch applier, not a relaxation
223			of context matching.
224	root	1.5
225	root	1.6	=over
226
227			=item ($diff, $max_offset) = AnyEvent::MCP::normalize_udiff $diff
228
229			Normalizes a relaxed, single-file unified diff into ordinary unified diff
230			syntax. Returns the normalized C<$diff> and an array reference C<$max_offset>
231			containing the permitted whole-hunk relocation for each hunk, in order.
232			Dies on malformed hunks or when no hunks are found.
233
234			Here is a suitable description for the diff format, e.g. in a tool
235			definition:
236
237			Apply a unified diff to one regular file. Hunk counts are recomputed,
238			fuzz is disabled, whole-hunk relocation is limited per hunk by distinct
239			old-side lines. Pure insertion is allowed only at the beginning;
240			elsewhere include old-side context.
241
242			=item $cv = AnyEvent::MCP::apply_udiff $input, $output, $diff
243
244			Asynchronously applies the relaxed C<$diff> to the input file C<$input>,
245			writing a separate output file C<$output>. C<$diff> must contain bytes;
246			callers working with characters must encode them for the file themselves.
247
248			Normalizes the diff, runs GNU patch using C<AnyEvent::Util::run_cmd>, and
249			validates its verbose output with C<check_patch_output>. The command uses
250			batch/forward mode, binary mode and fuzz zero. No shell is involved.
251
252			C<$output> must not exist. It is reserved with mode 0600; patch runs in its
253			directory so incidental temporary files stay there. Input and output paths
254			are made absolute before starting the command. These must be trusted paths
255			in a directory controlled by the caller.
256
257			Returns a condition variable. Its C<recv> returns the validated hunk array
258			reference, or throws on command/application failure. Setup failures throw
259			synchronously. Failed or partial output is removed. C<$input> is unchanged.
260
261			The caller owns committing the successful output and removing it when no
262			longer needed. Freshness checks, metadata preservation, atomic replacement
263			and application-specific permissions also belong to the caller.
264
265			For your reference, the exact options used are:
266
267			--verbose --batch --forward --binary --fuzz=0
268			--no-backup-if-mismatch
269			--reject-file=- --output=... -- <inputfile>
270
271			=item $parsed = AnyEvent::MCP::parse_patch_output $output
272	root	1.5
273			Parses C<LC_ALL=C> GNU patch C<--verbose> output without judging whether
274			the application is acceptable. C<$parsed> has two fields:
275
276	root	1.6	=over
277	root	1.5
278			=item hunks => [$hunk...]
279
280			Hunk records in output order. Each record contains C<hunk> (the one-based
281			number), C<success>, C<line> (the reported application line), C<fuzz> and
282			the signed C<offset>. Omitted fuzz and offset are zero. Failed and ignored
283			hunks have false C<success>.
284
285			=item unparsed => [$line...]
286
287			Lines not recognized as hunk results or GNU patch's verbose framing.
288			The parser preserves them for callers to interpret or reject.
289
290			=back
291
292			Use verbose output: ordinary patch output omits exact-position successes,
293			so it cannot account for every hunk.
294
295	root	1.6	=item $hunks = AnyEvent::MCP::check_patch_output $status, $output, [$max_offset...]
296	root	1.5
297			Parses C<$output> and validates a complete application. C<$status> is the
298			raw process wait status, as returned by C<waitpid> or
299			C<AnyEvent::Util::run_cmd>, not just the exit code.
300
301			Requires status zero, no unrecognized output, exactly the expected hunks
302			in numbered order, successful application, fuzz zero and each signed offset
303			within its corresponding absolute limit. C<[$max_offset...]> is the array
304			reference returned by C<normalize_udiff>. At least one hunk is required.
305
306			Returns the parsed hunk array reference on success; otherwise dies with a
307			diagnostic. This is also suitable for callers running patch inside their
308			own sandbox.
309
310	root	1.6	=back
311	root	1.5
312	root	1.1	=cut
313
314			package AnyEvent::MCP;
315
316			use common::sense;
317			use Digest::SHA ();
318
319			our $VERSION = '0.0';
320
321	root	1.2	sub random_bytes($) {
322			my ($length) = @_;
323
324			die "Invalid random byte count\n"
325			unless defined $length && $length =~ /\A[0-9]+\z/;
326			return "" unless $length;
327
328			my $bytes = "";
329
330			if (open my $fh, "<", "/dev/urandom") {
331			binmode $fh;
332			while (length $bytes < $length) {
333			read ($fh, $bytes, $length - length ($bytes), length $bytes)
334			or last;
335			}
336			close $fh;
337
338			return $bytes if length $bytes == $length;
339			}
340
341			if (open my $fh, "-\|", "openssl", "rand", $length) {
342			binmode $fh;
343			local $/;
344			$bytes = <$fh>;
345			my $success = close $fh;
346
347			return $bytes
348			if $success && defined $bytes && length $bytes == $length;
349			}
350
351			die "Cannot obtain $length random bytes from /dev/urandom or openssl rand\n";
352			}
353
354	root	1.1	sub hkdf_sha512_expand($$$) {
355			my ($prk, $info, $l) = @_;
356
357	root	1.2	64 == length $prk
358			or die "hkdf_sha512_expand: prk length mist be 64 octets";
359
360	root	1.1	my $t = "";
361			my $okm = "";
362			my $i = 0;
363
364			do {
365			$t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
366			$okm .= $t;
367			} while $l > length $okm;
368
369			substr $okm, 0, $l
370			}
371
372	root	1.5	sub normalize_udiff {
373			my $diff = shift;
374			my @line = split /\n/, $diff, -1;
375			my $delta = 0;
376			my $hunks = 0;
377			my @max_offset;
378
379			pop @line while @line and !length $line[-1];
380
381			for (my $i = 0; $i < @line; ++$i) {
382			next unless $line[$i] =~ /^@@ /;
383
384			$line[$i] =~ /^@@ -(\d+)(?:,\d+)?(?: \+\d+(?:,\d+)?)? @@(.*)$/
385			or die "normalize_udiff: bad hunk header '$line[$i]'\n";
386
387			my ($old_start, $suffix) = ($1, $2);
388			my ($old_count, $new_count) = (0, 0);
389			my %old_line;
390			my $j = $i + 1;
391
392			# GNU patch mishandles hunks with more prefix than suffix context.
393			# Make the first context line an identity change without losing it.
394			# see https://unix.stackexchange.com/questions/414542/does-patch-work-with-asymmetric-context
395			splice @line, $i + 1, 1, "-$1", "+$1"
396			if $line[$i + 1] =~ /^ (.*)\z/;
397
398			for (; $j < @line; ++$j) {
399			last if $line[$j] =~ /^@@ /;
400
401			my $tag = substr $line[$j], 0, 1;
402
403			if ($tag eq " ") {
404			++$old_count;
405			++$new_count;
406			$old_line{substr $line[$j], 1} = 1;
407			} elsif ($tag eq "-") {
408			++$old_count;
409			$old_line{substr $line[$j], 1} = 1;
410			} elsif ($tag eq "+") {
411			++$new_count;
412			} elsif ($line[$j] eq "\\ No newline at end of file") {
413			# Marker belongs to the preceding body line and counts neither side.
414			} else {
415			die "normalize_udiff: bad hunk line '$line[$j]'\n";
416			}
417			}
418
419			$old_count or $new_count
420			or die "normalize_udiff: empty hunk at old line $old_start\n";
421
422			$old_count or !$old_start
423			or die "normalize_udiff: hunk " . ($hunks + 1)
424			. " needs old-side context for insertion after old line $old_start\n";
425
426			my $new_start = $old_start + $delta;
427			++$new_start unless $old_count;
428			--$new_start unless $new_count;
429
430			$new_start >= 0
431			or die "normalize_udiff: invalid new line $new_start\n";
432
433			$line[$i] = sprintf "@@ -%d,%d +%d,%d @@%s",
434			$old_start, $old_count, $new_start, $new_count, $suffix;
435
436			$delta += $new_count - $old_count;
437			++$hunks;
438			my $max_offset = keys %old_line;
439			--$max_offset
440			if $max_offset;
441			push @max_offset, $max_offset;
442			$i = $j - 1;
443			}
444
445			$hunks
446			or die "normalize_udiff: no hunks\n";
447
448			(join ("\n", @line, ""), \@max_offset)
449			}
450
451			sub parse_patch_output {
452			my ($output) = @_;
453			my (@hunks, @unparsed);
454
455			for (split /\n/, $output) {
456			if (/^Hunk #(\d+) (succeeded\|FAILED\|ignored) at (-?\d+)(?: with fuzz (\d+))?(?: \(offset (-?\d+) lines?\))?\.\z/) {
457			push @hunks, {
458			hunk => 0 + $1,
459			success => $2 eq "succeeded",
460			line => 0 + $3,
461			fuzz => 0 + $4,
462			offset => 0 + $5,
463			};
464			} elsif (!length
465			\|\| /^Hmm\.\.\. +Looks like a unified diff to me\.\.\.\z/
466			\|\| /^The text leading up to this was:\z/
467			\|\| /^-+\z/ \|\| /^\\|/
468			\|\| /^patching file / \|\| /^checking file /
469			\|\| /^Using Plan [AB]\.\.\.\z/ \|\| /^done\z/) {
470			# GNU patch --verbose framing, not hunk results.
471			} else {
472			push @unparsed, $_;
473			}
474			}
475
476			{ hunks => \@hunks, unparsed => \@unparsed }
477			}
478
479			sub check_patch_output {
480			my ($status, $output, $max_offset) = @_;
481			my $parsed = parse_patch_output $output;
482			my $hunks = $parsed->{hunks};
483
484			die "patch failed (wait status $status):\n$output"
485			if $status;
486			die "patch: unrecognized output:\n" . (join "\n", @{$parsed->{unparsed}}) . "\n"
487			if @{$parsed->{unparsed}};
488			die "patch: expected " . @$max_offset . " hunks, got " . @$hunks . "\n"
489			unless @$hunks == @$max_offset && @$hunks;
490
491			for my $i (0 .. $#$hunks) {
492			my $hunk = $hunks->[$i];
493
494			die "patch: unexpected hunk number $hunk->{hunk}\n"
495			unless $hunk->{hunk} == $i + 1;
496			die "patch: hunk $hunk->{hunk} failed\n"
497			unless $hunk->{success};
498			die "patch: hunk $hunk->{hunk} used fuzz $hunk->{fuzz}\n"
499			if $hunk->{fuzz};
500			die "patch: hunk $hunk->{hunk} offset $hunk->{offset} exceeds $max_offset->[$i]\n"
501			if abs $hunk->{offset} > $max_offset->[$i];
502			}
503
504			$hunks
505			}
506
507			sub apply_udiff {
508			my ($input, $output, $diff) = @_;
509			my ($normalized, $max_offset) = normalize_udiff $diff;
510
511			require AnyEvent::Util;
512			require File::Spec;
513			require File::Basename;
514			require Fcntl;
515
516			$input = File::Spec->rel2abs ($input);
517			$output = File::Spec->rel2abs ($output);
518			my $directory = File::Basename::dirname ($output);
519
520			sysopen my $fh, $output, Fcntl::O_WRONLY () \| Fcntl::O_CREAT () \| Fcntl::O_EXCL (), 0600
521			or die "$output: $!\n";
522			close $fh or do { my $error = $!; unlink $output; die "$output: $error\n" };
523
524			my $cv = AE::cv ();
525			my $log;
526			my $process = eval {
527			AnyEvent::Util::run_cmd ([
528			"patch", "--verbose", "--batch", "--forward", "--binary", "--fuzz=0",
529			"--no-backup-if-mismatch", "--reject-file=-", "--output=$output", "--", $input,
530			],
531			"<" => \$normalized,
532			">" => \$log,
533			close_all => 1,
534			on_prepare => sub {
535			$ENV{LC_ALL} = "C";
536			chdir $directory or die "$directory: $!\n";
537			defined POSIX::dup2 (1, 2) or die "dup2: $!\n";
538			},
539			);
540			};
541
542			if ($@) {
543			my $error = $@;
544			unlink $output;
545			die $error;
546			}
547
548			$process->cb (sub {
549			my $hunks;
550			eval { $hunks = check_patch_output $_[0]->recv, $log, $max_offset; 1 } or do {
551			my $error = $@;
552			unlink $output;
553			$cv->croak ($error);
554			return;
555			};
556
557			$cv->send ($hunks);
558			});
559
560			$cv
561			}
562
563	root	1.1	sub _clean_text($) {
564			my ($text) = @_;
565
566			my ($prefix) = (join "\n", grep /\S/, split /\n/, $text)
567			=~ /\A([ \t])[^\n](?:\n\1[^\n])\z/;
568
569			$text =~ s/^\Q$prefix\E//mg;
570			$text =~ s/\A\s+//;
571			$text =~ s/\s+\z//;
572			$text
573			}
574
575			package AnyEvent::MCP::Base;
576
577			sub new {
578			my ($class, %kv) = @_;
579			bless \%kv, $class
580			}
581
582			sub event {
583			my ($self, $event, @args) = @_;
584			($self->{"on_$event"} or return)->($self, @args)
585			}
586
587			=head1 SEE ALSO
588
589			L<AnyEvent>, L<https://modelcontextprotocol.io/>
590
591			=head1 AUTHOR
592
593			The main author of this module is OpenAI ChatGPT.
594
595			Additional guidance received by:
596
597			Marc Lehmann <schmorp@schmorp.de>
598			http://home.schmorp.de/
599
600			=cut
601
602			1
603