[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 AnyEvent::HTTP ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Server::Permissions ();
use MIME::Base64 ();
use Encode ();
use JSON::XS ();

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