[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

Common options: L<AnyEvent::MCP::Server::Simple/mcp_getoptions>.

=over

=item --ask MODE

Use helper (default), tty, yad, mcp or auto.

=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.",
      options     => [["--ask MODE", "Permission prompts: helper (default), tty, yad, mcp, auto"]],
      examples    => "  mcp-http --stdio\n",
   },
   "ask=s" => \my $ask,
;

@ARGV and die "Unexpected arguments\n";

my $permissions = AnyEvent::MCP::Server::Permissions->new (
   name => "http-$options->{name}",
   (defined $ask ? (ask => $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.4
Committed:	Thu Nov 5 00:39:05 2026 UTC (3 days, 1 hour ago) by root
Branch:	MAIN
Changes since 1.3:	+30 -0 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			Common options: L<AnyEvent::MCP::Server::Simple/mcp_getoptions>.
87
88			=over
89
90			=item --ask MODE
91
92			Use helper (default), tty, yad, mcp or auto.
93
94			=back
95
96			=cut
97
98			use common::sense;
99	root	1.3
100			use MIME::Base64 ();
101			use Encode ();
102			use JSON::XS ();
103
104	root	1.1	use AnyEvent::HTTP ();
105			use AnyEvent::MCP ();
106			use AnyEvent::MCP::Server::Permissions ();
107
108			use AnyEvent::MCP::Server::Simple;
109
110			my $options = mcp_getoptions
111			{
112			usage => "Usage: mcp-http [OPTION]...\n",
113			description => "HTTP requests with URL/method permissions and caller-managed cookies.",
114			options => [["--ask MODE", "Permission prompts: helper (default), tty, yad, mcp, auto"]],
115			examples => " mcp-http --stdio\n",
116			},
117			"ask=s" => \my $ask,
118			;
119
120			@ARGV and die "Unexpected arguments\n";
121
122			my $permissions = AnyEvent::MCP::Server::Permissions->new (
123			name => "http-$options->{name}",
124			(defined $ask ? (ask => $ask) : ()),
125			);
126
127			mcp_config
128			permissions => $permissions,
129			server_name => "mcp-http",
130			server_version => $AnyEvent::MCP::VERSION,
131			short_instructions => "HTTP requests with URL/method permissions; pass cookie_jar between calls. No redirects.",
132			instructions => "request makes authorized HTTP(S) requests. Method is the permission action. "
133			. "URL scopes range from exact URL to any HTTP(S) URL. No automatic redirects or retries. "
134			. "Pass a returned cookie_jar to subsequent calls. "
135			. "grep/regex select lines; substitute applies literal replacements. "
136			. "Responses may be truncated and failed writes can still have taken effect.",
137			on_request => sub {
138			my ($server, $req) = @_;
139
140			return mcp_log_request $server, $req
141			unless $req->{method} eq "tools/call" && $req->{tool} eq "request";
142
143			my $args = $req->{args};
144			my $method = $args->{method} // "GET";
145			my $url = $args->{url} // "";
146			$method = "<invalid>" if ref $method;
147			$url = "<invalid>" if ref $url;
148			$url =~ s/[?#].*//s;
149			$url =~ s{(://)[^/@]*@}{$1};
150			$url =~ s/[\x00-\x1f\x7f]/ /g;
151
152	root	1.2	mcp_log_request $server, $req,
153			method => (substr $method, 0, 20),
154			url => (substr $url, 0, 160);
155	root	1.1	};
156
157			sub url_scopes {
158			my ($url) = @_;
159
160			defined $url && !ref $url && $url !~ /[\x00-\x20\x7f]/
161			or die "Invalid URL\n";
162			$url =~ m{\A(https?)://(\[[0-9a-f:.]+\]\|[a-z0-9.-]+)(?::([0-9]+))?([^#])(?:#.)?\z}i
163			or die "Expected HTTP(S) URL without userinfo\n";
164
165			my ($scheme, $host, $port, $rest) = (lc $1, lc $2, $3, $4);
166			!defined $port \|\| $port >= 1 && $port <= 65535
167			or die "Invalid URL port\n";
168			$port = undef if defined $port && $port == ($scheme eq "https" ? 443 : 80);
169			$rest =~ m{\A(?:/\|\?\|\z)} or die "Invalid URL path\n";
170			$rest = "/$rest" unless $rest =~ m{\A/};
171
172			my $origin = "$scheme://$host" . (defined $port ? ":$port" : "");
173			my $path = $rest;
174			$path =~ s/\?.*//s;
175			my $full = "$origin$rest";
176			my @choices = (
177			{ label => "Exact URL including query", match => $full },
178			{ label => "This path, any query",
179			match => "^" . (quotemeta "$origin$path") . "(?:\\?.*)?\\z" },
180			{ label => "This origin (scheme, host, port)",
181			match => "^" . (quotemeta $origin) . "/" },
182			{ label => "This hostname, any scheme or port",
183			match => "^https?://" . (quotemeta $host) . "(?::[0-9]+)?/" },
184			);
185			if ($host !~ /^\[/ && $host =~ /\./ && $host !~ /^[0-9.]+$/) {
186			push @choices, {
187			label => "Hostname and subdomains, any scheme or port",
188			match => "^https?://(?:[a-z0-9-]+\\.)*" . (quotemeta $host) . "(?::[0-9]+)?/",
189			};
190			}
191			push @choices, { label => "Any HTTP(S) URL", match => "^https?://" };
192
193			($full, \@choices)
194			}
195
196			sub text_regex {
197			my ($pattern) = @_;
198
199			defined $pattern && !ref $pattern && length $pattern <= 512
200			or die "Invalid regex pattern\n";
201			my $regex = eval { qr/$pattern/ };
202			$@ and die "Invalid regex: $@";
203
204			$regex
205			}
206
207			sub filter_text {
208			my ($text, $args) = @_;
209
210			if (defined $args->{grep} \|\| defined $args->{regex}) {
211			my $grep = $args->{grep};
212			my $regex = defined $args->{regex} ? text_regex ($args->{regex}) : undef;
213			$text = join "", grep {
214			(!defined $grep \|\| index ($_, $grep) >= 0)
215			&& (!defined $regex \|\| /$regex/)
216			} split /(?<=\n)/, $text;
217			}
218
219			if (my $subst = $args->{substitute}) {
220			my $regex = text_regex ($subst->{pattern});
221			my $replacement = $subst->{replacement};
222			$text =~ s/$regex/$replacement/g;
223			}
224
225			$text
226			}
227
228			mcp_tool request => "HTTP request. Method and URL permissions. No redirects; caller-managed cookie_jar returned. "
229			. "UTF-8 body or Base64, bounded response, optional grep/regex/substitute.",
230			{
231			type => "object",
232			required => ["url"],
233			additionalProperties => JSON::XS::false,
234			properties => {
235			url => { type => "string", minLength => 1 },
236			method => { type => "string", default => "GET" },
237			headers => { type => "object", additionalProperties => { type => "string" } },
238			body => { type => "string", description => "UTF-8 request body" },
239			body_base64 => { type => "string", description => "Raw request body, Base64" },
240			cookie_jar => { type => "object", description => "AnyEvent::HTTP cookie jar returned by an earlier call" },
241			timeout => { type => "number", minimum => 1, maximum => 300, default => 30 },
242			max_bytes => { type => "integer", minimum => 1, maximum => 2097152, default => 65536 },
243			grep => { type => "string", description => "Keep lines containing this literal substring" },
244			regex => { type => "string", description => "Keep lines matching this Perl regex" },
245			substitute => {
246			type => "object",
247			required => ["pattern", "replacement"],
248			additionalProperties => JSON::XS::false,
249			properties => {
250			pattern => { type => "string", maxLength => 512 },
251			replacement => { type => "string", maxLength => 512 },
252			},
253			},
254			},
255			},
256			sub {
257			my ($req, $args) = @_;
258
259			my $method = $args->{method} // "GET";
260			$method =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
261			or die "Invalid HTTP method\n";
262			exists $args->{body} && exists $args->{body_base64}
263			and die "Specify body or body_base64, not both\n";
264			my ($url, $scopes) = url_scopes ($args->{url});
265
266			my $headers = $args->{headers} \|\| {};
267			for my $key (keys %$headers) {
268			$key =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
269			&& defined $headers->{$key} && !ref $headers->{$key}
270			&& $headers->{$key} !~ /[\r\n\x00]/
271			or die "Invalid HTTP header\n";
272			}
273			$headers = { %$headers };
274			$headers->{"User-Agent"} = "mcp-http/$AnyEvent::MCP::VERSION"
275			unless grep lc $_ eq "user-agent", keys %$headers;
276			my $data = exists $args->{body} ? (AnyEvent::MCP::utf8enc $args->{body}) : undef;
277			if (defined $args->{body_base64}) {
278			$args->{body_base64} =~ /\A(?:[A-Za-z0-9+\/]{4})*(?:[A-Za-z0-9+\/]{2}==\|[A-Za-z0-9+\/]{3}=)?\z/
279			or die "Invalid Base64 body\n";
280			$data = MIME::Base64::decode_base64 ($args->{body_base64});
281			}
282			!defined $data \|\| length $data <= 1048576 or die "Request body exceeds 1 MiB\n";
283			my $limit = $args->{max_bytes} // 65536;
284			$limit >= 1 && $limit <= 2097152 or die "Invalid max_bytes\n";
285
286			!defined $args->{grep} \|\| !ref $args->{grep} or die "Invalid grep\n";
287			text_regex ($args->{regex}) if defined $args->{regex};
288			if (defined $args->{substitute}) {
289			ref $args->{substitute} eq "HASH" && defined $args->{substitute}{replacement}
290			&& !ref $args->{substitute}{replacement} && length $args->{substitute}{replacement} <= 512
291			or die "Invalid substitute\n";
292			text_regex ($args->{substitute}{pattern});
293			}
294			my $jar = $args->{cookie_jar};
295			!defined $jar \|\| ref $jar eq "HASH" or die "Invalid cookie jar\n";
296
297			$req->require_permission ({
298			tool => $req->{tool},
299			action => $method,
300			dimensions => { url => { label => "URL", value => $url, choices => $scopes } },
301			sandbox_grants => [],
302			reason => "$method $url",
303			});
304
305			my $body = "";
306			my $truncated = 0;
307			my $response_headers;
308			my $guard;
309			$guard = AnyEvent::HTTP::http_request
310			$method => $url,
311			recurse => 0,
312			persistent => 0,
313			proxy => undef,
314			tls_ctx => "high",
315			timeout => $args->{timeout} // 30,
316			headers => $headers,
317			(defined $data ? (body => $data) : ()),
318			(defined $jar ? (cookie_jar => $jar) : ()),
319			on_header => sub {
320			$response_headers = { %{$_[0]} };
321			1
322			},
323			on_body => sub {
324			my ($part) = @_;
325			if (length ($body) + length ($part) > $limit) {
326			$body .= substr $part, 0, $limit - length $body;
327			$truncated = 1;
328			return 0;
329			}
330			$body .= $part;
331			1
332			},
333			sub {
334			my ($unused, $hdr) = @_;
335
336			undef $guard;
337			return if $req->{finished};
338			$hdr = $response_headers if $truncated && $response_headers;
339			my %result = (
340			status => 0 + $hdr->{Status},
341			reason => $hdr->{Reason},
342			headers => { map +($_ => $hdr->{$_}), grep /^[a-z]/, keys %$hdr },
343			captured_bytes => length $body,
344			truncated => $truncated ? JSON::XS::true : JSON::XS::false,
345			(defined $jar ? (cookie_jar => $jar) : ()),
346			);
347
348			if (defined $unused \|\| $truncated) {
349			my $bytes = $body;
350			my $text = eval { Encode::decode ("UTF-8", $bytes, Encode::FB_CROAK) };
351			if (defined $text) {
352			$text = filter_text ($text, $args);
353			if (length $text > $limit) {
354			$text = substr $text, 0, $limit;
355			$result{truncated} = JSON::XS::true;
356			}
357			$result{body} = $text;
358			} elsif (defined $args->{grep} \|\| defined $args->{regex} \|\| defined $args->{substitute}) {
359			$req->error ("Cannot filter a non-UTF-8 response");
360			return;
361			} else {
362			$result{body_base64} = MIME::Base64::encode_base64 ($body, "");
363			}
364			}
365
366			$req->result (\%result);
367			}
368			;
369			$req->{on_cancel} = sub { undef $guard };
370			};
371
372			mcp_start %$options;