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

When spawned as a multibroker stdio child, the server exits after five
minutes without MCP requests and is restarted on demand. Directly connected
clients and HTTP listeners are unaffected.

=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";

mcp_permissions +AnyEvent::MCP::Server::Permissions->new (
   name => "http-$options->{name}",
);

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