AnyEvent-MCP

 view release on metacpan or  search on metacpan

lib/AnyEvent/MCP/Client/HTTP.pm  view on Meta::CPAN

}

sub _send {
   my ($self, $message, $done) = @_;

   my $key = exists $message->{id} && !exists $message->{result} && !exists $message->{error}
      ? $message->{id} : "send:" . ++$self->{send_id};
   my $generation = $self->{generation};
   my %headers = (
      %{$self->{headers} || {}},
      "content-type" => "application/json",
      accept         => "application/json, text/event-stream",
   );

   $headers{authorization} = "Bearer $self->{bearer}" if defined $self->{bearer};
   $headers{"mcp-protocol-version"} = $self->{protocol_version} if defined $self->{protocol_version};
   $headers{"mcp-session-id"} = $self->{session}
      if $self->{protocol_version} lt "2026" && defined $self->{session};

   if ($self->{protocol_version} ge "2026" && exists $message->{method} && exists $message->{id}) {
      $headers{"mcp-method"} = $message->{method};

lib/AnyEvent/MCP/Client/HTTP.pm  view on Meta::CPAN

         (map { exists $self->{$_} ? ($_ => $self->{$_}) : () }
            qw(timeout proxy tls_ctx handle_params sessionid on_prepare on_connect tcp_connect)),
         headers    => \%headers,
         body       => JSON::XS::encode_json ($message),
         recurse    => 0,
         persistent => 0,
         on_header  => sub {
            my ($hdr) = @_;

            return 0 unless $self && $self->{generation} == $generation;
            $sse = $hdr->{"content-type"} =~ m{\Atext/event-stream(?:\s*;|\z)}i;
            if ($message->{method} eq "initialize" && $hdr->{Status} >= 200 && $hdr->{Status} < 300
               && defined $hdr->{"mcp-session-id"}) {
               $self->{session} = $hdr->{"mcp-session-id"};
            }
            1
         },
         on_body => sub {
            my ($chunk, $hdr) = @_;

            return 0 unless $self && $self->{generation} == $generation;

lib/AnyEvent/MCP/Server/HTTP.pm  view on Meta::CPAN

               if defined $authenticated && $authenticated ne $token;
            $authenticated = $token;
         }
      }

      return $self->_respond ($handle, 401, "Unauthorized", "")
         unless defined $authenticated;
   }

   return $self->_respond ($handle, 415, "Unsupported Media Type", "")
      unless $hdr->{"content-type"} =~ m{\Aapplication/json(?:\s*;|\z)}i;

   my $message = eval { JSON::XS::decode_json $body };

   if ($@) {
      return $self->_rpc_error (sub {
         $self->_respond ($handle, 400, "Bad Request", JSON::XS::encode_json $_[0]);
      }, undef, -32700, "Parse error");
   }

   my $params = ref $message eq "HASH" && ref $message->{params} eq "HASH" ? $message->{params} : {};

