[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, (substr $method, 0, 20) . " " . (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.1
Committed:	Wed Oct 28 22:28:23 2026 UTC (11 days, 6 hours ago) by root
Branch:	MAIN
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			mcp_log_request $server, $req, (substr $method, 0, 20) . " " . (substr $url, 0, 160);
121			};
122
123			sub url_scopes {
124			my ($url) = @_;
125
126			defined $url && !ref $url && $url !~ /[\x00-\x20\x7f]/
127			or die "Invalid URL\n";
128			$url =~ m{\A(https?)://(\[[0-9a-f:.]+\]\|[a-z0-9.-]+)(?::([0-9]+))?([^#])(?:#.)?\z}i
129			or die "Expected HTTP(S) URL without userinfo\n";
130
131			my ($scheme, $host, $port, $rest) = (lc $1, lc $2, $3, $4);
132			!defined $port \|\| $port >= 1 && $port <= 65535
133			or die "Invalid URL port\n";
134			$port = undef if defined $port && $port == ($scheme eq "https" ? 443 : 80);
135			$rest =~ m{\A(?:/\|\?\|\z)} or die "Invalid URL path\n";
136			$rest = "/$rest" unless $rest =~ m{\A/};
137
138			my $origin = "$scheme://$host" . (defined $port ? ":$port" : "");
139			my $path = $rest;
140			$path =~ s/\?.*//s;
141			my $full = "$origin$rest";
142			my @choices = (
143			{ label => "Exact URL including query", match => $full },
144			{ label => "This path, any query",
145			match => "^" . (quotemeta "$origin$path") . "(?:\\?.*)?\\z" },
146			{ label => "This origin (scheme, host, port)",
147			match => "^" . (quotemeta $origin) . "/" },
148			{ label => "This hostname, any scheme or port",
149			match => "^https?://" . (quotemeta $host) . "(?::[0-9]+)?/" },
150			);
151			if ($host !~ /^\[/ && $host =~ /\./ && $host !~ /^[0-9.]+$/) {
152			push @choices, {
153			label => "Hostname and subdomains, any scheme or port",
154			match => "^https?://(?:[a-z0-9-]+\\.)*" . (quotemeta $host) . "(?::[0-9]+)?/",
155			};
156			}
157			push @choices, { label => "Any HTTP(S) URL", match => "^https?://" };
158
159			($full, \@choices)
160			}
161
162			sub text_regex {
163			my ($pattern) = @_;
164
165			defined $pattern && !ref $pattern && length $pattern <= 512
166			or die "Invalid regex pattern\n";
167			my $regex = eval { qr/$pattern/ };
168			$@ and die "Invalid regex: $@";
169
170			$regex
171			}
172
173			sub filter_text {
174			my ($text, $args) = @_;
175
176			if (defined $args->{grep} \|\| defined $args->{regex}) {
177			my $grep = $args->{grep};
178			my $regex = defined $args->{regex} ? text_regex ($args->{regex}) : undef;
179			$text = join "", grep {
180			(!defined $grep \|\| index ($_, $grep) >= 0)
181			&& (!defined $regex \|\| /$regex/)
182			} split /(?<=\n)/, $text;
183			}
184
185			if (my $subst = $args->{substitute}) {
186			my $regex = text_regex ($subst->{pattern});
187			my $replacement = $subst->{replacement};
188			$text =~ s/$regex/$replacement/g;
189			}
190
191			$text
192			}
193
194			mcp_tool request => "HTTP request. Method and URL permissions. No redirects; caller-managed cookie_jar returned. "
195			. "UTF-8 body or Base64, bounded response, optional grep/regex/substitute.",
196			{
197			type => "object",
198			required => ["url"],
199			additionalProperties => JSON::XS::false,
200			properties => {
201			url => { type => "string", minLength => 1 },
202			method => { type => "string", default => "GET" },
203			headers => { type => "object", additionalProperties => { type => "string" } },
204			body => { type => "string", description => "UTF-8 request body" },
205			body_base64 => { type => "string", description => "Raw request body, Base64" },
206			cookie_jar => { type => "object", description => "AnyEvent::HTTP cookie jar returned by an earlier call" },
207			timeout => { type => "number", minimum => 1, maximum => 300, default => 30 },
208			max_bytes => { type => "integer", minimum => 1, maximum => 2097152, default => 65536 },
209			grep => { type => "string", description => "Keep lines containing this literal substring" },
210			regex => { type => "string", description => "Keep lines matching this Perl regex" },
211			substitute => {
212			type => "object",
213			required => ["pattern", "replacement"],
214			additionalProperties => JSON::XS::false,
215			properties => {
216			pattern => { type => "string", maxLength => 512 },
217			replacement => { type => "string", maxLength => 512 },
218			},
219			},
220			},
221			},
222			sub {
223			my ($req, $args) = @_;
224
225			my $method = $args->{method} // "GET";
226			$method =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
227			or die "Invalid HTTP method\n";
228			exists $args->{body} && exists $args->{body_base64}
229			and die "Specify body or body_base64, not both\n";
230			my ($url, $scopes) = url_scopes ($args->{url});
231
232			my $headers = $args->{headers} \|\| {};
233			for my $key (keys %$headers) {
234			$key =~ /\A[A-Za-z0-9!#\$%&'*+.^_\x60\|~-]+\z/
235			&& defined $headers->{$key} && !ref $headers->{$key}
236			&& $headers->{$key} !~ /[\r\n\x00]/
237			or die "Invalid HTTP header\n";
238			}
239			$headers = { %$headers };
240			$headers->{"User-Agent"} = "mcp-http/$AnyEvent::MCP::VERSION"
241			unless grep lc $_ eq "user-agent", keys %$headers;
242			my $data = exists $args->{body} ? (AnyEvent::MCP::utf8enc $args->{body}) : undef;
243			if (defined $args->{body_base64}) {
244			$args->{body_base64} =~ /\A(?:[A-Za-z0-9+\/]{4})*(?:[A-Za-z0-9+\/]{2}==\|[A-Za-z0-9+\/]{3}=)?\z/
245			or die "Invalid Base64 body\n";
246			$data = MIME::Base64::decode_base64 ($args->{body_base64});
247			}
248			!defined $data \|\| length $data <= 1048576 or die "Request body exceeds 1 MiB\n";
249			my $limit = $args->{max_bytes} // 65536;
250			$limit >= 1 && $limit <= 2097152 or die "Invalid max_bytes\n";
251
252			!defined $args->{grep} \|\| !ref $args->{grep} or die "Invalid grep\n";
253			text_regex ($args->{regex}) if defined $args->{regex};
254			if (defined $args->{substitute}) {
255			ref $args->{substitute} eq "HASH" && defined $args->{substitute}{replacement}
256			&& !ref $args->{substitute}{replacement} && length $args->{substitute}{replacement} <= 512
257			or die "Invalid substitute\n";
258			text_regex ($args->{substitute}{pattern});
259			}
260			my $jar = $args->{cookie_jar};
261			!defined $jar \|\| ref $jar eq "HASH" or die "Invalid cookie jar\n";
262
263			$req->require_permission ({
264			tool => $req->{tool},
265			action => $method,
266			dimensions => { url => { label => "URL", value => $url, choices => $scopes } },
267			sandbox_grants => [],
268			reason => "$method $url",
269			});
270
271			my $body = "";
272			my $truncated = 0;
273			my $response_headers;
274			my $guard;
275			$guard = AnyEvent::HTTP::http_request
276			$method => $url,
277			recurse => 0,
278			persistent => 0,
279			proxy => undef,
280			tls_ctx => "high",
281			timeout => $args->{timeout} // 30,
282			headers => $headers,
283			(defined $data ? (body => $data) : ()),
284			(defined $jar ? (cookie_jar => $jar) : ()),
285			on_header => sub {
286			$response_headers = { %{$_[0]} };
287			1
288			},
289			on_body => sub {
290			my ($part) = @_;
291			if (length ($body) + length ($part) > $limit) {
292			$body .= substr $part, 0, $limit - length $body;
293			$truncated = 1;
294			return 0;
295			}
296			$body .= $part;
297			1
298			},
299			sub {
300			my ($unused, $hdr) = @_;
301
302			undef $guard;
303			return if $req->{finished};
304			$hdr = $response_headers if $truncated && $response_headers;
305			my %result = (
306			status => 0 + $hdr->{Status},
307			reason => $hdr->{Reason},
308			headers => { map +($_ => $hdr->{$_}), grep /^[a-z]/, keys %$hdr },
309			captured_bytes => length $body,
310			truncated => $truncated ? JSON::XS::true : JSON::XS::false,
311			(defined $jar ? (cookie_jar => $jar) : ()),
312			);
313
314			if (defined $unused \|\| $truncated) {
315			my $bytes = $body;
316			my $text = eval { Encode::decode ("UTF-8", $bytes, Encode::FB_CROAK) };
317			if (defined $text) {
318			$text = filter_text ($text, $args);
319			if (length $text > $limit) {
320			$text = substr $text, 0, $limit;
321			$result{truncated} = JSON::XS::true;
322			}
323			$result{body} = $text;
324			} elsif (defined $args->{grep} \|\| defined $args->{regex} \|\| defined $args->{substitute}) {
325			$req->error ("Cannot filter a non-UTF-8 response");
326			return;
327			} else {
328			$result{body_base64} = MIME::Base64::encode_base64 ($body, "");
329			}
330			}
331
332			$req->result (\%result);
333			}
334			;
335			$req->{on_cancel} = sub { undef $guard };
336			};
337
338			mcp_start %$options;