MCP/Server/Toolset.pm

=head1 NAME

AnyEvent::MCP::Server::Toolset - MCP tool declarations and callbacks

=head1 DESCRIPTION

A Toolset answers two questions: which tools exist, and what code should run
when one is called? It holds tool declarations and their callbacks, but no
transport or client state. You can therefore give the same Toolset to
several servers without copying or re-registering the tools.

If your program only needs one standalone server, the function interface in
L<AnyEvent::MCP::Server::Simple> manages a default Toolset for you.

=head1 REQUEST AND TOOL WORKFLOW

Register tools with C<tool>, then pass the Toolset to a server through its
C<toolsets> option. The server handles the protocol and transport; the Toolset
supplies declarations for C<tools/list> and callbacks for C<tools/call>.

For a tool call, the server creates an L<AnyEvent::MCP::Server::Request>,
sets C<< $req->{tool} >> and C<< $req->{args} >>, and calls its C<on_request>
hook. It then finds the first Toolset containing that tool and invokes its
callback as C<$callback->($req, $args)>. C<$args> is the same hash reference
as C<< $req->{args} >>; C<< $req->{toolset} >> identifies the invoking Toolset.

The input schema describes the arguments to the client; the server does not
validate arguments against it. The handler must validate the arguments it
uses and complete the request with one reply.

=head2 Permission checks and retries

Configure the server's C<permissions> option with an
L<AnyEvent::MCP::Server::Permissions> object. The handler can check several
paths or operations in sequence:

   sub {
      my ($req, $args) = @_;

      my $source_grant = $req->require_permission ({
         tool => $req->{tool}, subject => $args->{source},
         subjects => [{ label => "source file", subject => $args->{source} }],
         action => "read", sandbox_grants => ["workdir-read"],
         reason => "read the source file",
      });

      my $destination_grant = $req->require_permission ({
         tool => $req->{tool}, subject => $args->{destination},
         subjects => [{ label => "destination file", subject => $args->{destination} }],
         action => "write", sandbox_grants => ["workdir-write"],
         reason => "write the destination file",
      });

      ... # read using $source_grant, write using $destination_grant
      $req->result ({ ... });
   }

This example assumes both paths are inside the selected workdir and that
the application enforces the returned grants. C<action> chooses the kind
of operation to authorize; C<sandbox_grants> chooses the worker's authority.
Grant names and their implications belong to the application.
C<require_permission> returns the granted sandbox-grant array reference,
which may be smaller than the requested set. Execute using those grants
rather than assuming that everything requested was allowed.

Grants are separate; Server does not combine them. When reading the source
and writing the destination separately, use each grant for its corresponding
operation.

Combining authority is needed when one operation spans several subjects,
such as renaming a file. Request the required action and sandbox grants for
every affected path: a rename needs write authority for both source and
destination, unlike the read/write example above. Check that every grant
still permits the operation after any reductions. For an application using
C<workdir-write> for a rename within one workdir, after requesting that grant
for both paths:

   my $permissions = $req->{server}{permissions};
   my $source = $permissions->closure ($source_grant);
   my $destination = $permissions->closure ($destination_grant);

   $source->{"workdir-write"} && $destination->{"workdir-write"}
      or die "Rename needs write permission for both paths\n";

C<closure> includes implied sandbox grants. If the operation needs one
combined grant set, use the intersection of these closures, rather than their
union: authority granted for one path must not authorize the other.
Do this before starting the operation.

A denial dies and becomes a tool error. The first missing permission throws
a special exception: Server catches it and asks. Modern MCP asking replies
with C<input_required>; the client supplies the answer in a repeated call.
Local asking, including the legacy fallback, retries the handler internally.
An explicit local asking configuration also applies to modern callers.

The handler starts again from the beginning, including the server's
C<on_request> hook. Earlier one-time grants survive these retries but do not
authorize another tool invocation. Current rules are rechecked, so a new
denial can supersede an earlier approval.

Complete all checks before side effects or asynchronous work. Do not catch
the permission-needed exception as an ordinary tool failure; it must reach
the server's synchronous dispatch boundary. A deferred callback cannot use
that boundary to restart the handler.

=head2 Replies and failures

=over

=item $req->reply ($result)

Sends the MCP result hash reference as supplied. Use this for arbitrary
content, structured errors or large results. The server adds the JSON-RPC
envelope.

