ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MCP/lib/AnyEvent/MCP.pm
Revision: 1.36
Committed: Fri Oct 30 17:03:38 2026 UTC (4 days, 3 hours ago) by root
Branch: MAIN
CVS Tags: rel-0_71
Changes since 1.35: +1 -1 lines
Log Message:
0.71

File Contents

# 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.15 use AnyEvent::MCP::Server::Simple;
8 root 1.1
9 root 1.31 my $options = mcp_getoptions ...;
10 root 1.21 mcp_tool ...;
11 root 1.31 mcp_start %$options;
12 root 1.1
13     or use the object interface directly:
14    
15 root 1.6 use AnyEvent::MCP::Server ();
16 root 1.1
17     my $server = AnyEvent::MCP::Server->new (...);
18    
19     =head1 DESCRIPTION
20    
21 root 1.21 AnyEvent::MCP provides event-driven Model Context Protocol client and server
22     support. There are three starting points:
23    
24     =over
25    
26     =item Use the included servers without writing Perl
27    
28     L<AnyEvent::MCP::Intro> walks through installation, a first filesystem
29     request, client connections, configuration, permissions and combining
30     servers. Start there if you want the tools to work on your projects.
31    
32     =item Write a small MCP server
33 root 1.17
34 root 1.21 L<AnyEvent::MCP::Server::Simple/TUTORIAL> builds a complete server,
35     calls it, and adds options, replies, permission checks and asynchronous
36     work. Simple handles transport startup and the event loop.
37    
38     =item Embed MCP in an application
39    
40     The modules below expose tool registries, protocol dispatch, requests and
41     transports separately, for applications that need to control their own
42     connections or lifetime.
43    
44     =back
45 root 1.1
46     The usual way to implement a small MCP server is
47     L<AnyEvent::MCP::Server::Simple>, which provides a function-based interface and
48     creates the underlying server objects when a transport such as stdio or HTTP is
49     started.
50    
51     The lower-level object interfaces are intended for applications that need to
52     manage MCP connections, servers or reusable tool registries directly.
53    
54     =head2 MODULES
55    
56 root 1.7 =over
57 root 1.1
58     =item L<AnyEvent::MCP::Server::Simple>
59    
60     Function-based interface for implementing ordinary MCP servers.
61    
62     =item L<AnyEvent::MCP::Server>
63    
64     Object-oriented MCP server interface.
65    
66     =item L<AnyEvent::MCP::Client>
67    
68     Object-oriented MCP client interface.
69    
70     =item L<AnyEvent::MCP::Server::Toolset>
71    
72     Reusable registry of MCP tool declarations.
73    
74 root 1.29 =item L<AnyEvent::MCP::Server::Request>
75    
76     One incoming server request: arguments, replies, cancellation and progress.
77    
78     =item L<AnyEvent::MCP::Client::Request>
79    
80     Input requested from the MCP client, including human elicitation.
81    
82     =item L<AnyEvent::MCP::Server::HTTP> and L<AnyEvent::MCP::Server::JSONL>
83    
84     HTTP listener and stdio/byte-stream server transports. Both use the
85     protocol handling in L<AnyEvent::MCP::Server>.
86    
87     =item L<AnyEvent::MCP::Client::HTTP> and L<AnyEvent::MCP::Client::JSONL>
88    
89     HTTP and subprocess/byte-stream client transports; both use
90     L<AnyEvent::MCP::Client> for protocol negotiation and tool calls.
91    
92     =item L<AnyEvent::MCP::Server::Connect>
93    
94     Reverse MCP connection from a server into a multibroker.
95    
96 root 1.1 =item L<AnyEvent::MCP::Server::Permissions>
97    
98 root 1.21 Action authorization and sandbox-grant handling for MCP servers.
99 root 1.1
100 root 1.29 =item L<AnyEvent::MCP::Permissions::Ask>
101    
102     External permission dialog handling and form conversion for clients.
103    
104     =item L<AnyEvent::MCP::Config>
105    
106     Private global configuration, named server settings and derived credentials.
107    
108     =item L<AnyEvent::MCP::Helper>
109    
110     Asynchronous JSON exchange with an external form or permission helper.
111    
112     =item L<AnyEvent::MCP::Workdirs> and L<AnyEvent::MCP::File>
113    
114     Persistent workdir identifiers and their locked state-file utilities.
115    
116     =item L<AnyEvent::MCP::Extension>
117    
118     Private authenticated raw-TCP protocols sharing an HTTP listener.
119    
120 root 1.1 =back
121    
122 root 1.4 C<mcp-multibroker> combines downstream HTTP and stdio servers under tool-name
123     prefixes. It uses the same client, server and permission helper facilities,
124     including modern input forwarding and local permission prompts for legacy
125     callers. Run C<mcp-multibroker --help> for command-line syntax; its manual
126     describes authentication and configuration.
127    
128 root 1.16 The interfaces are still being designed. L<AnyEvent::MCP::Intro> explains
129     the installed programs; module-specific POD describes their Perl APIs.
130 root 1.9
131 root 1.16 =head1 TUTORIAL
132 root 1.9
133 root 1.21 For using the servers, see L<AnyEvent::MCP::Intro>. It includes a working
134     first connection, a complete configuration example, saved permissions,
135     multibroker setup and troubleshooting.
136    
137     For writing a server, see L<AnyEvent::MCP::Server::Simple/TUTORIAL>.
138     The tutorial starts with a complete echo server and a client that prints
139     its reply, then develops argument validation, command-line options,
140     result representations, permission retries and cancellable asynchronous
141     work. The Simple function reference follows it.
142    
143     For custom dispatch and reusable tool registries, see
144     L<AnyEvent::MCP::Server::Toolset/REQUEST AND TOOL WORKFLOW> and
145     L<AnyEvent::MCP::Server>. The client modules describe calling servers
146     from your own application.
147 root 1.9
148 root 1.1
149 root 1.2 =head1 GLOBAL CONFIGURATION
150    
151     The shared per-user configuration is C<$XDG_CONFIG_HOME/anyevent-mcp/global.ini>,
152     or C<$HOME/.config/anyevent-mcp/global.ini> when XDG_CONFIG_HOME is unset.
153     L<AnyEvent::MCP::Config> loads and holds it; loading this module does not access
154     configuration files.
155    
156     The file is UTF-8 and uses sections with single-line C<key = value> pairs.
157     Values are unquoted strings. Blank lines and whole-line comments beginning
158     with C<#> or C<;> are ignored; inline comment characters remain part of the
159     value. Later occurrences of a key replace earlier ones in the same section.
160    
161     [global]
162     secret = ...128 hexadecimal digits...
163    
164 root 1.18 [instance example]
165 root 1.11 bind = 127.0.0.1:31740
166 root 1.13 tokens = first-token,second-token
167 root 1.2
168 root 1.21 [program mcp-fs]
169     mount.opt = ro:/opt
170 root 1.2
171     Section names are unrestricted. Application-specific sections, including
172     exports, utility paths and user settings, are documented by their applications.
173    
174     C<[global]> holds C<secret>, a 64-byte master key encoded as 128 hexadecimal
175     digits. The file must be owned by the current user, with no group or other
176     permissions. A missing secret is generated automatically on first configuration
177     access and saved when possible. Existing secrets are never replaced implicitly.
178     An invalid secret is an error.
179    
180 root 1.22 Applications can derive their own purpose-specific secrets with
181     L<AnyEvent::MCP::Config/derive_secret>, using the cached global configuration
182     or an explicitly loaded configuration object.
183    
184 root 1.2 If saving fails, Config warns and retains the secret in memory. Credentials
185     then remain stable only for that process; other processes cannot derive the
186     same credentials. If randomness is unavailable, supply a securely generated
187     secret in the file.
188    
189 root 1.24 C<[program PROGRAM]> supplies settings for the invoked program basename;
190     C<[instance NAME]> overrides them for a named instance.
191 root 1.11 HTTP-capable executables use C<--name NAME> to select these settings, with
192 root 1.24 C<default> as the default instance name. Names consist of an ASCII
193 root 1.11 letter or underscore followed by ASCII letters, digits, underscores or
194     hyphens. Their C<--bind ADDRESS[:PORT]> overrides the configured C<bind>.
195 root 1.24 The default bind address is IPv4 loopback with a port derived from the program,
196     instance name and master secret in the range 16384..32767; C<:0> requests an ephemeral
197 root 1.12 port. C<--print-url> prints the URL using the first accepted token without
198     listening. Named server settings also include C<path>, C<url_host>,
199     C<url_scheme> and C<tokens>. C<tokens> is a comma-separated list of
200     URL-safe strings. Repeated C<--token TOKEN> options override this list.
201 root 1.27 Automatic permission defaults use C<auto-rule.SUFFIX = allow|deny
202     TOOL[,ACTION[,CAPABILITY]]> in program/instance sections, sorted by suffix.
203     Instance entries override matching keys or suppress them with empty values.
204     Command-line automatic rules are evaluated before configured defaults.
205 root 1.12 All accepted tokens work in the URL path or Authorization bearer header.
206 root 1.24 Without configured tokens, one token is derived from the program and instance
207     name. All derivation contexts have a fixed C<anyevent-mcp> namespace prefix.
208 root 1.11
209 root 1.12 C<mcp_start> resolves named settings and requires the selected token for
210     HTTP requests. Explicit tokens replace the derived default.
211 root 1.11 The low-level HTTP transport does not resolve configuration itself.
212 root 1.21 Simple's stdio startup does not access global HTTP configuration.
213     Applications can still load it for their own settings; C<mcp-fs>, for
214     example, reads trusted mount and executable settings even in stdio mode.
215     Browser origins are permitted by default, but must still pass MCP authentication.
216 root 1.3
217 root 1.12 C<[client NAME]> supplies HTTP client defaults: C<url>, C<bearer> and
218     C<timeout>. Clients consult it only when explicitly given a C<name>.
219 root 1.21 An unnamed HTTP client and the low-level HTTP server do not read global
220     configuration. C<mcp_start> resolves a default name and does read it.
221 root 1.3 Explicit constructor arguments take precedence over named defaults.
222    
223     =head1 ENVIRONMENT
224    
225     Project-specific environment variables use the C<PERL_ANYEVENT_MCP_> prefix.
226     C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio> selects stdio in Simple.
227 root 1.11 C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS> names a multibroker routing prefix;
228     it does not change the service-instance name.
229 root 1.3 C<PERL_ANYEVENT_MCP_PERMISSION_HELPER> selects the external asking executable.
230 root 1.21 C<PERL_ANYEVENT_MCP_PERMISSION_ASK> selects the permission engine's
231 root 1.25 asking default: C<helper>, C<tty>, C<yad>, C<auto> or C<mcp>. See
232 root 1.21 L<AnyEvent::MCP::Intro/Choose where to ask> for the behavior and client
233     requirements.
234 root 1.3 Standard C<HOME> and C<XDG_CONFIG_HOME> keep their standard names.
235 root 1.2
236     =head1 FUNCTIONS
237    
238 root 1.6 =over
239    
240 root 1.10 =item $class = AnyEvent::MCP::json_class
241    
242     Returns C<JSON::XS> if available, otherwise C<JSON::PP>. The caller
243     configures a new coder instance as needed.
244    
245 root 1.8 =item $bytes = AnyEvent::MCP::utf8enc $text
246    
247     Return a UTF-8 byte string for C<$text>, leaving the argument unchanged.
248    
249     =item $text = AnyEvent::MCP::utf8dec $bytes
250    
251     Decode a UTF-8 byte string into characters, dying on invalid UTF-8.
252     The argument is left unchanged. For intentional in-place conversions,
253     use Perl's C<utf8::encode> or C<utf8::decode> directly.
254    
255 root 1.26 =item AnyEvent::MCP::parse_ini $text, $callback, $filename
256    
257     Parse INI text and call C<$callback-E<gt>($name, $kv)> for each section
258     in file order, including the initial unnamed section (name C<"">).
259     Repeated sections remain separate; duplicate keys within a section use
260     their last value. The callback decides how to collect sections.
261     C<$filename> is optional and used only for line-numbered errors.
262    
263 root 1.6 =item $bytes = AnyEvent::MCP::random_bytes $length
264 root 1.2
265     Returns exactly C<$length> random bytes. Tries C</dev/urandom>, then an external
266     C<openssl rand> command. No additional random-number module is required.
267     Dies if neither source supplies the requested bytes successfully.
268     C<$length> must be a nonnegative integer; zero returns an empty string.
269    
270 root 1.6 =back
271    
272     =head2 PATCH UTILITIES
273    
274 root 1.7 Since applying patches to files is a common task for MCP servers, the
275 root 1.6 following utility functions can be used to ease that job. Together, they
276 root 1.7 define a common patch format (unified diff or a simplified version of it,
277     with fewer requirements to make it easier for the LLM to generate), helpers
278 root 1.6 to apply the patch and a helper to verify if the patch was applied
279     with sufficient precision.
280    
281 root 1.7 Use C<apply_udiff> to normalize, apply and validate a patch in one operation.
282     It writes a separate output file; the caller checks freshness and metadata
283     and commits the result.
284    
285     For an application-specific applier, the workflow is:
286 root 1.6
287     =over
288    
289     =item 1. AnyEvent::MCP::normalize_udiff
290    
291 root 1.7 Returns a unified diff for GNU patch and the permitted hunk offsets.
292    
293     =item 2. Apply the normalized diff
294 root 1.6
295 root 1.7 Run GNU patch with fuzz zero and capture its verbose output.
296 root 1.6
297 root 1.7 =item 3. AnyEvent::MCP::check_patch_output
298    
299     Checks the process status and output against the permitted offsets.
300     C<parse_patch_output> is available separately when only parsing is needed.
301 root 1.5
302 root 1.6 =back
303    
304 root 1.5 =head3 Input format
305    
306 root 1.6 The patch format accepted by normalize_udiff is an extension to the
307     (essentially undocumented) unified diff format.
308    
309 root 1.5 In a hunk header, only the old start C<-N> matters. It is the old-file line
310     of the first hunk body line, including context, not necessarily the first
311     changed line. Counts and the new-file position are ignored and recomputed.
312     Both ordinary headers and the abbreviated form are accepted:
313    
314     @@ -42,99 +123,99 @@
315     @@ -42 @@
316    
317     Optional text after the closing C<@@> is preserved. File headers and other
318     text before the first hunk are preserved; a diff must describe one file.
319    
320     Hunk body lines use the usual prefixes: a space for unchanged context,
321     C<-> for removed lines and C<+> for added lines. The
322     C<\ No newline at end of file> marker is preserved and counts neither side.
323     Trailing empty lines outside the final hunk are discarded.
324    
325 root 1.7 Pure insertion is permitted only at the beginning, using old start C<0>.
326     For example, C<@@ -0 @@> with one added line becomes C<@@ -0,0 +1,1 @@>.
327     An empty old-side range names the line before the insertion: C<-0,0>
328     means before line 1, whereas C<-1,0> would mean after line 1 and is rejected
329     here. Nonempty ranges use one-based line numbers.
330    
331 root 1.5 An insertion elsewhere needs old-side context. Empty hunks are rejected.
332     New positions include the cumulative line-count changes of preceding hunks.
333    
334     =head3 Applying the result
335    
336 root 1.6 The C<normalize_udiff> function does not apply the patch, check file
337     contents or guard against concurrent edits. The caller must supply those
338     checks, if required.
339 root 1.5
340     Context must match exactly: apply with fuzz zero. For each hunk,
341     C<$max_offset> permits relocation by at most the number of distinct old-side
342     lines minus one, or zero for a pure insertion. Repeated old-side lines do
343     not increase this allowance. The applier must enforce these limits; an
344     unrestricted search for matching context can select the wrong occurrence.
345    
346     For live Vim buffers, also require the expected changedtick to match.
347     File-based users need an equivalent check before replacing the file.
348    
349 root 1.6 To work around GNU patch's handling of asymmetric context, the
350     first context line of each hunk is rewritten as an identity
351     removal/addition. The line contents and old/new line counts are
352     unchanged. This is normalization for the patch applier, not a relaxation
353     of context matching.
354 root 1.5
355 root 1.6 =over
356    
357     =item ($diff, $max_offset) = AnyEvent::MCP::normalize_udiff $diff
358    
359     Normalizes a relaxed, single-file unified diff into ordinary unified diff
360     syntax. Returns the normalized C<$diff> and an array reference C<$max_offset>
361     containing the permitted whole-hunk relocation for each hunk, in order.
362     Dies on malformed hunks or when no hunks are found.
363    
364     Here is a suitable description for the diff format, e.g. in a tool
365     definition:
366    
367     Apply a unified diff to one regular file. Hunk counts are recomputed,
368     fuzz is disabled, whole-hunk relocation is limited per hunk by distinct
369     old-side lines. Pure insertion is allowed only at the beginning;
370     elsewhere include old-side context.
371    
372     =item $cv = AnyEvent::MCP::apply_udiff $input, $output, $diff
373    
374     Asynchronously applies the relaxed C<$diff> to the input file C<$input>,
375     writing a separate output file C<$output>. C<$diff> must contain bytes;
376     callers working with characters must encode them for the file themselves.
377    
378     Normalizes the diff, runs GNU patch using C<AnyEvent::Util::run_cmd>, and
379     validates its verbose output with C<check_patch_output>. The command uses
380     batch/forward mode, binary mode and fuzz zero. No shell is involved.
381    
382     C<$output> must not exist. It is reserved with mode 0600; patch runs in its
383     directory so incidental temporary files stay there. Input and output paths
384     are made absolute before starting the command. These must be trusted paths
385     in a directory controlled by the caller.
386    
387     Returns a condition variable. Its C<recv> returns the validated hunk array
388     reference, or throws on command/application failure. Setup failures throw
389     synchronously. Failed or partial output is removed. C<$input> is unchanged.
390    
391     The caller owns committing the successful output and removing it when no
392     longer needed. Freshness checks, metadata preservation, atomic replacement
393     and application-specific permissions also belong to the caller.
394    
395     For your reference, the exact options used are:
396    
397     --verbose --batch --forward --binary --fuzz=0
398     --no-backup-if-mismatch
399     --reject-file=- --output=... -- <inputfile>
400    
401     =item $parsed = AnyEvent::MCP::parse_patch_output $output
402 root 1.5
403     Parses C<LC_ALL=C> GNU patch C<--verbose> output without judging whether
404     the application is acceptable. C<$parsed> has two fields:
405    
406 root 1.6 =over
407 root 1.5
408     =item hunks => [$hunk...]
409    
410     Hunk records in output order. Each record contains C<hunk> (the one-based
411     number), C<success>, C<line> (the reported application line), C<fuzz> and
412     the signed C<offset>. Omitted fuzz and offset are zero. Failed and ignored
413     hunks have false C<success>.
414    
415     =item unparsed => [$line...]
416    
417     Lines not recognized as hunk results or GNU patch's verbose framing.
418     The parser preserves them for callers to interpret or reject.
419    
420     =back
421    
422     Use verbose output: ordinary patch output omits exact-position successes,
423     so it cannot account for every hunk.
424    
425 root 1.6 =item $hunks = AnyEvent::MCP::check_patch_output $status, $output, [$max_offset...]
426 root 1.5
427     Parses C<$output> and validates a complete application. C<$status> is the
428     raw process wait status, as returned by C<waitpid> or
429     C<AnyEvent::Util::run_cmd>, not just the exit code.
430    
431     Requires status zero, no unrecognized output, exactly the expected hunks
432     in numbered order, successful application, fuzz zero and each signed offset
433     within its corresponding absolute limit. C<[$max_offset...]> is the array
434     reference returned by C<normalize_udiff>. At least one hunk is required.
435    
436     Returns the parsed hunk array reference on success; otherwise dies with a
437     diagnostic. This is also suitable for callers running patch inside their
438     own sandbox.
439    
440 root 1.6 =back
441 root 1.5
442 root 1.1 =cut
443    
444     package AnyEvent::MCP;
445    
446     use common::sense;
447    
448 root 1.36 our $VERSION = 0.71;
449 root 1.1
450 root 1.10 sub json_class {
451     our $JSON_CLASS ||= eval { require JSON::XS; "JSON::XS" }
452     || do { require JSON::PP; "JSON::PP" };
453     }
454    
455 root 1.8 sub utf8enc($) {
456     my $text = shift;
457    
458     utf8::encode $text;
459     $text
460     }
461    
462     sub utf8dec($) {
463     my $bytes = shift;
464    
465     utf8::decode $bytes
466     or die "invalid UTF-8\n";
467     $bytes
468     }
469    
470 root 1.26 sub parse_ini {
471     my ($text, $cb, $file) = @_;
472     $file //= "INI";
473     my ($name, $kv, $line) = ("", {}, 0);
474    
475     for (split /\n/, $text) {
476     ++$line;
477     s/\r\z//;
478     next if /\A\s*(?:[#;]|\z)/;
479     if (/\A\s*\[([^\]\r\n]+)\]\s*\z/) {
480     my $next = $1;
481     $cb->($name, $kv);
482     ($name, $kv) = ($next, {});
483     } elsif (/\A\s*([^=\s]+)\s*=\s*(.*?)\s*\z/) {
484     $kv->{$1} = $2;
485     } else {
486     die "$file:$line: invalid INI line\n";
487     }
488     }
489    
490     $cb->($name, $kv);
491     }
492    
493 root 1.2 sub random_bytes($) {
494     my ($length) = @_;
495    
496 root 1.19 defined $length && $length =~ /\A[0-9]+\z/
497     or die "Invalid random byte count\n";
498 root 1.2 return "" unless $length;
499    
500     my $bytes = "";
501    
502     if (open my $fh, "<", "/dev/urandom") {
503     binmode $fh;
504     while (length $bytes < $length) {
505 root 1.34 read $fh, $bytes, $length - length $bytes, length $bytes
506 root 1.2 or last;
507     }
508     close $fh;
509    
510     return $bytes if length $bytes == $length;
511     }
512    
513     if (open my $fh, "-|", "openssl", "rand", $length) {
514     binmode $fh;
515     local $/;
516     $bytes = <$fh>;
517     my $success = close $fh;
518    
519     return $bytes
520     if $success && defined $bytes && length $bytes == $length;
521     }
522    
523     die "Cannot obtain $length random bytes from /dev/urandom or openssl rand\n";
524     }
525    
526 root 1.5 sub normalize_udiff {
527     my $diff = shift;
528     my @line = split /\n/, $diff, -1;
529     my $delta = 0;
530     my $hunks = 0;
531     my @max_offset;
532    
533     pop @line while @line and !length $line[-1];
534    
535     for (my $i = 0; $i < @line; ++$i) {
536     next unless $line[$i] =~ /^@@ /;
537    
538     $line[$i] =~ /^@@ -(\d+)(?:,\d+)?(?: \+\d+(?:,\d+)?)? @@(.*)$/
539     or die "normalize_udiff: bad hunk header '$line[$i]'\n";
540    
541     my ($old_start, $suffix) = ($1, $2);
542     my ($old_count, $new_count) = (0, 0);
543     my %old_line;
544     my $j = $i + 1;
545    
546     # GNU patch mishandles hunks with more prefix than suffix context.
547     # Make the first context line an identity change without losing it.
548     # see https://unix.stackexchange.com/questions/414542/does-patch-work-with-asymmetric-context
549     splice @line, $i + 1, 1, "-$1", "+$1"
550     if $line[$i + 1] =~ /^ (.*)\z/;
551    
552     for (; $j < @line; ++$j) {
553     last if $line[$j] =~ /^@@ /;
554    
555     my $tag = substr $line[$j], 0, 1;
556    
557     if ($tag eq " ") {
558     ++$old_count;
559     ++$new_count;
560     $old_line{substr $line[$j], 1} = 1;
561     } elsif ($tag eq "-") {
562     ++$old_count;
563     $old_line{substr $line[$j], 1} = 1;
564     } elsif ($tag eq "+") {
565     ++$new_count;
566     } elsif ($line[$j] eq "\\ No newline at end of file") {
567     # Marker belongs to the preceding body line and counts neither side.
568     } else {
569     die "normalize_udiff: bad hunk line '$line[$j]'\n";
570     }
571     }
572    
573     $old_count or $new_count
574     or die "normalize_udiff: empty hunk at old line $old_start\n";
575    
576     $old_count or !$old_start
577     or die "normalize_udiff: hunk " . ($hunks + 1)
578     . " needs old-side context for insertion after old line $old_start\n";
579    
580     my $new_start = $old_start + $delta;
581     ++$new_start unless $old_count;
582     --$new_start unless $new_count;
583    
584     $new_start >= 0
585     or die "normalize_udiff: invalid new line $new_start\n";
586    
587     $line[$i] = sprintf "@@ -%d,%d +%d,%d @@%s",
588     $old_start, $old_count, $new_start, $new_count, $suffix;
589    
590     $delta += $new_count - $old_count;
591     ++$hunks;
592     my $max_offset = keys %old_line;
593     --$max_offset
594     if $max_offset;
595     push @max_offset, $max_offset;
596     $i = $j - 1;
597     }
598    
599     $hunks
600     or die "normalize_udiff: no hunks\n";
601    
602 root 1.34 ((join "\n", @line, ""), \@max_offset)
603 root 1.5 }
604    
605     sub parse_patch_output {
606     my ($output) = @_;
607     my (@hunks, @unparsed);
608    
609     for (split /\n/, $output) {
610     if (/^Hunk #(\d+) (succeeded|FAILED|ignored) at (-?\d+)(?: with fuzz (\d+))?(?: \(offset (-?\d+) lines?\))?\.\z/) {
611     push @hunks, {
612     hunk => 0 + $1,
613     success => $2 eq "succeeded",
614     line => 0 + $3,
615     fuzz => 0 + $4,
616     offset => 0 + $5,
617     };
618     } elsif (!length
619     || /^Hmm\.\.\. +Looks like a unified diff to me\.\.\.\z/
620     || /^The text leading up to this was:\z/
621     || /^-+\z/ || /^\|/
622     || /^patching file / || /^checking file /
623     || /^Using Plan [AB]\.\.\.\z/ || /^done\z/) {
624     # GNU patch --verbose framing, not hunk results.
625     } else {
626     push @unparsed, $_;
627     }
628     }
629    
630     { hunks => \@hunks, unparsed => \@unparsed }
631     }
632    
633     sub check_patch_output {
634     my ($status, $output, $max_offset) = @_;
635     my $parsed = parse_patch_output $output;
636     my $hunks = $parsed->{hunks};
637    
638     die "patch failed (wait status $status):\n$output"
639     if $status;
640     die "patch: unrecognized output:\n" . (join "\n", @{$parsed->{unparsed}}) . "\n"
641     if @{$parsed->{unparsed}};
642     die "patch: expected " . @$max_offset . " hunks, got " . @$hunks . "\n"
643     unless @$hunks == @$max_offset && @$hunks;
644    
645     for my $i (0 .. $#$hunks) {
646     my $hunk = $hunks->[$i];
647    
648     die "patch: unexpected hunk number $hunk->{hunk}\n"
649     unless $hunk->{hunk} == $i + 1;
650     die "patch: hunk $hunk->{hunk} failed\n"
651     unless $hunk->{success};
652     die "patch: hunk $hunk->{hunk} used fuzz $hunk->{fuzz}\n"
653     if $hunk->{fuzz};
654     die "patch: hunk $hunk->{hunk} offset $hunk->{offset} exceeds $max_offset->[$i]\n"
655     if abs $hunk->{offset} > $max_offset->[$i];
656     }
657    
658     $hunks
659     }
660    
661     sub apply_udiff {
662     my ($input, $output, $diff) = @_;
663     my ($normalized, $max_offset) = normalize_udiff $diff;
664    
665     require AnyEvent::Util;
666     require File::Spec;
667     require File::Basename;
668     require Fcntl;
669    
670     $input = File::Spec->rel2abs ($input);
671     $output = File::Spec->rel2abs ($output);
672     my $directory = File::Basename::dirname ($output);
673    
674     sysopen my $fh, $output, Fcntl::O_WRONLY () | Fcntl::O_CREAT () | Fcntl::O_EXCL (), 0600
675     or die "$output: $!\n";
676     close $fh or do { my $error = $!; unlink $output; die "$output: $error\n" };
677    
678     my $cv = AE::cv ();
679     my $log;
680     my $process = eval {
681     AnyEvent::Util::run_cmd ([
682     "patch", "--verbose", "--batch", "--forward", "--binary", "--fuzz=0",
683     "--no-backup-if-mismatch", "--reject-file=-", "--output=$output", "--", $input,
684     ],
685     "<" => \$normalized,
686     ">" => \$log,
687     close_all => 1,
688     on_prepare => sub {
689     $ENV{LC_ALL} = "C";
690     chdir $directory or die "$directory: $!\n";
691     defined POSIX::dup2 (1, 2) or die "dup2: $!\n";
692     },
693     );
694     };
695    
696     if ($@) {
697     my $error = $@;
698     unlink $output;
699     die $error;
700     }
701    
702     $process->cb (sub {
703     my $hunks;
704     eval { $hunks = check_patch_output $_[0]->recv, $log, $max_offset; 1 } or do {
705     my $error = $@;
706     unlink $output;
707     $cv->croak ($error);
708     return;
709     };
710    
711     $cv->send ($hunks);
712     });
713    
714     $cv
715     }
716    
717 root 1.1 sub _clean_text($) {
718     my ($text) = @_;
719    
720     my ($prefix) = (join "\n", grep /\S/, split /\n/, $text)
721     =~ /\A([ \t]*)[^\n]*(?:\n\1[^\n]*)*\z/;
722    
723     $text =~ s/^\Q$prefix\E//mg;
724     $text =~ s/\A\s+//;
725     $text =~ s/\s+\z//;
726     $text
727     }
728    
729     package AnyEvent::MCP::Base;
730    
731     sub new {
732     my ($class, %kv) = @_;
733 root 1.19
734 root 1.1 bless \%kv, $class
735     }
736    
737     sub event {
738     my ($self, $event, @args) = @_;
739 root 1.19
740 root 1.1 ($self->{"on_$event"} or return)->($self, @args)
741     }
742    
743     =head1 SEE ALSO
744    
745 root 1.16 L<AnyEvent::MCP::Intro>, L<AnyEvent::MCP::Server::Simple>,
746 root 1.23 L<AnyEvent::MCP::Helper>, L<mcp-ask-user>, L<anyevent-mcp-form-elicitation>,
747 root 1.1 L<AnyEvent>, L<https://modelcontextprotocol.io/>
748    
749     =head1 AUTHOR
750    
751     The main author of this module is OpenAI ChatGPT.
752    
753     Additional guidance received by:
754    
755     Marc Lehmann <schmorp@schmorp.de>
756     http://home.schmorp.de/
757    
758     =cut
759    
760     1
761