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