ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MCP/lib/AnyEvent/MCP.pm
Revision: 1.38
Committed: Tue Nov 3 17:38:28 2026 UTC (21 hours, 49 minutes ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.37: +2 -2 lines
Log Message:
*** empty log message ***

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.37 port. C<--print-url> prints enabled user URLs, and C<--print-url=USER>
198     prints just the chosen user's URLs, without listening.
199     Named server settings also include C<path>, C<url_host>,
200 root 1.12 C<url_scheme> and C<tokens>. C<tokens> is a comma-separated list of
201     URL-safe strings. Repeated C<--token TOKEN> options override this list.
202 root 1.27 Automatic permission defaults use C<auto-rule.SUFFIX = allow|deny
203     TOOL[,ACTION[,CAPABILITY]]> in program/instance sections, sorted by suffix.
204     Instance entries override matching keys or suppress them with empty values.
205     Command-line automatic rules are evaluated before configured defaults.
206 root 1.12 All accepted tokens work in the URL path or Authorization bearer header.
207 root 1.37 Without configured tokens, enabled users in C<[global]>,
208     C<[program PROGRAM]> and C<[instance NAME]> each have derived credentials,
209     with later scopes overriding earlier ones. A missing global
210     C<user.default> is equivalent to C<user.default = 1>. Positive
211     generations are enabled; negative generations are revoked and retain
212     their counter for later rotation. Zero is invalid. The principal used
213     for permissions is C<global:USER>, C<program:USER>, or C<instance:USER>.
214     All derivation contexts have the C<anyevent-mcp> namespace prefix.
215     The C<connect_user> setting (default: C<default>) chooses which user's
216     token may attach Vim editor, browser WebSocket or reverse-MCP connections.
217     Disabling that user prevents new auxiliary connections, without stopping
218     other enabled users from making MCP requests.
219 root 1.11
220 root 1.12 C<mcp_start> resolves named settings and requires the selected token for
221 root 1.37 HTTP requests. Explicit tokens replace the derived managed users.
222 root 1.11 The low-level HTTP transport does not resolve configuration itself.
223 root 1.21 Simple's stdio startup does not access global HTTP configuration.
224     Applications can still load it for their own settings; C<mcp-fs>, for
225     example, reads trusted mount and executable settings even in stdio mode.
226     Browser origins are permitted by default, but must still pass MCP authentication.
227 root 1.3
228 root 1.12 C<[client NAME]> supplies HTTP client defaults: C<url>, C<bearer> and
229     C<timeout>. Clients consult it only when explicitly given a C<name>.
230 root 1.21 An unnamed HTTP client and the low-level HTTP server do not read global
231     configuration. C<mcp_start> resolves a default name and does read it.
232 root 1.3 Explicit constructor arguments take precedence over named defaults.
233    
234     =head1 ENVIRONMENT
235    
236     Project-specific environment variables use the C<PERL_ANYEVENT_MCP_> prefix.
237     C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL=stdio> selects stdio in Simple.
238 root 1.11 C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS> names a multibroker routing prefix;
239     it does not change the service-instance name.
240 root 1.3 C<PERL_ANYEVENT_MCP_PERMISSION_HELPER> selects the external asking executable.
241 root 1.21 C<PERL_ANYEVENT_MCP_PERMISSION_ASK> selects the permission engine's
242 root 1.25 asking default: C<helper>, C<tty>, C<yad>, C<auto> or C<mcp>. See
243 root 1.21 L<AnyEvent::MCP::Intro/Choose where to ask> for the behavior and client
244     requirements.
245 root 1.3 Standard C<HOME> and C<XDG_CONFIG_HOME> keep their standard names.
246 root 1.2
247     =head1 FUNCTIONS
248    
249 root 1.6 =over
250    
251 root 1.10 =item $class = AnyEvent::MCP::json_class
252    
253     Returns C<JSON::XS> if available, otherwise C<JSON::PP>. The caller
254     configures a new coder instance as needed.
255    
256 root 1.8 =item $bytes = AnyEvent::MCP::utf8enc $text
257    
258     Return a UTF-8 byte string for C<$text>, leaving the argument unchanged.
259    
260     =item $text = AnyEvent::MCP::utf8dec $bytes
261    
262     Decode a UTF-8 byte string into characters, dying on invalid UTF-8.
263     The argument is left unchanged. For intentional in-place conversions,
264     use Perl's C<utf8::encode> or C<utf8::decode> directly.
265    
266 root 1.26 =item AnyEvent::MCP::parse_ini $text, $callback, $filename
267    
268     Parse INI text and call C<$callback-E<gt>($name, $kv)> for each section
269     in file order, including the initial unnamed section (name C<"">).
270     Repeated sections remain separate; duplicate keys within a section use
271     their last value. The callback decides how to collect sections.
272     C<$filename> is optional and used only for line-numbered errors.
273    
274 root 1.6 =item $bytes = AnyEvent::MCP::random_bytes $length
275 root 1.2
276     Returns exactly C<$length> random bytes. Tries C</dev/urandom>, then an external
277     C<openssl rand> command. No additional random-number module is required.
278     Dies if neither source supplies the requested bytes successfully.
279     C<$length> must be a nonnegative integer; zero returns an empty string.
280    
281 root 1.6 =back
282    
283     =head2 PATCH UTILITIES
284    
285 root 1.7 Since applying patches to files is a common task for MCP servers, the
286 root 1.6 following utility functions can be used to ease that job. Together, they
287 root 1.7 define a common patch format (unified diff or a simplified version of it,
288     with fewer requirements to make it easier for the LLM to generate), helpers
289 root 1.6 to apply the patch and a helper to verify if the patch was applied
290     with sufficient precision.
291    
292 root 1.7 Use C<apply_udiff> to normalize, apply and validate a patch in one operation.
293     It writes a separate output file; the caller checks freshness and metadata
294     and commits the result.
295    
296     For an application-specific applier, the workflow is:
297 root 1.6
298     =over
299    
300     =item 1. AnyEvent::MCP::normalize_udiff
301    
302 root 1.7 Returns a unified diff for GNU patch and the permitted hunk offsets.
303    
304     =item 2. Apply the normalized diff
305 root 1.6
306 root 1.7 Run GNU patch with fuzz zero and capture its verbose output.
307 root 1.6
308 root 1.7 =item 3. AnyEvent::MCP::check_patch_output
309    
310     Checks the process status and output against the permitted offsets.
311     C<parse_patch_output> is available separately when only parsing is needed.
312 root 1.5
313 root 1.6 =back
314    
315 root 1.5 =head3 Input format
316    
317 root 1.6 The patch format accepted by normalize_udiff is an extension to the
318     (essentially undocumented) unified diff format.
319    
320 root 1.5 In a hunk header, only the old start C<-N> matters. It is the old-file line
321     of the first hunk body line, including context, not necessarily the first
322     changed line. Counts and the new-file position are ignored and recomputed.
323     Both ordinary headers and the abbreviated form are accepted:
324    
325     @@ -42,99 +123,99 @@
326     @@ -42 @@
327    
328     Optional text after the closing C<@@> is preserved. File headers and other
329     text before the first hunk are preserved; a diff must describe one file.
330    
331     Hunk body lines use the usual prefixes: a space for unchanged context,
332     C<-> for removed lines and C<+> for added lines. The
333     C<\ No newline at end of file> marker is preserved and counts neither side.
334     Trailing empty lines outside the final hunk are discarded.
335    
336 root 1.7 Pure insertion is permitted only at the beginning, using old start C<0>.
337     For example, C<@@ -0 @@> with one added line becomes C<@@ -0,0 +1,1 @@>.
338     An empty old-side range names the line before the insertion: C<-0,0>
339     means before line 1, whereas C<-1,0> would mean after line 1 and is rejected
340     here. Nonempty ranges use one-based line numbers.
341    
342 root 1.5 An insertion elsewhere needs old-side context. Empty hunks are rejected.
343     New positions include the cumulative line-count changes of preceding hunks.
344    
345     =head3 Applying the result
346    
347 root 1.6 The C<normalize_udiff> function does not apply the patch, check file
348     contents or guard against concurrent edits. The caller must supply those
349     checks, if required.
350 root 1.5
351     Context must match exactly: apply with fuzz zero. For each hunk,
352     C<$max_offset> permits relocation by at most the number of distinct old-side
353     lines minus one, or zero for a pure insertion. Repeated old-side lines do
354     not increase this allowance. The applier must enforce these limits; an
355     unrestricted search for matching context can select the wrong occurrence.
356    
357     For live Vim buffers, also require the expected changedtick to match.
358     File-based users need an equivalent check before replacing the file.
359    
360 root 1.6 To work around GNU patch's handling of asymmetric context, the
361     first context line of each hunk is rewritten as an identity
362     removal/addition. The line contents and old/new line counts are
363     unchanged. This is normalization for the patch applier, not a relaxation
364     of context matching.
365 root 1.5
366 root 1.6 =over
367    
368     =item ($diff, $max_offset) = AnyEvent::MCP::normalize_udiff $diff
369    
370     Normalizes a relaxed, single-file unified diff into ordinary unified diff
371     syntax. Returns the normalized C<$diff> and an array reference C<$max_offset>
372     containing the permitted whole-hunk relocation for each hunk, in order.
373     Dies on malformed hunks or when no hunks are found.
374    
375     Here is a suitable description for the diff format, e.g. in a tool
376     definition:
377    
378     Apply a unified diff to one regular file. Hunk counts are recomputed,
379     fuzz is disabled, whole-hunk relocation is limited per hunk by distinct
380     old-side lines. Pure insertion is allowed only at the beginning;
381     elsewhere include old-side context.
382    
383     =item $cv = AnyEvent::MCP::apply_udiff $input, $output, $diff
384    
385     Asynchronously applies the relaxed C<$diff> to the input file C<$input>,
386     writing a separate output file C<$output>. C<$diff> must contain bytes;
387     callers working with characters must encode them for the file themselves.
388    
389     Normalizes the diff, runs GNU patch using C<AnyEvent::Util::run_cmd>, and
390     validates its verbose output with C<check_patch_output>. The command uses
391     batch/forward mode, binary mode and fuzz zero. No shell is involved.
392    
393     C<$output> must not exist. It is reserved with mode 0600; patch runs in its
394     directory so incidental temporary files stay there. Input and output paths
395     are made absolute before starting the command. These must be trusted paths
396     in a directory controlled by the caller.
397    
398     Returns a condition variable. Its C<recv> returns the validated hunk array
399     reference, or throws on command/application failure. Setup failures throw
400     synchronously. Failed or partial output is removed. C<$input> is unchanged.
401    
402     The caller owns committing the successful output and removing it when no
403     longer needed. Freshness checks, metadata preservation, atomic replacement
404     and application-specific permissions also belong to the caller.
405    
406     For your reference, the exact options used are:
407    
408     --verbose --batch --forward --binary --fuzz=0
409     --no-backup-if-mismatch
410     --reject-file=- --output=... -- <inputfile>
411    
412     =item $parsed = AnyEvent::MCP::parse_patch_output $output
413 root 1.5
414     Parses C<LC_ALL=C> GNU patch C<--verbose> output without judging whether
415     the application is acceptable. C<$parsed> has two fields:
416    
417 root 1.6 =over
418 root 1.5
419     =item hunks => [$hunk...]
420    
421     Hunk records in output order. Each record contains C<hunk> (the one-based
422     number), C<success>, C<line> (the reported application line), C<fuzz> and
423     the signed C<offset>. Omitted fuzz and offset are zero. Failed and ignored
424     hunks have false C<success>.
425    
426     =item unparsed => [$line...]
427    
428     Lines not recognized as hunk results or GNU patch's verbose framing.
429     The parser preserves them for callers to interpret or reject.
430    
431     =back
432    
433     Use verbose output: ordinary patch output omits exact-position successes,
434     so it cannot account for every hunk.
435    
436 root 1.6 =item $hunks = AnyEvent::MCP::check_patch_output $status, $output, [$max_offset...]
437 root 1.5
438     Parses C<$output> and validates a complete application. C<$status> is the
439     raw process wait status, as returned by C<waitpid> or
440     C<AnyEvent::Util::run_cmd>, not just the exit code.
441    
442     Requires status zero, no unrecognized output, exactly the expected hunks
443     in numbered order, successful application, fuzz zero and each signed offset
444     within its corresponding absolute limit. C<[$max_offset...]> is the array
445     reference returned by C<normalize_udiff>. At least one hunk is required.
446    
447     Returns the parsed hunk array reference on success; otherwise dies with a
448     diagnostic. This is also suitable for callers running patch inside their
449     own sandbox.
450    
451 root 1.6 =back
452 root 1.5
453 root 1.1 =cut
454    
455     package AnyEvent::MCP;
456    
457     use common::sense;
458    
459 root 1.36 our $VERSION = 0.71;
460 root 1.1
461 root 1.10 sub json_class {
462     our $JSON_CLASS ||= eval { require JSON::XS; "JSON::XS" }
463     || do { require JSON::PP; "JSON::PP" };
464     }
465    
466 root 1.8 sub utf8enc($) {
467     my $text = shift;
468    
469     utf8::encode $text;
470     $text
471     }
472    
473     sub utf8dec($) {
474     my $bytes = shift;
475    
476     utf8::decode $bytes
477     or die "invalid UTF-8\n";
478     $bytes
479     }
480    
481 root 1.26 sub parse_ini {
482     my ($text, $cb, $file) = @_;
483     $file //= "INI";
484     my ($name, $kv, $line) = ("", {}, 0);
485    
486     for (split /\n/, $text) {
487     ++$line;
488     s/\r\z//;
489     next if /\A\s*(?:[#;]|\z)/;
490     if (/\A\s*\[([^\]\r\n]+)\]\s*\z/) {
491     my $next = $1;
492     $cb->($name, $kv);
493     ($name, $kv) = ($next, {});
494     } elsif (/\A\s*([^=\s]+)\s*=\s*(.*?)\s*\z/) {
495     $kv->{$1} = $2;
496     } else {
497     die "$file:$line: invalid INI line\n";
498     }
499     }
500    
501     $cb->($name, $kv);
502     }
503    
504 root 1.2 sub random_bytes($) {
505     my ($length) = @_;
506    
507 root 1.19 defined $length && $length =~ /\A[0-9]+\z/
508     or die "Invalid random byte count\n";
509 root 1.2 return "" unless $length;
510    
511     my $bytes = "";
512    
513     if (open my $fh, "<", "/dev/urandom") {
514     binmode $fh;
515     while (length $bytes < $length) {
516 root 1.34 read $fh, $bytes, $length - length $bytes, length $bytes
517 root 1.2 or last;
518     }
519     close $fh;
520    
521     return $bytes if length $bytes == $length;
522     }
523    
524     if (open my $fh, "-|", "openssl", "rand", $length) {
525     binmode $fh;
526     local $/;
527     $bytes = <$fh>;
528     my $success = close $fh;
529    
530     return $bytes
531     if $success && defined $bytes && length $bytes == $length;
532     }
533    
534     die "Cannot obtain $length random bytes from /dev/urandom or openssl rand\n";
535     }
536    
537 root 1.5 sub normalize_udiff {
538     my $diff = shift;
539     my @line = split /\n/, $diff, -1;
540     my $delta = 0;
541     my $hunks = 0;
542     my @max_offset;
543    
544     pop @line while @line and !length $line[-1];
545    
546     for (my $i = 0; $i < @line; ++$i) {
547     next unless $line[$i] =~ /^@@ /;
548    
549     $line[$i] =~ /^@@ -(\d+)(?:,\d+)?(?: \+\d+(?:,\d+)?)? @@(.*)$/
550     or die "normalize_udiff: bad hunk header '$line[$i]'\n";
551    
552     my ($old_start, $suffix) = ($1, $2);
553     my ($old_count, $new_count) = (0, 0);
554     my %old_line;
555     my $j = $i + 1;
556    
557     # GNU patch mishandles hunks with more prefix than suffix context.
558 root 1.38 # make the first context line an identity change without losing it.
559 root 1.5 # see https://unix.stackexchange.com/questions/414542/does-patch-work-with-asymmetric-context
560     splice @line, $i + 1, 1, "-$1", "+$1"
561     if $line[$i + 1] =~ /^ (.*)\z/;
562    
563     for (; $j < @line; ++$j) {
564     last if $line[$j] =~ /^@@ /;
565    
566     my $tag = substr $line[$j], 0, 1;
567    
568     if ($tag eq " ") {
569     ++$old_count;
570     ++$new_count;
571     $old_line{substr $line[$j], 1} = 1;
572     } elsif ($tag eq "-") {
573     ++$old_count;
574     $old_line{substr $line[$j], 1} = 1;
575     } elsif ($tag eq "+") {
576     ++$new_count;
577     } elsif ($line[$j] eq "\\ No newline at end of file") {
578 root 1.38 # marker belongs to the preceding body line and counts neither side.
579 root 1.5 } else {
580     die "normalize_udiff: bad hunk line '$line[$j]'\n";
581     }
582     }
583    
584     $old_count or $new_count
585     or die "normalize_udiff: empty hunk at old line $old_start\n";
586    
587     $old_count or !$old_start
588     or die "normalize_udiff: hunk " . ($hunks + 1)
589     . " needs old-side context for insertion after old line $old_start\n";
590    
591     my $new_start = $old_start + $delta;
592     ++$new_start unless $old_count;
593     --$new_start unless $new_count;
594    
595     $new_start >= 0
596     or die "normalize_udiff: invalid new line $new_start\n";
597    
598     $line[$i] = sprintf "@@ -%d,%d +%d,%d @@%s",
599     $old_start, $old_count, $new_start, $new_count, $suffix;
600    
601     $delta += $new_count - $old_count;
602     ++$hunks;
603     my $max_offset = keys %old_line;
604     --$max_offset
605     if $max_offset;
606     push @max_offset, $max_offset;
607     $i = $j - 1;
608     }
609    
610     $hunks
611     or die "normalize_udiff: no hunks\n";
612    
613 root 1.34 ((join "\n", @line, ""), \@max_offset)
614 root 1.5 }
615    
616     sub parse_patch_output {
617     my ($output) = @_;
618     my (@hunks, @unparsed);
619    
620     for (split /\n/, $output) {
621     if (/^Hunk #(\d+) (succeeded|FAILED|ignored) at (-?\d+)(?: with fuzz (\d+))?(?: \(offset (-?\d+) lines?\))?\.\z/) {
622     push @hunks, {
623     hunk => 0 + $1,
624     success => $2 eq "succeeded",
625     line => 0 + $3,
626     fuzz => 0 + $4,
627     offset => 0 + $5,
628     };
629     } elsif (!length
630     || /^Hmm\.\.\. +Looks like a unified diff to me\.\.\.\z/
631     || /^The text leading up to this was:\z/
632     || /^-+\z/ || /^\|/
633     || /^patching file / || /^checking file /
634     || /^Using Plan [AB]\.\.\.\z/ || /^done\z/) {
635     # GNU patch --verbose framing, not hunk results.
636     } else {
637     push @unparsed, $_;
638     }
639     }
640    
641     { hunks => \@hunks, unparsed => \@unparsed }
642     }
643    
644     sub check_patch_output {
645     my ($status, $output, $max_offset) = @_;
646     my $parsed = parse_patch_output $output;
647     my $hunks = $parsed->{hunks};
648    
649     die "patch failed (wait status $status):\n$output"
650     if $status;
651     die "patch: unrecognized output:\n" . (join "\n", @{$parsed->{unparsed}}) . "\n"
652     if @{$parsed->{unparsed}};
653     die "patch: expected " . @$max_offset . " hunks, got " . @$hunks . "\n"
654     unless @$hunks == @$max_offset && @$hunks;
655    
656     for my $i (0 .. $#$hunks) {
657     my $hunk = $hunks->[$i];
658    
659     die "patch: unexpected hunk number $hunk->{hunk}\n"
660     unless $hunk->{hunk} == $i + 1;
661     die "patch: hunk $hunk->{hunk} failed\n"
662     unless $hunk->{success};
663     die "patch: hunk $hunk->{hunk} used fuzz $hunk->{fuzz}\n"
664     if $hunk->{fuzz};
665     die "patch: hunk $hunk->{hunk} offset $hunk->{offset} exceeds $max_offset->[$i]\n"
666     if abs $hunk->{offset} > $max_offset->[$i];
667     }
668    
669     $hunks
670     }
671    
672     sub apply_udiff {
673     my ($input, $output, $diff) = @_;
674     my ($normalized, $max_offset) = normalize_udiff $diff;
675    
676     require AnyEvent::Util;
677     require File::Spec;
678     require File::Basename;
679     require Fcntl;
680    
681     $input = File::Spec->rel2abs ($input);
682     $output = File::Spec->rel2abs ($output);
683     my $directory = File::Basename::dirname ($output);
684    
685     sysopen my $fh, $output, Fcntl::O_WRONLY () | Fcntl::O_CREAT () | Fcntl::O_EXCL (), 0600
686     or die "$output: $!\n";
687     close $fh or do { my $error = $!; unlink $output; die "$output: $error\n" };
688    
689     my $cv = AE::cv ();
690     my $log;
691     my $process = eval {
692     AnyEvent::Util::run_cmd ([
693     "patch", "--verbose", "--batch", "--forward", "--binary", "--fuzz=0",
694     "--no-backup-if-mismatch", "--reject-file=-", "--output=$output", "--", $input,
695     ],
696     "<" => \$normalized,
697     ">" => \$log,
698     close_all => 1,
699     on_prepare => sub {
700     $ENV{LC_ALL} = "C";
701     chdir $directory or die "$directory: $!\n";
702     defined POSIX::dup2 (1, 2) or die "dup2: $!\n";
703     },
704     );
705     };
706    
707     if ($@) {
708     my $error = $@;
709     unlink $output;
710     die $error;
711     }
712    
713     $process->cb (sub {
714     my $hunks;
715     eval { $hunks = check_patch_output $_[0]->recv, $log, $max_offset; 1 } or do {
716     my $error = $@;
717     unlink $output;
718     $cv->croak ($error);
719     return;
720     };
721    
722     $cv->send ($hunks);
723     });
724    
725     $cv
726     }
727    
728 root 1.1 sub _clean_text($) {
729     my ($text) = @_;
730    
731     my ($prefix) = (join "\n", grep /\S/, split /\n/, $text)
732     =~ /\A([ \t]*)[^\n]*(?:\n\1[^\n]*)*\z/;
733    
734     $text =~ s/^\Q$prefix\E//mg;
735     $text =~ s/\A\s+//;
736     $text =~ s/\s+\z//;
737     $text
738     }
739    
740     package AnyEvent::MCP::Base;
741    
742     sub new {
743     my ($class, %kv) = @_;
744 root 1.19
745 root 1.1 bless \%kv, $class
746     }
747    
748     sub event {
749     my ($self, $event, @args) = @_;
750 root 1.19
751 root 1.1 ($self->{"on_$event"} or return)->($self, @args)
752     }
753    
754     =head1 SEE ALSO
755    
756 root 1.16 L<AnyEvent::MCP::Intro>, L<AnyEvent::MCP::Server::Simple>,
757 root 1.23 L<AnyEvent::MCP::Helper>, L<mcp-ask-user>, L<anyevent-mcp-form-elicitation>,
758 root 1.1 L<AnyEvent>, L<https://modelcontextprotocol.io/>
759    
760     =head1 AUTHOR
761    
762     The main author of this module is OpenAI ChatGPT.
763    
764     Additional guidance received by:
765    
766     Marc Lehmann <schmorp@schmorp.de>
767     http://home.schmorp.de/
768    
769     =cut
770    
771     1
772