[ViewVC] Annotation of: cvs/AnyEvent-MCP/bin/mcp-http

#!/opt/bin/perl

=encoding utf8

=head1 NAME

mcp-http - HTTP requests with URL and method permissions

=head1 SYNOPSIS

   mcp-http --stdio
   mcp-http --connect http://host:port/TOKEN/http

=head1 DESCRIPTION

One MCP C<request> tool backed by L<AnyEvent::HTTP>. HTTP methods are
permission actions. URL scopes: exact URL, path with any query, origin,
hostname, hostname and subdomains, or any HTTP(S) URL.

Supply a C<cookie_jar> from an earlier response to continue a session;
the server keeps no cookies. This uses AnyEvent::HTTP's simplified jar,
not a full browser cookie implementation. Treat the jar as confidential.

Responses include status, headers, UTF-8 body or Base64 bytes. Optional
C<grep> keeps lines containing a literal string; C<regex> keeps lines
matching a Perl regex; C<substitute> replaces regex matches with literal
replacement text. C<max_bytes> bounds downloads and C<truncated> reports
partial results.

Redirects and retries are disabled. HTTPS verifies certificates.
Network access is NOT sandboxed; permitted names can reach local or
private hosts. HTTP failures do not prove that a write did not happen.

=head1 FIRST USE

Configure your MCP client to launch:

   mcp-http --stdio --name web

Or combine it with other servers:

   mcp-multibroker --stdio web --- mcp-http --name web --stdio ---

Ask the assistant:

   Fetch https://example.org/ and report the status and page title.
   Do not submit forms or send any modifying requests.

The C<request> tool receives arguments such as:

   {"url": "https://example.org/", "method": "GET", "max_bytes": 8192}

The first request asks for permission to GET that URL. An approval for
GET does not authorize POST, and an approval for an exact URL need not
authorize its whole hostname. Review broader scope choices carefully,
especially on hosts serving private or local resources.

To carry a session between requests, supply the returned C<cookie_jar>
to the next call. To inspect a large text response without returning it
all, use C<grep> or C<regex> and a suitable C<max_bytes>. Redirect
responses are returned to the caller; they are not followed. Repeating
a failed modifying request can repeat its side effects.

=head1 TOOL

=over

=item request

Required C<url>. Optional C<method> (GET), C<headers>, UTF-8 C<body>
or C<body_base64>, C<cookie_jar>, C<timeout> (30s inactivity),
C<max_bytes> (65536 default, 2097152 maximum), C<grep>, C<regex>,
and C<substitute> with C<pattern> and C<replacement>. Responses contain
C<captured_bytes> and C<truncated>. Replacement text is literal.

=back

=head1 PERMISSIONS

Profile C<http-NAME>. Rules match HTTP method as C<action> and URL
as C<match.url>. Hostname and subdomain scopes are textual DNS suffixes,
not organizational or public-suffix boundaries. No sandbox grants.

=head1 OPTIONS

Shared switches are documented in
L<AnyEvent::MCP::Server::Simple/COMMON COMMAND-LINE OPTIONS>.
The following shared switch has HTTP-permission-specific behavior.

=over

=item --ask MODE

Select permission prompt handling: C<helper> (default) uses the local
permission helper; C<tty> or C<yad> selects only that interface;
C<mcp> forwards prompts to the MCP client; C<auto> uses client forms
when advertised, otherwise the local helper; C<none> denies unmatched
permission checks without prompting.

=back

=cut

use common::sense;

use MIME::Base64 ();
use Encode ();
use JSON::XS ();

use AnyEvent::HTTP ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Server::Permissions ();

use AnyEvent::MCP::Server::Simple;

my $options = mcp_getoptions
   {
      usage       => "Usage: mcp-http [OPTION]...\n",
      description => "HTTP requests with URL/method permissions and caller-managed cookies.",
      examples    => "  mcp-http --stdio\n",
   };

@ARGV and die "Unexpected arguments\n";

my $permissions = AnyEvent::MCP::Server::Permissions->new (
   name => "http-$options->{name}",
   (defined $options->{ask} ? (ask => delete $options->{ask}) : ()),
);