=item $req->result ($data)

Sends the hash reference C<$data> as C<structuredContent> and also as JSON in
one text content item. This duplicates the data for clients that consume
only text; use C<reply> when that representation is unsuitable.

=item $req->error ($message)

Sends a tool result with C<isError> set and C<$message> as one text item.

=back

A synchronous handler exception becomes a tool error. Tool failures do not
become JSON-RPC errors; malformed protocol requests and unknown tools are
handled by Server.

Reply exactly once. Replying after completion is a bug and dies. A reply
finishes the request, but returning from the callback does not.

=head2 Asynchronous work and cancellation

The callback may keep C<$req> and return without replying. Reply when the
operation completes. The callback runs in the event loop; use asynchronous
operations rather than blocking it.

Set C<< $req->{on_cancel} >> to stop an outstanding operation. Cancellation
sets C<< $req->{cancelled} >> and C<< $req->{finished} >> and sends no reply.
A late completion callback must check C<< $req->{finished} >> before replying.

Server catches exceptions during synchronous dispatch, not exceptions in
later application callbacks. Such callbacks must handle their own failures.

C<< $req->progress ($progress, $total, $message) >> reports progress when
the client supplied a progress token. Delivery is best effort and may be
dropped by the transport; it does not complete the request.

=head1 METHODS

=over

=item $toolset = AnyEvent::MCP::Server::Toolset->new

Creates an empty tool registry.

=item $toolset->tool ($name, $description, $input_schema, $callback->($req, $args))

Registers a tool named C<$name>. Underscores are converted to hyphens and
duplicate names are rejected.

C<$description> is stripped of surrounding whitespace and common indentation.
C<$input_schema> is a JSON Schema hash reference describing the arguments.

C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
and its C<< $req->{args} >> hash reference as C<$args>, for convenience:

   sub {
      my ($req, $args) = @_;

      $req->reply ({
         content => [{ type => "text", text => $args->{text} }],
      });
   }

Registered tools are callbacks, not methods of the Toolset.

=item $definitions = $toolset->list

Returns the array reference of MCP tool definitions in registration order.
C<$definitions> contains no callbacks.

=item $toolset->call ($req)

Invokes the tool named by C<< $req->{tool} >> with C<$req> and
C<< $req->{args} >>. Sets C<< $req->{toolset} >> to this Toolset.

Unknown names and exceptions from the callback are left for the server to
handle.

=back

=cut

package AnyEvent::MCP::Server::Toolset;

use common::sense;
use AnyEvent::MCP ();

our @ISA = qw(AnyEvent::MCP::Base);

sub new {
   my $class = shift;

   $class->SUPER::new (tool => {}, list => [], @_)
}

sub tool {
   my ($self, $name, $description, $input_schema, $callback) = @_;

   $name =~ y/_/-/;

   !exists $self->{tool}{$name}
      or die "duplicate MCP tool '$name'\n";

   my $definition = {
      name        => $name,
      description => AnyEvent::MCP::_clean_text $description,
      inputSchema => $input_schema,
   };

   $self->{tool}{$name} = {
      definition => $definition,
      callback   => $callback,
   };

   push @{$self->{list}}, $definition;
}

sub list {
   $_[0]{list}
}

sub call {
   my ($self, $req) = @_;

   my $name = $req->{tool};

   my $tool = $self->{tool}{$name}
      or die "unknown MCP tool '$name'\n";

   $req->{toolset} = $self;
   $tool->{callback}->($req, $req->{args})
}

