[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 switch is specific to C<mcp-http>.

=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.

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