mcp_config
   permissions        => $permissions,
   server_name        => "mcp-http",
   server_version     => $AnyEvent::MCP::VERSION,
   short_instructions => "HTTP requests with URL/method permissions; pass cookie_jar between calls. No redirects.",
   instructions       => "request makes authorized HTTP(S) requests. Method is the permission action. "
                      . "URL scopes range from exact URL to any HTTP(S) URL. No automatic redirects or retries. "
                      . "Pass a returned cookie_jar to subsequent calls. "
                      . "grep/regex select lines; substitute applies literal replacements. "
                      . "Responses may be truncated and failed writes can still have taken effect.",
   on_request         => sub {
      my ($server, $req) = @_;

      return mcp_log_request $server, $req
         unless $req->{method} eq "tools/call" && $req->{tool} eq "request";

      my $args = $req->{args};
      my $method = $args->{method} // "GET";
      my $url = $args->{url} // "";
      $method = "<invalid>" if ref $method;
      $url = "<invalid>" if ref $url;
      $url =~ s/[?#].*//s;
      $url =~ s{(://)[^/@]*@}{$1};
      $url =~ s/[\x00-\x1f\x7f]/ /g;

      mcp_log_request $server, $req,
         method => (substr $method, 0, 20),
         url    => (substr $url, 0, 160);
   };

sub url_scopes {
   my ($url) = @_;

   defined $url && !ref $url && $url !~ /[\x00-\x20\x7f]/
      or die "Invalid URL\n";
   $url =~ m{\A(https?)://(\[[0-9a-f:.]+\]|[a-z0-9.-]+)(?::([0-9]+))?([^#]*)(?:#.*)?\z}i
      or die "Expected HTTP(S) URL without userinfo\n";

   my ($scheme, $host, $port, $rest) = (lc $1, lc $2, $3, $4);
   !defined $port || $port >= 1 && $port <= 65535
      or die "Invalid URL port\n";
   $port = undef if defined $port && $port == ($scheme eq "https" ? 443 : 80);
   $rest =~ m{\A(?:/|\?|\z)} or die "Invalid URL path\n";
   $rest = "/$rest" unless $rest =~ m{\A/};

   my $origin = "$scheme://$host" . (defined $port ? ":$port" : "");
   my $path = $rest;
   $path =~ s/\?.*//s;
   my $full = "$origin$rest";
   my @choices = (
      { label => "Exact URL including query", match => $full },
      { label => "This path, any query",
        match => "^" . (quotemeta "$origin$path") . "(?:\\?.*)?\\z" },
      { label => "This origin (scheme, host, port)",
        match => "^" . (quotemeta $origin) . "/" },
      { label => "This hostname, any scheme or port",
        match => "^https?://" . (quotemeta $host) . "(?::[0-9]+)?/" },
   );
   if ($host !~ /^\[/ && $host =~ /\./ && $host !~ /^[0-9.]+$/) {
      push @choices, {
         label => "Hostname and subdomains, any scheme or port",
         match => "^https?://(?:[a-z0-9-]+\\.)*" . (quotemeta $host) . "(?::[0-9]+)?/",
      };
   }
   push @choices, { label => "Any HTTP(S) URL", match => "^https?://" };

   ($full, \@choices)
}

sub text_regex {
   my ($pattern) = @_;

   defined $pattern && !ref $pattern && length $pattern <= 512
      or die "Invalid regex pattern\n";
   my $regex = eval { qr/$pattern/ };
   $@ and die "Invalid regex: $@";

   $regex
}

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

   if (defined $args->{grep} || defined $args->{regex}) {
      my $grep = $args->{grep};
      my $regex = defined $args->{regex} ? text_regex ($args->{regex}) : undef;
      $text = join "", grep {
         (!defined $grep || index ($_, $grep) >= 0)
            && (!defined $regex || /$regex/)
      } split /(?<=\n)/, $text;
   }

   if (my $subst = $args->{substitute}) {
      my $regex = text_regex ($subst->{pattern});
      my $replacement = $subst->{replacement};
      $text =~ s/$regex/$replacement/g;
   }

   $text
}

mcp_tool request => "HTTP request. Method and URL permissions. No redirects; caller-managed cookie_jar returned. "
   . "UTF-8 body or Base64, bounded response, optional grep/regex/substitute.",
   {
      type => "object",
      required => ["url"],
      additionalProperties => JSON::XS::false,
      properties => {
         url         => { type => "string", minLength => 1 },
         method      => { type => "string", default => "GET" },
         headers     => { type => "object", additionalProperties => { type => "string" } },
         body        => { type => "string", description => "UTF-8 request body" },
         body_base64 => { type => "string", description => "Raw request body, Base64" },
         cookie_jar  => { type => "object", description => "AnyEvent::HTTP cookie jar returned by an earlier call" },
         timeout     => { type => "number", minimum => 1, maximum => 300, default => 30 },
         max_bytes   => { type => "integer", minimum => 1, maximum => 2097152, default => 65536 },
         grep        => { type => "string", description => "Keep lines containing this literal substring" },
         regex       => { type => "string", description => "Keep lines matching this Perl regex" },
         substitute  => {
            type => "object",
            required => ["pattern", "replacement"],
            additionalProperties => JSON::XS::false,
            properties => {
               pattern     => { type => "string", maxLength => 512 },
               replacement => { type => "string", maxLength => 512 },
            },
         },
      },
   },
   sub {
      my ($req, $args) = @_;

      my $method = $args->{method} // "GET";
      $method =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60|~-]+\z/
         or die "Invalid HTTP method\n";
      exists $args->{body} && exists $args->{body_base64}
         and die "Specify body or body_base64, not both\n";
      my ($url, $scopes) = url_scopes ($args->{url});

      my $headers = $args->{headers} || {};
      for my $key (keys %$headers) {
         $key =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60|~-]+\z/
            && defined $headers->{$key} && !ref $headers->{$key}
            && $headers->{$key} !~ /[\r\n\x00]/
            or die "Invalid HTTP header\n";
      }
      $headers = { %$headers };
      $headers->{"User-Agent"} = "mcp-http/$AnyEvent::MCP::VERSION"
         unless grep lc $_ eq "user-agent", keys %$headers;
      my $data = exists $args->{body} ? (AnyEvent::MCP::utf8enc $args->{body}) : undef;
      if (defined $args->{body_base64}) {
         $args->{body_base64} =~ /\A(?:[A-Za-z0-9+\/]{4})*(?:[A-Za-z0-9+\/]{2}==|[A-Za-z0-9+\/]{3}=)?\z/
            or die "Invalid Base64 body\n";
         $data = MIME::Base64::decode_base64 ($args->{body_base64});
      }
      !defined $data || length $data <= 1048576 or die "Request body exceeds 1 MiB\n";
      my $limit = $args->{max_bytes} // 65536;
      $limit >= 1 && $limit <= 2097152 or die "Invalid max_bytes\n";

      !defined $args->{grep} || !ref $args->{grep} or die "Invalid grep\n";
      text_regex ($args->{regex}) if defined $args->{regex};
      if (defined $args->{substitute}) {
         ref $args->{substitute} eq "HASH" && defined $args->{substitute}{replacement}
            && !ref $args->{substitute}{replacement} && length $args->{substitute}{replacement} <= 512
            or die "Invalid substitute\n";
         text_regex ($args->{substitute}{pattern});
      }
      my $jar = $args->{cookie_jar};
      !defined $jar || ref $jar eq "HASH" or die "Invalid cookie jar\n";

      $req->require_permission ({
         tool           => $req->{tool},
         action         => $method,
         dimensions     => { url => { label => "URL", value => $url, choices => $scopes } },
         sandbox_grants => [],
         reason         => "$method $url",
      });

      my $body = "";
      my $truncated = 0;
      my $response_headers;
      my $guard;
      $guard = AnyEvent::HTTP::http_request
         $method => $url,
         recurse    => 0,
         persistent => 0,
         proxy      => undef,
         tls_ctx    => "high",
         timeout    => $args->{timeout} // 30,
         headers    => $headers,
         (defined $data ? (body => $data) : ()),
         (defined $jar ? (cookie_jar => $jar) : ()),
         on_header => sub {
            $response_headers = { %{$_[0]} };
            1
         },
         on_body => sub {
            my ($part) = @_;
            if (length ($body) + length ($part) > $limit) {
               $body .= substr $part, 0, $limit - length $body;
               $truncated = 1;
               return 0;
            }
            $body .= $part;
            1
         },
         sub {
            my ($unused, $hdr) = @_;

            undef $guard;
            return if $req->{finished};
            $hdr = $response_headers if $truncated && $response_headers;
            my %result = (
               status         => 0 + $hdr->{Status},
               reason         => $hdr->{Reason},
               headers        => { map +($_ => $hdr->{$_}), grep /^[a-z]/, keys %$hdr },
               captured_bytes => length $body,
               truncated      => $truncated ? JSON::XS::true : JSON::XS::false,
               (defined $jar ? (cookie_jar => $jar) : ()),
            );

            if (defined $unused || $truncated) {
               my $bytes = $body;
               my $text = eval { Encode::decode ("UTF-8", $bytes, Encode::FB_CROAK) };
               if (defined $text) {
                  $text = filter_text ($text, $args);
                  if (length $text > $limit) {
                     $text = substr $text, 0, $limit;
                     $result{truncated} = JSON::XS::true;
                  }
                  $result{body} = $text;
               } elsif (defined $args->{grep} || defined $args->{regex} || defined $args->{substitute}) {
                  $req->error ("Cannot filter a non-UTF-8 response");
                  return;
               } else {
                  $result{body_base64} = MIME::Base64::encode_base64 ($body, "");
               }
            }

            $req->result (\%result);
         }
      ;
      $req->{on_cancel} = sub { undef $guard };
   };

mcp_start %$options;
Revision:	1.6
Committed:	Sat Nov 7 03:25:18 2026 UTC (39 hours, 39 minutes ago) by root
Branch:	MAIN
Changes since 1.5:	+5 -7 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3			=encoding utf8
4
5			=head1 NAME
6
7			mcp-http - HTTP requests with URL and method permissions
8
9			=head1 SYNOPSIS
10
11			mcp-http --stdio
12			mcp-http --connect http://host:port/TOKEN/http
13
14			=head1 DESCRIPTION
15
16			One MCP C<request> tool backed by L<AnyEvent::HTTP>. HTTP methods are
17			permission actions. URL scopes: exact URL, path with any query, origin,
18			hostname, hostname and subdomains, or any HTTP(S) URL.
19
20			Supply a C<cookie_jar> from an earlier response to continue a session;
21			the server keeps no cookies. This uses AnyEvent::HTTP's simplified jar,
22			not a full browser cookie implementation. Treat the jar as confidential.
23
24			Responses include status, headers, UTF-8 body or Base64 bytes. Optional
25			C<grep> keeps lines containing a literal string; C<regex> keeps lines
26			matching a Perl regex; C<substitute> replaces regex matches with literal
27			replacement text. C<max_bytes> bounds downloads and C<truncated> reports
28			partial results.
29
30			Redirects and retries are disabled. HTTPS verifies certificates.
31			Network access is NOT sandboxed; permitted names can reach local or
32			private hosts. HTTP failures do not prove that a write did not happen.
33
34	root	1.4	=head1 FIRST USE
35
36			Configure your MCP client to launch:
37
38			mcp-http --stdio --name web
39
40			Or combine it with other servers:
41
42			mcp-multibroker --stdio web --- mcp-http --name web --stdio ---
43
44			Ask the assistant:
45
46			Fetch https://example.org/ and report the status and page title.
47			Do not submit forms or send any modifying requests.
48
49			The C<request> tool receives arguments such as:
50
51			{"url": "https://example.org/", "method": "GET", "max_bytes": 8192}
52
53			The first request asks for permission to GET that URL. An approval for
54			GET does not authorize POST, and an approval for an exact URL need not
55			authorize its whole hostname. Review broader scope choices carefully,
56			especially on hosts serving private or local resources.
57
58			To carry a session between requests, supply the returned C<cookie_jar>
59			to the next call. To inspect a large text response without returning it
60			all, use C<grep> or C<regex> and a suitable C<max_bytes>. Redirect
61			responses are returned to the caller; they are not followed. Repeating
62			a failed modifying request can repeat its side effects.
63
64	root	1.1	=head1 TOOL
65
66			=over
67
68			=item request
69
70			Required C<url>. Optional C<method> (GET), C<headers>, UTF-8 C<body>
71			or C<body_base64>, C<cookie_jar>, C<timeout> (30s inactivity),
72			C<max_bytes> (65536 default, 2097152 maximum), C<grep>, C<regex>,
73			and C<substitute> with C<pattern> and C<replacement>. Responses contain
74			C<captured_bytes> and C<truncated>. Replacement text is literal.
75
76			=back
77
78			=head1 PERMISSIONS
79
80			Profile C<http-NAME>. Rules match HTTP method as C<action> and URL
81			as C<match.url>. Hostname and subdomain scopes are textual DNS suffixes,
82			not organizational or public-suffix boundaries. No sandbox grants.
83
84			=head1 OPTIONS
85
86	root	1.5	Shared switches are documented in
87			L<AnyEvent::MCP::Server::Simple/COMMON COMMAND-LINE OPTIONS>.
88	root	1.6	The following shared switch has HTTP-permission-specific behavior.
89	root	1.1
90			=over
91
92			=item --ask MODE
93
94	root	1.5	Select permission prompt handling: C<helper> (default) uses the local
95			permission helper; C<tty> or C<yad> selects only that interface;
96			C<mcp> forwards prompts to the MCP client; C<auto> uses client forms
97	root	1.6	when advertised, otherwise the local helper; C<none> denies unmatched
98			permission checks without prompting.
99	root	1.1
100			=back
101
102			=cut
103
104			use common::sense;
105	root	1.3
106			use MIME::Base64 ();
107			use Encode ();
108			use JSON::XS ();
109
110	root	1.1	use AnyEvent::HTTP ();
111			use AnyEvent::MCP ();
112			use AnyEvent::MCP::Server::Permissions ();
113
114			use AnyEvent::MCP::Server::Simple;
115
116			my $options = mcp_getoptions
117			{
118			usage => "Usage: mcp-http [OPTION]...\n",
119			description => "HTTP requests with URL/method permissions and caller-managed cookies.",
120			examples => " mcp-http --stdio\n",
121	root	1.6	};
122	root	1.1
123			@ARGV and die "Unexpected arguments\n";
124
125			my $permissions = AnyEvent::MCP::Server::Permissions->new (
126			name => "http-$options->{name}",
127	root	1.6	(defined $options->{ask} ? (ask => delete $options->{ask}) : ()),
128	root	1.1	);
129
130			mcp_config
131			permissions => $permissions,
132			server_name => "mcp-http",
133			server_version => $AnyEvent::MCP::VERSION,
134			short_instructions => "HTTP requests with URL/method permissions; pass cookie_jar between calls. No redirects.",
135			instructions => "request makes authorized HTTP(S) requests. Method is the permission action. "
136			. "URL scopes range from exact URL to any HTTP(S) URL. No automatic redirects or retries. "
137			. "Pass a returned cookie_jar to subsequent calls. "
138			. "grep/regex select lines; substitute applies literal replacements. "
139			. "Responses may be truncated and failed writes can still have taken effect.",
140			on_request => sub {
141			my ($server, $req) = @_;
142
143			return mcp_log_request $server, $req
144			unless $req->{method} eq "tools/call" && $req->{tool} eq "request";
145
146			my $args = $req->{args};
147			my $method = $args->{method} // "GET";
148			my $url = $args->{url} // "";
149			$method = "<invalid>" if ref $method;
150			$url = "<invalid>" if ref $url;
151			$url =~ s/[?#].*//s;
152			$url =~ s{(://)[^/@]*@}{$1};
153			$url =~ s/[\x00-\x1f\x7f]/ /g;
154
155	root	1.2	mcp_log_request $server, $req,
156			method => (substr $method, 0, 20),
157			url => (substr $url, 0, 160);
158	root	1.1	};
159
160			sub url_scopes {
161			my ($url) = @_;
162
163			defined $url && !ref $url && $url !~ /[\x00-\x20\x7f]/
164			or die "Invalid URL\n";
165			$url =~ m{\A(https?)://(\[[0-9a-f:.]+\]\|[a-z0-9.-]+)(?::([0-9]+))?([^#])(?:#.)?\z}i
166			or die "Expected HTTP(S) URL without userinfo\n";
167
168			my ($scheme, $host, $port, $rest) = (lc $1, lc $2, $3, $4);
169			!defined $port \|\| $port >= 1 && $port <= 65535
170			or die "Invalid URL port\n";
171			$port = undef if defined $port && $port == ($scheme eq "https" ? 443 : 80);
172			$rest =~ m{\A(?:/\|\?\|\z)} or die "Invalid URL path\n";
173			$rest = "/$rest" unless $rest =~ m{\A/};
174
175			my $origin = "$scheme://$host" . (defined $port ? ":$port" : "");
176			my $path = $rest;
177			$path =~ s/\?.*//s;
178			my $full = "$origin$rest";
179			my @choices = (
180			{ label => "Exact URL including query", match => $full },
181			{ label => "This path, any query",
182			match => "^" . (quotemeta "$origin$path") . "(?:\\?.*)?\\z" },
183			{ label => "This origin (scheme, host, port)",
184			match => "^" . (quotemeta $origin) . "/" },
185			{ label => "This hostname, any scheme or port",
186			match => "^https?://" . (quotemeta $host) . "(?::[0-9]+)?/" },
187			);
188			if ($host !~ /^\[/ && $host =~ /\./ && $host !~ /^[0-9.]+$/) {
189			push @choices, {
190			label => "Hostname and subdomains, any scheme or port",
191			match => "^https?://(?:[a-z0-9-]+\\.)*" . (quotemeta $host) . "(?::[0-9]+)?/",
192			};
193			}
194			push @choices, { label => "Any HTTP(S) URL", match => "^https?://" };
195
196			($full, \@choices)
197			}
198
199			sub text_regex {
200			my ($pattern) = @_;
201
202			defined $pattern && !ref $pattern && length $pattern <= 512
203			or die "Invalid regex pattern\n";
204			my $regex = eval { qr/$pattern/ };
205			$@ and die "Invalid regex: $@";
206
207			$regex
208			}
209
210			sub filter_text {
211			my ($text, $args) = @_;
212
213			if (defined $args->{grep} \|\| defined $args->{regex}) {
214			my $grep = $args->{grep};
215			my $regex = defined $args->{regex} ? text_regex ($args->{regex}) : undef;
216			$text = join "", grep {
217			(!defined $grep \|\| index ($_, $grep) >= 0)
218			&& (!defined $regex \|\| /$regex/)
219			} split /(?<=\n)/, $text;
220			}
221
222			if (my $subst = $args->{substitute}) {
223			my $regex = text_regex ($subst->{pattern});
224			my $replacement = $subst->{replacement};
225			$text =~ s/$regex/$replacement/g;
226			}
227
228			$text
229			}
230
231			mcp_tool request => "HTTP request. Method and URL permissions. No redirects; caller-managed cookie_jar returned. "
232			. "UTF-8 body or Base64, bounded response, optional grep/regex/substitute.",
233			{
234			type => "object",
235			required => ["url"],
236			additionalProperties => JSON::XS::false,
237			properties => {
238			url => { type => "string", minLength => 1 },
239			method => { type => "string", default => "GET" },
240			headers => { type => "object", additionalProperties => { type => "string" } },
241			body => { type => "string", description => "UTF-8 request body" },
242			body_base64 => { type => "string", description => "Raw request body, Base64" },
243			cookie_jar => { type => "object", description => "AnyEvent::HTTP cookie jar returned by an earlier call" },
244			timeout => { type => "number", minimum => 1, maximum => 300, default => 30 },
245			max_bytes => { type => "integer", minimum => 1, maximum => 2097152, default => 65536 },
246			grep => { type => "string", description => "Keep lines containing this literal substring" },
247			regex => { type => "string", description => "Keep lines matching this Perl regex" },
248			substitute => {
249			type => "object",
250			required => ["pattern", "replacement"],
251			additionalProperties => JSON::XS::false,
252			properties => {
253			pattern => { type => "string", maxLength => 512 },
254			replacement => { type => "string", maxLength => 512 },
255			},
256			},
257			},
258			},
259			sub {
260			my ($req, $args) = @_;
261
262			my $method = $args->{method} // "GET";
263			$method =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
264			or die "Invalid HTTP method\n";
265			exists $args->{body} && exists $args->{body_base64}
266			and die "Specify body or body_base64, not both\n";
267			my ($url, $scopes) = url_scopes ($args->{url});
268
269			my $headers = $args->{headers} \|\| {};
270			for my $key (keys %$headers) {
271			$key =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
272			&& defined $headers->{$key} && !ref $headers->{$key}
273			&& $headers->{$key} !~ /[\r\n\x00]/
274			or die "Invalid HTTP header\n";
275			}
276			$headers = { %$headers };
277			$headers->{"User-Agent"} = "mcp-http/$AnyEvent::MCP::VERSION"
278			unless grep lc $_ eq "user-agent", keys %$headers;
279			my $data = exists $args->{body} ? (AnyEvent::MCP::utf8enc $args->{body}) : undef;
280			if (defined $args->{body_base64}) {
281			$args->{body_base64} =~ /\A(?:[A-Za-z0-9+\/]{4})*(?:[A-Za-z0-9+\/]{2}==\|[A-Za-z0-9+\/]{3}=)?\z/
282			or die "Invalid Base64 body\n";
283			$data = MIME::Base64::decode_base64 ($args->{body_base64});
284			}
285			!defined $data \|\| length $data <= 1048576 or die "Request body exceeds 1 MiB\n";
286			my $limit = $args->{max_bytes} // 65536;
287			$limit >= 1 && $limit <= 2097152 or die "Invalid max_bytes\n";
288
289			!defined $args->{grep} \|\| !ref $args->{grep} or die "Invalid grep\n";
290			text_regex ($args->{regex}) if defined $args->{regex};
291			if (defined $args->{substitute}) {
292			ref $args->{substitute} eq "HASH" && defined $args->{substitute}{replacement}
293			&& !ref $args->{substitute}{replacement} && length $args->{substitute}{replacement} <= 512
294			or die "Invalid substitute\n";
295			text_regex ($args->{substitute}{pattern});
296			}
297			my $jar = $args->{cookie_jar};
298			!defined $jar \|\| ref $jar eq "HASH" or die "Invalid cookie jar\n";
299
300			$req->require_permission ({
301			tool => $req->{tool},
302			action => $method,
303			dimensions => { url => { label => "URL", value => $url, choices => $scopes } },
304			sandbox_grants => [],
305			reason => "$method $url",
306			});
307
308			my $body = "";
309			my $truncated = 0;
310			my $response_headers;
311			my $guard;
312			$guard = AnyEvent::HTTP::http_request
313			$method => $url,
314			recurse => 0,
315			persistent => 0,
316			proxy => undef,
317			tls_ctx => "high",
318			timeout => $args->{timeout} // 30,
319			headers => $headers,
320			(defined $data ? (body => $data) : ()),
321			(defined $jar ? (cookie_jar => $jar) : ()),
322			on_header => sub {
323			$response_headers = { %{$_[0]} };
324			1
325			},
326			on_body => sub {
327			my ($part) = @_;
328			if (length ($body) + length ($part) > $limit) {
329			$body .= substr $part, 0, $limit - length $body;
330			$truncated = 1;
331			return 0;
332			}
333			$body .= $part;
334			1
335			},
336			sub {
337			my ($unused, $hdr) = @_;
338
339			undef $guard;
340			return if $req->{finished};
341			$hdr = $response_headers if $truncated && $response_headers;
342			my %result = (
343			status => 0 + $hdr->{Status},
344			reason => $hdr->{Reason},
345			headers => { map +($_ => $hdr->{$_}), grep /^[a-z]/, keys %$hdr },
346			captured_bytes => length $body,
347			truncated => $truncated ? JSON::XS::true : JSON::XS::false,
348			(defined $jar ? (cookie_jar => $jar) : ()),
349			);
350
351			if (defined $unused \|\| $truncated) {
352			my $bytes = $body;
353			my $text = eval { Encode::decode ("UTF-8", $bytes, Encode::FB_CROAK) };
354			if (defined $text) {
355			$text = filter_text ($text, $args);
356			if (length $text > $limit) {
357			$text = substr $text, 0, $limit;
358			$result{truncated} = JSON::XS::true;
359			}
360			$result{body} = $text;
361			} elsif (defined $args->{grep} \|\| defined $args->{regex} \|\| defined $args->{substitute}) {
362			$req->error ("Cannot filter a non-UTF-8 response");
363			return;
364			} else {
365			$result{body_base64} = MIME::Base64::encode_base64 ($body, "");
366			}
367			}
368
369			$req->result (\%result);
370			}
371			;
372			$req->{on_cancel} = sub { undef $guard };
373			};
374
375			mcp_start %$options;