1
Revision:	1.4
Committed:	Tue Oct 13 22:54:22 2026 UTC (3 weeks, 6 days ago) by root
Branch:	MAIN
Changes since 1.3:	+21 -15 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::Server::Toolset - MCP tool declarations and callbacks
4
5			=head1 DESCRIPTION
6
7	root	1.2	A Toolset answers two questions: which tools exist, and what code should run
8			when one is called? It holds tool declarations and their callbacks, but no
9			transport or client state. You can therefore give the same Toolset to
10			several servers without copying or re-registering the tools.
11
12			If your program only needs one standalone server, the function interface in
13			L<AnyEvent::MCP::Server::Simple> manages a default Toolset for you.
14	root	1.1
15			=head1 REQUEST AND TOOL WORKFLOW
16
17			Register tools with C<tool>, then pass the Toolset to a server through its
18			C<toolsets> option. The server handles the protocol and transport; the Toolset
19			supplies declarations for C<tools/list> and callbacks for C<tools/call>.
20
21			For a tool call, the server creates an L<AnyEvent::MCP::Server::Request>,
22			sets C<< $req->{tool} >> and C<< $req->{args} >>, and calls its C<on_request>
23			hook. It then finds the first Toolset containing that tool and invokes its
24			callback as C<$callback->($req, $args)>. C<$args> is the same hash reference
25			as C<< $req->{args} >>; C<< $req->{toolset} >> identifies the invoking Toolset.
26
27			The input schema describes the arguments to the client; the server does not
28			validate arguments against it. The handler must validate the arguments it
29			uses and complete the request with one reply.
30
31			=head2 Permission checks and retries
32
33			Configure the server's C<permissions> option with an
34			L<AnyEvent::MCP::Server::Permissions> object. The handler can check several
35			paths or operations in sequence:
36
37			sub {
38			my ($req, $args) = @_;
39
40			my $source_grant = $req->require_permission ({
41			tool => $req->{tool}, subject => $args->{source},
42			subjects => [{ label => "source file", subject => $args->{source} }],
43	root	1.4	action => "read", sandbox_grants => ["workdir-read"],
44			reason => "read the source file",
45	root	1.1	});
46
47			my $destination_grant = $req->require_permission ({
48			tool => $req->{tool}, subject => $args->{destination},
49			subjects => [{ label => "destination file", subject => $args->{destination} }],
50	root	1.4	action => "write", sandbox_grants => ["workdir-write"],
51			reason => "write the destination file",
52	root	1.1	});
53
54			... # read using $source_grant, write using $destination_grant
55			$req->result ({ ... });
56			}
57
58	root	1.4	This example assumes both paths are inside the selected workdir and that
59			the application enforces the returned grants. C<action> chooses the kind
60			of operation to authorize; C<sandbox_grants> chooses the worker's authority.
61			Grant names and their implications belong to the application.
62			C<require_permission> returns the granted sandbox-grant array reference,
63			which may be smaller than the requested set. Execute using those grants
64			rather than assuming that everything requested was allowed.
65	root	1.1
66			Grants are separate; Server does not combine them. When reading the source
67			and writing the destination separately, use each grant for its corresponding
68			operation.
69
70			Combining authority is needed when one operation spans several subjects,
71	root	1.4	such as renaming a file. Request the required action and sandbox grants for
72			every affected path: a rename needs write authority for both source and
73			destination, unlike the read/write example above. Check that every grant
74			still permits the operation after any reductions. For an application using
75			C<workdir-write> for a rename within one workdir, after requesting that grant
76			for both paths:
77	root	1.1
78			my $permissions = $req->{server}{permissions};
79			my $source = $permissions->closure ($source_grant);
80			my $destination = $permissions->closure ($destination_grant);
81
82	root	1.4	$source->{"workdir-write"} && $destination->{"workdir-write"}
83			or die "Rename needs write permission for both paths\n";
84	root	1.1
85	root	1.4	C<closure> includes implied sandbox grants. If the operation needs one
86			combined grant set, use the intersection of these closures, rather than their
87	root	1.1	union: authority granted for one path must not authorize the other.
88			Do this before starting the operation.
89
90			A denial dies and becomes a tool error. The first missing permission throws
91			a special exception: Server catches it and asks. Modern MCP asking replies
92			with C<input_required>; the client supplies the answer in a repeated call.
93			Local asking, including the legacy fallback, retries the handler internally.
94			An explicit local asking configuration also applies to modern callers.
95
96			The handler starts again from the beginning, including the server's
97			C<on_request> hook. Earlier one-time grants survive these retries but do not
98			authorize another tool invocation. Current rules are rechecked, so a new
99			denial can supersede an earlier approval.
100
101			Complete all checks before side effects or asynchronous work. Do not catch
102			the permission-needed exception as an ordinary tool failure; it must reach
103			the server's synchronous dispatch boundary. A deferred callback cannot use
104			that boundary to restart the handler.
105
106			=head2 Replies and failures
107
108			=over
109
110			=item $req->reply ($result)
111
112			Sends the MCP result hash reference as supplied. Use this for arbitrary
113			content, structured errors or large results. The server adds the JSON-RPC
114			envelope.
115
116			=item $req->result ($data)
117
118			Sends the hash reference C<$data> as C<structuredContent> and also as JSON in
119			one text content item. This duplicates the data for clients that consume
120			only text; use C<reply> when that representation is unsuitable.
121
122			=item $req->error ($message)
123
124			Sends a tool result with C<isError> set and C<$message> as one text item.
125
126			=back
127
128			A synchronous handler exception becomes a tool error. Tool failures do not
129			become JSON-RPC errors; malformed protocol requests and unknown tools are
130			handled by Server.
131
132			Reply exactly once. Replying after completion is a bug and dies. A reply
133			finishes the request, but returning from the callback does not.
134
135			=head2 Asynchronous work and cancellation
136
137			The callback may keep C<$req> and return without replying. Reply when the
138			operation completes. The callback runs in the event loop; use asynchronous
139			operations rather than blocking it.
140
141			Set C<< $req->{on_cancel} >> to stop an outstanding operation. Cancellation
142			sets C<< $req->{cancelled} >> and C<< $req->{finished} >> and sends no reply.
143			A late completion callback must check C<< $req->{finished} >> before replying.
144
145			Server catches exceptions during synchronous dispatch, not exceptions in
146			later application callbacks. Such callbacks must handle their own failures.
147
148			C<< $req->progress ($progress, $total, $message) >> reports progress when
149			the client supplied a progress token. Delivery is best effort and may be
150			dropped by the transport; it does not complete the request.
151
152			=head1 METHODS
153
154			=over
155
156			=item $toolset = AnyEvent::MCP::Server::Toolset->new
157
158			Creates an empty tool registry.
159
160			=item $toolset->tool ($name, $description, $input_schema, $callback->($req, $args))
161
162			Registers a tool named C<$name>. Underscores are converted to hyphens and
163			duplicate names are rejected.
164
165			C<$description> is stripped of surrounding whitespace and common indentation.
166			C<$input_schema> is a JSON Schema hash reference describing the arguments.
167
168			C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
169			and its C<< $req->{args} >> hash reference as C<$args>, for convenience:
170
171			sub {
172			my ($req, $args) = @_;
173
174			$req->reply ({
175			content => [{ type => "text", text => $args->{text} }],
176			});
177			}
178
179			Registered tools are callbacks, not methods of the Toolset.
180
181			=item $definitions = $toolset->list
182
183			Returns the array reference of MCP tool definitions in registration order.
184			C<$definitions> contains no callbacks.
185
186			=item $toolset->call ($req)
187
188			Invokes the tool named by C<< $req->{tool} >> with C<$req> and
189			C<< $req->{args} >>. Sets C<< $req->{toolset} >> to this Toolset.
190
191			Unknown names and exceptions from the callback are left for the server to
192			handle.
193
194			=back
195
196			=cut
197
198			package AnyEvent::MCP::Server::Toolset;
199
200			use common::sense;
201			use AnyEvent::MCP ();
202
203			our @ISA = qw(AnyEvent::MCP::Base);
204
205			sub new {
206			my $class = shift;
207
208			$class->SUPER::new (tool => {}, list => [], @_)
209			}
210
211			sub tool {
212			my ($self, $name, $description, $input_schema, $callback) = @_;
213
214			$name =~ y/_/-/;
215
216	root	1.3	!exists $self->{tool}{$name}
217			or die "duplicate MCP tool '$name'\n";
218	root	1.1
219			my $definition = {
220			name => $name,
221			description => AnyEvent::MCP::_clean_text $description,
222			inputSchema => $input_schema,
223			};
224
225			$self->{tool}{$name} = {
226			definition => $definition,
227			callback => $callback,
228			};
229
230			push @{$self->{list}}, $definition;
231			}
232
233			sub list {
234			$_[0]{list}
235			}
236
237			sub call {
238			my ($self, $req) = @_;
239	root	1.3
240	root	1.1	my $name = $req->{tool};
241
242			my $tool = $self->{tool}{$name}
243			or die "unknown MCP tool '$name'\n";
244
245			$req->{toolset} = $self;
246			$tool->{callback}->($req, $req->{args})
247			}
248
249			1