lib/AnyEvent/MCP/Server/HTTP.pm  view on Meta::CPAN

   my $extra = "";

   if ($headers) {
      ref $headers eq "HASH" or die "HTTP response headers must be a hash\n";
      while (my ($name, $value) = each %$headers) {
         $name =~ /\A[!#\$%&'*+.^_`|~0-9A-Za-z-]+\z/
            && defined $value && !ref $value && $value !~ /[\r\n\0]/
            or die "Invalid HTTP response header\n";
         $name !~ /\A(?:content-length|connection|transfer-encoding)\z/i
            or die "HTTP response framing headers are managed by the server\n";
         if (lc $name eq "content-type") {
            $content_type = $value;
         } else {
            $extra .= "$name: $value\r\n";
         }
      }
   }

   if ($status >= 400) {
      my $level = $status == 404 ? "trace" : "warn";
      AE::log $level => "MCP HTTP"

lib/AnyEvent/MCP/Server/HTTP.pm  view on Meta::CPAN

   my $close = $handle->{mcp_close} || $status != 200 && $status != 202;

   $handle->push_write (
      "HTTP/1.1 $status $reason\r\n"
      . "Content-Type: $content_type\r\n"
      . "Content-Length: " . (length $body) . "\r\n"
      . $extra
      . (defined $handle->{mcp_origin} ? "Access-Control-Allow-Origin: $handle->{mcp_origin}\r\n"
         . ($handle->{mcp_origin} ne "*" ? "Vary: Origin\r\n" : "") : "")
      . ($status == 204 ? "Access-Control-Allow-Methods: POST, OPTIONS\r\n"
         . "Access-Control-Allow-Headers: content-type,authorization,mcp-protocol-version,mcp-method,mcp-name\r\n"
         . "Access-Control-Max-Age: 86400\r\n" : "")
      . ($status == 405 ? "Allow: POST" . (@{$self->{origins}} ? ", OPTIONS" : "") . "\r\n" : "")
      . ($status == 401 && $self->{tokens} ? "WWW-Authenticate: Bearer\r\n" : "")
      . ($close ? "Connection: close\r\n" : "")
      . "\r\n$body"
   );

   if ($close) {
      weaken $self;
      $handle->on_drain (sub { $self->_close ($_[0]) if $self });

t/c01_server.t  view on Meta::CPAN

   $http->accept ($a);
   $client = AnyEvent::Handle->new (fh => $b, on_error => sub { die $_[2] });
   $cv = AnyEvent->condvar;
   $timer = AnyEvent->timer (after => 30, cb => sub { die "CORS timeout" });

   my $request = $method eq "POST"
      ? post (message (50, "ping"), defined $origin ? "Origin: $origin\r\n" : "")
      : "OPTIONS /mcp/ HTTP/1.1\r\n"
         . (defined $origin ? "Origin: $origin\r\n" : "")
         . "Access-Control-Request-Method: POST\r\n"
         . "Access-Control-Request-Headers: content-type,mcp-method\r\n\r\n";
   $request =~ s{POST /mcp/}{POST /token/mcp/} if $cookie;

   $client->push_write ($request);
   http_read ($client, sub {
      my ($header) = @_;

      like $header, qr/HTTP\/1.1 $status /, "CORS $method status";
      if (defined $allowed) {
         like $header, qr/^Access-Control-Allow-Origin: \Q$allowed\E\r?$/m, "allowed origin";
         like $header, qr/^Vary: Origin\r?$/m, "vary by allowed origin" if $allowed ne "*";

t/c06_multibroker.t  view on Meta::CPAN

   for (1 .. 1500) {
      $socket = IO::Socket::INET->new (PeerAddr => "127.0.0.1", PeerPort => $port, Proto => "tcp", Timeout => 1);
      last if $socket;
      Time::HiRes::sleep (0.02);
   }
   $socket or die "CORS test socket: $!\n";
   print {$socket}
      "OPTIONS $path HTTP/1.1\r\nHost: localhost\r\n"
      . "Origin: http://localhost:5001\r\n"
      . "Access-Control-Request-Method: POST\r\n"
      . "Access-Control-Request-Headers: content-type,authorization\r\n\r\n";
   my $preflight;
   {
      local $/ = "\r\n\r\n";
      $preflight = <$socket>;
   }
   close $socket;
   my $allowed = "*";
   my $preflight_ok = $preflight =~ /HTTP\/1\.1 204/
      && $preflight =~ /^Access-Control-Allow-Origin: \Q$allowed\E\r?$/m;
   ok $preflight_ok, "CORS preflight allows any origin by default";

t/c25_http.t  view on Meta::CPAN

$r = call_http ({ url => "$base/page", verify_tls => JSON::XS::false });
is $r->{structuredContent}{status}, 200, "verify_tls=false accepted";
$r = call_http ({ url => "$base/page", verify_tls => JSON::XS::true });
is $r->{structuredContent}{status}, 200, "verify_tls=true accepted";
$r = call_http ({ url => "$base/page", verify_tls => "false" });
ok $r->{isError}, "non-boolean verify_tls rejected";

$r = call_http ({
   url => "$base/post", method => "POST", cookie_jar => $jar,
   headers => { "content-type" => "application/octet-stream" },
   body_base64 => MIME::Base64::encode_base64 ("A\0B", ""),
});
is $r->{structuredContent}{body}, "A\0B", "binary request body preserved";
like $seen[-1][2], qr/^cookie:\s*sid=abc/im, "cookie sent from caller-provided jar";
is $seen[-1][0], "POST", "HTTP method forwarded";

$r = call_http ({ url => "$base/page", headers => { "uSeR-aGeNt" => "custom-agent/1" } });
is $r->{structuredContent}{status}, 200, "custom User-Agent request succeeded";
like $seen[-1][2], qr/^user-agent:\s*custom-agent\/1\s*$/im,
   "explicit User-Agent is not overridden";