ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MCP/lib/AnyEvent/MCP/Server/Simple.pm
Revision: 1.51
Committed: Fri Nov 6 14:52:28 2026 UTC (6 days, 7 hours ago) by root
Branch: MAIN
CVS Tags: rel-0_82
Changes since 1.50: +22 -0 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3     AnyEvent::MCP::Server::Simple - simple function interface for MCP servers
4    
5     =head1 SYNOPSIS
6    
7     use AnyEvent::MCP::Server::Simple;
8    
9     mcp_config
10 root 1.34 server_name => "example",
11     server_version => 0,
12 root 1.1 instructions => <<'EOF';
13     Use echo to return the supplied text.
14     EOF
15    
16     mcp_tool echo =>
17     "Return the supplied text.",
18     {
19     type => "object",
20     properties => { text => { type => "string" } },
21     required => ["text"],
22     },
23     sub {
24     my ($req, $args) = @_;
25    
26     $req->reply ({
27     content => [{ type => "text", text => $args->{text} }],
28     });
29     };
30    
31     mcp_start;
32    
33     =head1 DESCRIPTION
34    
35 root 1.2 For most MCP servers, registering a few tools and starting a transport is
36     enough. This module does just that: call C<mcp_tool> to register callbacks,
37     optionally configure the server with C<mcp_config>, then start it with
38     C<mcp_start>, C<mcp_stdio> or C<mcp_http>. Registration alone does not start
39     a server or an event loop.
40 root 1.1
41     Human-readable descriptions and instructions are stripped of surrounding
42     whitespace and common indentation when registered, so indented here-documents
43     can be used naturally.
44    
45     C<mcp_start>, C<mcp_stdio> and C<mcp_http> are alternative blocking entry
46 root 1.2 points for a self-contained server. They run AnyEvent until shutdown; you
47     do not start another event loop. If your application already owns the server
48     lifetime or needs several transports, use the object interfaces instead.
49    
50     Simple uses L<AnyEvent::MCP::Server> and a default Toolset internally; it is
51     not a second server implementation. Applications needing custom dispatch,
52     such as a multibroker, can use the Server API directly.
53 root 1.1
54 root 1.15 Start with L</TUTORIAL> for a complete server and a first client call.
55     For running the bundled servers without writing Perl, see
56     L<AnyEvent::MCP::Intro>.
57    
58     =head1 TUTORIAL
59    
60     This tutorial builds a small server, calls it, then adds options, permission
61     checks and asynchronous work. You do not need to implement JSON-RPC,
62     authentication or a transport. Simple supplies those parts; your program
63     declares tools and handles their arguments.
64    
65     For installation, connecting AI clients and configuring the bundled servers,
66     see L<AnyEvent::MCP::Intro>. The function reference follows this tutorial.
67    
68     =head2 A complete first server
69    
70     Save the following as C<echo-mcp>:
71    
72     #!/opt/bin/perl
73    
74     use common::sense;
75     use AnyEvent::MCP::Server::Simple;
76    
77 root 1.33 my $options = mcp_getoptions {
78 root 1.15 name => "echo-demo",
79     usage => "Usage: $0 [OPTION]...\n",
80     description => "Return text supplied to the echo tool.",
81     };
82    
83     @ARGV == 0
84     or die "Unexpected arguments\n";
85    
86     mcp_config
87 root 1.34 server_name => "echo-demo",
88     server_version => 1,
89 root 1.15 instructions => "Use echo to return the supplied text.";
90    
91     mcp_tool echo =>
92     "Return the supplied text.",
93     {
94     type => "object",
95     properties => {
96     text => {
97     type => "string",
98     maxLength => 4096,
99     },
100     },
101     required => ["text"],
102     },
103     sub {
104     my ($req, $args) = @_;
105    
106     my $text = $args->{text};
107     defined $text and !ref $text and length $text <= 4096
108     or die "text must be a string of at most 4096 characters\n";
109    
110     $req->reply ({
111     content => [{ type => "text", text => $text }],
112     });
113     };
114    
115 root 1.33 mcp_start %$options;
116 root 1.15
117     Use your installed Perl's explicit path in the shebang, or invoke the file
118     with C<perl> as in the commands below.
119    
120     C<mcp_getoptions> parses the common server options and returns startup
121     settings. C<mcp_config> declares protocol metadata and instructions.
122     C<mcp_tool> registers a description, input schema and callback.
123     C<mcp_start> constructs the transport and runs AnyEvent until shutdown.
124     Register everything before starting: code after C<mcp_start> runs only
125     when the server stops.
126    
127     The input schema tells the client what to supply. The server does B<not>
128     validate arguments against JSON Schema, so the callback checks the value it
129     actually uses. A missing text, array or object fails as a tool error.
130     The example allows an empty string.
131    
132     C<$req> is an L<AnyEvent::MCP::Server::Request>; C<$args> is its argument
133     hash reference. Replying finishes the request. Merely returning from the
134     callback does not. You supply the MCP result, and the server supplies the
135     JSON-RPC envelope.
136    
137     =head2 Start and call the server
138    
139     Inspect the common options with:
140    
141     perl echo-mcp --help
142    
143     For a client launching a local subprocess, configure:
144    
145     perl /absolute/path/to/echo-mcp --stdio
146    
147     The client must launch the process itself. Stdin and stdout carry MCP,
148     so starting the program in a terminal and typing text at it is not a test
149     of the echo tool. Print diagnostics to stderr, not stdout.
150    
151     You can make a first call without an AI client. Save this as C<try-echo>
152     in the same directory as C<echo-mcp>:
153    
154     use common::sense;
155     use AnyEvent;
156     use AnyEvent::MCP::Client::JSONL;
157    
158     my $client = AnyEvent::MCP::Client::JSONL->new (
159     command => [$^X, "./echo-mcp", "--stdio"],
160     );
161    
162     my $cv = AE::cv;
163    
164     $client->call (echo => { text => "hello" }, sub {
165     $cv->send (@_);
166     });
167    
168     my ($success, $result) = $cv->recv;
169     $success
170     or die "$result->{message}\n";
171     !$result->{isError}
172     or die "$result->{content}[0]{text}\n";
173    
174     print $result->{content}[0]{text}, "\n";
175    
176     Run C<perl try-echo>. It prints:
177    
178     hello
179    
180     The JSONL client starts the server, connects and negotiates the protocol on
181     first use. C<$^X> chooses the same Perl interpreter as the test client.
182     The condition variable keeps the event loop running until the reply arrives.
183     Keep C<$client> alive while its operations are outstanding.
184    
185     There are two success checks. C<$success> means the JSON-RPC operation
186     completed successfully; a tool can still return C<isError> in that result.
187     This client expects our echo tool's text result. A general client must handle
188     other MCP content representations too.
189    
190     To use HTTP, start the server in one terminal:
191    
192     perl echo-mcp --bind :31742
193    
194     and retrieve its URL in another:
195    
196     perl echo-mcp --bind :31742 --print-url
197    
198     Configure that URL in your MCP client and ask it to call echo with text
199     C<hello>. Both commands use instance C<echo-demo>, unless you override it
200     with C<--name>. Repeat the same listener overrides when printing the URL.
201     C<--print-url> prints the address and exits; it does not start a server.
202    
203     For the small Perl client above, replace the JSONL import and constructor
204     with:
205    
206     use AnyEvent::MCP::Client::HTTP;
207    
208     my $client = AnyEvent::MCP::Client::HTTP->new (
209     url => $ARGV[0],
210     );
211    
212     Pass the printed URL as its first command-line argument.
213     The rest of the call and result handling stays the same.
214    
215     C<mcp_start> supplies named HTTP settings and a token derived from the
216 root 1.34 private global secret. Stdio needs no HTTP configuration. C<name> selects
217     local settings and credentials; C<server_name> identifies the advertised
218     MCP implementation. The two need not be the same.
219 root 1.15 See L<AnyEvent::MCP::Intro/CONFIGURING YOUR SETUP>.
220    
221     =head2 Add an application option
222    
223     Suppose you want the server user to choose the maximum text length.
224     Replace the original C<mcp_getoptions> call with:
225    
226     my $max_length = 4096;
227    
228 root 1.33 my $options = mcp_getoptions (
229 root 1.15 {
230     name => "echo-demo",
231     usage => "Usage: $0 [OPTION]...\n",
232     description => "Return text supplied to the echo tool.",
233     options => [
234     ["--max-length N", "Maximum text length in characters"],
235     ],
236     },
237     "max-length=i" => \$max_length,
238     );
239    
240     $max_length > 0
241     or die "--max-length must be positive\n";
242    
243     Use C<$max_length> in both the schema's C<maxLength> and the callback's
244     length check. The server user can then start:
245    
246     perl echo-mcp --stdio --max-length 1000
247    
248     The option specification is passed to L<Getopt::Long>. The C<options>
249     entries supply human-readable help; they do not register options.
250     The later tool examples use the original 4096-character limit; use your
251     chosen limit in them too if you keep this option.
252     Common options such as C<--stdio>, C<--bind> and C<--help> remain available.
253    
254     If your server also takes positional arguments, validate the remaining
255     C<@ARGV> after C<mcp_getoptions>. It handles C<--help> and C<--print-url>
256     before that validation, so the user can retrieve an HTTP URL without
257     supplying an application workdir or starting the application.
258    
259     Settings affecting URL discovery, such as C<name> and C<path>, should be
260     available to C<mcp_getoptions> through its leading settings hash or an
261     earlier C<mcp_config> call. A setting supplied only after the parser exits
262     for C<--print-url> cannot affect that printed URL.
263    
264     =head2 Choose a result representation
265    
266     Our echo callback returns one text content item. Use C<reply> when the
267     representation matters: text, other content types, a larger result or a
268     particular MCP result shape.
269    
270     For an ordinary result object, you can replace the reply with:
271    
272     $req->result ({ text => $text, length => length $text });
273    
274     C<result> returns that hash as C<structuredContent> and also serializes it
275     as JSON in one text content item. Clients consuming only text can still
276     see the data, but it is deliberately duplicated. Wrap arrays or scalars in
277     an object, or use C<reply> to choose a different representation.
278    
279     To report a tool failure explicitly:
280    
281     $req->error ("The requested operation cannot be completed");
282    
283     A synchronous exception from the handler also becomes a tool-error result.
284     Malformed protocol requests and an unknown tool name are handled by the
285     server. Your callback does not construct a JSON-RPC response itself.
286    
287     Reply once. Code that calls C<reply>, C<result> or C<error> and then calls
288     another reply method is a programming error. Keep a final reply separate
289     from the work leading to it so the completion point is easy to see.
290    
291     =head2 Add a permission check before changing state
292    
293     Authentication alone does not decide which tool operations a user allows.
294     For an example with a side effect but no external worker, add a tool that
295     stores one note in the server's memory.
296    
297     Add this before registering the tools:
298    
299     use AnyEvent::MCP::Server::Permissions;
300    
301     my $note;
302    
303     mcp_config permissions => AnyEvent::MCP::Server::Permissions->new (
304     name => "echo-notes",
305     actions => {
306     remember => "Replace the server's in-memory note",
307     },
308     );
309    
310     Then register this tool before C<mcp_start>:
311    
312     mcp_tool remember =>
313     "Replace the server's in-memory note with the supplied text.",
314     {
315     type => "object",
316     properties => {
317     text => { type => "string", maxLength => 4096 },
318     },
319     required => ["text"],
320     },
321     sub {
322     my ($req, $args) = @_;
323    
324     my $text = $args->{text};
325     defined $text and !ref $text and length $text <= 4096
326     or die "text must be a string of at most 4096 characters\n";
327    
328     $req->require_permission ({
329     tool => $req->{tool},
330     action => "remember",
331     sandbox_grants => [],
332     reason => "replace the server's in-memory note",
333     });
334    
335     $note = $text;
336    
337     $req->result ({ remembered => length $note });
338     };
339    
340     Restart the server and call remember through your client. The default
341     permission helper asks on the server machine. Allow once permits this
342     invocation. Allow always saves a rule for action C<remember>; subsequent
343     matching calls do not ask again. The note itself lasts only for this
344     server process and is shared by its clients.
345    
346     The permission engine's name C<echo-notes> selects its default policy file:
347    
348 root 1.16 ~/.config/anyevent-mcp/rules/echo-notes.ini
349 root 1.15
350     The actual directory follows C<XDG_CONFIG_HOME> when set.
351     This is the shared engine's default convention, different from mcp-fs's
352 root 1.16 C<rules/fs-NAME.ini>. Manage it using C<anyevent-mcp manage-rules-file>
353 root 1.15 with the actual pathname, or supply C<file> to the engine explicitly.
354    
355     For example, a manually written allow rule is:
356    
357     [rule]
358     decision=allow
359     action=remember
360     sandbox-grants=
361    
362     The empty grant list is intentional. This tool updates an in-memory value;
363     it does not launch a sandboxed worker. C<action> is the operation class
364     to authorize, while C<sandbox_grants> describes worker authority.
365    
366     The permission engine checks policy; it does not restrict filesystem or
367     network access by itself. If you add file or command tools, define the
368     necessary grants and enforce the returned set through your worker or
369     sandbox. Do not copy C<sandbox_grants =E<gt> []> into a file-writing
370     handler and assume it confines access.
371    
372     Here the permission name is deliberately fixed and independent of the
373     HTTP instance name. If you want each C<--name> to have separate policy,
374     pass C<$options{name}> as the permission engine's name instead.
375    
376     =head2 Why checks must precede side effects
377    
378     When permission is missing, C<require_permission> throws a special
379     exception. Server catches it, asks, and may invoke the handler again.
380     The assignment to C<$note> therefore comes B<after> the check.
381    
382     With a local prompt, the server retries internally. Modern MCP form asking
383     returns C<input_required>; the client repeats the call with its answer.
384     Earlier one-time grants survive permission retries within this invocation,
385     but do not authorize the next call. Saved rules are rechecked.
386    
387     Do not catch that exception as an ordinary failure around the permission
388     check. It must reach Server's synchronous dispatch boundary.
389     For several checks, complete all of them before modifying state or starting
390     asynchronous work. An C<on_request> hook also runs on retry, so it must not
391     perform a once-only side effect before the handler's checks.
392    
393     To choose client-side form asking for this example:
394    
395     PERL_ANYEVENT_MCP_PERMISSION_ASK=auto perl echo-mcp --stdio
396    
397     C<auto> uses modern form elicitation when the client advertises support,
398     otherwise the local helper. C<mcp> requires that support; C<helper> keeps
399     the prompt local. The tiny try-echo client advertises no form support,
400     so auto uses the helper there. To handle forms in a Perl client, see
401     L<AnyEvent::MCP::Client/on_request> and
402     L<AnyEvent::MCP::Permissions::Ask/elicitation>.
403    
404     For grant definitions, subject scopes and multi-path operations, see
405     L<AnyEvent::MCP::Server::Permissions> and
406     L<AnyEvent::MCP::Server::Toolset/Permission checks and retries>.
407    
408     =head2 Let an asynchronous operation finish later
409    
410     A tool callback runs in the AnyEvent event loop. Blocking it with C<sleep>
411     or a synchronous long-running command also blocks other requests.
412    
413     Add C<use AnyEvent;> and register the following before C<mcp_start>:
414    
415     mcp_tool delayed_echo =>
416     "Return the supplied text after a delay of up to 60 seconds.",
417     {
418     type => "object",
419     properties => {
420     text => { type => "string", maxLength => 4096 },
421     seconds => {
422     type => "integer",
423     minimum => 0,
424     maximum => 60,
425     },
426     },
427     required => ["text", "seconds"],
428     },
429     sub {
430     my ($req, $args) = @_;
431    
432     my $text = $args->{text};
433     defined $text and !ref $text and length $text <= 4096
434     or die "text must be a string of at most 4096 characters\n";
435    
436     my $seconds = $args->{seconds};
437     defined $seconds and !ref $seconds
438     and $seconds =~ /\A[0-9]+\z/ and $seconds <= 60
439     or die "seconds must be an integer from 0 to 60\n";
440    
441     $req->progress (0, 1, "Waiting");
442    
443     my $timer = AnyEvent->timer (after => $seconds, cb => sub {
444     $req->{finished}
445     and return;
446    
447     $req->progress (1, 1, "Done");
448     $req->reply ({
449     content => [{ type => "text", text => $text }],
450     });
451     });
452    
453     $req->{on_cancel} = sub {
454     undef $timer;
455     };
456     };
457    
458     The tool is advertised as C<delayed-echo>, because registration converts
459     underscores to hyphens. Ask the client to call it with text C<hello> and
460     seconds C<2>. The callback returns immediately; the timer supplies the reply
461     later. Other requests can run while it waits.
462    
463     Keep watcher objects alive while they are needed. Here the cancellation
464     callback retains C<$timer>, and the timer's callback retains C<$req> and
465     C<$text>. Cancellation releases the timer. Replying finishes the request
466     and removes its cancellation callback, releasing the watcher as well.
467     No separate job registry is needed for this example.
468    
469     Check C<finished> in late completion callbacks before replying.
470     Cancellation sets both C<finished> and C<cancelled> and sends no reply.
471     For subprocesses or network work, the cancellation callback should stop
472     that operation and release its resources instead of merely abandoning
473     the eventual reply.
474    
475     Server catches exceptions during synchronous dispatch, not exceptions
476     from a later timer or I/O callback. If an asynchronous operation can fail,
477     handle that failure in its completion callback and report it with
478     C<error> or C<reply>, provided the request is still active.
479    
480     C<progress> only sends when the caller supplied a progress token.
481     Delivery is best effort; the HTTP server in this distribution does not
482     deliver progress notifications. A client without progress display can
483     still receive the final result.
484    
485     =head2 When to use the object interfaces
486    
487     Simple owns one default Toolset and the blocking server lifetime.
488     That is useful for a small standalone program. If you already run an
489     event loop, want multiple transports or tool registries, or need custom
490     protocol dispatch, construct the objects directly.
491    
492     L<AnyEvent::MCP::Server::Toolset> registers reusable tools.
493     L<AnyEvent::MCP::Server> handles the protocol.
494     L<AnyEvent::MCP::Server::HTTP> and L<AnyEvent::MCP::Server::JSONL> manage
495     connections. L<AnyEvent::MCP::Server::Request> describes request fields,
496     replies, progress and cancellation. The same tool callback model applies
497     at both levels.
498    
499 root 1.1 =head1 FUNCTIONS
500    
501     =over
502    
503     =item mcp_config %config
504    
505     Adds server configuration. Repeated calls extend or replace previously declared
506     values. C<instructions> is treated as human-readable text and normalized.
507    
508 root 1.15 Server and transport options are passed to the underlying objects.
509     Common options include:
510    
511     =over
512    
513 root 1.34 =item name => $instance
514    
515     Local instance name used to select configuration and credentials. Independent
516     of the name reported to MCP clients.
517    
518     =item server_name => $name
519    
520     Advertised MCP server implementation name. Defaults to C<AnyEvent::MCP>.
521    
522     =item server_version => $version
523    
524     Advertised application version, not the MCP protocol revision. Accepts
525     an ordinary Perl version number; Simple stringifies it for MCP.
526     Defaults to the AnyEvent::MCP library version.
527    
528 root 1.15 =item server_info => { name => $name, version => $version }
529 root 1.1
530 root 1.34 Raw MCP server identity, passed through unchanged to the underlying
531     server. Cannot be combined with C<server_name> or C<server_version>.
532 root 1.1
533 root 1.15 =item instructions => $text
534 root 1.1
535 root 1.15 Human-readable guidance for the client, normalized when configured.
536 root 1.1
537 root 1.21 =item short_instructions => $text
538    
539     Optional condensed guidance for finding this server's tools. Used as the
540     advertised MCP instructions when C<auto_instructions> is enabled.
541    
542     =item auto_instructions => $boolean
543    
544     Enabled by default. Exposes full instructions through the generated
545     C<meta-instructions> tool while advertising the short instructions if set.
546 root 1.22 When short or custom instructions are provided, append a brief hint pointing
547     to the full tool description; otherwise advertise full instructions as before.
548 root 1.21 Disable to advertise full instructions and omit the generated tool.
549    
550     =item custom_instructions => $text
551    
552     Instance-specific purpose prepended to advertised instructions. Can also be
553     set through C<--custom-instructions> or C<custom_instructions> in the program
554     or instance section of the global INI configuration.
555    
556 root 1.15 =item on_request => $callback->($server, $req)
557    
558     Synchronous hook before each dispatch attempt. For example, refresh
559     database state here. This does not replace dispatch or receive a
560     completion callback, and permission retries can invoke it again.
561    
562     =item on_start => $callback->($server)
563    
564     Called after the transport is ready, before entering the event loop.
565     Use it for startup information or installing watchers. Stdout carries
566     protocol messages in stdio mode; print diagnostics to stderr.
567 root 1.1 The callback must not block.
568    
569 root 1.15 =item idle_exit => $seconds
570    
571     Optional positive idle time for spawned stdio servers. With a multibroker
572     advertising C<anyevent-mcp/multibroker> version 1, Simple requests shutdown
573     once no MCP requests have been active for that long. The broker can ignore
574     the request. HTTP servers, ordinary clients and servers without this
575     option are unaffected.
576    
577     =back
578    
579     See L<AnyEvent::MCP::Server> for further protocol options and events.
580 root 1.11
581 root 1.1 =item mcp_tool $name, $description, $input_schema, $callback->($req, $args)
582    
583     Registers a tool named C<$name> with C<$description> and the JSON Schema
584     hash reference C<$input_schema>. C<$description> is normalized like
585     C<instructions>.
586    
587     C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
588     and its C<< $req->{args} >> hash reference as C<$args>, for convenience.
589    
590     Tools complete the request with C<< $req->reply ($result) >>, or use
591     C<< $req->result ($data) >> and C<< $req->error ($message) >> for convenience.
592     Request context is available directly in
593     the hash, for example C<< $req->{tool} >> and C<< $req->{server} >>.
594    
595 root 1.33 =item $server_options = mcp_getoptions ({ %settings }, @getopt_options)
596 root 1.8
597 root 1.47 Parse the switches documented in L</COMMON COMMAND-LINE OPTIONS> alongside
598 root 1.8 application-specific L<Getopt::Long> option specifications:
599    
600     my $verbose;
601 root 1.33 my $options = mcp_getoptions (
602 root 1.9 {
603     usage => "Usage: $0 [OPTION]... WORKDIR\n",
604     description => "Provide example tools through MCP.",
605     option_heading => "Example options:",
606     options => [
607     ["--verbose", "Show additional diagnostics"],
608     ],
609     examples => " $0 --stdio ./project",
610     path => "/",
611     },
612 root 1.8 "verbose!" => \$verbose,
613     );
614     @ARGV == 1 or die "workdir required\n";
615 root 1.33 mcp_start %$options;
616 root 1.8
617 root 1.15 The optional leading hash accepts these help settings:
618    
619     =over
620    
621     =item usage => $text
622    
623     Usage synopsis, including its trailing newline. A default synopsis is
624     generated when omitted.
625    
626     =item description => $text
627    
628     Introductory help paragraph.
629    
630     =item options => [[$label, $description]...]
631    
632     Application option labels and descriptions. A plain string among the
633     pairs starts a new section; a string at the beginning replaces the
634     default section heading.
635    
636     =item option_heading => $text
637    
638     Initial section heading, defaulting to C<Application options:>.
639    
640     =item examples => $text
641    
642     Preformatted examples.
643    
644     =back
645    
646 root 1.47 See L</COMMON COMMAND-LINE OPTIONS> for the full reference to shared
647     server switches. Application-specific Getopt::Long options are parsed alongside them.
648 root 1.35
649     These switches also appear in C<--help>; application options are passed
650     through to L<Getopt::Long>. Other leading hash settings (e.g. C<path>,
651     C<auth>, C<url_scheme>) go to C<mcp_start>. Parse positional C<@ARGV>
652     in the application; C<mcp_getoptions> deliberately does not require them
653     for help or URL discovery. Default activity logging includes asynchronous
654     tool failures and formats time, program, instance and PID. Environment
655     C<PERL_ANYEVENT_LOG> can select destinations and verbosity.
656 root 1.8
657 root 1.26 =item mcp_tool_help ($enabled, @toolsets)
658    
659     If C<$enabled> is true, print the definitions registered in the supplied
660     L<AnyEvent::MCP::Server::Toolset> objects and exit. Otherwise do nothing.
661     Call after registering tools but before starting listeners for executables
662     which manage their own toolsets. Only registered tools appear.
663    
664 root 1.27 =item mcp_log $message
665    
666     Emit operator-facing activity to the configured AnyEvent::Log destination,
667     bypassing its diagnostic verbosity filter. C<--quiet> suppresses this log.
668    
669 root 1.38 =item mcp_log_request ($server, $req, %extra)
670 root 1.27
671     C<on_request> callback to report tool invocations once across permission
672 root 1.30 retries, and log tool-error replies, including asynchronous ones. It logs
673     selected arguments rather than entire request or reply payloads. This includes
674 root 1.39 JSON-quoted previews of command arguments and VCS filenames (up to four,
675     80 characters each), and Vim C<ex> commands (up to 200 characters).
676     These can contain sensitive text. The Simple starters install it by default;
677 root 1.30 custom servers can use it too.
678 root 1.38 C<%extra> appends application-specific C<key=value> fields in key order.
679     Sanitize sensitive arguments before passing them.
680 root 1.27
681 root 1.1 =item mcp_start %config
682    
683 root 1.15 Starts and runs the usual server. When C<stdio> is true or
684 root 1.1 C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL> is C<stdio>, uses C<mcp_stdio>.
685 root 1.4 Otherwise starts HTTP without printing its URL. HTTP-capable executables
686     provide C<--print-url> to retrieve the URL explicitly.
687 root 1.1
688 root 1.3 The HTTP defaults are IPv4 loopback, a stable name-derived port in
689     16384..32767, and C</> as the endpoint path.
690 root 1.7 Without explicit C<tokens>, one server-specific token is derived from
691     the private global secret. The selected token authenticates either its URL
692     path or an
693 root 1.5 C<Authorization: Bearer TOKEN> header at the clean URL returned by
694 root 1.6 C<< $server->url (0) >>. The corresponding executable's C<--print-url>
695     option prints the first accepted token in its URL.
696 root 1.1
697 root 1.10 C<name> selects the C<[instance NAME]> configuration section and credential.
698 root 1.16 It defaults to C<default>.
699 root 1.43 Named settings C<bind>, C<path>, C<url_host>, C<url_scheme>, C<tokens>,
700     C<tls_cert> and C<tls_key> are loaded from the global configuration.
701     Explicit C<tokens> (an ordered,
702 root 1.7 nonempty array reference of URL-safe strings) replaces the configured list
703     and the derived default. Every token works in the URL and bearer header.
704 root 1.3 An explicit C<bind> overrides the configured bind address. Other arguments
705 root 1.7 override these settings.
706 root 1.1
707     The global secret is generated automatically when needed; see
708     L<AnyEvent::MCP/GLOBAL CONFIGURATION>. No configuration is loaded for stdio.
709 root 1.4 HTTP startup neither prints to stdout nor changes its buffering.
710 root 1.7 C<mcp_start> does not parse C<@ARGV>; applications parse their own options.
711 root 1.8 The bundled executables use C<mcp_getoptions>, which handles shared
712     options and URL discovery before starting the event loop.
713 root 1.1
714 root 1.17 =item mcp_connect %config
715    
716     Run a reverse-connecting JSONL server using C<connect =E<gt>
717 root 1.47 "http[s]://host:port/token/alias">. HTTPS verifies the server certificate
718     and hostname. It sends the authenticated extension hello only after the
719     transport is established, then serves MCP over the socket. Refused TCP
720     connections retry every second for at most sixty attempts, and unexpected
721     established disconnects start a new retry period. Other TCP setup and TLS
722     handshake errors are reported and stop the server.
723     Calls are cancelled rather than replayed.
724 root 1.17 This connection has no spawned-child lifecycle authority.
725    
726 root 1.1 =item mcp_stdio %config
727    
728     Creates and runs a server over stdin/stdout. Arguments override the collected
729     configuration. Stdout buffering is disabled. On stdin EOF, pending replies
730     finish and stdout drains before
731     this function returns. Stream errors close the connection and cancel pending
732     requests.
733    
734     =item mcp_http %config
735    
736     Creates and runs an HTTP server. For example:
737    
738     mcp_http
739     host => "127.0.0.1",
740     port => 31740,
741 root 1.7 path => "/mcp/",
742     tokens => ["your-long-random-secret"];
743 root 1.1
744     Arguments override the collected configuration. Unlike C<mcp_start>, this
745 root 1.8 function does not derive or supply authentication. B<Always> pass C<tokens>,
746     or explicitly pass C<auth =E<gt> "none"> when a trusted embedding layer
747     enforces access. Omitting both is an error, not an unauthenticated default.
748     It does not print a URL; use
749 root 1.7 C<on_start> for application-specific startup output. Neither function
750     implements OAuth or Basic authentication. See
751     L<AnyEvent::MCP::Server::HTTP/AUTHENTICATION> for details.
752 root 1.1
753     All three starters return when the server is closed or on C<SIGINT> or
754     C<SIGTERM>. Signal shutdown closes connections and cancels outstanding
755     requests. The signal watchers belong to the blocking call.
756    
757     =back
758    
759 root 1.47 =head1 COMMON COMMAND-LINE OPTIONS
760    
761     C<mcp_getoptions> parses these options for executables using
762     L<AnyEvent::MCP::Server::Simple>. The executable's own OPTIONS section
763     documents any additional switches or differences in shared-option behavior.
764    
765     =over
766    
767     =item --name NAME
768    
769     Select the instance (default C<default>). NAME starts with a letter or
770     underscore, followed by letters, digits, underscores or hyphens.
771     Selects C<[instance NAME]> configuration, derived HTTP port and credentials;
772     does not change the advertised MCP implementation name.
773     Example: C<--name project>.
774    
775     =item --bind ADDRESS[:PORT]
776    
777     Override HTTP listening address and port. Defaults to C<127.0.0.1> and a
778     stable instance-derived port in 16384..32767. C<:31740> uses the loopback
779     address and port 31740; C<127.0.0.1:31740> specifies both.
780     Port zero requests an ephemeral port and is incompatible with
781     C<--print-url>. Ignored for stdio-only startup.
782    
783     =item --tls-cert FILE
784    
785     Enable opportunistic HTTPS using a PEM certificate chain. Without
786     C<--tls-key>, FILE must also contain the private key. The same listener
787     continues to accept plain HTTP.
788    
789     =item --tls-key FILE
790    
791     Private-key PEM file for C<--tls-cert>. If supplied alone, FILE must
792     contain both certificate chain and private key. Requires C<Net::SSLeay>.
793    
794     =item --token TOKEN
795    
796     Accept TOKEN for HTTP authentication. Repeat to accept multiple tokens.
797     Explicit tokens replace configured or master-secret-derived defaults.
798     Tokens work both as credential-bearing URL components and with the
799     C<Authorization: Bearer TOKEN> header.
800     Example: C<--token first --token second>.
801    
802 root 1.51 =item -s, --set KEY=VALUE
803    
804     Override one trusted configuration entry for the selected instance in this
805     process. Applied after C<[program NAME]> and C<[instance NAME]> defaults,
806     without changing the configuration file. Repeat to override multiple entries;
807     the last assignment to a key wins. Empty values suppress inherited settings,
808     and additional equals signs belong to the value. The supported keys depend
809     on the server (for example, C<executable.perl> and C<prepend-path> in
810     L<mcp-fs>). Example: C<-s executable.perl=/opt/perl/bin/perl>.
811    
812 root 1.47 =item --stdio
813    
814     Serve MCP JSONL on stdin/stdout rather than the default HTTP listener.
815     Applications with auxiliary listeners can keep those active. Cannot
816     combine explicitly with C<--connect>.
817    
818     =item --connect URL
819    
820     Reverse-connect to an upstream multibroker. For example:
821     C<http://host:port/TOKEN/alias> or C<https://host:port/TOKEN/alias>.
822     HTTPS requires successful certificate and hostname verification; it
823     never falls back to plaintext. Replaces the default MCP listener and
824     overrides implicit stdio selection. Cannot combine with explicit
825     C<--stdio>.
826    
827     =item --custom-instructions TEXT
828    
829     Override configured instance-purpose guidance describing when MCP
830     clients should use the server.
831     Example: C<--custom-instructions 'Use for build logs'>.
832    
833     =item --auto-allow TOOL[,ACTION[,CAPABILITY]]
834    
835     Add a process-local permission allow rule, repeatable. TOOL identifies
836     the permission-checked tool; ACTION and CAPABILITY narrow the match.
837     Missing fields and C<*> match anything.
838     Example: C<--auto-allow '*,read,workdir-read'>.
839     Rules run in command-line order before saved rules; they cannot grant
840     permissions to tools that do not check permissions.
841     See L<AnyEvent::MCP::Server::Permissions/auto_rules>.
842    
843     =item --auto-deny TOOL[,ACTION[,CAPABILITY]]
844    
845     Add a repeatable process-local deny rule with the same matching syntax
846     and evaluation order as C<--auto-allow>.
847     Example: C<--auto-deny '*,exec'>.
848    
849     =item --quiet
850    
851     Suppress routine tool activity and tool-failure logging. Warnings and
852     ordinary diagnostics remain; C<PERL_ANYEVENT_LOG> determines diagnostic
853     levels and destinations.
854    
855     =item --print-url[=USER]
856    
857     Print credential-bearing URLs and exit without starting a listener.
858     With managed users, prints each effective enabled user's URL, or only
859     the exact username USER. Comments identify scope-qualified principals
860     and the selected auxiliary connection user. With configured TLS, HTTPS
861     is printed before HTTP. Explicit tokens retain a single-token output
862     and cannot be combined with a user selector. Requires a predictable,
863     nonzero port and a persistent master secret for derived credentials.
864     Example: C<--name project --print-url=claude>.
865    
866     =item --print-urls
867    
868     Alias for C<--print-url>.
869    
870     =item --tool-help
871    
872     Print currently registered tool names, descriptions, argument types,
873     required fields and defaults; exit without starting the MCP listener.
874     Registered tools can depend on installed utilities and application setup.
875    
876 root 1.48 =item --help
877 root 1.47
878     Print shared and application-specific command-line help; exit without
879     starting a server. Invalid options instead report usage.
880    
881     =back
882    
883 root 1.1 =cut
884    
885     package AnyEvent::MCP::Server::Simple;
886    
887     use common::sense;
888 root 1.46
889     use Exporter ();
890     use JSON::XS ();
891     use Scalar::Util qw(refaddr);
892    
893 root 1.1 use AnyEvent ();
894 root 1.40 use AnyEvent::Log ();
895 root 1.1 use AnyEvent::MCP ();
896     use AnyEvent::MCP::Server::Toolset ();
897    
898     our @ISA = qw(Exporter);
899 root 1.27 our @EXPORT = qw(mcp_config mcp_tool mcp_getoptions mcp_tool_help mcp_log mcp_log_request mcp_start mcp_stdio mcp_http mcp_connect);
900 root 1.1
901 root 1.41 my %config = (
902     auto_instructions => 1,
903     on_request => \&mcp_log_request,
904 root 1.42 on_connection_error => sub {
905     my ($server, $handle, $error) = @_;
906     my $info = $handle->{mcp_peer}{client_info};
907     my $name = ref $info eq "HASH" ? $info->{name} : undef;
908     my @details = (
909     "id=" . sprintf ("%x", refaddr $handle),
910     defined $handle->{mcp_remote} ? "remote=$handle->{mcp_remote}" : (),
911     defined $name && !ref $name ? "client=" . JSON::XS::encode_json (substr $name, 0, 80) : (),
912     );
913 root 1.50 AE::log trace => "MCP connection " . join (" ", @details) . ": $error";
914 root 1.42 },
915 root 1.41 );
916 root 1.1 my $toolset = AnyEvent::MCP::Server::Toolset->new;
917 root 1.27 my $quiet;
918 root 1.1
919     sub _run;
920    
921 root 1.27 # operational messages go to the configured AnyEvent::Log destination,
922     # independently of the diagnostic verbosity filter.
923     sub mcp_log {
924     return if $quiet;
925     $AnyEvent::Log::LOG->log (info => @_);
926     }
927    
928     sub mcp_log_request {
929 root 1.38 my ($server, $req, %extra) = @_;
930 root 1.27
931     return unless $req->{method} eq "tools/call";
932     return if $req->{mcp_logged}++;
933    
934     my $args = $req->{args};
935 root 1.39 my $vcs = $req->{tool} =~ /\Avcs-(?:diff|status|log)\z/;
936 root 1.27 my @details;
937 root 1.39 for (qw(target workdir path cwd), $vcs ? "backend" : ()) {
938 root 1.27 push @details, "$_=" . (substr $args->{$_}, 0, 160)
939     if defined $args->{$_} && !ref $args->{$_};
940     }
941 root 1.36 push @details, substr +(join " ", @{$args->{ranges}}), 0, 180
942 root 1.27 if ref $args->{ranges} eq "ARRAY";
943 root 1.39 for my $key ("argv", $vcs ? "files" : ()) {
944     next unless ref $args->{$key} eq "ARRAY" && @{$args->{$key}};
945 root 1.31 require JSON::XS;
946 root 1.39 my @values = @{$args->{$key}};
947     push @details, "$key=" . join (" ", map {
948 root 1.31 JSON::XS::encode_json (substr $_, 0, 80) . (length $_ > 80 ? "..." : "")
949 root 1.39 } @values[0 .. ($#values < 3 ? $#values : 3)])
950     . (@values > 4 ? " ..." : "");
951 root 1.31 }
952     if ($req->{tool} eq "grep" && defined $args->{pattern} && !ref $args->{pattern}) {
953     require JSON::XS;
954     push @details, "pattern=" . JSON::XS::encode_json (substr $args->{pattern}, 0, 160)
955     . (length $args->{pattern} > 160 ? "..." : "");
956     }
957 root 1.29 push @details, "name=" . (substr $args->{name}, 0, 160)
958     if $req->{tool} eq "call-tool" && defined $args->{name} && !ref $args->{name};
959     if ($req->{tool} eq "ex" && defined $args->{command} && !ref $args->{command}) {
960     require JSON::XS;
961     push @details, "command=" . JSON::XS::encode_json (substr $args->{command}, 0, 200)
962     . (length $args->{command} > 200 ? "..." : "");
963     }
964 root 1.28 if ($req->{tool} eq "path-op") {
965     push @details, map {
966     ($_ eq "unlink" || $_ eq "rmdir")
967     ? ($args->{$_} ? $_ : ())
968     : (defined $args->{$_} && !ref $args->{$_}
969     ? "$_=" . (substr $args->{$_}, 0, 80) : ())
970     } qw(unlink rmdir mkpath mkdir symlink truncate chmod rename);
971     }
972 root 1.38 for my $key (sort keys %extra) {
973     next unless defined $extra{$key} && !ref $extra{$key};
974     push @details, "$key=" . (substr $extra{$key}, 0, 160);
975     }
976 root 1.27
977     (my $message = join " ", $req->{tool}, @details) =~ s/[\r\n]/ /g;
978     mcp_log $message;
979    
980     my $reply = $req->{on_reply};
981     $req->{on_reply} = sub {
982     my ($req, $result) = @_;
983    
984     if ($result->{isError}) {
985     my $message = ref $result->{content} eq "ARRAY"
986     && ref $result->{content}[0] eq "HASH"
987     ? $result->{content}[0]{text} // "unknown error" : "unknown error";
988     $message =~ s/\n.*//s;
989     mcp_log "$req->{tool} failed: " . (substr $message, 0, 240);
990     }
991     $reply->(@_);
992     };
993     }
994    
995     sub _mcp_log_init {
996     my ($name, $silent) = @_;
997    
998     $quiet = $silent;
999     my $identity = AnyEvent::MCP::Config::program_name () . "/$name" . "[$$]";
1000    
1001     no warnings 'redefine';
1002     *AnyEvent::Log::default_format = sub ($$$$) {
1003     my ($when, $ctx, $level, $message) = @_;
1004 root 1.36 my $stamp = substr +(AnyEvent::Log::format_time $when), 8, 14;
1005 root 1.27 my $source = $ctx == $AnyEvent::Log::LOG ? "" : "$AnyEvent::Log::LEVEL2STR[$level] $ctx->[0]: ";
1006     join "", map "$stamp $identity $source$_\n", split /\n/, $message;
1007     };
1008     }
1009    
1010 root 1.1 sub mcp_config {
1011     my %kv = @_;
1012    
1013     $kv{instructions} = AnyEvent::MCP::_clean_text $kv{instructions}
1014     if exists $kv{instructions};
1015    
1016 root 1.14 %config = (%config, %kv);
1017 root 1.1 }
1018    
1019     sub mcp_tool {
1020     $toolset->tool (@_)
1021     }
1022    
1023 root 1.26 # format a JSON Schema type for command-line tool help.
1024     sub _tool_type {
1025     my ($schema) = @_;
1026     return "any" unless ref $schema eq "HASH";
1027     for my $key (qw(anyOf oneOf)) {
1028     return join "|", map _tool_type ($_), @{$schema->{$key}}
1029     if ref $schema->{$key} eq "ARRAY";
1030     }
1031     my $type = $schema->{type} // "any";
1032     $type = join "|", @$type if ref $type eq "ARRAY";
1033     $type = "array[" . _tool_type ($schema->{items}) . "]" if $type eq "array";
1034     $type
1035     }
1036    
1037     sub mcp_tool_help {
1038     my ($enabled, @toolsets) = @_;
1039     return unless $enabled;
1040    
1041     my $json = AnyEvent::MCP::json_class ()->new->canonical;
1042     my @tools = map @{$_->list}, @toolsets;
1043     for my $tool (@tools) {
1044     print "$tool->{name}\n";
1045     (my $description = $tool->{description} // "") =~ s/\n/\n /g;
1046     print " $description\n" if length $description;
1047    
1048     my $schema = $tool->{inputSchema} || {};
1049     my $properties = $schema->{properties} || {};
1050     my %required = map { $_ => 1 } @{$schema->{required} || []};
1051     for my $name (sort keys %$properties) {
1052     my $property = $properties->{$name};
1053     my $type = _tool_type ($property);
1054     my $status = $required{$name} ? "required" : "optional";
1055     my @extras;
1056     push @extras, "default: " . $json->encode ($property->{default})
1057     if exists $property->{default};
1058     push @extras, "values: " . join (", ", @{$property->{enum}})
1059     if ref $property->{enum} eq "ARRAY";
1060     print " $name $type $status", (@extras ? " (" . join ("; ", @extras) . ")" : ""), "\n";
1061     if (length ($property->{description} // "")) {
1062     (my $detail = $property->{description}) =~ s/\n/\n /g;
1063     print " $detail\n";
1064     }
1065     }
1066     print "\n";
1067     }
1068     print "No tools registered.\n" unless @tools;
1069     exit;
1070     }
1071    
1072 root 1.9 sub _mcp_help_row {
1073     my ($option, $description) = @_;
1074 root 1.13
1075 root 1.9 my $start = " $option";
1076     my $margin = " " x 34;
1077 root 1.13 my $out = length $start < 34 ? "" : "$start\n";
1078     my $line = length $start < 34 ? $start . (substr $margin, length $start) : $margin;
1079 root 1.9
1080     for my $word (split /\s+/, $description) {
1081 root 1.13 if (length $line > 34 && (length $line) + 1 + length $word > 79) {
1082 root 1.9 $out .= "$line\n";
1083     $line = $margin;
1084     }
1085 root 1.13
1086     $line .= " " if length $line > 34;
1087 root 1.9 $line .= $word;
1088     }
1089    
1090     "$out$line\n"
1091     }
1092    
1093     sub _mcp_help {
1094 root 1.19 my ($usage, $description, $options, $option_heading, $examples) = @_;
1095 root 1.13
1096 root 1.9 $usage =~ s/\n*\z/\n/;
1097     my $help = $usage;
1098     $help .= "\n$description\n" if defined $description && length $description;
1099    
1100     $help .= "\nCommon options:\n";
1101     my @common = (
1102 root 1.25 ["--name NAME", "Select named configuration (instance defaults to 'default')"],
1103 root 1.9 ["--bind ADDRESS[:PORT]", "Override the HTTP listen address or port"],
1104 root 1.43 ["--tls-cert FILE", "PEM certificate (and optionally key) for HTTPS"],
1105     ["--tls-key FILE", "PEM private key (or combined key/certificate PEM)"],
1106 root 1.9 ["--token TOKEN", "Set an accepted token (repeatable; replaces defaults)"],
1107 root 1.51 ["-s, --set KEY=VALUE", "Override a trusted instance setting (repeatable)"],
1108 root 1.9 ["--stdio", "Serve MCP on stdin/stdout; other listeners may remain"],
1109 root 1.43 ["--connect URL", "Connect to a multibroker at http[s]://host:port/token/alias"],
1110 root 1.21 ["--custom-instructions TEXT", "Describe when this server instance should be used"],
1111 root 1.23 ["--auto-allow TOOL[,ACTION[,CAPABILITY]]", "Add an ordered automatic allow rule (repeatable)"],
1112     ["--auto-deny TOOL[,ACTION[,CAPABILITY]]", "Add an ordered automatic deny rule (repeatable)"],
1113 root 1.27 ["--quiet", "Suppress routine tool activity and tool-failure logging"],
1114 root 1.44 ["--print-url[=USER] (--print-urls)", "Print enabled user URLs, or one exact user"],
1115 root 1.26 ["--tool-help", "Print registered tool descriptions and arguments, then exit"],
1116 root 1.48 ["--help", "Display this help and exit"],
1117 root 1.9 );
1118 root 1.19 $help .= _mcp_help_row (@$_) for @common;
1119 root 1.9
1120     if ($options && @$options) {
1121 root 1.12 $help .= "\n" . ($option_heading // "Application options:") . "\n"
1122     if ref $options->[0];
1123     for my $option (@$options) {
1124     if (ref $option) {
1125     $help .= _mcp_help_row (@$option);
1126     } else {
1127     $help .= "\n" unless $help =~ /\n\n\z/;
1128     $help .= "$option\n";
1129     }
1130     }
1131 root 1.9 }
1132     $help .= "\nExamples:\n$examples\n"
1133     if defined $examples && length $examples;
1134 root 1.45 $help .= "\nNamed users and URLs:\n"
1135     . " anyevent-mcp create-user chatgpt\n"
1136     . " $0 --print-urls # list URLs for all enabled users\n"
1137     . " $0 --print-url=chatgpt # select one user\n"
1138     . "A URL marked (connect) is the one used for browser, Vim, or reverse connections.\n"
1139     . "Users inherit from global, program, then instance; server restart is needed\n"
1140     . "after changing user definitions.\n";
1141 root 1.9
1142     $help
1143     }
1144    
1145 root 1.8 sub mcp_getoptions {
1146     require Getopt::Long;
1147     require AnyEvent::MCP::Config;
1148    
1149 root 1.13 my %settings = %{ref $_[0] eq "HASH" ? shift : {}};
1150 root 1.8 my $usage = delete $settings{usage}
1151 root 1.9 // "Usage: $0 [OPTION]... [ARG]...\n";
1152 root 1.13 my @help = delete @settings{qw(description options option_heading examples)};
1153 root 1.8 my %url = (%config, %settings);
1154     delete @url{qw(name bind stdio)};
1155 root 1.23 my @auto_rules;
1156 root 1.51 my %set;
1157 root 1.8
1158     Getopt::Long::GetOptions (
1159 root 1.13 AnyEvent::MCP::Config::http_getopt (\my $name, \my $bind, \my $print_url, \my @tokens),
1160 root 1.43 "tls-cert=s" => \my $tls_cert,
1161     "tls-key=s" => \my $tls_key,
1162 root 1.13 "stdio" => \my $stdio,
1163 root 1.17 "connect=s" => \my $connect,
1164 root 1.21 "custom-instructions=s" => \my $custom_instructions,
1165 root 1.23 "auto-allow=s" => sub { push @auto_rules, ["allow", $_[1]] },
1166     "auto-deny=s" => sub { push @auto_rules, ["deny", $_[1]] },
1167 root 1.51 "set|s=s" => sub {
1168     my ($key, $value) = $_[1] =~ /\A([^\s=]+)=(.*)\z/;
1169     defined $value or die "Invalid --set KEY=VALUE\n";
1170     $set{$key} = $value;
1171     },
1172 root 1.26 "tool-help" => \my $tool_help,
1173 root 1.27 "quiet" => \my $silent,
1174 root 1.48 "help" => \my $help,
1175 root 1.8 @_,
1176     ) or die $usage;
1177    
1178     if ($help) {
1179 root 1.19 print _mcp_help $usage, @help;
1180 root 1.8 exit;
1181     }
1182    
1183     $name = AnyEvent::MCP::Config::server_name ($name // $settings{name} // $config{name});
1184 root 1.51 if (%set) {
1185     my $instance = AnyEvent::MCP::Config->global->{section}{"instance $name"} ||= {};
1186     %$instance = (%$instance, %set);
1187     }
1188    
1189 root 1.27 _mcp_log_init ($name, $silent);
1190 root 1.8 my %server = (
1191     %settings,
1192     name => $name,
1193     (defined $bind ? (bind => $bind) : ()),
1194 root 1.43 (defined $tls_cert ? (tls_cert => $tls_cert) : ()),
1195     (defined $tls_key ? (tls_key => $tls_key) : ()),
1196 root 1.8 (@tokens ? (tokens => \@tokens) : ()),
1197     ($stdio ? (stdio => 1) : ()),
1198 root 1.17 (defined $connect ? (connect => $connect) : ()),
1199 root 1.21 (defined $custom_instructions ? (custom_instructions => $custom_instructions) : ()),
1200 root 1.23 (@auto_rules ? (auto_rules => \@auto_rules) : ()),
1201 root 1.26 ($tool_help ? (tool_help => 1) : ()),
1202 root 1.8 );
1203    
1204 root 1.44 if (defined $print_url) {
1205 root 1.43 my %options = (
1206     %url,
1207     (defined $tls_cert ? (tls_cert => $tls_cert) : ()),
1208     (defined $tls_key ? (tls_key => $tls_key) : ()),
1209     (@tokens ? (tokens => \@tokens) : ()),
1210     );
1211 root 1.8 my $global = AnyEvent::MCP::Config->global;
1212 root 1.16 $options{path} //= $global->{section}{"instance $name"}{path}
1213     // $global->{section}{"program " . AnyEvent::MCP::Config::program_name ()}{path} // "/";
1214 root 1.8 if (($options{auth} || "") eq "none") {
1215     !exists $options{tokens} or die "Cannot combine auth => none with tokens\n";
1216     }
1217     my $selected_bind = defined $bind ? $bind : ($settings{bind} // $config{bind});
1218 root 1.43 my %http = ($global->http_settings ($name, $selected_bind), %options);
1219 root 1.44 my @schemes = defined $http{tls_cert} || defined $http{tls_key}
1220     ? ("https", "http") : ($http{url_scheme} || "http");
1221     my $managed = ($http{auth} || "") ne "none"
1222     && !exists $options{tokens}
1223     && !exists $global->{section}{"instance $name"}{tokens}
1224     && !exists $global->{section}{"program " . AnyEvent::MCP::Config::program_name ()}{tokens};
1225    
1226     if ($managed) {
1227     my $saved = (ref $global)->new (file => $global->{file});
1228     $saved->{section}{global}{secret} eq $global->{section}{global}{secret}
1229     or die "MCP master secret is not persistently stored in $global->{file}\n";
1230     my $credentials = $global->user_credentials ($name);
1231     if (length $print_url) {
1232     @$credentials = grep $_->[0] eq $print_url, @$credentials;
1233     @$credentials or die "User '$print_url' is not enabled\n";
1234     }
1235     my $connect = $global->connect_user ($name);
1236     for my $entry (@$credentials) {
1237     my ($user, $principal, $token) = @$entry;
1238     for my $scheme (@schemes) {
1239     print $global->http_url ($name, $selected_bind, %options,
1240     tokens => [$token], url_scheme => $scheme),
1241     " # user $principal", ($user eq $connect ? " (connect)" : ""), "\n";
1242     }
1243     }
1244 root 1.43 } else {
1245 root 1.44 length $print_url
1246     and die "Cannot select a managed user with explicit tokens or auth=none\n";
1247     for my $scheme (@schemes) {
1248     print $global->http_url ($name, $selected_bind, %options, url_scheme => $scheme), "\n";
1249     }
1250 root 1.43 }
1251 root 1.8 exit;
1252     }
1253    
1254 root 1.33 \%server
1255 root 1.8 }
1256    
1257 root 1.20 sub _permission_options {
1258     my %kv = @_;
1259    
1260 root 1.23 if (my $rules = delete $kv{auto_rules}) {
1261 root 1.20 require AnyEvent::MCP::Server::Permissions;
1262     my $permissions = $kv{permissions} ||= AnyEvent::MCP::Server::Permissions->new;
1263 root 1.23 $permissions->auto_rules ($rules);
1264 root 1.20 }
1265    
1266     %kv
1267     }
1268    
1269 root 1.34 sub _server_options {
1270     my %kv = @_;
1271    
1272     if (exists $kv{server_name} || exists $kv{server_version}) {
1273     !exists $kv{server_info}
1274     or die "Cannot combine server_info with server_name/server_version\n";
1275    
1276     my $name = delete $kv{server_name};
1277     my $version = delete $kv{server_version};
1278     $kv{server_info} = {
1279     name => defined $name ? $name : "AnyEvent::MCP",
1280     version => defined $version ? "$version" : "$AnyEvent::MCP::VERSION",
1281     };
1282     }
1283    
1284     %kv
1285     }
1286    
1287 root 1.1 sub mcp_start {
1288 root 1.3 require AnyEvent::MCP::Config;
1289 root 1.1
1290 root 1.24 my %kv = (%config, @_);
1291 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1292 root 1.3 my $name = AnyEvent::MCP::Config::server_name ($kv{name});
1293 root 1.21 my $config_file = AnyEvent::MCP::Config::_file ();
1294     my $global = -e $config_file ? AnyEvent::MCP::Config->global : undef;
1295     my %ini = $global ? (
1296     %{$global->{section}{"program " . AnyEvent::MCP::Config::program_name ()} || {}},
1297     %{$global->{section}{"instance $name"} || {}},
1298     ) : ();
1299 root 1.24 if ($global) {
1300     my @rules = $global->auto_rules ($name);
1301     $kv{auto_rules} = [@{$kv{auto_rules} || []}, @rules] if @rules;
1302     }
1303 root 1.21 $kv{custom_instructions} = $ini{custom_instructions}
1304     if !exists $kv{custom_instructions} && exists $ini{custom_instructions};
1305 root 1.24 %kv = _permission_options (%kv);
1306 root 1.8 my $stdio = delete $kv{stdio};
1307 root 1.17 my $listen = delete $kv{listen};
1308     my $connect = delete $kv{connect};
1309     !($stdio && defined $connect) or die "Cannot combine --stdio and --connect\n";
1310     $stdio ||= !defined $connect && $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio";
1311 root 1.1
1312     $kv{name} = $name;
1313    
1314 root 1.17 if (!$listen) {
1315     return mcp_connect (%kv, connect => $connect) if defined $connect;
1316     return mcp_stdio (%kv) if $stdio;
1317     }
1318 root 1.1
1319 root 1.21 my %http = ($global ||= AnyEvent::MCP::Config->global)->http_settings ($name, delete $kv{bind});
1320 root 1.44 delete @http{qw(tokens connect_tokens token_users)} if ($kv{auth} || "") eq "none";
1321 root 1.17 my %options = (path => "/", %http, %kv);
1322 root 1.44 if (exists $kv{tokens}) {
1323     $options{connect_tokens} = $kv{tokens};
1324     delete $options{token_users};
1325     }
1326 root 1.8
1327 root 1.17 if ($stdio || defined $connect) {
1328     require AnyEvent::MCP::Server::HTTP;
1329 root 1.34 my $listener = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], _server_options (%options));
1330 root 1.17 $listener->listen;
1331     my $result = defined $connect
1332     ? mcp_connect (%kv, connect => $connect)
1333     : mcp_stdio (%kv);
1334     $listener->close;
1335     return $result
1336     }
1337    
1338     mcp_http (%options)
1339     }
1340    
1341     sub mcp_connect {
1342     require AnyEvent::MCP::Server::Connect;
1343 root 1.1
1344 root 1.34 my %kv = _server_options (%config, @_);
1345 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1346     my $server = AnyEvent::MCP::Server::Connect->new (toolsets => [$toolset], _permission_options (%kv));
1347 root 1.17 $server->start;
1348     _run ($server, 1)
1349 root 1.1 }
1350    
1351     sub mcp_stdio {
1352     require AnyEvent::MCP::Server::JSONL;
1353    
1354 root 1.34 my %kv = _permission_options (_server_options (%config, @_));
1355 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1356 root 1.11 my $idle_exit = delete $kv{idle_exit};
1357 root 1.1 binmode STDIN;
1358     binmode STDOUT;
1359     my $selected = select STDOUT;
1360     $| = 1;
1361     select $selected;
1362    
1363 root 1.11 my $server = AnyEvent::MCP::Server::JSONL->new (toolsets => [$toolset], %kv);
1364 root 1.1 $server->accept (\*STDIN, \*STDOUT);
1365 root 1.11
1366     if ($idle_exit) {
1367     $idle_exit =~ /\A[0-9]+(?:\.[0-9]+)?\z/ && $idle_exit > 0
1368     or die "invalid idle_exit seconds\n";
1369     if ($ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio") {
1370     my ($timer, $check);
1371     $check = sub {
1372     return if $server->{idle_exit_requested};
1373     if (grep $_->{mcp_active}, values %{$server->{connections} || {}}) {
1374     $timer = AnyEvent->timer (after => $idle_exit, cb => $check);
1375     } else {
1376     $server->request_idle_exit;
1377     }
1378     };
1379     my $schedule = sub {
1380     $timer = AnyEvent->timer (after => $idle_exit, cb => $check);
1381     };
1382     my $on_request = $server->{on_request};
1383     $server->{on_request} = sub {
1384     my ($server, $req) = @_;
1385 root 1.13
1386 root 1.11 if ($req->{method} ne "anyevent-mcp/shutdown") {
1387     $server->{idle_exit_requested} = 0;
1388     $schedule->();
1389     my $reply = $req->{on_reply};
1390     $req->{on_reply} = sub {
1391     $reply->(@_);
1392     $schedule->() unless $server->{_idle_shutting_down};
1393     };
1394     }
1395     $on_request->(@_) if $on_request;
1396     };
1397     my $on_close = $server->{on_close};
1398     $server->{on_close} = sub {
1399     undef $timer;
1400     $on_close->(@_) if $on_close;
1401     };
1402     $schedule->();
1403     }
1404     }
1405 root 1.1 _run $server
1406     }
1407    
1408     sub mcp_http {
1409     require AnyEvent::MCP::Server::HTTP;
1410    
1411 root 1.34 my %kv = _permission_options (_server_options (%config, @_));
1412 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1413     my $server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], %kv);
1414 root 1.1 $server->listen;
1415     _run $server
1416     }
1417    
1418     sub _run {
1419 root 1.17 my ($server, $keep_alive) = @_;
1420 root 1.1
1421     my $cv = AnyEvent->condvar;
1422     my $stopped;
1423     my $stop = sub { $cv->send unless $stopped++ };
1424     my $on_close = $server->{on_close};
1425     $server->{on_close} = sub {
1426     $on_close->(@_) if $on_close;
1427     $stop->();
1428     };
1429    
1430 root 1.17 if (!$keep_alive && $server->isa ("AnyEvent::MCP::Server::JSONL")) {
1431 root 1.1 my $on_connection_close = $server->{on_connection_close};
1432     $server->{on_connection_close} = sub {
1433     $on_connection_close->(@_) if $on_connection_close;
1434     $stop->();
1435     };
1436     }
1437    
1438     my @signals = map {
1439     AnyEvent->signal (signal => $_, cb => sub { $server->close })
1440     } qw(INT TERM);
1441    
1442     my $ok = eval {
1443     $server->event (start =>);
1444     $cv->recv;
1445     1
1446     };
1447     my $error = $@;
1448     $server->close;
1449     die $error unless $ok;
1450     return
1451     }
1452    
1453     1