Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-MCP for openSUSE:Factory checked in at 2026-06-29 17:30:23 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-MCP (Old) and /work/SRC/openSUSE:Factory/.perl-MCP.new.11887 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-MCP" Mon Jun 29 17:30:23 2026 rev:7 rq:1362461 version:0.120.0 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-MCP/perl-MCP.changes 2026-05-18 17:48:47.234212894 +0200 +++ /work/SRC/openSUSE:Factory/.perl-MCP.new.11887/perl-MCP.changes 2026-06-29 17:31:15.447868871 +0200 @@ -1,0 +2,27 @@ +Mon Jun 29 10:40:19 UTC 2026 - Tina Müller <[email protected]> + +- Downgrade to 0.12 again to avoid the new (failing) dependency for now + +------------------------------------------------------------------- +Mon Jun 22 10:52:47 UTC 2026 - Tina Müller <[email protected]> + +- updated to 0.130.0 (0.13) + see /usr/share/doc/packages/perl-MCP/Changes + + 0.13 2026-06-22 + - Switched from JSON::Valdiator to JSON::Schema::Tiny for better portability. + + 0.12 2026-06-19 + - Fixed bug in MCP::Server::Transport::Stdio where the server could disconnect when reading from Windows pipes, + such as when spawned by Claude Desktop. + + 0.11 2026-06-19 + - Added OAuth scope support, so MCP servers can act as OAuth 2.0 resource servers. + - Added scopes attribute to MCP::Primitive, and therefore to MCP::Tool, MCP::Prompt, and MCP::Resource. + - Added scopes and insufficient_scope attributes, and a has_scope method, to MCP::Server::Context. + - Added auth and metadata_url attributes to MCP::Server::Transport::HTTP. + - Added headers attribute to MCP::Client. + - Added oauth_metadata method to MCP::Server. + - Added INSUFFICIENT_SCOPE constant to MCP::Constants. + +------------------------------------------------------------------- Old: ---- MCP-0.10.tar.gz New: ---- MCP-0.12.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-MCP.spec ++++++ --- /var/tmp/diff_new_pack.FeKFaY/_old 2026-06-29 17:31:16.111891541 +0200 +++ /var/tmp/diff_new_pack.FeKFaY/_new 2026-06-29 17:31:16.111891541 +0200 @@ -18,10 +18,10 @@ %define cpan_name MCP Name: perl-MCP -Version: 0.100.0 +Version: 0.120.0 Release: 0 -# 0.10 -> normalize -> 0.100.0 -%define cpan_version 0.10 +# 0.12 -> normalize -> 0.120.0 +%define cpan_version 0.12 License: MIT Summary: Connect Perl with AI using MCP (Model Context Protocol) URL: https://metacpan.org/release/%{cpan_name} @@ -85,7 +85,8 @@ app->start; Authentication can be added by the web application, just like for any - other route. To allow for MCP applications to scale with prefork web + other route. OAuth scopes can be enforced per tool, prompt and + resource. To allow for MCP applications to scale with prefork web servers, server to client streaming is currentlly avoided when possible. ++++++ MCP-0.10.tar.gz -> MCP-0.12.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/Changes new/MCP-0.12/Changes --- old/MCP-0.10/Changes 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/Changes 2026-06-19 20:16:48.000000000 +0200 @@ -1,4 +1,17 @@ +0.12 2026-06-19 + - Fixed bug in MCP::Server::Transport::Stdio where the server could disconnect when reading from Windows pipes, + such as when spawned by Claude Desktop. + +0.11 2026-06-19 + - Added OAuth scope support, so MCP servers can act as OAuth 2.0 resource servers. + - Added scopes attribute to MCP::Primitive, and therefore to MCP::Tool, MCP::Prompt, and MCP::Resource. + - Added scopes and insufficient_scope attributes, and a has_scope method, to MCP::Server::Context. + - Added auth and metadata_url attributes to MCP::Server::Transport::HTTP. + - Added headers attribute to MCP::Client. + - Added oauth_metadata method to MCP::Server. + - Added INSUFFICIENT_SCOPE constant to MCP::Constants. + 0.10 2026-05-06 - Added opt-in server-to-client streaming and session termination to the HTTP transport. Not compatible with pre-forking web servers. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/MANIFEST new/MCP-0.12/MANIFEST --- old/MCP-0.10/MANIFEST 2026-05-06 22:58:51.000000000 +0200 +++ new/MCP-0.12/MANIFEST 2026-06-19 20:17:23.000000000 +0200 @@ -24,6 +24,7 @@ t/apps/lite_app.pl t/apps/mojolicious.png t/apps/stdio.pl +t/auth_scopes_app.t t/lib/MCPStdioTest.pm t/lite_app.t t/pod.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/META.json new/MCP-0.12/META.json --- old/MCP-0.10/META.json 2026-05-06 22:58:51.000000000 +0200 +++ new/MCP-0.12/META.json 2026-06-19 20:17:22.000000000 +0200 @@ -61,6 +61,6 @@ "web" : "https://web.libera.chat/#mojo"; } }, - "version" : "0.10", + "version" : "0.12", "x_serialization_backend" : "JSON::PP version 4.16" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/META.yml new/MCP-0.12/META.yml --- old/MCP-0.10/META.yml 2026-05-06 22:58:51.000000000 +0200 +++ new/MCP-0.12/META.yml 2026-06-19 20:17:22.000000000 +0200 @@ -33,5 +33,5 @@ homepage: https://mojolicious.org license: http://www.opensource.org/licenses/mit repository: https://github.com/mojolicious/mojo-mcp.git -version: '0.10' +version: '0.12' x_serialization_backend: 'CPAN::Meta::YAML version 0.020' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/README.md new/MCP-0.12/README.md --- old/MCP-0.10/README.md 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/README.md 2026-06-19 20:01:34.000000000 +0200 @@ -1,7 +1,7 @@ # MCP Perl SDK - [](https://github.com/mojolicious/mojo-mcp/actions) [](https://github.com/mojolicious/mojo-mcp/actions) + [](https://github.com/mojolicious/mojo-mcp/actions) [](https://github.com/mojolicious/mojo-mcp/actions) [](https://github.com/mojolicious/mojo-mcp/actions) [Model Context Protocol](https://modelcontextprotocol.io/) support for [Perl](https://perl.org) and the [Mojolicious](https://mojolicious.org) real-time web framework. @@ -15,6 +15,7 @@ * Streamable HTTP and Stdio transports * Notifications for list changes (tools, prompts, resources) * Progress tracking for long-running operations + * OAuth scopes for tools, prompts and resources * Scalable with pre-forking web server and async tools using promises * HTTP client for testing * Can be embedded in Mojolicious web apps @@ -51,7 +52,8 @@ app->start; ``` -Authentication can be added by the web application, just like for any other route. +Authentication can be added by the web application, just like for any other route. OAuth scopes can be enforced per +tool, prompt and resource. ## Server-to-Client Streaming diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Client.pm new/MCP-0.12/lib/MCP/Client.pm --- old/MCP-0.10/lib/MCP/Client.pm 2026-05-06 21:53:53.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Client.pm 2026-06-19 16:05:31.000000000 +0200 @@ -7,7 +7,8 @@ use Mojo::UserAgent; use Scalar::Util qw(weaken); -has name => 'PerlClient'; +has headers => sub { {} }; +has name => 'PerlClient'; has 'session_id'; has ua => sub { Mojo::UserAgent->new }; has url => sub {'http://localhost:3000/mcp'}; @@ -30,7 +31,7 @@ sub delete_session ($self) { return undef unless my $session_id = $self->session_id; - my $tx = $self->ua->build_tx(DELETE => $self->url => {'Mcp-Session-Id' => $session_id}); + my $tx = $self->ua->build_tx(DELETE => $self->url => {%{$self->headers}, 'Mcp-Session-Id' => $session_id}); $tx = $self->ua->start($tx); if (my $err = $tx->error) { croak "$err->{code} response: $err->{message}" if $err->{code}; @@ -69,7 +70,8 @@ } sub send_request ($self, $request) { - my $headers = {Accept => 'application/json, text/event-stream', 'Content-Type' => 'application/json'}; + my $headers + = {%{$self->headers}, Accept => 'application/json, text/event-stream', 'Content-Type' => 'application/json'}; if (my $session_id = $self->session_id) { $headers->{'Mcp-Session-Id'} = $session_id } my $ua = $self->ua; my $tx = $ua->build_tx(POST => $self->url => $headers => json => $request); @@ -133,6 +135,14 @@ L<MCP::Client> inherits all attributes from L<Mojo::Base> and implements the following new ones. +=head2 headers + + my $headers = $client->headers; + $client = $client->headers({Authorization => 'Bearer abc123'}); + +Extra HTTP headers to send with every request, as a hash reference. Useful for passing an C<Authorization> header to +an MCP server that requires OAuth bearer authentication. Defaults to an empty hash reference. + =head2 name my $name = $client->name; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Constants.pm new/MCP-0.12/lib/MCP/Constants.pm --- old/MCP-0.10/lib/MCP/Constants.pm 2025-12-04 16:10:03.000000000 +0100 +++ new/MCP-0.12/lib/MCP/Constants.pm 2026-06-19 16:05:31.000000000 +0200 @@ -2,6 +2,7 @@ use Mojo::Base 'Exporter'; use constant { + INSUFFICIENT_SCOPE => -32003, INVALID_PARAMS => -32602, INVALID_REQUEST => -32600, METHOD_NOT_FOUND => -32601, @@ -10,7 +11,8 @@ RESOURCE_NOT_FOUND => -32002 }; -our @EXPORT_OK = qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); +our @EXPORT_OK + = qw(INSUFFICIENT_SCOPE INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); 1; @@ -32,6 +34,10 @@ L<MCP::Constants> exports the following constants. +=head2 INSUFFICIENT_SCOPE + +The error code for a request whose access token lacks a required OAuth scope. + =head2 INVALID_PARAMS The error code for invalid parameters. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Primitive.pm new/MCP-0.12/lib/MCP/Primitive.pm --- old/MCP-0.10/lib/MCP/Primitive.pm 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Primitive.pm 2026-06-19 16:05:31.000000000 +0200 @@ -3,6 +3,8 @@ use MCP::Server::Context; +has scopes => sub { [] }; + sub context ($self) { $self->{context} || MCP::Server::Context->new } 1; @@ -25,6 +27,20 @@ L<MCP::Primitive> is a base class for MCP (Model Context Protocol) primitives such as L<MCP::Tool>, L<MCP::Prompt>, and L<MCP::Resource>. +=head1 ATTRIBUTES + +L<MCP::Primitive> implements the following attributes. + +=head2 scopes + + my $scopes = $primitive->scopes; + $primitive = $primitive->scopes(['mcp:read', 'mcp:write']); + +OAuth scopes required to list or call this primitive, as an array reference; all of them must be granted. This is a +local authorization policy layered on the HTTP transport's L<MCP::Server::Transport::HTTP/"auth"> hook, not wire-level +MCP metadata, and is only enforced for requests that supply scopes (so it has no effect over stdio). Defaults to no +required scopes. + =head1 METHODS L<MCP::Primitive> inherits all methods from L<Mojo::Base> and implements the following new ones. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Server/Context.pm new/MCP-0.12/lib/MCP/Server/Context.pm --- old/MCP-0.10/lib/MCP/Server/Context.pm 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Server/Context.pm 2026-06-19 16:05:31.000000000 +0200 @@ -1,7 +1,14 @@ package MCP::Server::Context; use Mojo::Base -base, -signatures; -has [qw(controller progress_token session_id transport)]; +has [qw(controller insufficient_scope progress_token scopes session_id transport)]; + +sub has_scope ($self, @needed) { + return 1 unless defined(my $scopes = $self->scopes); + my %granted = map { $_ => 1 } @$scopes; + for my $scope (@needed) { return 0 unless $granted{$scope} } + return 1; +} sub notify ($self, $method, $params = {}) { return undef unless my $transport = $self->transport; @@ -46,6 +53,14 @@ The L<Mojolicious::Controller> serving the current request, when the HTTP transport is in use. +=head2 insufficient_scope + + my $needed = $context->insufficient_scope; + $context = $context->insufficient_scope(['mcp:write']); + +Array reference of scopes a denied request was missing, set by the server so the HTTP transport can emit an +C<insufficient_scope> challenge. C<undef> when no scope check failed. + =head2 progress_token my $token = $context->progress_token; @@ -60,6 +75,15 @@ Identifier of the session this request belongs to. +=head2 scopes + + my $scopes = $context->scopes; + $context = $context->scopes(['mcp:read', 'mcp:write']); + +OAuth scopes granted to the current request, as an array reference, populated from the C<auth> hook of the HTTP +transport. C<undef> (the default) imposes no scope restriction, so scopes are only enforced for authenticated +requests that provide them. + =head2 transport my $transport = $context->transport; @@ -71,6 +95,13 @@ L<MCP::Server::Context> inherits all methods from L<Mojo::Base> and implements the following new ones. +=head2 has_scope + + my $bool = $context->has_scope('mcp:write'); + my $bool = $context->has_scope('mcp:read', 'mcp:write'); + +Returns true if every given scope is present in L</"scopes">, or if L</"scopes"> is C<undef> (no restriction). + =head2 notify my $bool = $context->notify($method); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Server/Transport/HTTP.pm new/MCP-0.12/lib/MCP/Server/Transport/HTTP.pm --- old/MCP-0.10/lib/MCP/Server/Transport/HTTP.pm 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Server/Transport/HTTP.pm 2026-06-19 16:05:31.000000000 +0200 @@ -11,7 +11,9 @@ use constant DEBUG => $ENV{MCP_DEBUG} || 0; -has heartbeat => 30; +has 'auth'; +has heartbeat => 30; +has 'metadata_url'; has session_timeout => 3600; has sessions => sub { {} }; has streaming => 0; @@ -19,6 +21,11 @@ sub notifications ($self) { $self->streaming ? 1 : 0 } sub handle_request ($self, $c) { + if (my $auth = $self->auth) { + return $self->_unauthorized($c) unless my $info = $auth->($c); + $c->stash('mcp.auth' => $info); + } + my $method = $c->req->method; return $self->_handle_post($c) if $method eq 'POST'; return $self->_handle_get($c) if $method eq 'GET' && $self->streaming; @@ -43,6 +50,14 @@ return 1; } +sub _challenge_header ($self, %extra) { + my @parts; + push @parts, qq{resource_metadata="@{[$self->metadata_url]}"} if $self->metadata_url; + push @parts, qq{error="$extra{error}"} if $extra{error}; + push @parts, qq{scope="$extra{scope}"} if defined $extra{scope}; + return 'Bearer' . (@parts ? ' ' . join(', ', @parts) : ''); +} + sub _extract_session_id ($self, $c) { return $c->req->headers->header('Mcp-Session-Id') } sub _handle ($self, $data, $context) { @@ -93,7 +108,7 @@ sub _handle_initialization ($self, $c, $data) { my $session_id = random_v4uuid; - my $result = $self->_handle($data, MCP::Server::Context->new); + my $result = $self->_handle($data, MCP::Server::Context->new(scopes => $self->_scopes($c))); if ($self->streaming) { $self->sessions->{$session_id} = MCP::Server::Session->new(id => $session_id); $self->_start_sweep; @@ -121,9 +136,21 @@ } $c->res->headers->header('Mcp-Session-Id' => $session_id); - my $context = MCP::Server::Context->new(transport => $self, session_id => $session_id, controller => $c); + my $context = MCP::Server::Context->new( + transport => $self, + session_id => $session_id, + controller => $c, + scopes => $self->_scopes($c) + ); return $c->render(data => '', status => 202) unless defined(my $result = $self->_handle($data, $context)); + # Insufficient scope + if (my $needed = $context->insufficient_scope) { + $c->res->headers->header( + 'WWW-Authenticate' => $self->_challenge_header(error => 'insufficient_scope', scope => join(' ', @$needed))); + return $c->render(json => $result, status => 403); + } + # Sync return $c->render(json => $result, status => 200) if !blessed($result) || !$result->isa('Mojo::Promise'); @@ -133,6 +160,11 @@ $result->then(sub { $c->write_sse({text => to_json($_[0])})->finish }); } +sub _scopes ($self, $c) { + return undef unless $self->auth; + return ($c->stash('mcp.auth') // {})->{scopes} // []; +} + sub _start_sweep ($self) { return if $self->{_sweep_id}; return unless my $interval = $self->session_timeout; @@ -150,6 +182,11 @@ } } +sub _unauthorized ($self, $c) { + $c->res->headers->header('WWW-Authenticate' => $self->_challenge_header); + return $c->render(json => {error => 'Unauthorized'}, status => 401); +} + 1; =encoding utf8 @@ -179,6 +216,17 @@ L<MCP::Server::Transport::HTTP> inherits all attributes from L<MCP::Server::Transport> and implements the following new ones. +=head2 auth + + my $cb = $http->auth; + $http = $http->auth(sub ($c) {...}); + +Optional callback to authenticate each request before it is dispatched. It receives the L<Mojolicious::Controller> +and returns a hash reference of authentication info on success, or a false value to reject the request with a +C<401> C<WWW-Authenticate> challenge. The C<scopes> key of the returned hash reference is made available to handlers +as L<MCP::Server::Context/"scopes">. Token validation is left to the application, so this is where you verify an +OAuth 2.0 access token; when not set, requests are not authenticated. + =head2 heartbeat my $seconds = $http->heartbeat; @@ -188,6 +236,15 @@ set to C<0> to disable. Useful when running behind reverse proxies that close idle connections. Only used when L</"streaming"> is enabled. +=head2 metadata_url + + my $url = $http->metadata_url; + $http = $http->metadata_url('https://example.com/.well-known/oauth-protected-resource'); + +URL of the OAuth 2.0 Protected Resource Metadata document. When set, it is included as the C<resource_metadata> +parameter of the C<WWW-Authenticate> challenge sent with C<401> and C<403> responses, so clients can discover the +authorization server. Use an absolute URL so remote clients can fetch it. See L<MCP::Server/"oauth_metadata">. + =head2 session_timeout my $seconds = $http->session_timeout; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Server/Transport/Stdio.pm new/MCP-0.12/lib/MCP/Server/Transport/Stdio.pm --- old/MCP-0.10/lib/MCP/Server/Transport/Stdio.pm 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Server/Transport/Stdio.pm 2026-06-19 20:01:34.000000000 +0200 @@ -9,9 +9,13 @@ sub handle_requests ($self) { my $server = $self->server; + binmode STDIN, ':raw'; + binmode STDOUT, ':raw'; STDOUT->autoflush(1); - while (my $input = <>) { - chomp $input; + + my $buffer = ''; + while (defined(my $input = _read_line(\$buffer))) { + next if $input eq ''; my $request = eval { decode_json($input) }; next unless my $response = $server->handle($request, MCP::Server::Context->new(transport => $self)); @@ -22,6 +26,19 @@ } } +sub _read_line ($buffer) { + while (index($$buffer, "\n") < 0) { + last unless sysread STDIN, my $chunk, 131072; + $$buffer .= $chunk; + } + return undef if $$buffer eq ''; + + my $pos = index($$buffer, "\n"); + my $line = $pos < 0 ? substr($$buffer, 0, length($$buffer), '') : substr($$buffer, 0, $pos + 1, ''); + $line =~ s/\r?\n?$//; + return $line; +} + sub notify ($self, $session_id, $method, $params = {}) { _print_response({jsonrpc => '2.0', method => $method, params => $params}); return 1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP/Server.pm new/MCP-0.12/lib/MCP/Server.pm --- old/MCP-0.10/lib/MCP/Server.pm 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/lib/MCP/Server.pm 2026-06-19 16:05:31.000000000 +0200 @@ -1,9 +1,10 @@ package MCP::Server; use Mojo::Base 'Mojo::EventEmitter', -signatures; -use List::Util qw(first); -use Mojo::JSON qw(false true); -use MCP::Constants qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); +use List::Util qw(first); +use Mojo::JSON qw(false true); +use MCP::Constants + qw(INSUFFICIENT_SCOPE INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); use MCP::Prompt; use MCP::Resource; use MCP::Server::Transport::HTTP; @@ -70,6 +71,16 @@ return $transport->notify_all("notifications/$kind/list_changed"); } +sub oauth_metadata ($self, %args) { + my %scopes; + for my $primitive (@{$self->tools}, @{$self->prompts}, @{$self->resources}) { + $scopes{$_} = 1 for @{$primitive->scopes}; + } + my $metadata = {%args}; + $metadata->{scopes_supported} //= [sort keys %scopes] if keys %scopes; + return $metadata; +} + sub prompt ($self, %args) { my $prompt = MCP::Prompt->new(%args); push @{$self->prompts}, $prompt; @@ -111,6 +122,7 @@ sub _handle_prompts_list ($self, $context) { my @prompts; for my $prompt (@{$self->_prompts($context)}) { + next unless $context->has_scope(@{$prompt->scopes}); my $info = {name => $prompt->name, description => $prompt->description, arguments => $prompt->arguments}; push @prompts, $info; } @@ -121,9 +133,10 @@ sub _handle_prompts_get ($self, $params, $id, $context) { my $name = $params->{name} // ''; my $args = $params->{arguments} // {}; - return _jsonrpc_error(METHOD_NOT_FOUND, "Prompt '$name' not found") + return _jsonrpc_error(METHOD_NOT_FOUND, "Prompt '$name' not found", $id) unless my $prompt = first { $_->name eq $name } @{$self->_prompts($context)}; - return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments') if $prompt->validate_input($args); + if (my $err = $self->_check_scope($prompt, $context, $id)) { return $err } + return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments', $id) if $prompt->validate_input($args); my $result = $prompt->call($args, $context); return $result->then(sub { _jsonrpc_response($_[0], $id) }) if blessed($result) && $result->isa('Mojo::Promise'); @@ -133,6 +146,7 @@ sub _handle_resources_list ($self, $context) { my @resources; for my $resource (@{$self->_resources($context)}) { + next unless $context->has_scope(@{$resource->scopes}); my $info = { uri => $resource->uri, name => $resource->name, @@ -147,8 +161,9 @@ sub _handle_resources_read ($self, $params, $id, $context) { my $uri = $params->{uri} // ''; - return _jsonrpc_error(RESOURCE_NOT_FOUND, 'Resource not found') + return _jsonrpc_error(RESOURCE_NOT_FOUND, 'Resource not found', $id) unless my $resource = first { $_->uri eq $uri } @{$self->_resources($context)}; + if (my $err = $self->_check_scope($resource, $context, $id)) { return $err } my $result = $resource->call($context); return $result->then(sub { _jsonrpc_response($_[0], $id) }) if blessed($result) && $result->isa('Mojo::Promise'); @@ -158,9 +173,10 @@ sub _handle_tools_call ($self, $params, $id, $context) { my $name = $params->{name} // ''; my $args = $params->{arguments} // {}; - return _jsonrpc_error(METHOD_NOT_FOUND, "Tool '$name' not found") + return _jsonrpc_error(METHOD_NOT_FOUND, "Tool '$name' not found", $id) unless my $tool = first { $_->name eq $name } @{$self->_tools($context)}; - return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments') if $tool->validate_input($args); + if (my $err = $self->_check_scope($tool, $context, $id)) { return $err } + return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments', $id) if $tool->validate_input($args); my $result = $tool->call($args, $context); return $result->then(sub { _jsonrpc_response($_[0], $id) }) if blessed($result) && $result->isa('Mojo::Promise'); @@ -170,6 +186,7 @@ sub _handle_tools_list ($self, $context) { my @tools; for my $tool (@{$self->_tools($context)}) { + next unless $context->has_scope(@{$tool->scopes}); my $info = {name => $tool->name, description => $tool->description, inputSchema => $tool->input_schema}; if (my $output_schema = $tool->output_schema) { $info->{outputSchema} = $output_schema } @@ -181,6 +198,13 @@ return {tools => \@tools}; } +sub _check_scope ($self, $primitive, $context, $id) { + my $scopes = $primitive->scopes; + return undef if $context->has_scope(@$scopes); + $context->insufficient_scope($scopes); + return _jsonrpc_error(INSUFFICIENT_SCOPE, 'Insufficient scope', $id); +} + sub _jsonrpc_error ($code, $message, $id = undef) { return {jsonrpc => '2.0', id => $id, error => {code => $code, message => $message}}; } @@ -339,6 +363,17 @@ Broadcast a C<notifications/$kind/list_changed> JSON-RPC notification to all connected clients. Returns true on success, or C<undef> if no notification could be delivered. +=head2 oauth_metadata + + my $metadata = $server->oauth_metadata( + resource => 'https://example.com/mcp', + authorization_servers => ['https://auth.example.com'] + ); + +Build an OAuth 2.0 Protected Resource Metadata document from the given fields, to be served from +C</.well-known/oauth-protected-resource>. Unless C<scopes_supported> is provided, it is filled in with the sorted +union of all scopes declared by registered tools, prompts, and resources. + =head2 prompt my $prompt = $server->prompt( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/lib/MCP.pm new/MCP-0.12/lib/MCP.pm --- old/MCP-0.10/lib/MCP.pm 2026-05-06 21:53:53.000000000 +0200 +++ new/MCP-0.12/lib/MCP.pm 2026-06-19 16:08:09.000000000 +0200 @@ -1,7 +1,7 @@ package MCP; use Mojo::Base -base, -signatures; -our $VERSION = '0.10'; +our $VERSION = '0.12'; 1; @@ -59,8 +59,9 @@ app->start; -Authentication can be added by the web application, just like for any other route. To allow for MCP applications to -scale with prefork web servers, server to client streaming is currentlly avoided when possible. +Authentication can be added by the web application, just like for any other route. OAuth scopes can be enforced per +tool, prompt and resource. To allow for MCP applications to scale with prefork web servers, server to client +streaming is currentlly avoided when possible. =head3 Stdio Transport diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/t/apps/stdio.pl new/MCP-0.12/t/apps/stdio.pl --- old/MCP-0.10/t/apps/stdio.pl 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/t/apps/stdio.pl 2026-06-19 16:05:31.000000000 +0200 @@ -49,5 +49,14 @@ return "Echo: $args->{msg}"; } ); +$server->tool( + name => 'echo_scoped', + description => 'Echo the input text, requires a scope', + scopes => ['mcp:read'], + input_schema => {type => 'object', properties => {msg => {type => 'string'}}, required => ['msg']}, + code => sub ($tool, $args) { + return "Echo: $args->{msg}"; + } +); $server->to_stdio; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/t/auth_scopes_app.t new/MCP-0.12/t/auth_scopes_app.t --- old/MCP-0.10/t/auth_scopes_app.t 1970-01-01 01:00:00.000000000 +0100 +++ new/MCP-0.12/t/auth_scopes_app.t 2026-06-19 16:05:31.000000000 +0200 @@ -0,0 +1,219 @@ +use Mojo::Base -strict, -signatures; + +use Test::More; + +use Mojolicious::Lite; +use Test::Mojo; +use MCP::Client; +use MCP::Constants qw(PROTOCOL_VERSION); +use MCP::Server; + +my $server = MCP::Server->new; + +$server->tool( + name => 'read_tool', + scopes => ['mcp:read'], + code => sub ($tool, $args) { + return 'Read result'; + } +); +$server->tool( + name => 'write_tool', + scopes => ['mcp:write'], + code => sub ($tool, $args) { + return 'Write result'; + } +); +$server->tool( + name => 'custom_tool', + scopes => ['mcp:something.custom'], + code => sub ($tool, $args) { + return 'custom result'; + } +); +$server->on( + tools => sub ($server, $tools, $context) { + my $c = $context->controller; + my $role = $c ? $c->stash('role') : ''; + return if $role eq 'admin'; + @$tools = grep { $_->name ne 'custom_tool' } @$tools; + } +); + +$server->prompt( + name => 'read_prompt', + scopes => ['mcp:read'], + code => sub ($prompt, $args) { + return 'Read prompt'; + } +); +$server->prompt( + name => 'write_prompt', + scopes => ['mcp:write'], + code => sub ($prompt, $args) { + return 'Write prompt'; + } +); + +$server->resource( + uri => 'file:///read', + scopes => ['mcp:read'], + code => sub ($resource) { + return 'Read resource'; + } +); +$server->resource( + uri => 'file:///write', + scopes => ['mcp:write'], + code => sub ($resource) { + return 'Write resource'; + } +); + +get '/.well-known/oauth-protected-resource' => sub ($c) { + $c->render( + json => $server->oauth_metadata( + resource => 'http://example.com/mcp', + authorization_servers => ['https://auth.example.com'] + ) + ); +}; + +# Fake token validation, replace with real OAuth access token verification in production +my $tokens = { + ro => {scopes => ['mcp:read'], role => 'user'}, + rw => {scopes => ['mcp:read', 'mcp:write', 'mcp:something.custom'], role => 'user'}, + admin => {scopes => ['mcp:read', 'mcp:write', 'mcp:something.custom'], role => 'admin'} +}; +my $metadata_url = 'http://example.com/.well-known/oauth-protected-resource'; +any '/mcp' => $server->to_action({ + auth => sub ($c) { + return undef unless ($c->req->headers->authorization // '') =~ /^Bearer\s+(\S+)$/; + return undef unless my $token = $tokens->{$1}; + $c->stash(role => $token->{role}); + return {scopes => $token->{scopes}}; + }, + metadata_url => $metadata_url +}); + +my $t = Test::Mojo->new; + +subtest 'Discovery' => sub { + $t->post_ok('/mcp' => json => {}) + ->status_is(401) + ->header_like('WWW-Authenticate' => qr/^Bearer/) + ->header_like('WWW-Authenticate' => qr/resource_metadata="\Q$metadata_url\E"/); + $t->post_ok('/mcp' => {Authorization => 'Bearer bogus'} => json => {})->status_is(401); + + $t->get_ok('/.well-known/oauth-protected-resource') + ->status_is(200) + ->json_is('/scopes_supported' => ['mcp:read', 'mcp:something.custom', 'mcp:write']) + ->json_is('/authorization_servers' => ['https://auth.example.com']); +}; + +subtest 'Read-only token' => sub { + my $client = MCP::Client->new(ua => $t->ua, url => $t->ua->server->url->path('/mcp'), + headers => {Authorization => 'Bearer ro'}); + $client->initialize_session; + + subtest 'Tools' => sub { + my $result = $client->list_tools; + is $result->{tools}[0]{name}, 'read_tool', 'read tool present'; + is $result->{tools}[1], undef, 'no more tools'; + + is $client->call_tool('read_tool')->{content}[0]{text}, 'Read result', 'read tool call result'; + eval { $client->call_tool('write_tool') }; + like $@, qr/403 response/, 'write tool denied'; + }; + + subtest 'Prompts' => sub { + my $result = $client->list_prompts; + is $result->{prompts}[0]{name}, 'read_prompt', 'read prompt present'; + is $result->{prompts}[1], undef, 'no more prompts'; + + is $client->get_prompt('read_prompt')->{messages}[0]{content}{text}, 'Read prompt', 'read prompt result'; + eval { $client->get_prompt('write_prompt') }; + like $@, qr/403 response/, 'write prompt denied'; + }; + + subtest 'Resources' => sub { + my $result = $client->list_resources; + is $result->{resources}[0]{uri}, 'file:///read', 'read resource present'; + is $result->{resources}[1], undef, 'no more resources'; + + is $client->read_resource('file:///read')->{contents}[0]{text}, 'Read resource', 'read resource result'; + eval { $client->read_resource('file:///write') }; + like $@, qr/403 response/, 'write resource denied'; + }; +}; + +subtest 'Read-write token' => sub { + my $client = MCP::Client->new(ua => $t->ua, url => $t->ua->server->url->path('/mcp'), + headers => {Authorization => 'Bearer rw'}); + $client->initialize_session; + + subtest 'Tools' => sub { + my $result = $client->list_tools; + is $result->{tools}[0]{name}, 'read_tool', 'read tool present'; + is $result->{tools}[1]{name}, 'write_tool', 'write tool present'; + is $result->{tools}[2], undef, 'custom tool hidden by role'; + + is $client->call_tool('write_tool')->{content}[0]{text}, 'Write result', 'write tool call result'; + eval { $client->call_tool('custom_tool') }; + like $@, qr/Error -32601/, 'custom tool hidden by role'; + }; + + subtest 'Prompts' => sub { + my $result = $client->list_prompts; + is $result->{prompts}[0]{name}, 'read_prompt', 'read prompt present'; + is $result->{prompts}[1]{name}, 'write_prompt', 'write prompt present'; + is $result->{prompts}[2], undef, 'no more prompts'; + + is $client->get_prompt('write_prompt')->{messages}[0]{content}{text}, 'Write prompt', 'write prompt result'; + }; + + subtest 'Resources' => sub { + my $result = $client->list_resources; + is $result->{resources}[0]{uri}, 'file:///read', 'read resource present'; + is $result->{resources}[1]{uri}, 'file:///write', 'write resource present'; + is $result->{resources}[2], undef, 'no more resources'; + + is $client->read_resource('file:///write')->{contents}[0]{text}, 'Write resource', 'write resource result'; + }; +}; + +subtest 'Admin token' => sub { + my $client = MCP::Client->new( + ua => $t->ua, + url => $t->ua->server->url->path('/mcp'), + headers => {Authorization => 'Bearer admin'} + ); + $client->initialize_session; + + my $result = $client->list_tools; + is $result->{tools}[0]{name}, 'read_tool', 'read tool present'; + is $result->{tools}[1]{name}, 'write_tool', 'write tool present'; + is $result->{tools}[2]{name}, 'custom_tool', 'custom tool present'; + is $result->{tools}[3], undef, 'no more tools'; + + is $client->call_tool('custom_tool')->{content}[0]{text}, 'custom result', 'custom tool call result'; +}; + +subtest 'Insufficient scope challenge' => sub { + my $init = { + jsonrpc => '2.0', + id => 1, + method => 'initialize', + params => {protocolVersion => PROTOCOL_VERSION, capabilities => {}, clientInfo => {name => 't', version => '1'}} + }; + $t->post_ok('/mcp' => {Authorization => 'Bearer ro'} => json => $init)->status_is(200); + my $session_id = $t->tx->res->headers->header('Mcp-Session-Id'); + + my $call = {jsonrpc => '2.0', id => 2, method => 'tools/call', params => {name => 'write_tool', arguments => {}}}; + $t->post_ok('/mcp' => {Authorization => 'Bearer ro', 'Mcp-Session-Id' => $session_id} => json => $call) + ->status_is(403) + ->header_like('WWW-Authenticate' => qr/error="insufficient_scope"/) + ->header_like('WWW-Authenticate' => qr/scope="mcp:write"/); +}; + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/t/lib/MCPStdioTest.pm new/MCP-0.12/t/lib/MCPStdioTest.pm --- old/MCP-0.10/t/lib/MCPStdioTest.pm 2026-05-06 21:53:53.000000000 +0200 +++ new/MCP-0.12/t/lib/MCPStdioTest.pm 2026-06-19 20:01:34.000000000 +0200 @@ -32,6 +32,12 @@ return 1; } +sub send_request_crlf ($self, $method, $params) { + $self->{timeout}->start(60); + $self->{stdin} .= encode_json($self->client->build_request($method, $params)) . "\r\n"; + return 1; +} + sub run ($self, @command) { $self->{run} = start(\@command, \$self->{stdin}, \$self->{stdout}, \$self->{stderr}, $self->{timeout} = timeout(60)); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.10/t/stdio.t new/MCP-0.12/t/stdio.t --- old/MCP-0.10/t/stdio.t 2026-05-06 22:55:47.000000000 +0200 +++ new/MCP-0.12/t/stdio.t 2026-06-19 20:01:34.000000000 +0200 @@ -110,6 +110,22 @@ is_deeply $res->{result}, {content => [{text => 'Echo: hi', type => 'text'}], isError => false}, 'tool call result'; }; +subtest 'Scoped tool (no scope enforcement over stdio)' => sub { + my $res = $test->request('tools/call', {name => 'echo_scoped', arguments => {msg => 'hi'}}); + is $res->{jsonrpc}, '2.0', 'JSON-RPC version'; + is $res->{id}, 9, 'request id'; + is_deeply $res->{result}, {content => [{text => 'Echo: hi', type => 'text'}], isError => false}, 'tool call result'; +}; + +subtest 'Tool call (CRLF line endings)' => sub { + $test->send_request_crlf('tools/call', {name => 'echo', arguments => {msg => 'hello mojo'}}); + my $res = $test->read_line; + is $res->{jsonrpc}, '2.0', 'JSON-RPC version'; + is $res->{id}, 10, 'request id'; + is_deeply $res->{result}, {content => [{text => 'Echo: hello mojo', type => 'text'}], isError => false}, + 'tool call result'; +}; + ok $test->stop, 'process stopped'; done_testing; ++++++ _scmsync.obsinfo ++++++ --- /var/tmp/diff_new_pack.FeKFaY/_old 2026-06-29 17:31:16.307898232 +0200 +++ /var/tmp/diff_new_pack.FeKFaY/_new 2026-06-29 17:31:16.315898505 +0200 @@ -1,6 +1,6 @@ -mtime: 1778141034 -commit: 2743c0c65b98fe23eefe3241e65f3926ea2b56fd6924cd9044f09a4d0c0d5a98 +mtime: 1782729687 +commit: 9b4485a5897cfd345e224a9ec10f306d5a9e94b89cac1e2e69042ec2635014fe url: https://src.opensuse.org/perl/perl-MCP -revision: 2743c0c65b98fe23eefe3241e65f3926ea2b56fd6924cd9044f09a4d0c0d5a98 +revision: 9b4485a5897cfd345e224a9ec10f306d5a9e94b89cac1e2e69042ec2635014fe projectscmsync: https://src.opensuse.org/perl/_ObsPrj ++++++ build.specials.obscpio ++++++ ++++++ build.specials.obscpio ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/.gitignore new/.gitignore --- old/.gitignore 1970-01-01 01:00:00.000000000 +0100 +++ new/.gitignore 2026-06-29 12:41:27.000000000 +0200 @@ -0,0 +1 @@ +.osc
