diff options
Diffstat (limited to 't')
42 files changed, 5040 insertions, 0 deletions
diff --git a/t/00use.t b/t/00use.t new file mode 100644 index 0000000..b7e97d0 --- /dev/null +++ b/t/00use.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use_ok( "Net::Async::HTTP" ); + +done_testing; diff --git a/t/01request.t b/t/01request.t new file mode 100644 index 0000000..ce56199 --- /dev/null +++ b/t/01request.t @@ -0,0 +1,571 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +ok( defined $http, 'defined $http' ); +isa_ok( $http, "Net::Async::HTTP", '$http isa Net::Async::HTTP' ); + +$loop->add( $http ); + +my $hostnum = 0; + +sub do_test_req +{ + my $name = shift; + my %args = @_; + + my $response; + my $error; + + my $request = $args{req}; + my $host = $args{no_host} ? $request->uri->host : $http->{proxy_host} || "host$hostnum"; $hostnum++; + my $service = $http->{proxy_port} || 80; + + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq $host or die "Expected $args{host} eq $host"; + $args{service} eq $service or die "Expected $args{service} eq $service"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $future = $http->do_request( + request => $request, + ( $args{no_host} ? () : ( host => $host ) ), + + timeout => 10, + + on_response => sub { $response = $_[0] }, + on_error => sub { $error = $_[0] }, + ); + $future->on_fail( sub { $future->get } ) unless $args{expect_error}; + + ok( defined $future, "\$future defined for $name" ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, $args{expect_req_firstline}, "First line for $name" ); + + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + my %req_headers = map { m/^([^:]+):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + my $req_content; + if( defined( my $len = $req_headers{'Content-Length'} ) ) { + wait_for { length( $request_stream ) >= $len }; + + $req_content = substr( $request_stream, 0, $len ); + substr( $request_stream, 0, $len ) = ""; + } + + my $expect_req_headers = $args{expect_req_headers}; + + foreach my $header ( keys %$expect_req_headers ) { + is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); + } + + if( defined $args{expect_req_content} ) { + is( $req_content, $args{expect_req_content}, "Request content for $name" ); + } + + $peersock->syswrite( $args{response} ); + $peersock->close if $args{close_after_response}; + + # Future shouldn't be ready yet + ok( !$future->is_ready, "\$future is not ready before response given for $name" ); + + # Wait for the server to finish its response + wait_for { defined $response or defined $error }; + + if( $args{expect_error} ) { + ok( defined $error, "Expected error for $name" ); + return; + } + else { + ok( !defined $error, "Failed to error for $name" ); + if( defined $error ) { + diag( "Got error $error" ); + } + } + + identical( $response->request, $request, "\$response->request is \$request for $name" ); + + ok( $future->is_ready, "\$future is now ready after response given for $name" ); + identical( scalar $future->get, $response, "\$future->get yields \$response for $name" ); + + if( exists $args{expect_res_code} ) { + is( $response->code, $args{expect_res_code}, "Result code for $name" ); + } + + if( exists $args{expect_res_content} ) { + is( $response->content, $args{expect_res_content}, "Result content for $name" ); + } + + if( exists $args{expect_res_headers} ) { + my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; + + is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); + } +} + +my $req; + +$req = HTTP::Request->new( HEAD => "/some/path", [ Host => "myhost" ] ); + +do_test_req( "simple HEAD", + req => $req, + + expect_req_firstline => "HEAD /some/path HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: keep-alive$CRLF" . + $CRLF, + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "keep-alive", + }, + expect_res_content => "", +); + +$req = HTTP::Request->new( GET => "/some/path", [ Host => "myhost" ] ); + +do_test_req( "simple GET", + req => $req, + host => "myhost", + + expect_req_firstline => "GET /some/path HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Hello, world!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Hello, world!", +); + +$req = HTTP::Request->new( GET => "http://myhost/some/path" ); + +do_test_req( "GET to full URL", + req => $req, + host => "myhost", + + expect_req_firstline => "GET /some/path HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Hello, world!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Hello, world!", +); + +{ + $http->configure( proxy_host => 'proxyhost', proxy_port => 3128 ); + + do_test_req( "GET over proxy", + req => $req, + host => "myhost", + + expect_req_firstline => "GET http://myhost/some/path HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Hello, world!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Hello, world!", + ); + + $http->configure( proxy_host => undef, proxy_port => undef ); +} + +$req = HTTP::Request->new( GET => "/empty", [ Host => "myhost" ] ); + +do_test_req( "GET with empty body", + req => $req, + host => "myhost", + + expect_req_firstline => "GET /empty HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF, + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 0, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "", +); + +$req = HTTP::Request->new( GET => "/" ); + +do_test_req( "GET with no response headers", + req => $req, + host => "myhost", + + expect_req_firstline => "GET / HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.0 200 OK$CRLF". + $CRLF . + "Your data here", + close_after_response => 1, + + expect_res_code => 200, + expect_req_headers => {}, + expect_res_content => "Your data here", +); + +$req = HTTP::Request->new( GET => "/somethingmissing", [ Host => "somewhere" ] ); + +do_test_req( "GET not found", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /somethingmissing HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 404 Not Found$CRLF" . + "Content-Length: 0$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF, + + expect_res_code => 404, + expect_res_headers => { + 'Content-Length' => 0, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "", +); + +$req = HTTP::Request->new( GET => "/stream", [ Host => "somewhere" ] ); + +do_test_req( "GET chunks", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /stream HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "Transfer-Encoding: chunked$CRLF" . + $CRLF . + "7$CRLF" . "Hello, " . $CRLF . + # Handle trailing whitespace on chunk size + "6 $CRLF" . "world!" . $CRLF . + "0$CRLF" . + "$CRLF", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + 'Transfer-Encoding' => "chunked", + }, + expect_res_content => "Hello, world!", +); + +do_test_req( "GET chunks LWS stripping", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /stream HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "Transfer-Encoding: chunked $CRLF" . + $CRLF . + "7$CRLF" . "Hello, " . $CRLF . + "6$CRLF" . "world!" . $CRLF . + "0$CRLF" . + "$CRLF", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + 'Transfer-Encoding' => "chunked", + }, + expect_res_content => "Hello, world!", +); + +do_test_req( "GET chunks corrupted", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /stream HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 500 Internal Server Error$CRLF" . + "Content-Length: 21$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "Transfer-Encoding: chunked$CRLF" . + $CRLF . + "Internal Server Error" . $CRLF, # no chunk header + close_after_response => 1, + + expect_error => 1, +); + +$req = HTTP::Request->new( GET => "/untileof", [ Host => "somewhere" ] ); + +do_test_req( "GET unspecified length", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /untileof HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: close$CRLF" . + $CRLF . + "Some more content here", + close_after_response => 1, + + expect_res_code => 200, + expect_res_headers => { + 'Content-Type' => "text/plain", + 'Connection' => "close", + }, + expect_res_content => "Some more content here", +); + +do_test_req( "GET unspecified length LWS stripping", + req => $req, + host => "somewhere", + + expect_req_firstline => "GET /untileof HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: close $CRLF" . + $CRLF . + "Some more content here", + close_after_response => 1, + + expect_res_code => 200, + expect_res_headers => { + 'Content-Type' => "text/plain", + 'Connection' => "close", + }, + expect_res_content => "Some more content here", +); + +$req = HTTP::Request->new( POST => "/handler", [ Host => "somewhere" ], "New content" ); + +do_test_req( "simple POST", + req => $req, + host => "somewhere", + + expect_req_firstline => "POST /handler HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + 'Content-Length' => 11, + }, + expect_req_content => "New content", + + response => "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 11$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "New content", + + expect_res_code => 201, + expect_res_headers => { + 'Content-Length' => 11, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "New content", +); + +$req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ], "New content" ); + +do_test_req( "simple PUT", + req => $req, + host => "somewhere", + + expect_req_firstline => "PUT /handler HTTP/1.1", + expect_req_headers => { + Host => "somewhere", + 'Content-Length' => 11, + }, + expect_req_content => "New content", + + response => "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF, + + expect_res_code => 201, + expect_res_headers => { + 'Content-Length' => 0, + 'Connection' => "Keep-Alive", + }, +); + +$req = HTTP::Request->new( GET => "http://somehost/with/path" ); + +do_test_req( "request-implied host", + req => $req, + no_host => 1, + + expect_req_firstline => "GET /with/path HTTP/1.1", + expect_req_headers => { + Host => "somehost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 2$CRLF" . + "Content-Type: text/plain$CRLF" . + $CRLF . + "OK", + + expect_res_code => 200, +); + +$req = HTTP::Request->new( GET => "http://user:pass\@somehost2/with/secret" ); + +do_test_req( "request-implied authentication", + req => $req, + no_host => 1, + + expect_req_firstline => "GET /with/secret HTTP/1.1", + expect_req_headers => { + Host => "somehost2", + Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 4$CRLF" . + "Content-Type: text/plain$CRLF" . + $CRLF . + "Booo", + + expect_res_code => 200, +); + +$req = HTTP::Request->new( GET => "/", [ Host => "myhost" ] ); + +do_test_req( "Non-HTTP response", + req => $req, + host => "myhost", + + expect_req_firstline => "GET / HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "Some other protocol, sorry\n", + + expect_error => 1, +); + +done_testing; diff --git a/t/02uri.t b/t/02uri.t new file mode 100644 index 0000000..cff36dd --- /dev/null +++ b/t/02uri.t @@ -0,0 +1,392 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +# Most of this function copypasted from t/01http-req.t + +sub do_test_uri +{ + my $name = shift; + my %args = @_; + + my $response; + my $error; + + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + $http->do_request( + uri => $args{uri}, + method => $args{method}, + user => $args{user}, + pass => $args{pass}, + headers => $args{headers}, + content => $args{content}, + content_type => $args{content_type}, + + on_response => sub { $response = $_[0] }, + on_error => sub { $error = $_[0] }, + ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, $args{expect_req_firstline}, "First line for $name" ); + + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + my $req_content; + if( defined( my $len = $req_headers{'Content-Length'} ) ) { + wait_for { length( $request_stream ) >= $len }; + + $req_content = substr( $request_stream, 0, $len ); + substr( $request_stream, 0, $len ) = ""; + } + + my $expect_req_headers = $args{expect_req_headers}; + + foreach my $header ( keys %$expect_req_headers ) { + is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); + } + + if( defined $args{expect_req_content} ) { + is( $req_content, $args{expect_req_content}, "Request content for $name" ); + } + + $peersock->syswrite( $args{response} ); + + # Wait for the server to finish its response + wait_for { defined $response or defined $error }; + + if( $args{expect_error} ) { + ok( defined $error, "Expected error for $name" ); + return; + } + else { + ok( !defined $error, "Failed to error for $name" ); + if( defined $error ) { + diag( "Got error $error" ); + } + } + + if( exists $args{expect_res_code} ) { + is( $response->code, $args{expect_res_code}, "Result code for $name" ); + } + + if( exists $args{expect_res_content} ) { + is( $response->content, $args{expect_res_content}, "Result content for $name" ); + } + + if( exists $args{expect_res_headers} ) { + my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; + + is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); + } +} + +do_test_uri( "simple HEAD", + method => "HEAD", + uri => URI->new( "http://host0/some/path" ), + + expect_req_firstline => "HEAD /some/path HTTP/1.1", + expect_req_headers => { + Host => "host0", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF, + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "", +); + +do_test_uri( "simple GET", + method => "GET", + uri => URI->new( "http://host1/some/path" ), + + expect_req_firstline => "GET /some/path HTTP/1.1", + expect_req_headers => { + Host => "host1", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Hello, world!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Hello, world!", +); + +do_test_uri( "GET with params", + method => "GET", + uri => URI->new( "http://host2/cgi?param=value" ), + + expect_req_firstline => "GET /cgi?param=value HTTP/1.1", + expect_req_headers => { + Host => "host2", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 11$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "CGI content", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 11, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "CGI content", +); + +do_test_uri( "authenticated GET", + method => "GET", + uri => URI->new( "http://host3/secret" ), + user => "user", + pass => "pass", + + expect_req_firstline => "GET /secret HTTP/1.1", + expect_req_headers => { + Host => "host3", + Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 18$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "For your eyes only", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 18, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "For your eyes only", +); + +do_test_uri( "authenticated GET (URL embedded)", + method => "GET", + uri => URI->new( "http://user:pass\@host4/private" ), + + expect_req_firstline => "GET /private HTTP/1.1", + expect_req_headers => { + Host => "host4", + Authorization => "Basic dXNlcjpwYXNz", # determined using 'wget' + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 6$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Shhhh!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 6, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Shhhh!", +); + +do_test_uri( "GET with additional headers from ARRAY", + method => "GET", + uri => URI->new( "http://host5/" ), + headers => [ + "X-Net-Async-HTTP", "Test", + ], + + expect_req_firstline => "GET / HTTP/1.1", + expect_req_headers => { + Host => "host5", + "X-Net-Async-HTTP" => "Test", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF, + + expect_res_code => 200, +); + +do_test_uri( "GET with additional headers from HASH", + method => "GET", + uri => URI->new( "http://host6/" ), + headers => { + "X-Net-Async-HTTP", "Test", + }, + + expect_req_firstline => "GET / HTTP/1.1", + expect_req_headers => { + Host => "host6", + "X-Net-Async-HTTP" => "Test", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF, + + expect_res_code => 200, +); + +do_test_uri( "simple PUT", + method => "PUT", + uri => URI->new( "http://host7/resource" ), + content => "The content", + content_type => "text/plain", + + expect_req_firstline => "PUT /resource HTTP/1.1", + expect_req_headers => { + Host => "host7", + 'Content-Length' => 11, + 'Content-Type' => "text/plain", + }, + expect_req_content => "The content", + + response => "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF, + + expect_res_code => 201, + expect_res_headers => { + 'Content-Length' => 0, + 'Connection' => "Keep-Alive", + }, +); + +do_test_uri( "simple POST", + method => "POST", + uri => URI->new( "http://host8/handler" ), + content => "New content", + content_type => "text/plain", + + expect_req_firstline => "POST /handler HTTP/1.1", + expect_req_headers => { + Host => "host8", + 'Content-Length' => 11, + 'Content-Type' => "text/plain", + }, + expect_req_content => "New content", + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 11$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "New content", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 11, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "New content", +); + +do_test_uri( "form POST", + method => "POST", + uri => URI->new( "http://host9/handler" ), + content => [ param => "value", another => "value with things" ], + + expect_req_firstline => "POST /handler HTTP/1.1", + expect_req_headers => { + Host => "host9", + 'Content-Length' => 37, + 'Content-Type' => "application/x-www-form-urlencoded", + }, + expect_req_content => "param=value&another=value+with+things", + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 4$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Done", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 4, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Done", +); + +do_test_uri( "plain string URI", + method => "GET", + uri => "http://host10/path", + + expect_req_firstline => "GET /path HTTP/1.1", + expect_req_headers => { + Host => "host10", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + "$CRLF", + + expect_res_code => 200, +); + +done_testing; diff --git a/t/03future.t b/t/03future.t new file mode 100644 index 0000000..f8efcee --- /dev/null +++ b/t/03future.t @@ -0,0 +1,112 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +{ + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $request = HTTP::Request->new( + GET => "/some/path", + [ Host => "myhost" ] + ); + + my $future = $http->do_request( + host => "myhost", + request => $request, + ); + + ok( defined $future, '$future defined for request' ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Type: text/plain", + "Content-Length: 12", + "" ) . $CRLF . + "Hello world!" + ); + + wait_for { $future->is_ready }; + + my $response = $future->get; + isa_ok( $response, "HTTP::Response", '$future->get for request' ); + + is( $response->code, 200, '$response->code for request' ); +} + +{ + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $future = $http->do_request( + method => "GET", + uri => URI->new( "http://host0/some/path" ), + ); + + ok( defined $future, '$future defined for uri' ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Type: text/plain", + "Content-Length: 12", + "" ) . $CRLF . + "Hello world!" + ); + + wait_for { $future->is_ready }; + + my $response = $future->get; + isa_ok( $response, "HTTP::Response", '$future->get for uri' ); + + is( $response->code, 200, '$response->code for uri' ); +} + +done_testing; diff --git a/t/04fail.t b/t/04fail.t new file mode 100644 index 0000000..fa618ad --- /dev/null +++ b/t/04fail.t @@ -0,0 +1,183 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +# fail_on_error false +{ + $http->configure( fail_on_error => 0 ); + + my $request = HTTP::Request->new( + GET => "/some/path", + [ Host => "myhost" ] + ); + + my $future = $http->do_request( + method => "GET", + uri => URI->new( "http://host0/some/path" ), + ); + + ok( defined $future, '$future defined for request' ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 404 Not Found", + "Content-Type: text/plain", + "Content-Length: 9", + "" ) . $CRLF . + "Not Found" + ); + + wait_for { $future->is_ready }; + + my $response = $future->get; + isa_ok( $response, "HTTP::Response", '$future->get for fail_on_error false' ); + + is( $response->code, 404, '$response->code for fail_on_error false' ); +} + +# fail_on_error true +{ + $http->configure( fail_on_error => 1 ); + + my $request = HTTP::Request->new( + GET => "/some/path", + [ Host => "myhost" ] + ); + + my ( $response_c, $request_c ); + my $future = $http->do_request( + method => "GET", + uri => URI->new( "http://host0/some/path" ), + on_error => sub { + ( my $message, $response_c, $request_c ) = @_; + is( $message, "404 Not Found", '$message to on_error' ); + }, + ); + + ok( defined $future, '$future defined for request' ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 404 Not Found", + "Content-Type: text/plain", + "Content-Length: 9", + "" ) . $CRLF . + "Not Found" + ); + + wait_for { $future->is_ready }; + + is( scalar $future->failure, "404 Not Found", '$future->failure for fail_on_error true' ); + my ( undef, undef, $response_f, $request_f ) = $future->failure; + + is( $response_f->code, 404, '$response_f->code for fail_on_error true' ); + is( $response_c->code, 404, '$response_c->code for fail_on_error true' ); + + is( $request_f->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); + is( $request_c->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); + + # Now check that non-errors don't fail + $future = $http->do_request( + method => "GET", + uri => URI->new( "http://host0/other/path" ), + ); + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Type: text/plain", + "Content-Length: 9", + "" ) . $CRLF . + "Here I am" + ); + + wait_for { $future->is_ready }; + my $response = $future->get; + + is( $response->code, 200, '$response->code for non-fail' ); +} + +# fail_on_error non-Future (RT102022) +{ + $http->configure( fail_on_error => 1 ); + + my $request = HTTP::Request->new( + GET => "/some/path", + [ Host => "myhost" ] + ); + + my ( $response_c, $request_c ); + $http->do_request( + method => "GET", + uri => URI->new( "http://host0/some/path" ), + on_response => sub { + die "Test failed - on_response with $_[0]"; + }, + on_error => sub { + ( my $message, $response_c, $request_c ) = @_; + is( $message, "404 Not Found", '$message to on_error' ); + }, + ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 404 Not Found", + "Content-Type: text/plain", + "Content-Length: 9", + "" ) . $CRLF . + "Not Found" + ); + + wait_for { defined $response_c }; + + is( $response_c->code, 404, '$response_c->code for fail_on_error true' ); + is( $request_c->uri, "http://host0/some/path", '$request_f->uri for fail_on_error true' ); +} + +done_testing; diff --git a/t/05redir.t b/t/05redir.t new file mode 100644 index 0000000..9cdc217 --- /dev/null +++ b/t/05redir.t @@ -0,0 +1,262 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +{ + my $redir_response; + my $location; + + my $response; + + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host0" or die "Expected $args{host} eq host0"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $future = $http->do_request( + uri => URI->new( "http://host0/doc" ), + + timeout => 10, + + on_response => sub { $response = $_[0] }, + on_redirect => sub { ( $redir_response, $location ) = @_ }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + ok( defined $future, '$future defined for redirect' ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, "GET /doc HTTP/1.1", 'First line for request' ); + + # Trim headers + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: http://host0/get_doc?name=doc$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" ); + + wait_for { defined $location }; + + is( $location, "http://host0/get_doc?name=doc", 'Redirect happens' ); + + ok( !$future->is_ready, '$future is not yet ready after redirect' ); + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + $req_firstline = $1; + + is( $req_firstline, "GET /get_doc?name=doc HTTP/1.1", 'First line for redirected request' ); + + # Trim headers + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 8$CRLF". + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" . + "Document" ); + + wait_for { defined $response }; + + is( $response->content_type, "text/plain", 'Content type of final response' ); + is( $response->content, "Document", 'Content of final response' ); + + isa_ok( $response->previous, "HTTP::Response", '$response->previous' ); + + my $previous = $response->previous; + isa_ok( $previous->request->uri, "URI", 'Previous request URI is a URI' ); + is( $previous->request->uri, "http://host0/doc", 'Previous request URI string' ); + + ok( $future->is_ready, '$future is now ready for final response' ); + identical( scalar $future->get, $response, '$future->get yields final response' ); +} + +{ + my $redir_response; + my $location; + + my $response; + + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host1" or die "Expected $args{host} eq host1"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + $http->do_request( + uri => URI->new( "http://host1/somedir" ), + + timeout => 10, + + on_response => sub { $response = $_[0] }, + on_redirect => sub { ( $redir_response, $location ) = @_ }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, "GET /somedir HTTP/1.1", 'First line for request for local redirect' ); + + # Trim headers + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: /somedir/$CRLF" . + "$CRLF" ); + + undef $location; + wait_for { defined $location }; + + is( $location, "http://host1/somedir/", 'Local redirect happens' ); + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + $req_firstline = $1; + + is( $req_firstline, "GET /somedir/ HTTP/1.1", 'First line for locally redirected request' ); + + # Trim headers + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 9$CRLF". + "Content-Type: text/plain$CRLF" . + "$CRLF" . + "Directory" ); + + undef $response; + wait_for { defined $response }; + + is( $response->content_type, "text/plain", 'Content type of final response to local redirect' ); + is( $response->content, "Directory", 'Content of final response to local redirect' ); +} + +# 304 Not Modified should not redirect (RT98093) +{ + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host2" or die "Expected $args{host} eq host2"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $f = $http->do_request( + uri => URI->new( "http://host2/unmod" ), + + on_redirect => sub { die "Should not be redirected" }, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 304 Not Modified$CRLF" . + $CRLF ); # 304 has no body + + wait_for { $f->is_ready }; + + my $response = $f->get; + is( $response->code, 304, 'HTTP 304 response not redirected' ); +} + +# Methods other than GET and HEAD should not redirect +{ + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host3" or die "Expected $args{host} eq host3"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $f = $http->do_request( + method => "PUT", + uri => URI->new( "http://host3/somewhere" ), + content => "new content", + content_type => "text/plain", + + on_redirect => sub { die "Should not be redirected" }, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: /somewhere/else$CRLF" . + $CRLF ); + + wait_for { $f->is_ready }; + + my $response = $f->get; + is( $response->code, 301, 'POST request not redirected' ); +} + +done_testing; diff --git a/t/06close.t b/t/06close.t new file mode 100644 index 0000000..9fb2f6e --- /dev/null +++ b/t/06close.t @@ -0,0 +1,109 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +$SIG{PIPE} = "IGNORE"; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new; +$loop->add( $http ); + +my $host = "host.example"; + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq $host or die "Expected $args{host} eq $host"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +# HTTP/1.1 pipelining - if server closes after first request, others should fail +{ + my @f = map { $http->do_request( + request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), + host => $host, + ) } 1 .. 3; + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream = ""; + + $peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + + wait_for { $f[0]->is_ready }; + ok( !$f[0]->failure, 'First request succeeds before EOF' ); + + $peersock->close; + + wait_for { $f[1]->is_ready }; + ok( $f[1]->failure, 'Second request fails after EOF' ); + + # Not sure which error will happen + like( scalar $f[1]->failure, qr/^Connection closed($| while awaiting header)/, + 'Queued request gets connection closed error' ); + + wait_for { $f[2]->is_ready }; + ok( $f[2]->failure ); +} + +# HTTP/1.0 connection: close behaviour. second request should get written +{ + my @f = map { $http->do_request( + request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), + host => $host, + ) } 1 .. 2; + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream = ""; + + $peersock->print( "HTTP/1.0 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + $CRLF . + "Hello " ); + $peersock->close; + undef $peersock; + + wait_for { $f[0]->is_ready }; + ok( !$f[0]->failure, 'First request succeeds after HTTP/1.0 EOF' ); + + wait_for { defined $peersock }; + ok( defined $peersock, 'A second connection is made' ); + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->print( "HTTP/1.0 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + $CRLF . + "World!" ); + $peersock->close; + undef $peersock; + + wait_for { $f[1]->is_ready }; + ok( !$f[1]->failure, 'Second request succeeds after second HTTP/1.0 EOF' ); +} + +done_testing; diff --git a/t/07continue.t b/t/07continue.t new file mode 100644 index 0000000..6bf309f --- /dev/null +++ b/t/07continue.t @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +$SIG{PIPE} = "IGNORE"; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new; +$loop->add( $http ); + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host0" or die "Expected $args{host} eq host0"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +my $body_sent; +my $resp; +$http->do_request( + method => "PUT", + uri => URI->new( "http://host0/" ), + expect_continue => 1, + content_type => "text/plain", + request_body => sub { + return undef if $body_sent; + $body_sent++; + return "Here is the body content\n"; + }, + on_response => sub { $resp = shift }, + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $peersock }; + +my $request_stream = ""; +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; +$request_stream =~ s/^(.*?$CRLF$CRLF)//s; +my $header = HTTP::Request->parse( $1 ); + +is( $header->header( "Expect" ), "100-continue", 'Received Expect header' ); + +ok( !$body_sent, 'request_body not yet invoked before 100 Continue' ); + +$peersock->print( "HTTP/1.1 100 Continue$CRLF" . + $CRLF ); + +wait_for { $body_sent }; +ok( !defined $resp, '$resp not yet defined after 100 Continue' ); + +$peersock->print( "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + +wait_for { defined $resp }; + +ok( defined $resp, '$resp now defined after 201 Created' ); +is( $resp->code, 201, '$resp->code is 201' ); + +done_testing; diff --git a/t/08prepareprocess.t b/t/08prepareprocess.t new file mode 100644 index 0000000..f34fdae --- /dev/null +++ b/t/08prepareprocess.t @@ -0,0 +1,100 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = TestingHTTP->new( + user_agent => "", # Don't put one in request headers +); + +ok( defined $http, 'defined $http' ); +isa_ok( $http, "Net::Async::HTTP", '$http isa Net::Async::HTTP' ); + +$loop->add( $http ); + +my $peersock; + +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "some.server" or die "Expected $args{host} eq some.server"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +my $response; + +$http->do_request( + uri => URI->new( "http://some.server/here" ), + + on_response => sub { $response = $_[0] }, + on_error => sub { die "Test died early - $_[0]" }, +); + +my $request_stream = ""; +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + +$request_stream =~ s/^(.*)$CRLF//; +my $req_firstline = $1; + +is( $req_firstline, "GET /here HTTP/1.1", 'First line for request' ); + +# Trim headers +$request_stream =~ s/^(.*)$CRLF$CRLF//s; +my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); + +is( $req_headers{"X-Request-Foo"}, "Bar", 'Request sets X-Request-Foo header' ); + +$peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 7$CRLF". + "Content-Type: text/plain$CRLF" . + "X-Response-Foo: Splot$CRLF" . + "$CRLF" . + "Blahbla" ); + +my $response_header_X; + +undef $response; +wait_for { defined $response }; + +is( $response_header_X, "Splot", 'Response processed' ); + +done_testing; + +package TestingHTTP; +use base qw( Net::Async::HTTP ); + +sub prepare_request +{ + my $self = shift; + my ( $request ) = @_; + $self->SUPER::prepare_request( $request ); + + $request->header( "X-Request-Foo" => "Bar" ); +} + +sub process_response +{ + my $self = shift; + my ( $response ) = @_; + $self->SUPER::process_response( $response ); + + $response_header_X = $response->header( "X-Response-Foo" ); +} diff --git a/t/09cookies.t b/t/09cookies.t new file mode 100644 index 0000000..68f17ca --- /dev/null +++ b/t/09cookies.t @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use HTTP::Cookies; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $cookie_jar = HTTP::Cookies->new; + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + cookie_jar => $cookie_jar, +); + +$loop->add( $http ); + +my $peersock; + +sub do_test_req +{ + my $name = shift; + my %args = @_; + + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "myhost" or die "Expected $args{host} eq myhost"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $response; + my $error; + + my $request = $args{req}; + + $http->do_request( + request => $request, + host => "myhost", + + on_response => sub { $response = $_[0] }, + on_error => sub { $error = $_[0] }, + ); + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + # Ignore first line + $request_stream =~ s/^(.*)$CRLF//; + + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + my $req_content; + if( defined( my $len = $req_headers{'Content-Length'} ) ) { + wait_for { length( $request_stream ) >= $len }; + + $req_content = substr( $request_stream, 0, $len ); + substr( $request_stream, 0, $len ) = ""; + } + + my $expect_req_headers = $args{expect_req_headers}; + + foreach my $header ( keys %$expect_req_headers ) { + is( $req_headers{$header}, $expect_req_headers->{$header}, "Expected value for $header" ); + } + + $peersock->syswrite( $args{response} ); + + # Wait for the server to finish its response + wait_for { defined $response or defined $error }; + + my %h = map { $_ => $response->header( $_ ) } $response->header_field_names; + + is_deeply( \%h, $args{expect_res_headers}, "Result headers for $name" ); +} + +my $req; + +$req = HTTP::Request->new( GET => "http://myhost/", [ Host => "myhost" ] ); + +do_test_req( "set cookie", + req => $req, + + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Set-Cookie: X_TEST=MyCookie; path=/$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF, + + expect_res_headers => { + 'Content-Length' => 0, + 'Set-Cookie' => "X_TEST=MyCookie; path=/", + }, +); + +$req = HTTP::Request->new( POST => "http://myhost/", [ Host => "myhost" ] ); + +do_test_req( "get cookie", + req => $req, + + expect_req_headers => { + Host => "myhost", + Cookie => "X_TEST=MyCookie", + Cookie2 => '$Version="1"', + 'Content-Length' => 0, + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF, + + expect_res_headers => { + 'Content-Length' => 0, + }, +); + +done_testing; diff --git a/t/10request-streaming.t b/t/10request-streaming.t new file mode 100644 index 0000000..6b0df01 --- /dev/null +++ b/t/10request-streaming.t @@ -0,0 +1,155 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $peersock; + +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +{ + my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]); + $req->content_length( 21 ); # set this manually based on what we plan to send + + my $response; + + my $done = 0; + $http->do_request( + request => $req, + host => "myhost", + + request_body => sub { + if( !$done ) { + pass( "Callback after headers sent" ); + $done++; + return "Content from callback"; + } + elsif( $done == 1 ) { + pass( "Second request seen, returning undef" ); + $done++; + return undef; + } + else { + fail( "called request_body too many times" ); + } + }, + + on_response => sub { $response = $_[0] }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, "PUT /handler HTTP/1.1", 'First line for streaming PUT' ); + + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + is_deeply( \%req_headers, + { + 'Host' => "somewhere", + 'Content-Length' => 21, + 'Connection' => 'keep-alive', + }, + 'Request headers for streaming PUT' + ); + + my $req_content; + if( defined( my $len = $req_headers{'Content-Length'} ) ) { + wait_for_stream { length( $request_stream ) >= $len } $peersock => $request_stream; + + $req_content = substr( $request_stream, 0, $len ); + substr( $request_stream, 0, $len ) = ""; + } + + is( $req_content, "Content from callback", 'Request content for streaming PUT' ); + + $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF ); + + wait_for { defined $response }; + + is( $response->code, 201, 'Result code for streaming PUT' ); + + my %res_headers = map { $_ => $response->header( $_ ) } $response->header_field_names; + is_deeply( \%res_headers, + { + 'Content-Length' => 0, + 'Connection' => "Keep-Alive", + }, + 'Result headers for streaming PUT' + ); +} + +{ + my $req = HTTP::Request->new( PUT => "/handler", [ Host => "somewhere" ]); + $req->content_length( 15 ); + + my $body_f = $loop->new_future; + + my $response; + $http->do_request( + request => $req, + request_body => $body_f, + host => "myhost", + + on_response => sub { $response = $_[0] }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + + $body_f->done( "Delayed content" ); + + wait_for_stream { length $request_stream >= 15 } $peersock => $request_stream; + + is( $request_stream, "Delayed content" ); + + $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF ); + + wait_for { defined $response }; + + is( $response->code, 201, 'Result code for streaming PUT from Future' ); +} + +done_testing; diff --git a/t/11response-streaming.t b/t/11response-streaming.t new file mode 100644 index 0000000..67ddcf7 --- /dev/null +++ b/t/11response-streaming.t @@ -0,0 +1,219 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $peersock; + +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +{ + my $header; + my $body; + my $body_is_done; + + $http->do_request( + uri => URI->new( "http://my.server/here" ), + + on_header => sub { + ( $header ) = @_; + $body = ""; + return sub { + @_ ? $body .= $_[0] : $body_is_done++; + } + }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + # Wait for request but don't really care what it actually is + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 15$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" ); + + wait_for { defined $header }; + + isa_ok( $header, "HTTP::Response", '$header for Content-Length' ); + is( $header->content_length, 15, '$header->content_length' ); + is( $header->content_type, "text/plain", '$header->content_type' ); + + $peersock->syswrite( "Hello, " ); + + wait_for { length $body == 7 }; + + is( $body, "Hello, ", '$body partial Content-Length' ); + + $peersock->syswrite( "world!$CRLF" ); + + wait_for { $body_is_done }; + is( $body, "Hello, world!$CRLF", '$body' ); +} + +{ + my $header; + my $body; + my $body_is_done; + + $http->do_request( + uri => URI->new( "http://my.server/here" ), + + on_header => sub { + ( $header ) = @_; + $body = ""; + return sub { + @_ ? $body .= $_[0] : $body_is_done++; + } + }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + # Wait for request but don't really care what it actually is + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 15$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + "Transfer-Encoding: chunked$CRLF" . + "$CRLF" ); + + wait_for { defined $header }; + + isa_ok( $header, "HTTP::Response", '$header for chunked' ); + is( $header->content_length, 15, '$header->content_length' ); + is( $header->content_type, "text/plain", '$header->content_type' ); + + $peersock->syswrite( "7$CRLF" . "Hello, " . $CRLF ); + + wait_for { length $body == 7 }; + is( $body, "Hello, ", '$body partial chunked' ); + + $peersock->syswrite( "8$CRLF" . "world!$CRLF" . $CRLF ); + + wait_for { length $body == 15 }; + is( $body, "Hello, world!$CRLF", '$body partial(2) chunked' ); + + $peersock->syswrite( "0$CRLF" . $CRLF ); + + wait_for { $body_is_done }; + is( $body, "Hello, world!$CRLF", '$body chunked' ); +} + +{ + my $header; + my $body; + my $body_is_done; + + $http->do_request( + uri => URI->new( "http://my.server/here" ), + + on_header => sub { + ( $header ) = @_; + $body = ""; + return sub { + @_ ? $body .= $_[0] : $body_is_done++; + } + }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + # Wait for request but don't really care what it actually is + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.0 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: close$CRLF" . + "$CRLF" ); + + wait_for { defined $header }; + + isa_ok( $header, "HTTP::Response", '$header for EOF' ); + is( $header->content_type, "text/plain", '$header->content_type' ); + + $peersock->syswrite( "Hello, " ); + + wait_for { length $body == 7 }; + + is( $body, "Hello, ", '$body partial EOF' ); + + $peersock->syswrite( "world!$CRLF" ); + + wait_for { length $body == 15 }; + + is( $body, "Hello, world!$CRLF", '$body' ); + + $peersock->close; + + wait_for { $body_is_done }; +} + +# on_header should see a redirect once we run out of indirections (RT124920) +{ + my $header; + + $http->do_request( + uri => URI->new( "http://my.server.here/" ), + max_redirects => 1, + + on_header => sub { + ( $header ) = @_; + return sub {}; + }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + # Wait for request but don't really care what it actually is + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: http://my.server.here/elsewhere$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" ); + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: http://my.server.here/try-again$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" ); + + wait_for { defined $header }; +} + +done_testing; diff --git a/t/12conn-persistence.t b/t/12conn-persistence.t new file mode 100644 index 0000000..26e3d75 --- /dev/null +++ b/t/12conn-persistence.t @@ -0,0 +1,194 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +foreach my $close ( 0, 1, 2 ) { + # We'll run an almost-identical test three times, with different server responses. + # 0 == keepalive + # 1 == close + # 2 == close with no Content-Length + + my $peersock; + my $connections = 0; + + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $connections++; + + $args{host} eq "host$close" or die "Expected $args{host} eq host$close"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $response; + + # placate IO::Async bug where this returns () instead of 0 + is( scalar $http->children || 0, 0, 'scalar $http->children 0 initially' ); + + my $future = $http->do_request( + uri => URI->new( "http://host$close/first" ), + + on_response => sub { $response = $_[0] }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + ok( defined $future, 'defined $future' ); + + wait_for { $peersock }; + is( $connections, 1, '->connect called once for first request' ); + is( scalar $http->children, 1, 'scalar $http->children 1 after first request' ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + is( $req_firstline, "GET /first HTTP/1.1", 'First line for first request' ); + + ok( !$future->is_ready, '$future is not ready before response given' ); + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . + "Content-Type: text/plain$CRLF" . + ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . + "$CRLF" . + "1st" ); + $peersock->close, undef $peersock if $close; + + undef $response; + wait_for { defined $response }; + + if( $close ) { + is( scalar $http->children, 0, 'scalar $http->children now 0 again after first response' ); + } + else { + is( scalar $http->children, 1, 'scalar $http->children still 1 after first response' ); + } + + is( $response->content, "1st", 'Content of first response' ); + identical( scalar $future->get, $response, '$future->get for first request' ); + + my $inner_response; + my $inner_future; + $future = $http->do_request( + uri => URI->new( "http://host$close/second" ), + + on_response => sub { + $response = $_[0]; + $inner_future = $http->do_request( + uri => URI->new( "http://host$close/inner" ), + on_response => sub { $inner_response = $_[0] }, + on_error => sub { die "Test died early - $_[0]" }, + ); + }, + on_error => sub { die "Test died early - $_[0]" }, + ); + + wait_for { $peersock }; + + if( $close ) { + is( $connections, 2, '->connect called again for second request to same server' ); + } + else { + is( $connections, 1, '->connect not called again for second request to same server' ); + } + + is( scalar $http->children, 1, 'scalar $http->children 1 after second request to same server' ); + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + $req_firstline = $1; + + is( $req_firstline, "GET /second HTTP/1.1", 'First line for second request' ); + + ok( !$future->is_ready, '$future is not ready before response given for second request' ); + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . + "Content-Type: text/plain$CRLF" . + ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . + "$CRLF" . + "2nd" ); + $peersock->close, undef $peersock if $close; + + undef $response; + wait_for { defined $response }; + + is( $response->content, "2nd", 'Content of second response' ); + identical( scalar $future->get, $response, '$future->get for second request' ); + + ok( defined $inner_future, 'defined $inner_future' ); + + wait_for { $peersock }; + + if( $close ) { + is( $connections, 3, '->connect called again for inner request to same server' ); + } + else { + is( $connections, 1, '->connect not called again for inner request to same server' ); + } + + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + $req_firstline = $1; + + is( $req_firstline, "GET /inner HTTP/1.1", 'First line for inner request' ); + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + ( $close == 2 ? "" : "Content-Length: 3$CRLF" ) . + "Content-Type: text/plain$CRLF" . + ( $close ? "Connection: close$CRLF" : "Connection: Keep-Alive$CRLF" ) . + "$CRLF" . + "3rd" ); + $peersock->close if $close; + + undef $inner_response; + wait_for { defined $inner_response }; + + is( $inner_response->content, "3rd", 'Content of inner response' ); + identical( scalar $inner_future->get, $inner_response, '$inner_future->get for inner request' ); + + if( $close ) { + is( scalar $http->children, 0, 'scalar $http->children now 0 again after inner response' ); + } + else { + is( scalar $http->children, 1, 'scalar $http->children still 1 after inner response' ); + } + + # Drain connections for next test + undef $peersock; + wait_for { scalar $http->children == 0 }; +} + +done_testing; diff --git a/t/13conn-pipeline.t b/t/13conn-pipeline.t new file mode 100644 index 0000000..ef80cf4 --- /dev/null +++ b/t/13conn-pipeline.t @@ -0,0 +1,132 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $test_mode; + +# Most of this function copypasted from t/01http-req.t +sub do_uris +{ + my %wait; + my $wait_id = 0; + + my $http = Net::Async::HTTP->new( pipeline => not( $test_mode eq "no_pipeline" ) ); + $loop->add( $http ); + + my $peersock; + + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + while( my ( $uri, $on_resp ) = splice @_, 0, 2 ) { + $wait{$wait_id} = 1; + + my $id = $wait_id; + + $http->do_request( + uri => $uri, + method => 'GET', + + timeout => 10, + + on_response => sub { $on_resp->( @_ ); delete $wait{$id} }, + on_error => sub { die "Test failed early - $_[-1]" }, + ); + + $wait_id++; + } + + my $request_stream = ""; + my $not_first = 0; + + while( keys %wait ) { + # Wait for the client to send its request + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + my $req_firstline = $1; + + $request_stream =~ s/^(.*?)$CRLF$CRLF//s; + my %req_headers = map { m/^(.*?):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + if( $test_mode ne "pipeline" ) { + is( length $request_stream, 0, "Stream is idle after request for $test_mode" ); + } + elsif( keys %wait > 1 && $not_first++ ) { + # Just in case it wasn't flushed yet, wait for another request to be + # written anyway before we respond to this one + wait_for_stream { length $request_stream } $peersock => $request_stream; + ok( length $request_stream > 0, "Stream is not idle after middle request for $test_mode" ); + } + + my $req_content; + if( defined( my $len = $req_headers{'Content-Length'} ) ) { + wait_for { length( $request_stream ) >= $len }; + + $req_content = substr( $request_stream, 0, $len ); + substr( $request_stream, 0, $len ) = ""; + } + + my $waitcount = keys %wait; + + my $body = "$req_firstline"; + + my $protocol = "HTTP/1.1"; + $protocol = "HTTP/1.0" if $test_mode eq "http/1.0"; + + $peersock->syswrite( "$protocol 200 OK$CRLF" . + "Content-Length: " . length( $body ) . $CRLF . + "Connection: Keep-Alive$CRLF" . + $CRLF . + $body ); + + # Wait for the server to finish its response + wait_for { keys %wait < $waitcount }; + } + + $loop->remove( $http ); +} + +# foreach $test_mode doesn't quite work as expected +foreach (qw( pipeline no_pipeline http/1.0 )) { + $test_mode = $_; + + do_uris( + URI->new( "http://server/path/1" ) => sub { + my ( $req ) = @_; + is( $req->content, "GET /path/1 HTTP/1.1", "First of three pipeline for $test_mode" ); + }, + URI->new( "http://server/path/2" ) => sub { + my ( $req ) = @_; + is( $req->content, "GET /path/2 HTTP/1.1", "Second of three pipeline for $test_mode" ); + }, + URI->new( "http://server/path/3" ) => sub { + my ( $req ) = @_; + is( $req->content, "GET /path/3 HTTP/1.1", "Third of three pipeline for $test_mode" ); + }, + ); +} + +done_testing; diff --git a/t/14conn-max.t b/t/14conn-max.t new file mode 100644 index 0000000..15e44da --- /dev/null +++ b/t/14conn-max.t @@ -0,0 +1,105 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + pipeline => 0, # Disable pipelining or we'll break the tests +); + +$loop->add( $http ); + +my @peersocks; + +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + + my ( $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + push @peersocks, $peersock; + + return Future->new->done( $self ); +}; + +foreach my $max ( 1, 2, 0 ) { + $http->configure( max_connections_per_host => $max ); + + my @done; + foreach my $idx ( 0 .. 2 ) { + $http->do_request( + request => HTTP::Request->new( GET => "/" ), + host => "myhost", + on_response => sub { $done[$idx]++ }, + on_error => sub { }, + ) + } + + ## First batch of requests looks the same in all cases + + my $expect_conns = $max || 3; + is( scalar @peersocks, $expect_conns, "Expected number of connections for max=$max" ); + + # Wait for all the pending requests to be written + my @buffers; + wait_for_stream { ($buffers[$_]||"") =~ m/$CRLF$CRLF/ } $peersocks[$_] => $buffers[$_] for 0 .. $#peersocks; + $_ = "" for @buffers; + + # Write responses for all + $_->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . $CRLF ) for @peersocks; + + wait_for { $done[$_] } for 0 .. $expect_conns-1; + + if( $max == 1 ) { + # The other two requests come over the same initial socket + wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersocks[0] => $buffers[0]; + $_ = "" for @buffers; + $peersocks[0]->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . $CRLF ); + wait_for { $done[1] }; + + wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersocks[0] => $buffers[0]; + $_ = "" for @buffers; + $peersocks[0]->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . $CRLF ); + } + elsif( $max == 2 ) { + # The third request will come over one of these $peersocks again, but we don't know which + my $peersock; + { + $loop->watch_io( handle => $peersocks[0], on_read_ready => sub { $peersock = $peersocks[0] } ); + $loop->watch_io( handle => $peersocks[1], on_read_ready => sub { $peersock = $peersocks[1] } ); + wait_for { defined $peersock }; + $loop->unwatch_io( handle => $_, on_read_ready => 1 ) for @peersocks; + } + + wait_for_stream { ($buffers[0]||"") =~ m/$CRLF$CRLF/ } $peersock => $buffers[0]; + $_ = "" for @buffers; + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . $CRLF ); + } + + wait_for { $done[0] && $done[1] && $done[2] }; + ok( 1, "All three requests are now done for max=$max" ); + + undef @peersocks; + + # CHEATING + $_->remove_from_parent for @{ delete $http->{connections}{"myhost:80"} }; +} + +done_testing; diff --git a/t/15conn-errors.t b/t/15conn-errors.t new file mode 100644 index 0000000..f26bcb2 --- /dev/null +++ b/t/15conn-errors.t @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +# connect errors +{ + my @on_connect_errors; + + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + my $f = $self->loop->new_future; + + push @on_connect_errors, sub { $f->fail( @_ ) }; + + return $f; + }; + + my $f1 = $http->do_request( + uri => URI->new( "http://hostname/first" ), + ); + my $f2 = $http->do_request( + uri => URI->new( "http://hostname/second" ), + ); + + is( scalar @on_connect_errors, 1, '1 on_connect_errors queued before first connect error' ); + ok( !$f1->is_ready, '$f1 still pending before connect error' ); + + ( shift @on_connect_errors )->( connect => "No route to host" ); + + wait_for { $f1->is_ready }; + is( scalar $f1->failure, "hostname:80 - connect failed [No route to host]", '$f1->failure' ); + + is( scalar @on_connect_errors, 1, '1 on_connect_errors queued before second connect error' ); + ok( !$f2->is_ready, '$f2 still pending before connect error' ); + + ( shift @on_connect_errors )->( connect => "No route to host" ); + + wait_for { $f2->is_ready }; + is( scalar $f2->failure, "hostname:80 - connect failed [No route to host]", '$f2->failure' ); +} + +done_testing; diff --git a/t/16max-in-flight.t b/t/16max-in-flight.t new file mode 100644 index 0000000..d6a8b11 --- /dev/null +++ b/t/16max-in-flight.t @@ -0,0 +1,101 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + max_in_flight => 2 +); +$loop->add( $http ); + +my $host = "host.example"; + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq $host or die "Expected $args{host} eq $host"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +my @resp; +$http->do_request( + request => HTTP::Request->new( GET => "/$_", [ Host => $host ] ), + host => $host, + on_response => sub { push @resp, shift }, + on_error => sub { die "Test died early - $_[-1]" }, +) for 0 .. 3; + +wait_for { $peersock }; + +# CHEATING +my $conn = $http->{connections}->{"$host:80"}->[0] or die "Unable to find connection object"; +ref $conn eq "Net::Async::HTTP::Connection" or die "Unable to find connection object"; + +my $request_stream = ""; +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + +ok( $request_stream =~ m[^GET /0 HTTP/1\.1$CRLF.*?$CRLF$CRLF$]s, 'Request stream contains first request only' ); +$request_stream = ""; + +# CHEATING +is( scalar @{ $conn->{ready_queue} }, 3, '3 requests still queued' ); + +$peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + "$CRLF" ); + +wait_for { $resp[0] }; +is( $resp[0]->code, 200, 'Request /0 responded OK' ); + +wait_for_stream { $request_stream =~ m/(?:.*$CRLF$CRLF){2}/s } $peersock => $request_stream; + +ok( $request_stream =~ m[^GET /1 HTTP/1\.1$CRLF.*?${CRLF}${CRLF}GET /2 HTTP/1\.1$CRLF.*?${CRLF}${CRLF}$]s, + 'Request stream contains second and third requests after first response' ); +$request_stream = ""; + +# CHEATING +is( scalar @{ $conn->{ready_queue} }, 1, '1 request still queued' ); + +$peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 1$CRLF" . + "$CRLF" . + "A" ); +$peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 2$CRLF" . + "$CRLF" . + "AB" ); + +wait_for { $resp[2] }; +is( $resp[1]->content, "A", 'Request /1 content' ); +is( $resp[2]->content, "AB", 'Request /2 content' ); + +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; +ok( $request_stream =~ m[^GET /3 HTTP/1\.1$CRLF.*?$CRLF$CRLF$]s, 'Request stream contains final request' ); + +$peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + "$CRLF" ); + +wait_for { $resp[3] }; +is( $resp[3]->code, 200, 'Request /3 responded OK' ); + +done_testing; diff --git a/t/17on-write.t b/t/17on-write.t new file mode 100644 index 0000000..a29121f --- /dev/null +++ b/t/17on-write.t @@ -0,0 +1,68 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $peersock; + +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + $self->configure( write_len => 10 ); + + return Future->new->done( $self ); +}; + +{ + my @written; + my $req_f = $http->do_request( + request => HTTP::Request->new( PUT => "/content", [ Host => "somewhere" ] ), + host => "somewhere", + request_body => "X" x 100, + + on_body_write => sub { push @written, $_[0] }, + ); + + defined $peersock or die "No peersock\n"; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + wait_for_stream { $request_stream =~ m/X{100}/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 201 Created$CRLF" . + "Content-Length: 0$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF ); + + wait_for { $req_f->is_ready }; + + is_deeply( \@written, + [ 10, 20, 30, 40, 50, 60, 70, 80, 90, 100 ], + 'on_body_write invoked per body write call' ); +} + +done_testing; diff --git a/t/18content-coding.t b/t/18content-coding.t new file mode 100644 index 0000000..030585e --- /dev/null +++ b/t/18content-coding.t @@ -0,0 +1,144 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + decode_content => 1, +); +$loop->add( $http ); + +my $TEST_CONTENT = "Here is the compressed content\n"; + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq "host" or die "Expected $args{host} eq 'host'"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +# RFC 2616 "gzip" +SKIP: { + skip "Compress::Raw::Zlib not available", 4 unless eval { require Compress::Raw::Zlib and $Compress::Raw::Zlib::VERSION >= 2.057 }; + diag( "Using optional dependency Compress::Raw::Zlib $Compress::Raw::Zlib::VERSION" ); + + my $f = $http->GET( "http://host/gzip" ); + $f->on_fail( sub { $f->get } ); + + { + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + my ( undef, @headers ) = split m/$CRLF/, $request_stream; + ok( scalar( grep { m/^Accept-Encoding: / } @headers ), 'Request as an Accept-Encoding header' ); + + my $compressor = Compress::Raw::Zlib::Deflate->new( + -WindowBits => Compress::Raw::Zlib::WANT_GZIP(), + -AppendOutput => 1, + ); + my $content = ""; + $compressor->deflate( $TEST_CONTENT, $content ); + $compressor->flush( $content ); + + $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . + "Content-Length: %d$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Encoding: gzip$CRLF" . + $CRLF . "%s", + length $content, $content ); + } + + my $response = $f->get; + + is( $response->content, $TEST_CONTENT, '$response->content is decompressed from gzip' ); + ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); + is( $response->header( "X-Original-Content-Encoding" ), "gzip", '$response has X-Original-Content-Encoding' ); +} + +# RFC 2616 "deflate" +SKIP: { + skip "Compress::Raw::Zlib not available", 3 unless eval { require Compress::Raw::Zlib and $Compress::Raw::Zlib::VERSION >= 2.057 }; + + my $f = $http->GET( "http://host/deflate" ); + $f->on_fail( sub { $f->get } ); + + { + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + my $compressor = Compress::Raw::Zlib::Deflate->new( + -WindowBits => 15, + -AppendOutput => 1, + ); + my $content = ""; + $compressor->deflate( $TEST_CONTENT, $content ); + $compressor->flush( $content ); + + $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . + "Content-Length: %d$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Encoding: deflate$CRLF" . + $CRLF . "%s", + length $content, $content ); + } + + my $response = $f->get; + + is( $response->content, $TEST_CONTENT, '$response->content is decompressed from deflate' ); + ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); + is( $response->header( "X-Original-Content-Encoding" ), "deflate", '$response has X-Original-Content-Encoding' ); +} + +SKIP: { + # Compress::Bzip2 2.09 appears to fail + skip "Compress::Bzip2 not available", 3 unless eval { require Compress::Bzip2 and $Compress::Bzip2::VERSION >= 2.10 }; + diag( "Using optional dependency Compress::Bzip2 $Compress::Bzip2::VERSION" ); + + my $f = $http->GET( "http://host/bzip2" ); + $f->on_fail( sub { $f->get } ); + + { + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + my $compressor = Compress::Bzip2::bzdeflateInit(); + my $content = ""; + $content .= $compressor->bzdeflate( my $tmp = $TEST_CONTENT ); + $content .= $compressor->bzclose; + + $peersock->syswrite( sprintf "HTTP/1.1 200 OK$CRLF" . + "Content-Length: %d$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Encoding: bzip2$CRLF" . + $CRLF . "%s", + length $content, $content ); + } + + my $response = $f->get; + + is( $response->content, $TEST_CONTENT, '$response->content is decompressed from bzip2' ); + ok( !defined $response->header( "Content-Encoding" ), '$response has no Content-Encoding' ); + is( $response->header( "X-Original-Content-Encoding" ), "bzip2", '$response has X-Original-Content-Encoding' ); +} + +done_testing; diff --git a/t/19idle.t b/t/19idle.t new file mode 100644 index 0000000..f55adb4 --- /dev/null +++ b/t/19idle.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Identity; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my @on_error; + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + + on_error => sub { + my ( undef, @args ) = @_; + + push @on_error, [ @args ]; + }, +); + +$loop->add( $http ); + +# spurious trailing content +{ + my $peersock; + no warnings 'redefine'; + local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); + }; + + my $f = $http->do_request( + request => HTTP::Request->new( GET => "http://host/" ), + ); + + wait_for { $peersock }; + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 11$CRLF" . + $CRLF . + "Hello world" . + "more stuff here" ); + + wait_for { $f->is_ready }; + ok( !$f->failure, '$f is ready and does not fail' ); +} + +done_testing; diff --git a/t/20local-connect.t b/t/20local-connect.t new file mode 100644 index 0000000..3fda97d --- /dev/null +++ b/t/20local-connect.t @@ -0,0 +1,92 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ m/$CRLF$CRLF/; + + $self->write( "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK" ); + + $self->close_when_empty; + + return 0; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my $local_uri = URI->new( "http://127.0.0.1:$port/" ); + +my $response; + +my $connected_port; + +$http->do_request( + uri => $local_uri, + + on_ready => sub { + my ( $conn ) = @_; + $connected_port = $conn->read_handle->peerport; + + Future->done; + }, + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +is( $connected_port, $port, 'peerport visible within on_ready' ); + +done_testing; diff --git a/t/21local-connect-ssl.t b/t/21local-connect-ssl.t new file mode 100644 index 0000000..1c9d159 --- /dev/null +++ b/t/21local-connect-ssl.t @@ -0,0 +1,111 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +eval { + require IO::Async::SSL; + IO::Async::SSL->VERSION( '0.12' ); +} or plan skip_all => "No IO::Async::SSL"; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + + # This also checks that object-wide SSL params are applied + SSL_verify_mode => 0, +); + +$loop->add( $http ); + +my $port; +$loop->SSL_listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + SSL_key_file => "t/privkey.pem", + SSL_cert_file => "t/server.pem", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + # SNI - RT#94605 + SKIP: { + skip "SSL server does not support SNI", 1 unless IO::Socket::SSL->can_server_sni; + + my $sslsocket = $stream->read_handle; + is( $sslsocket->get_servername, "127.0.0.1", '->get_servername on server' ); + } + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ m/$CRLF$CRLF/; + + $self->write( "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK" ); + + $self->close_when_empty; + + return 0; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, + on_ssl_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my $local_uri = URI->new( "https://127.0.0.1:$port/" ); + +my $response; + +$http->do_request( + uri => $local_uri, + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +# require_SSL +{ + $http->configure( require_SSL => 1 ); + + my $f = $http->GET( "http://127.0.0.1:$port/" ); + + ok( $f->failure, '->GET on http with require_SSL fails' ); + like( scalar $f->failure, qr/require_SSL/, 'require_SSL failure' ); +} + +done_testing; diff --git a/t/22local-connect-pipeline.t b/t/22local-connect-pipeline.t new file mode 100644 index 0000000..0ccd4fb --- /dev/null +++ b/t/22local-connect-pipeline.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + $self->write( "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" . + "OK" ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my @local_uris = map { URI->new( "http://127.0.0.1:$port/page/$_" ) } 1 .. 2; + +my @responses; + +$http->do_request( + uri => $_, + + on_response => sub { + push @responses, $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +) for @local_uris; + +wait_for { @responses == 2 }; + +is( $responses[0]->content_type, "text/plain", '$response->content_type' ); +is( $responses[0]->content, "OK", '$response->content' ); + +is( $responses[1]->content_type, "text/plain", '$response->content_type' ); +is( $responses[1]->content, "OK", '$response->content' ); + +done_testing; diff --git a/t/23local-connect-redir.t b/t/23local-connect-redir.t new file mode 100644 index 0000000..8f9ceaf --- /dev/null +++ b/t/23local-connect-redir.t @@ -0,0 +1,88 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + my $header = $1; + + my $response = ( $header =~ m{^GET /redir} ) + ? "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: http://127.0.0.1:$port/moved$CRLF" . + "Connection: close$CRLF" . + "$CRLF" + : "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK"; + + $self->write( $response ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my $response; + +$http->do_request( + uri => URI->new( "http://127.0.0.1:$port/redir" ), + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +done_testing; diff --git a/t/24local-connect-redir-ssl.t b/t/24local-connect-redir-ssl.t new file mode 100644 index 0000000..f9ac518 --- /dev/null +++ b/t/24local-connect-redir-ssl.t @@ -0,0 +1,117 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +eval { + require IO::Async::SSL; + IO::Async::SSL->VERSION( '0.12' ); +} or plan skip_all => "No IO::Async::SSL"; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $redir_url; + +my $port; +$loop->SSL_listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + SSL_key_file => "t/privkey.pem", + SSL_cert_file => "t/server.pem", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + my $header = $1; + + my $response = ( $header =~ m{^GET /redir} ) + ? "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: $redir_url$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" + : "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" . + "OK"; + + $self->write( $response ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, + on_ssl_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +$redir_url = "https://127.0.0.1:$port/moved"; + +my $response; + +$http->do_request( + uri => URI->new( "https://127.0.0.1:$port/redir" ), + + SSL_verify_mode => 0, + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +# require_SSL +{ + $http->configure( require_SSL => 1 ); + + $redir_url = "http://127.0.0.1:$port/moved_to_plaintext"; + + my $f = $http->GET( "https://127.0.0.1:$port/redir" ); + + wait_for { $f->is_ready }; + + ok( $f->failure, '->GET on http with require_SSL fails' ); + like( scalar $f->failure, qr/require_SSL/, 'require_SSL failure' ); +} + +done_testing; diff --git a/t/30timeout.t b/t/30timeout.t new file mode 100644 index 0000000..05bd6ae --- /dev/null +++ b/t/30timeout.t @@ -0,0 +1,209 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +use Errno qw( EAGAIN ); + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new(); + +$loop->add( $http ); + +my $peersock; + +no warnings 'redefine'; +my $latest_connection; +local *IO::Async::Handle::connect = sub { + $latest_connection = my $self = shift; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +{ + my $errcount; + my $error; + + my $future = $http->do_request( + uri => URI->new( "http://my.server/doc" ), + + timeout => 0.1, # Really quick for testing + + on_response => sub { die "Test died early - got a response but shouldn't have" }, + on_error => sub { $errcount++; $error = $_[0] }, + ); + + is_refcount( $http, 2, '$http refcount 2 after ->do_request with timeout' ); + + wait_for { defined $error }; + + is( $error, "Timed out", 'Received timeout error' ); + is( $errcount, 1, 'on_error invoked once' ); + + ok( $future->is_ready, '$future is ready after timeout' ); + is( scalar $future->failure, "Timed out", '$future->failure after timeout' ); + is( ( $future->failure )[1], "timeout", '$future->failure [1] is timeout' ); + + is_refcount( $http, 2, '$http refcount 2 after ->do_request with timeout fails' ); +} + +{ + my $errcount; + my $error; + + my $future = $http->do_request( + uri => URI->new( "http://my.server/redir" ), + + timeout => 0.1, # Really quick for testing + + on_response => sub { die "Test died early - got a response but shouldn't have" }, + on_error => sub { $errcount++; $error = $_[0] }, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + + $peersock->syswrite( "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: http://my.server/get_doc?name=doc$CRLF" . + "Connection: Keep-Alive$CRLF" . + "$CRLF" ); + + wait_for { defined $error }; + + is( $error, "Timed out", 'Received timeout error from redirect' ); + is( $errcount, 1, 'on_error invoked once from redirect' ); + + ok( $future->is_ready, '$future is ready after timeout' ); + is( scalar $future->failure, "Timed out", '$future->failure after timeout' ); + is( ( $future->failure )[1], "timeout", '$future->failure [1] is timeout' ); +} + +{ + my $error; + my $errcount; + + $http->do_request( + uri => URI->new( "http://my.server/first" ), + + timeout => 0.1, # Really quick for testing + + on_response => sub { die "Test died early - got a response but shouldn't have" }, + on_error => sub { $errcount++; $error = $_[0] }, + ); + + my $error2; + my $errcount2; + + $http->do_request( + uri => URI->new( "http://my.server/second" ), + + timeout => 0.3, + + on_response => sub { die "Test died early - got a response but shouldn't have" }, + on_error => sub { $errcount2++; $error2 = $_[0] }, + ); + + wait_for { defined $error }; + is( $error, "Timed out", 'Received timeout error from pipeline' ); + is( $errcount, 1, 'on_error invoked once from pipeline' ); + + wait_for { defined $error2 }; + is( $error2, "Timed out", 'Received timeout error from pipeline(2)' ); + is( $errcount2, 1, 'on_error invoked once from pipeline(2)' ); +} + +# Stall during write +{ + my $future = $http->do_request( + uri => URI->new( "http://stalling.server/write" ), + + stall_timeout => 0.1, + ); + + # Much hackery for unit-testing purposes + $latest_connection->configure( + writer => sub { $! = EAGAIN; return undef }, + ); + + wait_for { $future->is_ready }; + is( scalar $future->failure, "Stalled while writing request", '$future->failure for stall during write' ); + is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); +} + +# Stall during header read +{ + my $future = $http->do_request( + uri => URI->new( "http://stalling.server/header" ), + + stall_timeout => 0.1, + ); + + # Don't write anything + + wait_for { $future->is_ready }; + is( scalar $future->failure, "Stalled while waiting for response", '$future->failure for stall during response header' ); + is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); +} + +# Stall during header read +{ + my $future = $http->do_request( + uri => URI->new( "http://stalling.server/read" ), + + stall_timeout => 0.1, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 100$CRLF" ); # unfinished + + wait_for { $future->is_ready }; + is( scalar $future->failure, "Stalled while receiving response header", '$future->failure for stall during response header' ); + is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); +} + +# Stall during body read +{ + my $future = $http->do_request( + uri => URI->new( "http://stalling.server/read" ), + + stall_timeout => 0.1, + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 100$CRLF" . + $CRLF ); + $peersock->syswrite( "some of the content" ); # unfinished + + wait_for { $future->is_ready }; + is( scalar $future->failure, "Stalled while receiving body", '$future->failure for stall during response body' ); + is( ( $future->failure )[1], "stall_timeout", '$future->failure [1] is stall_timeout' ); +} + +$loop->remove( $http ); + +is_oneref( $http, '$http has refcount 1 before EOF' ); + +done_testing; diff --git a/t/31cancel.t b/t/31cancel.t new file mode 100644 index 0000000..aa8ada4 --- /dev/null +++ b/t/31cancel.t @@ -0,0 +1,143 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + pipeline => 1, + max_connections_per_host => 1, +); + +$loop->add( $http ); + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + $peersock->blocking(0); + + return Future->new->done( $self ); +}; + +# Cancellation +{ + undef $peersock; + my $f1 = $http->do_request( + method => "GET", + uri => URI->new( "http://host1/some/path" ), + ); + + wait_for { $peersock }; + + $f1->cancel; + + wait_for { my $ret = sysread($peersock, my $buffer, 1); defined $ret and $ret == 0 }; + ok( 1, '$peersock closed' ); + + # Retry after cancel should establish another connection + + undef $peersock; + my $f2 = $http->do_request( + method => "GET", + uri => URI->new( "http://host1/some/path" ), + ); + + wait_for { $peersock }; + + # Wait for the client to send its request + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Type: text/plain", + "Content-Length: 12", + "" ) . $CRLF . + "Hello world!" + ); + + wait_for { $f2->is_ready }; + $f2->get; +} + +# Cancelling a pending unpipelined request +{ + undef $peersock; + + # Make first -one- request/response to establish HTTP/1.1 pipeline ability + my $f0 = $http->do_request( + method => "GET", + uri => URI->new( "http://host2/" ), + ); + + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Length: 0", + "" ) . $CRLF + ); + + wait_for { $f0->is_ready }; + + my ( $f1, $f2, $f3 ) = map { + $http->do_request( + method => "GET", + uri => URI->new( "http://host2/req/$_" ), + ); + } 1, 2, 3; + + wait_for { $peersock }; + + # cancel $f2 - 1 and 3 should still complete + $f2->cancel; + + # Wait for the $f1 and $f3 + $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + like( $request_stream, qr(^GET /req/1 HTTP/1.1), '$f1 request written' ); + $request_stream = ""; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Length: 0", + "" ) . $CRLF + ); + + wait_for { $f1->is_ready }; + ok( $f1->is_done, '$f1 is done' ); + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + like( $request_stream, qr(^GET /req/3 HTTP/1.1), '$f3 request written' ); + $request_stream = ""; + + $peersock->syswrite( join( $CRLF, + "HTTP/1.1 200 OK", + "Content-Length: 0", + "" ) . $CRLF + ); + + wait_for { $f3->is_ready }; + ok( $f3->is_done, '$f3 is done' ); +} + +done_testing; diff --git a/t/32remove.t b/t/32remove.t new file mode 100644 index 0000000..b849fe1 --- /dev/null +++ b/t/32remove.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new; +$loop->add( $http ); + +my $host = "host.example"; + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + + $args{host} eq $host or die "Expected $args{host} eq $host"; + $args{service} eq "80" or die "Expected $args{service} eq 80"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->new->done( $self ); +}; + +my $f = $http->do_request( + request => HTTP::Request->new( GET => "/", [ Host => $host ] ), + host => $host, +); + +my $request_stream = ""; +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + +$request_stream = ""; + +$peersock->print( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + +wait_for { $f->is_ready }; + +# gut-wrenching +my $conn = $http->{connections}{"$host:80"}[0]; +ok( $conn, 'Found a connection' ); + +# 1 internally in the $http, 2 in IO::Async internals, 1 here +is_refcount( $conn, 4, 'Connection has 4 references' ); + +$loop->remove( $http ); +undef $http; + +is_oneref( $conn, 'Connection has 1 reference remaining at EOF' ); + +done_testing; diff --git a/t/40socks.t b/t/40socks.t new file mode 100644 index 0000000..c7d104e --- /dev/null +++ b/t/40socks.t @@ -0,0 +1,108 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +BEGIN { + eval { + require Net::Async::SOCKS; + Net::Async::SOCKS->VERSION( '0.003' ); + } or plan skip_all => "No Net::Async::SOCKS"; +} + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + SOCKS_host => "socks.host", + SOCKS_port => "1234", +); + +$loop->add( $http ); + +my %connect_args; +my $connect_f; + +no warnings 'redefine'; +local *IO::Async::Loop::SOCKS_connect = sub { + shift; + ( %connect_args ) = @_; + + return $connect_f = Future->new; +}; + +my $f = $http->do_request( + uri => URI->new( "http://remote-site-here/" ), +); + +# Check that ->SOCKS_connect was invoked correctly +my $handle; +{ + wait_for { keys %connect_args }; + + $handle = delete $connect_args{handle}; + delete @connect_args{qw( SSL on_error )}; + is_deeply( \%connect_args, + { + family => 0, + socktype => "stream", + host => "remote-site-here", + service => 80, + is_proxy => '', + + SOCKS_host => "socks.host", + SOCKS_port => 1234, + }, + 'SOCKS_connect invoked' + ); +} + +# Set up a socket connection +my $peersock; +{ + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $handle->set_handle( $selfsock ); + + $connect_f->done( $handle ); +} + +# Handle request/response cycle +{ + my $request_stream = ""; + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + + $request_stream =~ s/^(.*)$CRLF//; + is( $1, "GET / HTTP/1.1", + 'Received request firstline' ); + + $request_stream =~ s/^(.*)$CRLF$CRLF//s; + my %req_headers = map { m/^([^:]+):\s+(.*)$/g } split( m/$CRLF/, $1 ); + + is_deeply( \%req_headers, + { + Host => "remote-site-here", + Connection => "keep-alive", + }, + 'Received request headers' ); + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); +} + +wait_for { $f->is_ready }; + +my $response = $f->get; + +is( $response->code, 200, '$response' ); + +done_testing; diff --git a/t/80cross-http.t b/t/80cross-http.t new file mode 100644 index 0000000..01939e9 --- /dev/null +++ b/t/80cross-http.t @@ -0,0 +1,76 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use IO::Async::Stream; + +unless( eval { require Net::Async::HTTP::Server and + Net::Async::HTTP::Server->VERSION( '0.03' ) } ) { + plan skip_all => "Net::Async::HTTP::Server 0.03 is not available"; +} +unless( eval { require Net::Async::HTTP } ) { + plan skip_all => "Net::Async::HTTP is not available"; +} + +my $CRLF = "\x0d\x0a"; + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $server = Net::Async::HTTP::Server->new( + on_request => sub { + my $self = shift; + my ( $req ) = @_; + + my $content = "Response to " . join " ", $req->method, $req->path, "with " . length( $req->body ) . " bytes"; + + $req->write( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: " . length( $content ) . $CRLF . + "Content-Type: text/plain$CRLF" . + $CRLF . + $content + ); + + $req->done; + }, +); + +$loop->add( $server ); + +$loop->add( my $client = Net::Async::HTTP->new ); + +my ( $host, $port ); +$server->listen( + addr => { family => "inet", socktype => "stream", ip => "127.0.0.1", port => 0 }, + on_listen => sub { + my $socket = $_[0]->read_handle; + $host = $socket->sockhost; + $port = $socket->sockport; + }, + on_listen_error => sub { die "Cannot listen - $_[-1]\n" }, +); + +wait_for { defined $host and defined $port }; + +my $response; + +$client->do_request( + uri => URI->new( "http://$host:$port/" ), + on_response => sub { + ( $response ) = @_; + }, + on_error => sub { die "Test failed early - $_[-1]\n" }, +); + +wait_for { $response }; + +is( $response->code, 200, '$response->code' ); +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "Response to GET / with 0 bytes", '$response->content' ); + +done_testing; diff --git a/t/81cross-https.t b/t/81cross-https.t new file mode 100644 index 0000000..b0fc710 --- /dev/null +++ b/t/81cross-https.t @@ -0,0 +1,83 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use IO::Async::Stream; + +unless( eval { require Net::Async::HTTP::Server and + Net::Async::HTTP::Server->VERSION( '0.06' ) } ) { + plan skip_all => "Net::Async::HTTP::Server 0.06 is not available"; +} +unless( eval { require Net::Async::HTTP } ) { + plan skip_all => "Net::Async::HTTP is not available"; +} +unless( eval { require IO::Async::SSL and + IO::Async::SSL->VERSION( '0.12' ) } ) { + plan skip_all => "IO::Async::SSL is not available"; +} + +my $CRLF = "\x0d\x0a"; + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $server = Net::Async::HTTP::Server->new( + on_request => sub { + my $self = shift; + my ( $req ) = @_; + + my $content = "Response to " . join " ", $req->method, $req->path, "with " . length( $req->body ) . " bytes"; + + $req->write( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: " . length( $content ) . $CRLF . + "Content-Type: text/plain$CRLF" . + $CRLF . + $content + ); + + $req->done; + }, +); + +$loop->add( $server ); + +$loop->add( my $client = Net::Async::HTTP->new ); + +my ( $host, $port ); +$server->listen( + addr => { family => "inet", socktype => "stream", ip => "127.0.0.1", port => 0 }, + on_listen => sub { + my $socket = $_[0]->read_handle; + $host = $socket->sockhost; + $port = $socket->sockport; + }, + + extensions => [qw( SSL )], + SSL_key_file => "t/privkey.pem", + SSL_cert_file => "t/server.pem", +)->get; + +my $response; + +$client->do_request( + uri => URI->new( "https://$host:$port/" ), + SSL_verify_mode => 0, + + on_response => sub { + ( $response ) = @_; + }, + on_error => sub { die "Test failed early - $_[0]\n" }, +); + +wait_for { $response }; + +is( $response->code, 200, '$response->code' ); +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "Response to GET / with 0 bytes", '$response->content' ); + +done_testing; diff --git a/t/90rt75615.t b/t/90rt75615.t new file mode 100644 index 0000000..8cba89d --- /dev/null +++ b/t/90rt75615.t @@ -0,0 +1,102 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + my $header = $1; + + my $response = ( $header =~ m{^GET /redir} ) + ? "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: /moved$CRLF" . + "Connection: close$CRLF" . + "$CRLF" + : "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK"; + + $self->write( $response ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my $code = \&IO::Async::Handle::connect; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + $args{service} = $port if $args{service} eq '80'; + $code->($self, %args); +}; + +my $response; + +my $req = HTTP::Request->new(GET => '/redir'); +$req->protocol('HTTP/1.1'); +$req->header(Host => '127.0.0.1'); +$http->do_request( + method => "GET", + host => '127.0.0.1', + request => $req, + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +done_testing; diff --git a/t/90rt75616.t b/t/90rt75616.t new file mode 100644 index 0000000..f2193f8 --- /dev/null +++ b/t/90rt75616.t @@ -0,0 +1,103 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + my $header = $1; + + my $response = ( $header =~ m{^GET /redir} ) + ? "HTTP/1.1 301 Moved Permanently$CRLF" . + "Content-Length: 0$CRLF" . + "Location: /moved$CRLF" . + "Connection: close$CRLF" . + "$CRLF" + : "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK"; + + $self->write( $response ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, + + on_listen_error => sub { die "Test failed early - $_[-1]" }, + on_resolve_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $port }; + +my $code = \&IO::Async::Handle::connect; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + $args{service} = $port if $args{service} eq 'http'; + $args{service} = $port if $args{service} == 80; + $code->($self, %args); +}; + +my $response; + +my $req = HTTP::Request->new(GET => '/redir'); +$req->protocol('HTTP/1.1'); +$req->header(Host => '127.0.0.1'); +$http->do_request( + method => "GET", + host => '127.0.0.1', + request => $req, + + on_response => sub { + $response = $_[0]; + }, + + on_error => sub { die "Test failed early - $_[-1]" }, +); + +wait_for { defined $response }; + +is( $response->content_type, "text/plain", '$response->content_type' ); +is( $response->content, "OK", '$response->content' ); + +done_testing; diff --git a/t/90rt92904.t b/t/90rt92904.t new file mode 100644 index 0000000..7c2534a --- /dev/null +++ b/t/90rt92904.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $loop = IO::Async::Loop->new; +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + max_connections_per_host => 2, +); + +$loop->add( $http ); + +my @conn_f; +no warnings 'redefine'; +local *IO::Async::Loop::connect = sub { + shift; + my %args = @_; + $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; + $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; + + push @conn_f, my $f = $loop->new_future; + return $f; +}; + +my @f = map { $http->do_request(uri=>'http://localhost:5000/') } 0 .. 1; + +is( scalar @conn_f, 2, 'Two pending connect() attempts after two concurrent ->do_request' ); + +# Fail them both +( shift @conn_f )->fail( "Connection refused", connect => ) for 0 .. 1; + +ok( $f[$_]->is_ready && $f[$_]->failure, "Request [$_] Future fails after connect failure" ) for 0 .. 1; + +ok( !@conn_f, 'No more pending connect() attempts' ); + +done_testing; diff --git a/t/90rt93232.t b/t/90rt93232.t new file mode 100644 index 0000000..9c11277 --- /dev/null +++ b/t/90rt93232.t @@ -0,0 +1,78 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use Test::Refcount; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $port; +$loop->listen( + host => "127.0.0.1", + service => 0, + socktype => "stream", + + on_listen => sub { + $port = shift->sockport; + }, + + on_stream => sub { + my ( $stream ) = @_; + + $stream->configure( + on_read => sub { + my ( $self, $buffref ) = @_; + return 0 unless $$buffref =~ s/^(.*?)$CRLF$CRLF//s; + + my $header = $1; + + $self->write( + "HTTP/1.1 200 OK$CRLF" . + "Content-Type: text/plain$CRLF" . + "Content-Length: 2$CRLF" . + "Connection: close$CRLF" . + "$CRLF" . + "OK" + ); + + return 1; + }, + ); + + $loop->add( $stream ); + }, +)->get; + +my $on_body_chunk; + +$http->do_request( + method => "GET", + host => "127.0.0.1", + port => $port, + request => HTTP::Request->new(GET => "/"), + + on_header => sub { + my ( $header ) = @_; + # Needs to be a real closure + return $on_body_chunk = sub { $header = $header; 1 }; + }, +)->get; + +is_oneref( $on_body_chunk, '$on_body_chunk has refcount 1 before EOF' ); + +done_testing; diff --git a/t/90rt99142.t b/t/90rt99142.t new file mode 100644 index 0000000..453a1d4 --- /dev/null +++ b/t/90rt99142.t @@ -0,0 +1,93 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers + max_connections_per_host => 2, +); + +$loop->add( $http ); + +{ + my @pending; + no warnings 'redefine'; + *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; + $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; + + push @pending, [ $self, my $f = $loop->new_future ]; + return $f; + }; + + sub await_connection + { + wait_for { scalar @pending }; + + return @{ shift @pending }; + } +} + +# Make a first connection +my $req_f1 = $http->GET( "http://localhost:5000/1" ); +my $peersock; +{ + my ( $conn, $conn_f ) = await_connection; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $conn->set_handle( $selfsock ); + + $conn_f->done( $conn ); +} + +# Before the first is ready, make a second one +my $req_f2 = $http->GET( "http://localhost:5000/2" ); +my ( $conn2, $conn_f2 ) = await_connection; +ok( $conn_f2, 'Second connection request is pending' ); + +# Gutwrenching +is( scalar @{ $http->{connections}{"localhost:5000"} }, 2, + '$http has two pending connections to localhost:5000' ); + +my $request_stream = ""; +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + +like( $request_stream, qr(^GET /1), 'First request written' ); +$request_stream = ""; + +# Respond with HTTP/1.1 so client knows it can pipeline +$peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + +wait_for { $req_f1->is_ready }; +ok( $req_f1->is_done, '$req_f1 is done after first response' ); + +# At this point, req 2 should already be made down the socket +wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + +like( $request_stream, qr(^GET /2), 'Second request written down first socket' ); + +# And $conn_f2 should already be cancelled +ok( $conn_f2->is_cancelled, '$conn_f2 now cancelled' ); + +# Gutwrenching +is( scalar @{ $http->{connections}{"localhost:5000"} }, 1, + '$http has only one connection to localhost:5000 at EOF' ); + +done_testing; diff --git a/t/91rt100066.t b/t/91rt100066.t new file mode 100644 index 0000000..f6eb95d --- /dev/null +++ b/t/91rt100066.t @@ -0,0 +1,120 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +my $CRLF = "\x0d\x0a"; # because \r\n isn't portable + +my $loop = IO::Async::Loop->new(); +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + user_agent => "", # Don't put one in request headers +); + +$loop->add( $http ); + +my $peersock; +no warnings 'redefine'; +local *IO::Async::Handle::connect = sub { + my $self = shift; + my %args = @_; + $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; + $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; + + ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; + $self->set_handle( $selfsock ); + + return Future->done( $self ); +}; + +# Without on_error +{ + my $f1 = $http->GET( "http://localhost:5000/1" ) + ->on_done( sub { die "Oopsie" } ); + + my $f2 = $http->GET( "http://localhost:5000/2" ); + + wait_for { defined $peersock }; + + my $request_stream = ""; + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + pass( "First request is made" ); + + $request_stream =~ s/^.*$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + + my $e = eval { $loop->loop_once(0) for 1 .. 5; 1 } ? undef : $@; + like( $e, qr/^Oopsie at \Q$0\E line \d+/, + 'Oopsie exception caught at loop toplevel' ); + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + pass( "Second request is made after first one dies at ->done" ); + + $request_stream =~ s/^.*$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + + wait_for { $f2->is_ready }; + ok( !$f2->failure, '$f2 completes successfully' ); +} + +# With on_error +{ + my $error; + $http->configure( + on_error => sub { ( undef, $error ) = @_; }, + ); + + my $f1 = $http->GET( "http://localhost:5000/1" ) + ->on_done( sub { die "Oopsie" } ); + + my $f2 = $http->GET( "http://localhost:5000/2" ); + + wait_for { defined $peersock }; + + my $request_stream = ""; + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + pass( "First request is made" ); + + $request_stream =~ s/^.*$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + + my $e = eval { $loop->loop_once(0) for 1 .. 5; 1 } ? undef : $@; + ok( !defined $e, 'Loop toplevel does not catch exception' ) or + diag( "Caught exception was: $e" ); + + like( $error, qr/^Oopsie at \Q$0\E line \d+/, + 'Oopsie exception caught by on_error handler' ); + + wait_for_stream { $request_stream =~ m/$CRLF$CRLF/ } $peersock => $request_stream; + pass( "Second request is made after first one dies at ->done" ); + + $request_stream =~ s/^.*$CRLF$CRLF//s; + + $peersock->syswrite( "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 0$CRLF" . + $CRLF ); + + wait_for { $f2->is_ready }; + ok( !$f2->failure, '$f2 completes successfully' ); +} + +done_testing; diff --git a/t/91rt102547.t b/t/91rt102547.t new file mode 100644 index 0000000..fa2e9d5 --- /dev/null +++ b/t/91rt102547.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; +use IO::Async::Test; +use IO::Async::Loop; + +use Net::Async::HTTP; + +# When connections failed, they weren't being removed from memory +# so we'd slowly leak + +my $loop = IO::Async::Loop->new; +testing_loop( $loop ); + +my $http = Net::Async::HTTP->new( + max_connections_per_host => 2, +); + +$loop->add( $http ); + +my @conn_f; +my @remove_f; + +no warnings 'redefine'; +local *IO::Async::Loop::connect = sub { + shift; + my %args = @_; + $args{host} eq "localhost" or die "Cannot fake connect - expected host 'localhost'"; + $args{service} eq "5000" or die "Cannot fake connect - expected service '5000'"; + + push @conn_f, my $f = $loop->new_future; + return $f; +}; + +my $old = \&IO::Async::Notifier::remove_from_parent; + +# Make sure these actually get removed! +local *IO::Async::Notifier::remove_from_parent = sub { + my $self = shift; + push @remove_f, $self; + return $old->($self, @_); +}; + +my @f = map { $http->do_request(uri=>'http://localhost:5000/') } 0 .. 2; + +is( scalar @conn_f, 2, 'Two pending connect() attempts after two concurrent ->do_request' ); + +# Fail them all +( shift @conn_f )->fail( "Connection refused", connect => ) for 0 .. 2; + +ok( !@conn_f, 'No more pending connect() attempts' ); + +is( scalar @remove_f, 3, 'Three connect() attempts removed after connection failure' ); + +done_testing; diff --git a/t/99pod.t b/t/99pod.t new file mode 100644 index 0000000..eb319fb --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/privkey.pem b/t/privkey.pem new file mode 100644 index 0000000..0e466a6 --- /dev/null +++ b/t/privkey.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEAk9NZtcKAu9FqMKWOdtn5QHtqgMbVhiGmUfpR6ropmqFciu+V +jZD+30WSBOzCEuO7bYSz5s5X33qi+lna3DzEfgJ4DvZtkO1D0Wg4zQn6oYA2ZhlC +b0dnmW2eWEiTmDT375DLq5U3TMH9TWEtxgn5EXdV8gW2wyDxnx4ax5FTNx6X6Ek/ +7pr2G46+ezfON2jymYPCM23U7yROu/WlZ6vz3hnafSc9zCjHsdLRQVvjoBOCXuKx +PCN0KppCMCq0cA43fe5Y5bQnLydhghsEpuWTJpd37ioWlV6lbqJpqinruOxwh4YY +N8czxHZ1L+4A0Aoq3HLQpUleeLh1TdLv7OqSZQIDAQABAoIBABs/adnG8FOuVhSB +b7EYnIj2Nrtl6xW+Phn+Ofs6NVD7TUOOxdJCV7hv6mpd+afhsjqNq1tvzWK0CDZ9 +OYo+6TkQ23Bmm+uK0GVZAJ9Kp5f9Ogm3vjckwkPVoMpFFm+H0+uklOYbqwXK/BW3 +Q+itDevaQ01JIFb3S5I4ylbewqf2A/KTfosVUgkrv4U1wcr8DYat8baplfy0sp0j +Q9w8P4HH4UOZL9OAjKABXLw7xDc5kvYxG1aLPf55QryEHmyr3SpRxwnK0c7/LwHZ +1lqhKnyUiDzD/yyxNMzTWQeaohV6MMb2MysAx7AiL09WLzc4gIzUIQYfeiCdHSoQ +vbN7IAECgYEAw9tcSDgyi+ucRY9DOtRDGeNONhgds6Hzkeed0eNap7qDfTeRcfsF +2sCgxStyAMmwx+cMrRwA3yINkcdc68RpKDCxADD7Mk6wxys4PkNAJYiV5giupMAp +U1L276op+14yL36/DKAt95M6Xhp44l+Mvpfc001nrTW2SbeuoDD9wuUCgYEAwTgr +VVOn4el3izYZua/S7rGO4nj/KaUfdZXUPqyqOYgirQy9DlhrJTdtHW3kc47jXDX4 +OuSoa3Xqli2o7qFBKfUaZKrZmcwZD6L9Y0kKBj9s9DM1roMlA3wiBylJ/ZNughyi +jMDhvVwWdwJaXOJBPgqBWggwWh48MuTZ49HHGYECgYB5vgPZvFznDnhf4JJYohJn +qBw4kbr8qsF9Qyydh6YVNmF/VygoYnGcLTqB9ORzSuuBBsShYhPEnyUyJWtD/h2j +ZsjPJqMt/S3zT5ExWpon+oO6rlDoha3qZlqqVOqtnjqxvSZCUdrg1npkfi4AAIa6 +/ii8i5PTXdzGa8+3MVy7ZQKBgG5S0AtMVNNdJvDJ1y57AglgQKF3TNpOegP9pM6U +cC2hWYtNdrU2Lxd06kyfbo28zHzeI/ocjT2uel99erOmRzrZxFQuaUizjKus+Nkz +3xFqLZ/RjZkzMHMo8ZT9Mk4jXDnWd8m+aCZi6kDRix714SK3hNwPSOxrzxuQKAk4 +wmIBAoGBAK9F/ejKimwBpzQ0kv90i8j5NyGTJNnI/tjls/KaQrnI0b/VqqRnI/xk +Dm1lJabaUAG5P51b2KwitnKo7/+dhcG2hOtxJdUKGPVLzeRhfEx1KXx8bTMg9nvu +n5sP1sN9Sw+jjpHm3r+YD/+QNK1eiVcAO0D6FcxSRKQ5ztHZt1tw +-----END RSA PRIVATE KEY----- diff --git a/t/regen-certs.sh b/t/regen-certs.sh new file mode 100755 index 0000000..9790ddf --- /dev/null +++ b/t/regen-certs.sh @@ -0,0 +1,3 @@ +#!/bin/sh +openssl genrsa -out privkey.pem +openssl req -new -x509 -key privkey.pem -out server.pem diff --git a/t/server.pem b/t/server.pem new file mode 100644 index 0000000..e472001 --- /dev/null +++ b/t/server.pem @@ -0,0 +1,21 @@ +-----BEGIN CERTIFICATE----- +MIIDazCCAlOgAwIBAgIUHVSMA9ScUWYlkkHEQWBDJr+wNTswDQYJKoZIhvcNAQEL +BQAwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3RhdGUxITAfBgNVBAoM +GEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDAeFw0xOTAyMTcxNDA0MzZaFw0xOTAz +MTkxNDA0MzZaMEUxCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEw +HwYDVQQKDBhJbnRlcm5ldCBXaWRnaXRzIFB0eSBMdGQwggEiMA0GCSqGSIb3DQEB +AQUAA4IBDwAwggEKAoIBAQCT01m1woC70WowpY522flAe2qAxtWGIaZR+lHquima +oVyK75WNkP7fRZIE7MIS47tthLPmzlffeqL6WdrcPMR+AngO9m2Q7UPRaDjNCfqh +gDZmGUJvR2eZbZ5YSJOYNPfvkMurlTdMwf1NYS3GCfkRd1XyBbbDIPGfHhrHkVM3 +HpfoST/umvYbjr57N843aPKZg8IzbdTvJE679aVnq/PeGdp9Jz3MKMex0tFBW+Og +E4Je4rE8I3QqmkIwKrRwDjd97ljltCcvJ2GCGwSm5ZMml3fuKhaVXqVuommqKeu4 +7HCHhhg3xzPEdnUv7gDQCircctClSV54uHVN0u/s6pJlAgMBAAGjUzBRMB0GA1Ud +DgQWBBRcIn5rxKiGpScWWrKkmbJ64+09AjAfBgNVHSMEGDAWgBRcIn5rxKiGpScW +WrKkmbJ64+09AjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQBo +PLlcaXaVvZ0K3fN+t3Ijs6QAWEZr0yH6WTT4g4+KTTSulIWAsNLaaTgbmb1qfJkz +gGXXuhjNFY2BbD9YuBZP02SeNgc0vL/UnRCGTSy7akK6jV+v0fblwaye01Fg5Plp +Yh114haTA9rwQ4geXKMl70KIoB71zR6MYcNPjDYHt0WiNJqGOgvYdO6d276AccDn +CP66xnx9//7ynYcHcCkhf7+5YzUv7eiNo995W9A6xUWHLq52jj0DqCpwofIoJXHx +CQ15c38qYcrmzG8X7oXL+vTLIvpj2tsRjPrf0q0Q+epHonxkxo6b+h/7g4mHyIig +yEe8MNBTU/gOTGGL8XnK +-----END CERTIFICATE----- |