Feersum
view release on metacpan or search on metacpan
feersum_h2.c.inc view on Meta::CPAN
int n = 0;
/* no stream, nowhere to park the body: advertise zero, not a length we will not send */
size_t body_len = (stream && msg) ? strlen(msg) : 0;
int slen = my_snprintf(status_buf, sizeof(status_buf), "%d", err_code);
nva[n].name = (uint8_t *)":status"; nva[n].namelen = 7;
nva[n].value = (uint8_t *)status_buf; nva[n].valuelen = slen;
nva[n].flags = NGHTTP2_NV_FLAG_NONE; n++;
nva[n].name = (uint8_t *)"content-type"; nva[n].namelen = 12;
nva[n].value = (uint8_t *)"text/plain"; nva[n].valuelen = 10;
nva[n].flags = NGHTTP2_NV_FLAG_NONE; n++;
nva[n].name = (uint8_t *)"cache-control"; nva[n].namelen = 13;
nva[n].value = (uint8_t *)"no-cache, no-store"; nva[n].valuelen = 18;
nva[n].flags = NGHTTP2_NV_FLAG_NONE; n++;
nva[n].name = (uint8_t *)"date"; nva[n].namelen = 4;
nva[n].value = (uint8_t *)(DATE_BUF + 6); nva[n].valuelen = DATE_VALUE_LENGTH;
nva[n].flags = NGHTTP2_NV_FLAG_NONE; n++;
feersum_psgi.c.inc view on Meta::CPAN
for (i=0; i<r->num_headers; i++) {
struct phr_header *hdr = &(r->headers[i]);
// hdr->name is never NULL: obs-fold is rejected at parse time
if (unlikely(hdr->name_len == 14) &&
str_case_eq_fixed("content-length", hdr->name, 14))
{
// CONTENT_LENGTH was set above; PSGI forbids HTTP_CONTENT_LENGTH
continue;
}
else if (unlikely(hdr->name_len == 12) &&
str_case_eq_fixed("content-type", hdr->name, 12))
{
hv_stores(e, "CONTENT_TYPE", newSVpvn(hdr->value, hdr->value_len));
continue;
}
else if (unlikely(hdr->name_len == 17) &&
str_case_eq_fixed("transfer-encoding", hdr->name, 17))
{
// Body already de-chunked; TE next to CONTENT_LENGTH is a CL.TE hazard
continue;
}
lib/Feersum/Connection.pm view on Meta::CPAN
=item C<< my $headers = $req->headers([normalization_style]) >>
Returns a hash reference of headers in form of { name => value, ... }.
normalization_style is one of (always use named constants, not numeric values):
HEADER_NORM_SKIP (0) - skip normalization (default)
HEADER_NORM_UPCASE_DASH (1) - "CONTENT_TYPE" (like PSGI, but without "HTTP_" prefix)
HEADER_NORM_LOCASE_DASH (2) - "content_type"
HEADER_NORM_UPCASE (3) - "CONTENT-TYPE"
HEADER_NORM_LOCASE (4) - "content-type"
One can export these constants via C<< use Feersum 'HEADER_NORM_LOCASE' >>
=item C<< my $value = $req->header(name) >>
Lookup a single header value by name (case-insensitive). When multiple
headers share the same name, values are joined with C<", "> (or C<"; "> for
cookies per RFC 9113 section 8.2.3). Returns C<undef> if the header is absent.
=item C<< my $addr = $req->remote_address >>
t/core-01-simple.t view on Meta::CPAN
$cv->begin;
my $w = simple_client GET => '/?qqqqq',
name => 'ascii',
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $hdr) = @_;
is $hdr->{Status}, 200, "client 1 got 200";
like $hdr->{'x-client'}, qr/^\d+$/, 'got a custom x-client header';
is $hdr->{'content-length'}, 4, 'content-length was overwritten by the engine';
is $hdr->{'content-type'}, 'text/plain';
is $body, 'Baz!', 'plain old body';
$cv->end;
};
$cv->begin;
my $w2 = simple_client GET => "/?zzzzz",
name => 'unicode',
headers => { 'X-Unicode-Please' => 1 },
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $hdr) = @_;
is $hdr->{Status}, 200, "client 2 got 200";
like $hdr->{'x-client'}, qr/^\d+$/, 'got a custom x-client header';
is $hdr->{'content-length'}, 5, 'content-length was overwritten by the engine';
is $hdr->{'content-type'}, 'text/plain; charset=UTF-8';
like $hdr->{'date'}, qr/^(Mon|Tue|Wed|Thu|Fri|Sat|Sun), \d{2} (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) \d{4} \d{2}:\d{2}:\d{2} GMT$/, 'got date header';
note($hdr->{'date'});
is Encode::decode_utf8($body), 'BÄz!', 'unicode body!';
$cv->end;
};
$cv->recv;
pass "all done";
t/core-02-array-body.t view on Meta::CPAN
$evh->use_socket($socket);
}, undef, 'assigned socket';
my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => '/?blar',
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "client got 200";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8';
$body = Encode::decode_utf8($body) unless Encode::is_utf8($body);
is $headers->{'content-length'}, bytes::length($body),
'content-length was calculated correctly';
is $body, 'this should be cøncÄtenated.',
'body was concatenated together';
$cv->end;
};
t/core-03-died.t view on Meta::CPAN
is exception {
$evh->use_socket($socket);
}, undef, 'assigned socket';
my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => "/?blar", timeout => 2 * TIMEOUT_MULT, sub {
my ($body, $headers) = @_;
is $headers->{Status}, 500, "client got 500";
is $headers->{'content-type'}, 'text/plain';
is $body, "Request handler exception\n", 'got expected body';
$cv->end;
};
$cv->recv;
pass "all done";
t/core-07-respond-304.t view on Meta::CPAN
}, undef, 'assigned socket';
my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => '/?blef',
headers => { 'X-Client' => 1 },
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 304, "client got 304";
ok !exists $headers->{'content-type'}, 'missing c-t';
# 304 not-modifieds shouldn't auto-generate a content-length header or
# any other "entity" headers. These reflect the actual entity, and
# can update cache's respresentation of the object.
ok !exists $headers->{'content-length'},'no c-l generated';
ok !$body, 'no body';
$cv->end;
};
$cv->begin;
my $w2 = simple_client GET => '/?blef',
headers => { 'X-Client' => 2 },
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 304, "2nd client got 304";
ok !exists $headers->{'content-type'}, 'missing c-t';
# If the app specified a C-L, we should respect it for the same
# reasons.
is $headers->{'content-length'}, 123, 'c-l not replaced';
ok !$body, 'no body';
$cv->end;
};
$cv->recv;
pass "all done";
t/core-11-req.t view on Meta::CPAN
my %hdr = %{$r->headers(Feersum::HEADER_NORM_LOCASE_DASH)};
is $hdr{user_agent}, 'FeersumSimpleClient/1.0', 'got a ua!';
is $env{method}, uc'post', 'method';
is $env{uri}, '/aaa?a=1', 'uri';
is $env{path}, '/aaa', 'path';
is $env{query}, 'a=1', 'query';
is $env{content_length}, 1000, 'content length 0';
is $env{content_length}, $hdr{content_length}, 'content length 1';
is $hdr{content_length}, $r->header('content-length'), 'content length 2';
is $hdr{content_type}, 'text/plain', 'content type 1 ';
is $hdr{content_type}, $r->header('content-type'), 'content type 2';
is $env{remote_address}, '127.0.0.1', 'remote address';
ok $env{remote_port} =~ /^[1-9][0-9]+$/, 'remote port';
$env{input}->read((my $body), $env{content_length});
$env{input}->close;
my $env = $r->env;
is $env->{uc'path_info'}, $env{path}, 'env match';
is $body, ('x' x 1000), 'body';
eval { $r->send_response(200, [qw'content-type text/plain connection close'], 'baz') };
warn $@ if $@;
pass "done request handler";
};
my ($socket, $port) = get_listen_socket();
my $feer = Feersum->new;
$feer->use_socket($socket);
$feer->request_handler($cb);
my $cv = AE::cv;
my $w = simple_client
t/h2-15-error-response-shape.t view on Meta::CPAN
#!perl
# H2 error responses carry the same payload as the HTTP/1 twin: date,
# content-type, content-length and a body, not a lone :status HEADERS frame.
use warnings;
use strict;
use constant TIMEOUT_MULT => $ENV{PERL_TEST_TIME_OUT_FACTOR} || ($ENV{AUTOMATED_TESTING} ? 4 : 1);
use Test::More;
use Time::HiRes qw(time);
use lib 't'; use Utils;
use Feersum;
my $evh = Feersum->new();
t/h2-15-error-response-shape.t view on Meta::CPAN
}
$sock->syswrite(h2_frame(H2_GOAWAY, 0, 0, pack('NN', 0, 0)));
select(undef, undef, undef, 0.1);
$sock->close();
return \%r;
}
# A lone ":status" is one HPACK byte for the indexed 500/404/... entries and a
# handful for the rest, so anything past this proves the companion headers
# (content-type, cache-control, date, content-length) are on the wire too.
use constant BARE_STATUS_MAX => 8;
h2_fork_test("app exception -> full 500", $port, sub {
my ($port) = @_;
my $r = h2_error_exchange($port, 'GET', '/die-test') or exit 1;
exit 2 unless defined $r->{status} && $r->{status} eq '500';
exit 3 unless defined $r->{hdr_len} && $r->{hdr_len} > BARE_STATUS_MAX;
exit 4 unless $r->{data} eq "Request handler exception\n";
exit 0;
});
t/listen-01-multi-listen.t view on Meta::CPAN
# Test request to port 1
$cv->begin;
my $h1;
$h1 = simple_client GET => '/',
port => $port1,
name => "port1_client",
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "request to port $port1 got 200";
is $headers->{'content-type'}, 'text/plain',
"request to port $port1 has correct content-type";
is $body, "port=$port1",
"request to port $port1 reports correct SERVER_PORT";
$cv->end;
undef $h1;
};
# Test request to port 2
$cv->begin;
my $h2;
$h2 = simple_client GET => '/',
port => $port2,
name => "port2_client",
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "request to port $port2 got 200";
is $headers->{'content-type'}, 'text/plain',
"request to port $port2 has correct content-type";
is $body, "port=$port2",
"request to port $port2 reports correct SERVER_PORT";
$cv->end;
undef $h2;
};
$cv->recv;
pass "all done";
t/native-03-connection-methods.t view on Meta::CPAN
# Test POST with body
{
my $cv = AE::cv;
my %captured;
my $body_content = 'test=data&more=stuff';
$feer->request_handler(sub {
my $r = shift;
$captured{method} = $r->method;
$captured{content_length} = $r->content_length;
$captured{content_type} = $r->header('content-type');
my $input = $r->input;
ok defined $input, 'input handle defined for POST';
my $body = '';
$input->read($body, $captured{content_length});
$captured{body} = $body;
$input->close;
$r->send_response(200, ['Content-Type' => 'text/plain'], 'OK');
t/native-03-connection-methods.t view on Meta::CPAN
my $h = simple_client POST => '/submit',
body => $body_content,
headers => { 'Content-Type' => 'application/x-www-form-urlencoded' },
sub { };
$cv->recv;
is $captured{method}, 'POST', 'method returns POST';
is $captured{content_length}, length($body_content), 'content_length matches body';
is $captured{content_type}, 'application/x-www-form-urlencoded', 'content-type header';
is $captured{body}, $body_content, 'body content matches';
}
# Test metrics: active_conns and total_requests
{
my $active = $feer->active_conns;
ok defined $active, 'active_conns returns a value';
ok $active >= 0, 'active_conns is non-negative';
my $total = $feer->total_requests;
t/psgi-01-env-hash.t view on Meta::CPAN
}, undef, 'assigned socket';
my $cv = AE::cv;
$cv->begin;
my $w = simple_client GET => "/what%20is%20wrong%3f?blar",
headers => {'x-test-num' => 1, 'Referer' => '/wrong'},
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "client 1 got 200";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8';
$body = Encode::decode_utf8($body) unless Encode::is_utf8($body);
is $headers->{'content-length'}, bytes::length($body),
'client 1 content-length was calculated correctly';
is $body, "Oh Hai 1\n", 'client 1 expected body';
$cv->end;
};
$cv->begin;
my $w2 = simple_client GET => "/what%%20is%20good%3F%2?dlux=sonice",
headers => {'x-test-num' => 2, 'Referer' => 'good'},
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "client 2 got 200";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8';
$body = Encode::decode_utf8($body) unless Encode::is_utf8($body);
is $headers->{'content-length'}, bytes::length($body),
'client 2 content-length was calculated correctly';
is $body, "Oh Hai 2\n", 'client 2 expected body';
$cv->end;
};
$cv->begin;
my $w3 = simple_client GET => "/no%20query",
headers => {'x-test-num' => 3, 'Referer' => 'ugly'},
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "client 3 got 200";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8';
$body = Encode::decode_utf8($body) unless Encode::is_utf8($body);
is $headers->{'content-length'}, bytes::length($body),
'client 3 content-length was calculated correctly';
is $body, "Oh Hai 3\n", 'client 3 expected body';
$cv->end;
};
$cv->begin;
my $w4 = simple_client GET => "/no spaces allowed",
headers => {'x-test-num' => 4, 'Referer' => 'ugly'},
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 400, 'client 4 Bad Request';
is $headers->{Reason}, "Bad Request";
is $headers->{'content-type'}, 'text/plain';
is $body, "Malformed request\n", 'client 4 expected error';
$cv->end;
};
$cv->begin;
my $w5 = simple_client POST => "/post",
headers => {
'x-test-num' => 5,
'Content-Type' => 'text/plain; charset=US-ASCII',
},
body => "The post\n",
timeout => 2 * TIMEOUT_MULT,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, "client 5 got 200";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8';
$body = Encode::decode_utf8($body) unless Encode::is_utf8($body);
is $headers->{'content-length'}, bytes::length($body),
'client 5 content-length was calculated correctly';
is $body, "Oh Hai 5\n", 'client 5 expected body';
$cv->end;
};
t/psgi-03-simple.t view on Meta::CPAN
my $cv = AE::cv;
for my $n (1 .. CLIENTS) {
$cv->begin;
my $h; $h = simple_client GET => '/',
name => "($n)",
sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "($n) Response OK";
is $headers->{'content-type'}, 'text/plain', "... ($n) is text";
is $body, 'Hello World', "... ($n) correct body";
$cv->end;
undef $h;
};
}
$cv->recv;
pass "all done";
t/psgi-04-body-merge.t view on Meta::CPAN
ok ref($evh), 'handler set';
my $cv = AE::cv;
# 1. Single-element small body (<=4KB) - fast path, merged into header buffer
$cv->begin;
my $h1; $h1 = simple_client GET => '/single-small', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "single-small: 200 OK";
is $headers->{'content-type'}, 'text/plain', "single-small: content-type";
is $headers->{'content-length'}, 100, "single-small: content-length";
is length($body), 100, "single-small: body length";
is $body, $small_body, "single-small: body content";
$cv->end; undef $h1;
};
# 2. Boundary body (exactly 4096 bytes) - still fast path
$cv->begin;
my $h2; $h2 = simple_client GET => '/single-boundary', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "boundary: 200 OK";
is $headers->{'content-type'}, 'text/plain', "boundary: content-type";
is $headers->{'content-length'}, 4096, "boundary: content-length";
is length($body), 4096, "boundary: body length";
is $body, $boundary_body, "boundary: body content";
$cv->end; undef $h2;
};
# 3. Boundary+1 body (exactly 4097 bytes) - first byte above threshold, large path
$cv->begin;
my $h2b; $h2b = simple_client GET => '/single-boundary-plus1', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "boundary+1: 200 OK";
is $headers->{'content-type'}, 'text/plain', "boundary+1: content-type";
is $headers->{'content-length'}, 4097, "boundary+1: content-length";
is length($body), 4097, "boundary+1: body length";
is $body, $boundary_plus1, "boundary+1: body content";
$cv->end; undef $h2b;
};
# 4. Large body (>4KB) - large path, CL in header + body as separate iovec
$cv->begin;
my $h3; $h3 = simple_client GET => '/single-large', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "large: 200 OK";
is $headers->{'content-type'}, 'text/plain', "large: content-type";
is $headers->{'content-length'}, 8192, "large: content-length";
is length($body), 8192, "large: body length";
is $body, $large_body, "large: body content";
$cv->end; undef $h3;
};
# 4. Multi-element array body - standard slow path
$cv->begin;
my $h4; $h4 = simple_client GET => '/multi', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "multi: 200 OK";
is $headers->{'content-type'}, 'text/plain', "multi: content-type";
is $headers->{'content-length'}, 11, "multi: content-length";
is length($body), 11, "multi: body length";
is $body, 'Hello World', "multi: body content";
$cv->end; undef $h4;
};
# 5. Empty body - fast path with 0 bytes
$cv->begin;
my $h5; $h5 = simple_client GET => '/empty', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "empty: 200 OK";
is $headers->{'content-type'}, 'text/plain', "empty: content-type";
is $headers->{'content-length'}, 0, "empty: content-length";
is length($body), 0, "empty: body length";
is $body, '', "empty: body content";
$cv->end; undef $h5;
};
# 6. Many headers + small body - coalesced header buffer + body merge
$cv->begin;
my $h6; $h6 = simple_client GET => '/many-headers', sub {
my ($body, $headers) = @_;
t/psgi-05-streaming.t view on Meta::CPAN
ok $app, 'got an app' or diag $@;
$evh->psgi_request_handler($app);
returning_body: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'application/json', "... is JSON";
ok !$headers->{'transfer-encoding'}, '... no T-E header';
is $body, q({"message":"O hai 1"}), '... correct body';
$cv->end;
undef $h;
};
$cv->recv;
pass "all done app 1";
}
t/psgi-05-streaming.t view on Meta::CPAN
my $app2 = eval $APP2;
ok $app2, 'got app 2' or diag $@;
$evh->psgi_request_handler($app2);
using_writer: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'application/json', "... is JSON";
is $headers->{'transfer-encoding'}, 'chunked', '... was chunked';
is $headers->{'connection'}, 'close', '... close';
is $body, q({"message":"O hai 2"}), "... correct de-chunked body";
$cv->end;
undef $h;
};
$cv->recv;
}
using_writer_and_1_0: {
my $cv = AE::cv;
$cv->begin;
my $h2; $h2 = simple_client GET => '/', proto => '1.0', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'application/json', "... is JSON";
ok !$headers->{'transfer-encoding'}, '... was not chunked';
isnt $headers->{'connection'}, 'keep-alive', '... got close';
is $body, q({"message":"O hai 3"}), "... correct body";
$cv->end;
undef $h2;
};
$cv->recv;
}
$evh->set_keepalive(1);
using_writer_and_1_1: {
my $cv = AE::cv;
$cv->begin;
my $h2; $h2 = simple_client GET => '/', proto => '1.1', keepalive => 1, sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'application/json', "... is JSON";
ok $headers->{'transfer-encoding'}, '... not chunked';
isnt $headers->{'connection'}, 'close', '... keep';
is $body, q({"message":"O hai 4"}), "... correct de-chunked body";
$cv->end;
undef $h2;
};
$cv->recv;
}
t/psgi-06-iohandle.t view on Meta::CPAN
ok $app, 'got an app' or diag $@;
$evh->psgi_request_handler($app);
returning_mock: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'text/plain';
is $body, qq(line one\nline two\n);
$cv->end;
undef $h;
};
$cv->recv;
pass "all done app 1";
}
my ($tempfh, $tempname) = tempfile(UNLINK=>1);
t/psgi-06-iohandle.t view on Meta::CPAN
my $app2 = eval $APP2;
ok $app2, 'got app 2' or diag $@;
$evh->psgi_request_handler($app2);
returning_glob: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'text/plain';
is $body, qq(temp line one\ntemp line two\n);
$cv->end;
undef $h;
};
$cv->recv;
}
pass "all done app 2";
my $APP3 = <<'EOAPP';
t/psgi-06-iohandle.t view on Meta::CPAN
my $app3 = eval $APP3;
ok $app3, 'got app 3' or diag $@;
$evh->psgi_request_handler($app3);
returning_io_file: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'text/plain', "C-T";
is $body, qq(temp line one\ntemp line two\n), "body";
$cv->end;
undef $h;
};
$cv->recv;
}
pass "all done app 3";
{
t/psgi-06-iohandle.t view on Meta::CPAN
my $app4 = eval $APP4;
ok $app4, 'got app 4' or diag $@;
$evh->psgi_request_handler($app4);
returning_perlio_layer: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8', "C-T";
is decode_utf8($body), qq(\x{2603}\n), "utf8 body";
$cv->end;
undef $h;
};
$cv->recv;
}
pass "all done app 4";
my $APP5 = <<'EOAPP';
t/psgi-06-iohandle.t view on Meta::CPAN
my $app5 = eval $APP5;
ok $app5, 'got app 5' or diag $@;
$evh->psgi_request_handler($app5);
returning_perlio_layer_from_stream: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'text/plain; charset=UTF-8', "C-T";
is decode_utf8($body), qq(\x{2603}\n), "utf8 body from streamer";
$cv->end;
undef $h;
};
$cv->recv;
}
pass "all done app 5";
t/psgi-07-overloaded.t view on Meta::CPAN
ok $app, 'got an app' or diag $@;
$evh->psgi_request_handler($app);
returning_body: {
my $cv = AE::cv;
$cv->begin;
my $h; $h = simple_client GET => '/', sub {
my ($body, $headers) = @_;
is $headers->{'Status'}, 200, "Response OK";
is $headers->{'content-type'}, 'application/json', "... is JSON";
ok !$headers->{'transfer-encoding'}, '... no T-E header';
is $body, q({"message":"O hai 1"}), '... correct body';
$cv->end;
undef $h;
};
$cv->recv;
}
pass "all done";
xt/browser-01-firefox.t view on Meta::CPAN
my ($k, $v) = split /=/, $pair, 2;
$params{$k} = $v if defined $k;
}
my $json = JSON::PP::encode_json(\%params);
$r->send_response(200, [
'Content-Type' => 'application/json',
], \$json);
}
elsif ($path eq '/upload') {
my $body = read_body($r);
my $ct = $r->header('content-type') || '';
my $json = JSON::PP::encode_json({
content_type => $ct,
body => $body,
length => length($body),
});
$r->send_response(200, [
'Content-Type' => 'application/json',
], \$json);
}
elsif ($path =~ m{^/redirect/(\d+)$}) {
xt/stress-02-psgi-simple.t view on Meta::CPAN
my $h; $h = simple_client GET => '/',
name => "($n)",
sub {
my ($body, $headers) = @_;
scope_guard { $cv->end };
# Asserting per-response would emit thousands of TAP lines, so tally
# instead and check the tallies once at the end. With these commented
# out entirely (as they were), a server answering 500 to everything
# still ran green.
$bad_status++ unless ($headers->{'Status'} || 0) == 200;
$bad_type++ unless ($headers->{'content-type'} || '') eq 'text/plain';
$bad_body++ unless ($body || '') eq 'Hello World';
$bad_length++ unless ($headers->{'content-length'} || 0) == 11;
$total_latency += AE::time - $r_start;
$cv->croak("extra crap!") if length($h->{rbuf});
undef $h;
if ($headers->{'Status'}) {
$responses++;
cli $n;
}
};
xt/transport-01-http.t view on Meta::CPAN
my ($sock, $stream_id, $method, $path, $port, %opts) = @_;
my $body = $opts{body} // '';
my @hdrs = (
[':method', $method],
[':path', $path],
[':scheme', 'https'],
[':authority', "127.0.0.1:$port"],
);
if (length $body) {
push @hdrs, ['content-type', 'text/plain'];
push @hdrs, ['content-length', length($body)];
}
my $hdr_block = hpack_encode_headers(@hdrs);
my $flags = FLAG_END_HEADERS;
$flags |= FLAG_END_STREAM if !length($body);
my $out = h2_frame(H2_HEADERS, $flags, $stream_id, $hdr_block);
if (length $body) {
$out .= h2_frame(H2_DATA, FLAG_END_STREAM, $stream_id, $body);
}
xt/transport-01-http.t view on Meta::CPAN
@captured = ();
run_client("large POST h2", sub {
my $sock = h2_connect($port) or return 1;
# Send HEADERS without END_STREAM
my $hdr_block = hpack_encode_headers(
[':method', 'POST'],
[':path', '/large-post-h2'],
[':scheme', 'https'],
[':authority', "127.0.0.1:$port"],
['content-type', 'text/plain'],
['content-length', length($large_body)],
);
$sock->blocking(1);
$sock->syswrite(h2_frame(H2_HEADERS, FLAG_END_HEADERS, 1, $hdr_block));
# Send body in 16384-byte DATA frames
my $offset = 0;
while ($offset < length($large_body)) {
my $chunk_size = 16384;
$chunk_size = length($large_body) - $offset if $offset + $chunk_size > length($large_body);
xt/transport-01-http.t view on Meta::CPAN
my $large_body = 'W' x 32768; # 32KB: 2 full DATA frames, within 65535 window
run_client("large POST h2 64k", sub {
my $sock = h2_connect($port) or return 1;
my $hdr_block = hpack_encode_headers(
[':method', 'POST'],
[':path', '/large-post-h2-64k'],
[':scheme', 'https'],
[':authority', "127.0.0.1:$port"],
['content-type', 'text/plain'],
['content-length', length($large_body)],
);
$sock->blocking(1);
$sock->syswrite(h2_frame(H2_HEADERS, FLAG_END_HEADERS, 1, $hdr_block));
# Send body in 8192-byte DATA frames
my $offset = 0;
while ($offset < length($large_body)) {
my $chunk_size = 8192;
$chunk_size = length($large_body) - $offset if $offset + $chunk_size > length($large_body);
( run in 4.712 seconds using v1.01-cache-2.11-cpan-99fa8243a42 )