ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MCP/lib/AnyEvent/MCP/Server/Simple.pm
Revision: 1.54
Committed: Sat Nov 7 17:09:30 2026 UTC (3 days, 15 hours ago) by root
Branch: MAIN
Changes since 1.53: +9 -2 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 root 1.53 mcp_permissions +AnyEvent::MCP::Server::Permissions->new (
304 root 1.15 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 root 1.54 the request. An application may veto shutdown with C<on_idle_shutdown>;
575     Simple retries after the configured interval if it is declined. HTTP servers,
576     ordinary clients and servers without this option are unaffected.
577 root 1.15
578     =back
579    
580     See L<AnyEvent::MCP::Server> for further protocol options and events.
581 root 1.11
582 root 1.53 =item mcp_permissions $object
583    
584     Select the L<AnyEvent::MCP::Server::Permissions> object used by the Simple
585     starters. If never called (and no explicit C<permissions> option is supplied),
586     Simple creates one automatically, named from the program and selected instance.
587     C<mcp_permissions undef> explicitly disables the permission system:
588     tool callbacks calling C<require_permission> then fail instead of prompting.
589     Applications can still pass C<permissions> through C<mcp_config> or startup
590     arguments when needed.
591    
592     The common C<--ask> option overrides the object's prompting mode, and CLI
593     automatic permission rules precede configured rules and rules originally
594     supplied with the object. Those rules are applied when starting the server,
595     not when C<mcp_permissions> is called. No permission object is created when
596     it is explicitly disabled.
597    
598 root 1.1 =item mcp_tool $name, $description, $input_schema, $callback->($req, $args)
599    
600     Registers a tool named C<$name> with C<$description> and the JSON Schema
601     hash reference C<$input_schema>. C<$description> is normalized like
602     C<instructions>.
603    
604     C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
605     and its C<< $req->{args} >> hash reference as C<$args>, for convenience.
606    
607     Tools complete the request with C<< $req->reply ($result) >>, or use
608     C<< $req->result ($data) >> and C<< $req->error ($message) >> for convenience.
609     Request context is available directly in
610     the hash, for example C<< $req->{tool} >> and C<< $req->{server} >>.
611    
612 root 1.33 =item $server_options = mcp_getoptions ({ %settings }, @getopt_options)
613 root 1.8
614 root 1.47 Parse the switches documented in L</COMMON COMMAND-LINE OPTIONS> alongside
615 root 1.8 application-specific L<Getopt::Long> option specifications:
616    
617     my $verbose;
618 root 1.33 my $options = mcp_getoptions (
619 root 1.9 {
620     usage => "Usage: $0 [OPTION]... WORKDIR\n",
621     description => "Provide example tools through MCP.",
622     option_heading => "Example options:",
623     options => [
624     ["--verbose", "Show additional diagnostics"],
625     ],
626     examples => " $0 --stdio ./project",
627     path => "/",
628     },
629 root 1.8 "verbose!" => \$verbose,
630     );
631     @ARGV == 1 or die "workdir required\n";
632 root 1.33 mcp_start %$options;
633 root 1.8
634 root 1.15 The optional leading hash accepts these help settings:
635    
636     =over
637    
638     =item usage => $text
639    
640     Usage synopsis, including its trailing newline. A default synopsis is
641     generated when omitted.
642    
643     =item description => $text
644    
645     Introductory help paragraph.
646    
647     =item options => [[$label, $description]...]
648    
649     Application option labels and descriptions. A plain string among the
650     pairs starts a new section; a string at the beginning replaces the
651     default section heading.
652    
653     =item option_heading => $text
654    
655     Initial section heading, defaulting to C<Application options:>.
656    
657     =item examples => $text
658    
659     Preformatted examples.
660    
661 root 1.52 =item without => [OPTION...]
662    
663     Exclude selected common options by their long names, for example
664     C<< without => ["ask"] >>. The parser rejects excluded switches, and
665     C<--help> omits them. All common options are enabled by default.
666    
667 root 1.15 =back
668    
669 root 1.47 See L</COMMON COMMAND-LINE OPTIONS> for the full reference to shared
670     server switches. Application-specific Getopt::Long options are parsed alongside them.
671 root 1.35
672     These switches also appear in C<--help>; application options are passed
673     through to L<Getopt::Long>. Other leading hash settings (e.g. C<path>,
674     C<auth>, C<url_scheme>) go to C<mcp_start>. Parse positional C<@ARGV>
675     in the application; C<mcp_getoptions> deliberately does not require them
676     for help or URL discovery. Default activity logging includes asynchronous
677     tool failures and formats time, program, instance and PID. Environment
678     C<PERL_ANYEVENT_LOG> can select destinations and verbosity.
679 root 1.8
680 root 1.26 =item mcp_tool_help ($enabled, @toolsets)
681    
682     If C<$enabled> is true, print the definitions registered in the supplied
683     L<AnyEvent::MCP::Server::Toolset> objects and exit. Otherwise do nothing.
684     Call after registering tools but before starting listeners for executables
685     which manage their own toolsets. Only registered tools appear.
686    
687 root 1.27 =item mcp_log $message
688    
689     Emit operator-facing activity to the configured AnyEvent::Log destination,
690     bypassing its diagnostic verbosity filter. C<--quiet> suppresses this log.
691    
692 root 1.38 =item mcp_log_request ($server, $req, %extra)
693 root 1.27
694     C<on_request> callback to report tool invocations once across permission
695 root 1.30 retries, and log tool-error replies, including asynchronous ones. It logs
696     selected arguments rather than entire request or reply payloads. This includes
697 root 1.39 JSON-quoted previews of command arguments and VCS filenames (up to four,
698     80 characters each), and Vim C<ex> commands (up to 200 characters).
699     These can contain sensitive text. The Simple starters install it by default;
700 root 1.30 custom servers can use it too.
701 root 1.38 C<%extra> appends application-specific C<key=value> fields in key order.
702     Sanitize sensitive arguments before passing them.
703 root 1.27
704 root 1.1 =item mcp_start %config
705    
706 root 1.15 Starts and runs the usual server. When C<stdio> is true or
707 root 1.1 C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL> is C<stdio>, uses C<mcp_stdio>.
708 root 1.4 Otherwise starts HTTP without printing its URL. HTTP-capable executables
709     provide C<--print-url> to retrieve the URL explicitly.
710 root 1.1
711 root 1.3 The HTTP defaults are IPv4 loopback, a stable name-derived port in
712     16384..32767, and C</> as the endpoint path.
713 root 1.7 Without explicit C<tokens>, one server-specific token is derived from
714     the private global secret. The selected token authenticates either its URL
715     path or an
716 root 1.5 C<Authorization: Bearer TOKEN> header at the clean URL returned by
717 root 1.6 C<< $server->url (0) >>. The corresponding executable's C<--print-url>
718     option prints the first accepted token in its URL.
719 root 1.1
720 root 1.10 C<name> selects the C<[instance NAME]> configuration section and credential.
721 root 1.16 It defaults to C<default>.
722 root 1.43 Named settings C<bind>, C<path>, C<url_host>, C<url_scheme>, C<tokens>,
723     C<tls_cert> and C<tls_key> are loaded from the global configuration.
724     Explicit C<tokens> (an ordered,
725 root 1.7 nonempty array reference of URL-safe strings) replaces the configured list
726     and the derived default. Every token works in the URL and bearer header.
727 root 1.3 An explicit C<bind> overrides the configured bind address. Other arguments
728 root 1.7 override these settings.
729 root 1.1
730     The global secret is generated automatically when needed; see
731     L<AnyEvent::MCP/GLOBAL CONFIGURATION>. No configuration is loaded for stdio.
732 root 1.53 Unless explicitly disabled using C<mcp_permissions undef>, Simple constructs
733     a default permission engine. C<--ask> and automatic permission rules configure
734     it along with any application-supplied permission object.
735 root 1.4 HTTP startup neither prints to stdout nor changes its buffering.
736 root 1.7 C<mcp_start> does not parse C<@ARGV>; applications parse their own options.
737 root 1.8 The bundled executables use C<mcp_getoptions>, which handles shared
738     options and URL discovery before starting the event loop.
739 root 1.1
740 root 1.17 =item mcp_connect %config
741    
742     Run a reverse-connecting JSONL server using C<connect =E<gt>
743 root 1.47 "http[s]://host:port/token/alias">. HTTPS verifies the server certificate
744     and hostname. It sends the authenticated extension hello only after the
745     transport is established, then serves MCP over the socket. Refused TCP
746     connections retry every second for at most sixty attempts, and unexpected
747     established disconnects start a new retry period. Other TCP setup and TLS
748     handshake errors are reported and stop the server.
749     Calls are cancelled rather than replayed.
750 root 1.17 This connection has no spawned-child lifecycle authority.
751    
752 root 1.1 =item mcp_stdio %config
753    
754     Creates and runs a server over stdin/stdout. Arguments override the collected
755     configuration. Stdout buffering is disabled. On stdin EOF, pending replies
756     finish and stdout drains before
757     this function returns. Stream errors close the connection and cancel pending
758     requests.
759    
760     =item mcp_http %config
761    
762     Creates and runs an HTTP server. For example:
763    
764     mcp_http
765     host => "127.0.0.1",
766     port => 31740,
767 root 1.7 path => "/mcp/",
768     tokens => ["your-long-random-secret"];
769 root 1.1
770     Arguments override the collected configuration. Unlike C<mcp_start>, this
771 root 1.8 function does not derive or supply authentication. B<Always> pass C<tokens>,
772     or explicitly pass C<auth =E<gt> "none"> when a trusted embedding layer
773     enforces access. Omitting both is an error, not an unauthenticated default.
774     It does not print a URL; use
775 root 1.7 C<on_start> for application-specific startup output. Neither function
776     implements OAuth or Basic authentication. See
777     L<AnyEvent::MCP::Server::HTTP/AUTHENTICATION> for details.
778 root 1.1
779     All three starters return when the server is closed or on C<SIGINT> or
780     C<SIGTERM>. Signal shutdown closes connections and cancels outstanding
781     requests. The signal watchers belong to the blocking call.
782    
783     =back
784    
785 root 1.47 =head1 COMMON COMMAND-LINE OPTIONS
786    
787     C<mcp_getoptions> parses these options for executables using
788     L<AnyEvent::MCP::Server::Simple>. The executable's own OPTIONS section
789     documents any additional switches or differences in shared-option behavior.
790 root 1.52 An application can exclude specific common switches via C<without>.
791 root 1.47
792     =over
793    
794     =item --name NAME
795    
796 root 1.52 Select the instance (default C<default>). NAME starts with an ASCII letter,
797     digit or underscore; subsequent characters may also contain C<.>, C<@>,
798     C<+> and C<->.
799 root 1.47 Selects C<[instance NAME]> configuration, derived HTTP port and credentials;
800     does not change the advertised MCP implementation name.
801     Example: C<--name project>.
802    
803     =item --bind ADDRESS[:PORT]
804    
805     Override HTTP listening address and port. Defaults to C<127.0.0.1> and a
806     stable instance-derived port in 16384..32767. C<:31740> uses the loopback
807     address and port 31740; C<127.0.0.1:31740> specifies both.
808     Port zero requests an ephemeral port and is incompatible with
809     C<--print-url>. Ignored for stdio-only startup.
810    
811     =item --tls-cert FILE
812    
813     Enable opportunistic HTTPS using a PEM certificate chain. Without
814     C<--tls-key>, FILE must also contain the private key. The same listener
815     continues to accept plain HTTP.
816    
817     =item --tls-key FILE
818    
819     Private-key PEM file for C<--tls-cert>. If supplied alone, FILE must
820     contain both certificate chain and private key. Requires C<Net::SSLeay>.
821    
822     =item --token TOKEN
823    
824     Accept TOKEN for HTTP authentication. Repeat to accept multiple tokens.
825     Explicit tokens replace configured or master-secret-derived defaults.
826     Tokens work both as credential-bearing URL components and with the
827     C<Authorization: Bearer TOKEN> header.
828     Example: C<--token first --token second>.
829    
830 root 1.51 =item -s, --set KEY=VALUE
831    
832     Override one trusted configuration entry for the selected instance in this
833     process. Applied after C<[program NAME]> and C<[instance NAME]> defaults,
834     without changing the configuration file. Repeat to override multiple entries;
835     the last assignment to a key wins. Empty values suppress inherited settings,
836     and additional equals signs belong to the value. The supported keys depend
837     on the server (for example, C<executable.perl> and C<prepend-path> in
838     L<mcp-fs>). Example: C<-s executable.perl=/opt/perl/bin/perl>.
839    
840 root 1.47 =item --stdio
841    
842     Serve MCP JSONL on stdin/stdout rather than the default HTTP listener.
843     Applications with auxiliary listeners can keep those active. Cannot
844     combine explicitly with C<--connect>.
845    
846     =item --connect URL
847    
848     Reverse-connect to an upstream multibroker. For example:
849     C<http://host:port/TOKEN/alias> or C<https://host:port/TOKEN/alias>.
850     HTTPS requires successful certificate and hostname verification; it
851     never falls back to plaintext. Replaces the default MCP listener and
852     overrides implicit stdio selection. Cannot combine with explicit
853     C<--stdio>.
854    
855     =item --custom-instructions TEXT
856    
857     Override configured instance-purpose guidance describing when MCP
858     clients should use the server.
859     Example: C<--custom-instructions 'Use for build logs'>.
860    
861     =item --auto-allow TOOL[,ACTION[,CAPABILITY]]
862    
863     Add a process-local permission allow rule, repeatable. TOOL identifies
864     the permission-checked tool; ACTION and CAPABILITY narrow the match.
865     Missing fields and C<*> match anything.
866     Example: C<--auto-allow '*,read,workdir-read'>.
867     Rules run in command-line order before saved rules; they cannot grant
868     permissions to tools that do not check permissions.
869     See L<AnyEvent::MCP::Server::Permissions/auto_rules>.
870    
871     =item --auto-deny TOOL[,ACTION[,CAPABILITY]]
872    
873     Add a repeatable process-local deny rule with the same matching syntax
874     and evaluation order as C<--auto-allow>.
875     Example: C<--auto-deny '*,exec'>.
876    
877 root 1.52 =item --ask MODE
878    
879     Choose how permissions or other human input are requested: C<helper>,
880     C<tty>, C<yad>, C<mcp>, or C<auto>. C<none> immediately declines requests
881     that would otherwise require prompting; existing allow and deny rules
882     still apply. Multibroker replies to downstream forms with a standard decline.
883     The default depends on the application and its multibroker environment.
884    
885 root 1.47 =item --quiet
886    
887     Suppress routine tool activity and tool-failure logging. Warnings and
888     ordinary diagnostics remain; C<PERL_ANYEVENT_LOG> determines diagnostic
889     levels and destinations.
890    
891     =item --print-url[=USER]
892    
893     Print credential-bearing URLs and exit without starting a listener.
894     With managed users, prints each effective enabled user's URL, or only
895     the exact username USER. Comments identify scope-qualified principals
896     and the selected auxiliary connection user. With configured TLS, HTTPS
897     is printed before HTTP. Explicit tokens retain a single-token output
898     and cannot be combined with a user selector. Requires a predictable,
899     nonzero port and a persistent master secret for derived credentials.
900     Example: C<--name project --print-url=claude>.
901    
902     =item --print-urls
903    
904     Alias for C<--print-url>.
905    
906     =item --tool-help
907    
908     Print currently registered tool names, descriptions, argument types,
909     required fields and defaults; exit without starting the MCP listener.
910     Registered tools can depend on installed utilities and application setup.
911    
912 root 1.48 =item --help
913 root 1.47
914     Print shared and application-specific command-line help; exit without
915     starting a server. Invalid options instead report usage.
916    
917     =back
918    
919 root 1.1 =cut
920    
921     package AnyEvent::MCP::Server::Simple;
922    
923     use common::sense;
924 root 1.46
925     use Exporter ();
926     use JSON::XS ();
927     use Scalar::Util qw(refaddr);
928    
929 root 1.1 use AnyEvent ();
930 root 1.40 use AnyEvent::Log ();
931 root 1.1 use AnyEvent::MCP ();
932     use AnyEvent::MCP::Server::Toolset ();
933    
934     our @ISA = qw(Exporter);
935 root 1.53 our @EXPORT = qw(mcp_config mcp_permissions mcp_tool mcp_getoptions mcp_tool_help mcp_log mcp_log_request mcp_start mcp_stdio mcp_http mcp_connect);
936 root 1.1
937 root 1.41 my %config = (
938     auto_instructions => 1,
939     on_request => \&mcp_log_request,
940 root 1.42 on_connection_error => sub {
941     my ($server, $handle, $error) = @_;
942     my $info = $handle->{mcp_peer}{client_info};
943     my $name = ref $info eq "HASH" ? $info->{name} : undef;
944     my @details = (
945     "id=" . sprintf ("%x", refaddr $handle),
946     defined $handle->{mcp_remote} ? "remote=$handle->{mcp_remote}" : (),
947     defined $name && !ref $name ? "client=" . JSON::XS::encode_json (substr $name, 0, 80) : (),
948     );
949 root 1.50 AE::log trace => "MCP connection " . join (" ", @details) . ": $error";
950 root 1.42 },
951 root 1.41 );
952 root 1.1 my $toolset = AnyEvent::MCP::Server::Toolset->new;
953 root 1.27 my $quiet;
954 root 1.1
955     sub _run;
956    
957 root 1.27 # operational messages go to the configured AnyEvent::Log destination,
958     # independently of the diagnostic verbosity filter.
959     sub mcp_log {
960     return if $quiet;
961     $AnyEvent::Log::LOG->log (info => @_);
962     }
963    
964     sub mcp_log_request {
965 root 1.38 my ($server, $req, %extra) = @_;
966 root 1.27
967     return unless $req->{method} eq "tools/call";
968     return if $req->{mcp_logged}++;
969    
970     my $args = $req->{args};
971 root 1.39 my $vcs = $req->{tool} =~ /\Avcs-(?:diff|status|log)\z/;
972 root 1.27 my @details;
973 root 1.39 for (qw(target workdir path cwd), $vcs ? "backend" : ()) {
974 root 1.27 push @details, "$_=" . (substr $args->{$_}, 0, 160)
975     if defined $args->{$_} && !ref $args->{$_};
976     }
977 root 1.36 push @details, substr +(join " ", @{$args->{ranges}}), 0, 180
978 root 1.27 if ref $args->{ranges} eq "ARRAY";
979 root 1.39 for my $key ("argv", $vcs ? "files" : ()) {
980     next unless ref $args->{$key} eq "ARRAY" && @{$args->{$key}};
981 root 1.31 require JSON::XS;
982 root 1.39 my @values = @{$args->{$key}};
983     push @details, "$key=" . join (" ", map {
984 root 1.31 JSON::XS::encode_json (substr $_, 0, 80) . (length $_ > 80 ? "..." : "")
985 root 1.39 } @values[0 .. ($#values < 3 ? $#values : 3)])
986     . (@values > 4 ? " ..." : "");
987 root 1.31 }
988     if ($req->{tool} eq "grep" && defined $args->{pattern} && !ref $args->{pattern}) {
989     require JSON::XS;
990     push @details, "pattern=" . JSON::XS::encode_json (substr $args->{pattern}, 0, 160)
991     . (length $args->{pattern} > 160 ? "..." : "");
992     }
993 root 1.29 push @details, "name=" . (substr $args->{name}, 0, 160)
994     if $req->{tool} eq "call-tool" && defined $args->{name} && !ref $args->{name};
995     if ($req->{tool} eq "ex" && defined $args->{command} && !ref $args->{command}) {
996     require JSON::XS;
997     push @details, "command=" . JSON::XS::encode_json (substr $args->{command}, 0, 200)
998     . (length $args->{command} > 200 ? "..." : "");
999     }
1000 root 1.28 if ($req->{tool} eq "path-op") {
1001     push @details, map {
1002     ($_ eq "unlink" || $_ eq "rmdir")
1003     ? ($args->{$_} ? $_ : ())
1004     : (defined $args->{$_} && !ref $args->{$_}
1005     ? "$_=" . (substr $args->{$_}, 0, 80) : ())
1006     } qw(unlink rmdir mkpath mkdir symlink truncate chmod rename);
1007     }
1008 root 1.38 for my $key (sort keys %extra) {
1009     next unless defined $extra{$key} && !ref $extra{$key};
1010     push @details, "$key=" . (substr $extra{$key}, 0, 160);
1011     }
1012 root 1.27
1013     (my $message = join " ", $req->{tool}, @details) =~ s/[\r\n]/ /g;
1014     mcp_log $message;
1015    
1016     my $reply = $req->{on_reply};
1017     $req->{on_reply} = sub {
1018     my ($req, $result) = @_;
1019    
1020     if ($result->{isError}) {
1021     my $message = ref $result->{content} eq "ARRAY"
1022     && ref $result->{content}[0] eq "HASH"
1023     ? $result->{content}[0]{text} // "unknown error" : "unknown error";
1024     $message =~ s/\n.*//s;
1025     mcp_log "$req->{tool} failed: " . (substr $message, 0, 240);
1026     }
1027     $reply->(@_);
1028     };
1029     }
1030    
1031     sub _mcp_log_init {
1032     my ($name, $silent) = @_;
1033    
1034     $quiet = $silent;
1035     my $identity = AnyEvent::MCP::Config::program_name () . "/$name" . "[$$]";
1036    
1037     no warnings 'redefine';
1038     *AnyEvent::Log::default_format = sub ($$$$) {
1039     my ($when, $ctx, $level, $message) = @_;
1040 root 1.36 my $stamp = substr +(AnyEvent::Log::format_time $when), 8, 14;
1041 root 1.27 my $source = $ctx == $AnyEvent::Log::LOG ? "" : "$AnyEvent::Log::LEVEL2STR[$level] $ctx->[0]: ";
1042     join "", map "$stamp $identity $source$_\n", split /\n/, $message;
1043     };
1044     }
1045    
1046 root 1.1 sub mcp_config {
1047     my %kv = @_;
1048    
1049     $kv{instructions} = AnyEvent::MCP::_clean_text $kv{instructions}
1050     if exists $kv{instructions};
1051    
1052 root 1.14 %config = (%config, %kv);
1053 root 1.1 }
1054    
1055 root 1.53 sub mcp_permissions {
1056     @_ == 1 or die "mcp_permissions expects one argument (object or undef)\n";
1057     $config{permissions} = $_[0];
1058     }
1059    
1060 root 1.1 sub mcp_tool {
1061     $toolset->tool (@_)
1062     }
1063    
1064 root 1.26 # format a JSON Schema type for command-line tool help.
1065     sub _tool_type {
1066     my ($schema) = @_;
1067     return "any" unless ref $schema eq "HASH";
1068     for my $key (qw(anyOf oneOf)) {
1069     return join "|", map _tool_type ($_), @{$schema->{$key}}
1070     if ref $schema->{$key} eq "ARRAY";
1071     }
1072     my $type = $schema->{type} // "any";
1073     $type = join "|", @$type if ref $type eq "ARRAY";
1074     $type = "array[" . _tool_type ($schema->{items}) . "]" if $type eq "array";
1075     $type
1076     }
1077    
1078     sub mcp_tool_help {
1079     my ($enabled, @toolsets) = @_;
1080     return unless $enabled;
1081    
1082     my $json = AnyEvent::MCP::json_class ()->new->canonical;
1083     my @tools = map @{$_->list}, @toolsets;
1084     for my $tool (@tools) {
1085     print "$tool->{name}\n";
1086     (my $description = $tool->{description} // "") =~ s/\n/\n /g;
1087     print " $description\n" if length $description;
1088    
1089     my $schema = $tool->{inputSchema} || {};
1090     my $properties = $schema->{properties} || {};
1091     my %required = map { $_ => 1 } @{$schema->{required} || []};
1092     for my $name (sort keys %$properties) {
1093     my $property = $properties->{$name};
1094     my $type = _tool_type ($property);
1095     my $status = $required{$name} ? "required" : "optional";
1096     my @extras;
1097     push @extras, "default: " . $json->encode ($property->{default})
1098     if exists $property->{default};
1099     push @extras, "values: " . join (", ", @{$property->{enum}})
1100     if ref $property->{enum} eq "ARRAY";
1101     print " $name $type $status", (@extras ? " (" . join ("; ", @extras) . ")" : ""), "\n";
1102     if (length ($property->{description} // "")) {
1103     (my $detail = $property->{description}) =~ s/\n/\n /g;
1104     print " $detail\n";
1105     }
1106     }
1107     print "\n";
1108     }
1109     print "No tools registered.\n" unless @tools;
1110     exit;
1111     }
1112    
1113 root 1.9 sub _mcp_help_row {
1114     my ($option, $description) = @_;
1115 root 1.13
1116 root 1.9 my $start = " $option";
1117     my $margin = " " x 34;
1118 root 1.13 my $out = length $start < 34 ? "" : "$start\n";
1119     my $line = length $start < 34 ? $start . (substr $margin, length $start) : $margin;
1120 root 1.9
1121     for my $word (split /\s+/, $description) {
1122 root 1.13 if (length $line > 34 && (length $line) + 1 + length $word > 79) {
1123 root 1.9 $out .= "$line\n";
1124     $line = $margin;
1125     }
1126 root 1.13
1127     $line .= " " if length $line > 34;
1128 root 1.9 $line .= $word;
1129     }
1130    
1131     "$out$line\n"
1132     }
1133    
1134     sub _mcp_help {
1135 root 1.52 my ($usage, $description, $options, $option_heading, $examples, $without) = @_;
1136 root 1.13
1137 root 1.9 $usage =~ s/\n*\z/\n/;
1138     my $help = $usage;
1139     $help .= "\n$description\n" if defined $description && length $description;
1140    
1141     $help .= "\nCommon options:\n";
1142     my @common = (
1143 root 1.25 ["--name NAME", "Select named configuration (instance defaults to 'default')"],
1144 root 1.9 ["--bind ADDRESS[:PORT]", "Override the HTTP listen address or port"],
1145 root 1.43 ["--tls-cert FILE", "PEM certificate (and optionally key) for HTTPS"],
1146     ["--tls-key FILE", "PEM private key (or combined key/certificate PEM)"],
1147 root 1.9 ["--token TOKEN", "Set an accepted token (repeatable; replaces defaults)"],
1148 root 1.51 ["-s, --set KEY=VALUE", "Override a trusted instance setting (repeatable)"],
1149 root 1.9 ["--stdio", "Serve MCP on stdin/stdout; other listeners may remain"],
1150 root 1.43 ["--connect URL", "Connect to a multibroker at http[s]://host:port/token/alias"],
1151 root 1.21 ["--custom-instructions TEXT", "Describe when this server instance should be used"],
1152 root 1.23 ["--auto-allow TOOL[,ACTION[,CAPABILITY]]", "Add an ordered automatic allow rule (repeatable)"],
1153     ["--auto-deny TOOL[,ACTION[,CAPABILITY]]", "Add an ordered automatic deny rule (repeatable)"],
1154 root 1.52 ["--ask MODE", "Prompt via helper, tty, yad, mcp, auto; none declines without prompting"],
1155 root 1.27 ["--quiet", "Suppress routine tool activity and tool-failure logging"],
1156 root 1.44 ["--print-url[=USER] (--print-urls)", "Print enabled user URLs, or one exact user"],
1157 root 1.26 ["--tool-help", "Print registered tool descriptions and arguments, then exit"],
1158 root 1.48 ["--help", "Display this help and exit"],
1159 root 1.9 );
1160 root 1.52 $help .= _mcp_help_row (@$_) for grep {
1161     my ($name) = $_->[0] =~ /--([a-z-]+)/;
1162     !$without->{$name}
1163     } @common;
1164 root 1.9
1165     if ($options && @$options) {
1166 root 1.12 $help .= "\n" . ($option_heading // "Application options:") . "\n"
1167     if ref $options->[0];
1168     for my $option (@$options) {
1169     if (ref $option) {
1170     $help .= _mcp_help_row (@$option);
1171     } else {
1172     $help .= "\n" unless $help =~ /\n\n\z/;
1173     $help .= "$option\n";
1174     }
1175     }
1176 root 1.9 }
1177     $help .= "\nExamples:\n$examples\n"
1178     if defined $examples && length $examples;
1179 root 1.45 $help .= "\nNamed users and URLs:\n"
1180     . " anyevent-mcp create-user chatgpt\n"
1181     . " $0 --print-urls # list URLs for all enabled users\n"
1182     . " $0 --print-url=chatgpt # select one user\n"
1183     . "A URL marked (connect) is the one used for browser, Vim, or reverse connections.\n"
1184     . "Users inherit from global, program, then instance; server restart is needed\n"
1185     . "after changing user definitions.\n";
1186 root 1.9
1187     $help
1188     }
1189    
1190 root 1.8 sub mcp_getoptions {
1191     require Getopt::Long;
1192     require AnyEvent::MCP::Config;
1193    
1194 root 1.13 my %settings = %{ref $_[0] eq "HASH" ? shift : {}};
1195 root 1.8 my $usage = delete $settings{usage}
1196 root 1.9 // "Usage: $0 [OPTION]... [ARG]...\n";
1197 root 1.13 my @help = delete @settings{qw(description options option_heading examples)};
1198 root 1.52 my %without = map { $_ => 1 } @{delete $settings{without} || []};
1199 root 1.8 my %url = (%config, %settings);
1200     delete @url{qw(name bind stdio)};
1201 root 1.23 my @auto_rules;
1202 root 1.51 my %set;
1203 root 1.8
1204 root 1.52 my @common = (
1205 root 1.13 AnyEvent::MCP::Config::http_getopt (\my $name, \my $bind, \my $print_url, \my @tokens),
1206 root 1.43 "tls-cert=s" => \my $tls_cert,
1207     "tls-key=s" => \my $tls_key,
1208 root 1.13 "stdio" => \my $stdio,
1209 root 1.17 "connect=s" => \my $connect,
1210 root 1.21 "custom-instructions=s" => \my $custom_instructions,
1211 root 1.23 "auto-allow=s" => sub { push @auto_rules, ["allow", $_[1]] },
1212     "auto-deny=s" => sub { push @auto_rules, ["deny", $_[1]] },
1213 root 1.51 "set|s=s" => sub {
1214     my ($key, $value) = $_[1] =~ /\A([^\s=]+)=(.*)\z/;
1215     defined $value or die "Invalid --set KEY=VALUE\n";
1216     $set{$key} = $value;
1217     },
1218 root 1.26 "tool-help" => \my $tool_help,
1219 root 1.27 "quiet" => \my $silent,
1220 root 1.52 "ask=s" => \my $ask,
1221 root 1.48 "help" => \my $help,
1222 root 1.52 );
1223     my @enabled;
1224     my %known;
1225     while (@common) {
1226     my ($option, $target) = splice @common, 0, 2;
1227     my ($name) = $option =~ /\A([a-z-]+)/;
1228     $known{$name} = 1;
1229     push @enabled, $option => $target unless $without{$name};
1230     }
1231     die "Unknown common option: " . join (", ", sort grep !$known{$_}, keys %without) . "\n"
1232     if grep !$known{$_}, keys %without;
1233     Getopt::Long::GetOptions (
1234     @enabled,
1235 root 1.8 @_,
1236     ) or die $usage;
1237 root 1.52 die "--ask must be helper, tty, yad, mcp, auto, or none\n"
1238     if defined $ask && $ask !~ /\A(?:helper|tty|yad|mcp|auto|none)\z/;
1239 root 1.8
1240     if ($help) {
1241 root 1.52 print _mcp_help $usage, @help, \%without;
1242 root 1.8 exit;
1243     }
1244    
1245 root 1.52 $name = AnyEvent::MCP::instance_name ($name // $settings{name} // $config{name});
1246 root 1.51 if (%set) {
1247     my $instance = AnyEvent::MCP::Config->global->{section}{"instance $name"} ||= {};
1248     %$instance = (%$instance, %set);
1249     }
1250    
1251 root 1.27 _mcp_log_init ($name, $silent);
1252 root 1.8 my %server = (
1253     %settings,
1254     name => $name,
1255     (defined $bind ? (bind => $bind) : ()),
1256 root 1.43 (defined $tls_cert ? (tls_cert => $tls_cert) : ()),
1257     (defined $tls_key ? (tls_key => $tls_key) : ()),
1258 root 1.8 (@tokens ? (tokens => \@tokens) : ()),
1259     ($stdio ? (stdio => 1) : ()),
1260 root 1.17 (defined $connect ? (connect => $connect) : ()),
1261 root 1.52 (defined $ask ? (ask => $ask) : ()),
1262 root 1.21 (defined $custom_instructions ? (custom_instructions => $custom_instructions) : ()),
1263 root 1.23 (@auto_rules ? (auto_rules => \@auto_rules) : ()),
1264 root 1.26 ($tool_help ? (tool_help => 1) : ()),
1265 root 1.8 );
1266    
1267 root 1.44 if (defined $print_url) {
1268 root 1.43 my %options = (
1269     %url,
1270     (defined $tls_cert ? (tls_cert => $tls_cert) : ()),
1271     (defined $tls_key ? (tls_key => $tls_key) : ()),
1272     (@tokens ? (tokens => \@tokens) : ()),
1273     );
1274 root 1.8 my $global = AnyEvent::MCP::Config->global;
1275 root 1.16 $options{path} //= $global->{section}{"instance $name"}{path}
1276     // $global->{section}{"program " . AnyEvent::MCP::Config::program_name ()}{path} // "/";
1277 root 1.8 if (($options{auth} || "") eq "none") {
1278     !exists $options{tokens} or die "Cannot combine auth => none with tokens\n";
1279     }
1280     my $selected_bind = defined $bind ? $bind : ($settings{bind} // $config{bind});
1281 root 1.43 my %http = ($global->http_settings ($name, $selected_bind), %options);
1282 root 1.44 my @schemes = defined $http{tls_cert} || defined $http{tls_key}
1283     ? ("https", "http") : ($http{url_scheme} || "http");
1284     my $managed = ($http{auth} || "") ne "none"
1285     && !exists $options{tokens}
1286     && !exists $global->{section}{"instance $name"}{tokens}
1287     && !exists $global->{section}{"program " . AnyEvent::MCP::Config::program_name ()}{tokens};
1288    
1289     if ($managed) {
1290     my $saved = (ref $global)->new (file => $global->{file});
1291     $saved->{section}{global}{secret} eq $global->{section}{global}{secret}
1292     or die "MCP master secret is not persistently stored in $global->{file}\n";
1293     my $credentials = $global->user_credentials ($name);
1294     if (length $print_url) {
1295     @$credentials = grep $_->[0] eq $print_url, @$credentials;
1296     @$credentials or die "User '$print_url' is not enabled\n";
1297     }
1298     my $connect = $global->connect_user ($name);
1299     for my $entry (@$credentials) {
1300     my ($user, $principal, $token) = @$entry;
1301     for my $scheme (@schemes) {
1302     print $global->http_url ($name, $selected_bind, %options,
1303     tokens => [$token], url_scheme => $scheme),
1304     " # user $principal", ($user eq $connect ? " (connect)" : ""), "\n";
1305     }
1306     }
1307 root 1.43 } else {
1308 root 1.44 length $print_url
1309     and die "Cannot select a managed user with explicit tokens or auth=none\n";
1310     for my $scheme (@schemes) {
1311     print $global->http_url ($name, $selected_bind, %options, url_scheme => $scheme), "\n";
1312     }
1313 root 1.43 }
1314 root 1.8 exit;
1315     }
1316    
1317 root 1.33 \%server
1318 root 1.8 }
1319    
1320 root 1.20 sub _permission_options {
1321     my %kv = @_;
1322    
1323 root 1.53 my $rules = delete $kv{auto_rules};
1324     my $ask = delete $kv{ask};
1325     unless (exists $kv{permissions}) {
1326 root 1.20 require AnyEvent::MCP::Server::Permissions;
1327 root 1.53 require AnyEvent::MCP::Config;
1328     $kv{permissions} = AnyEvent::MCP::Server::Permissions->new (
1329     name => AnyEvent::MCP::Config::program_name () . "-" . AnyEvent::MCP::instance_name ($kv{name}),
1330     );
1331     }
1332     if (my $permissions = $kv{permissions}) {
1333     $permissions->{ask} = $ask if defined $ask;
1334     $permissions->auto_rules ($rules, 1) if $rules && @$rules;
1335 root 1.20 }
1336    
1337     %kv
1338     }
1339    
1340 root 1.34 sub _server_options {
1341     my %kv = @_;
1342    
1343     if (exists $kv{server_name} || exists $kv{server_version}) {
1344     !exists $kv{server_info}
1345     or die "Cannot combine server_info with server_name/server_version\n";
1346    
1347     my $name = delete $kv{server_name};
1348     my $version = delete $kv{server_version};
1349     $kv{server_info} = {
1350     name => defined $name ? $name : "AnyEvent::MCP",
1351     version => defined $version ? "$version" : "$AnyEvent::MCP::VERSION",
1352     };
1353     }
1354    
1355     %kv
1356     }
1357    
1358 root 1.1 sub mcp_start {
1359 root 1.3 require AnyEvent::MCP::Config;
1360 root 1.1
1361 root 1.24 my %kv = (%config, @_);
1362 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1363 root 1.52 my $name = AnyEvent::MCP::instance_name ($kv{name});
1364 root 1.21 my $config_file = AnyEvent::MCP::Config::_file ();
1365     my $global = -e $config_file ? AnyEvent::MCP::Config->global : undef;
1366     my %ini = $global ? (
1367     %{$global->{section}{"program " . AnyEvent::MCP::Config::program_name ()} || {}},
1368     %{$global->{section}{"instance $name"} || {}},
1369     ) : ();
1370 root 1.24 if ($global) {
1371     my @rules = $global->auto_rules ($name);
1372     $kv{auto_rules} = [@{$kv{auto_rules} || []}, @rules] if @rules;
1373     }
1374 root 1.21 $kv{custom_instructions} = $ini{custom_instructions}
1375     if !exists $kv{custom_instructions} && exists $ini{custom_instructions};
1376 root 1.24 %kv = _permission_options (%kv);
1377 root 1.8 my $stdio = delete $kv{stdio};
1378 root 1.17 my $listen = delete $kv{listen};
1379     my $connect = delete $kv{connect};
1380     !($stdio && defined $connect) or die "Cannot combine --stdio and --connect\n";
1381     $stdio ||= !defined $connect && $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio";
1382 root 1.1
1383     $kv{name} = $name;
1384    
1385 root 1.17 if (!$listen) {
1386     return mcp_connect (%kv, connect => $connect) if defined $connect;
1387     return mcp_stdio (%kv) if $stdio;
1388     }
1389 root 1.1
1390 root 1.21 my %http = ($global ||= AnyEvent::MCP::Config->global)->http_settings ($name, delete $kv{bind});
1391 root 1.44 delete @http{qw(tokens connect_tokens token_users)} if ($kv{auth} || "") eq "none";
1392 root 1.17 my %options = (path => "/", %http, %kv);
1393 root 1.44 if (exists $kv{tokens}) {
1394     $options{connect_tokens} = $kv{tokens};
1395     delete $options{token_users};
1396     }
1397 root 1.8
1398 root 1.17 if ($stdio || defined $connect) {
1399     require AnyEvent::MCP::Server::HTTP;
1400 root 1.34 my $listener = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], _server_options (%options));
1401 root 1.17 $listener->listen;
1402     my $result = defined $connect
1403     ? mcp_connect (%kv, connect => $connect)
1404     : mcp_stdio (%kv);
1405     $listener->close;
1406     return $result
1407     }
1408    
1409     mcp_http (%options)
1410     }
1411    
1412     sub mcp_connect {
1413     require AnyEvent::MCP::Server::Connect;
1414 root 1.1
1415 root 1.34 my %kv = _server_options (%config, @_);
1416 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1417     my $server = AnyEvent::MCP::Server::Connect->new (toolsets => [$toolset], _permission_options (%kv));
1418 root 1.17 $server->start;
1419     _run ($server, 1)
1420 root 1.1 }
1421    
1422     sub mcp_stdio {
1423     require AnyEvent::MCP::Server::JSONL;
1424    
1425 root 1.34 my %kv = _permission_options (_server_options (%config, @_));
1426 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1427 root 1.11 my $idle_exit = delete $kv{idle_exit};
1428 root 1.1 binmode STDIN;
1429     binmode STDOUT;
1430     my $selected = select STDOUT;
1431     $| = 1;
1432     select $selected;
1433    
1434 root 1.11 my $server = AnyEvent::MCP::Server::JSONL->new (toolsets => [$toolset], %kv);
1435 root 1.1 $server->accept (\*STDIN, \*STDOUT);
1436 root 1.11
1437     if ($idle_exit) {
1438     $idle_exit =~ /\A[0-9]+(?:\.[0-9]+)?\z/ && $idle_exit > 0
1439     or die "invalid idle_exit seconds\n";
1440     if ($ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio") {
1441     my ($timer, $check);
1442     $check = sub {
1443     return if $server->{idle_exit_requested};
1444     if (grep $_->{mcp_active}, values %{$server->{connections} || {}}) {
1445     $timer = AnyEvent->timer (after => $idle_exit, cb => $check);
1446     } else {
1447     $server->request_idle_exit;
1448     }
1449     };
1450     my $schedule = sub {
1451     $timer = AnyEvent->timer (after => $idle_exit, cb => $check);
1452     };
1453 root 1.54 my $on_idle_shutdown = $server->{on_idle_shutdown};
1454     $server->{on_idle_shutdown} = sub {
1455     my $allowed = !$on_idle_shutdown || $on_idle_shutdown->(@_);
1456     $schedule->() unless $allowed;
1457     $allowed
1458     };
1459 root 1.11 my $on_request = $server->{on_request};
1460     $server->{on_request} = sub {
1461     my ($server, $req) = @_;
1462 root 1.13
1463 root 1.11 if ($req->{method} ne "anyevent-mcp/shutdown") {
1464     $server->{idle_exit_requested} = 0;
1465     $schedule->();
1466     my $reply = $req->{on_reply};
1467     $req->{on_reply} = sub {
1468     $reply->(@_);
1469     $schedule->() unless $server->{_idle_shutting_down};
1470     };
1471     }
1472     $on_request->(@_) if $on_request;
1473     };
1474     my $on_close = $server->{on_close};
1475     $server->{on_close} = sub {
1476     undef $timer;
1477     $on_close->(@_) if $on_close;
1478     };
1479     $schedule->();
1480     }
1481     }
1482 root 1.1 _run $server
1483     }
1484    
1485     sub mcp_http {
1486     require AnyEvent::MCP::Server::HTTP;
1487    
1488 root 1.34 my %kv = _permission_options (_server_options (%config, @_));
1489 root 1.26 mcp_tool_help (delete $kv{tool_help}, @{$kv{toolsets} || [$toolset]});
1490     my $server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], %kv);
1491 root 1.1 $server->listen;
1492     _run $server
1493     }
1494    
1495     sub _run {
1496 root 1.17 my ($server, $keep_alive) = @_;
1497 root 1.1
1498     my $cv = AnyEvent->condvar;
1499     my $stopped;
1500     my $stop = sub { $cv->send unless $stopped++ };
1501     my $on_close = $server->{on_close};
1502     $server->{on_close} = sub {
1503     $on_close->(@_) if $on_close;
1504     $stop->();
1505     };
1506    
1507 root 1.17 if (!$keep_alive && $server->isa ("AnyEvent::MCP::Server::JSONL")) {
1508 root 1.1 my $on_connection_close = $server->{on_connection_close};
1509     $server->{on_connection_close} = sub {
1510     $on_connection_close->(@_) if $on_connection_close;
1511     $stop->();
1512     };
1513     }
1514    
1515     my @signals = map {
1516     AnyEvent->signal (signal => $_, cb => sub { $server->close })
1517     } qw(INT TERM);
1518    
1519     my $ok = eval {
1520     $server->event (start =>);
1521     $cv->recv;
1522     1
1523     };
1524     my $error = $@;
1525     $server->close;
1526     die $error unless $ok;
1527     return
1528     }
1529    
1530     1