The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

use strict;
use lib 't/lib';
my $host = '127.0.0.1';
subtest 'client/server' => sub {
for my $opts (
[ "without tls", [], [] ],
[ "without tls, upgrade", [ upgrade => 1 ], [ upgrade => 1 ] ],
[
"tls/npn",
[ npn => 1 ],
[
npn => 1,
tls_crt => 'examples/test.crt',
tls_key => 'examples/test.key'
]
],
[
"tls/alpn",
[ alpn => 1 ],
[
alpn => 1,
tls_crt => 'examples/test.crt',
tls_key => 'examples/test.key'
]
],
)
{
my $test = shift @$opts;
note "test: $test\n";
# Check for NPN/ALPN
if ( !check_tls( @{ $opts->[0] } ) ) {
note "skipped $test: feature not available\n";
next;
}
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm 16;
test_tcp(
client => sub {
my $port = shift;
client(
@{ $opts->[0] },
port => $port,
host => $host,
on_error => sub {
fail "error occurred: " . shift;
},
test_cb => sub {
my $client = shift;
$client->request(
':scheme' => "http",
':authority' => $host . ":" . $port,
':path' => "/",
':method' => "GET",
headers => [
'accept' => '*/*',
'user-agent' => 'perl-Protocol-HTTP2/'
. $Protocol::HTTP2::VERSION,
],
on_done => sub {
my ( $headers, $data ) = @_;
is scalar(@$headers) / 2, 6,
"get response headers";
is length($data), 13, "get body";
},
);
}
);
},
server => sub {
my $port = shift;
my $server;
server(
@{ $opts->[1] },
port => $port,
host => $host,
on_error => sub {
fail "error occurred: " . shift;
},
test_cb => sub {
$server = shift;
},
on_request => sub {
my ( $stream_id, $headers, $data ) = @_;
my $message = "hello, world!";
$server->response(
':status' => 200,
stream_id => $stream_id,
headers => [
'server' => 'perl-Protocol-HTTP2/'
. $Protocol::HTTP2::VERSION,
'content-length' => length($message),
'cache-control' => 'max-age=3600',
'date' => 'Fri, 18 Apr 2014 07:27:11 GMT',
'last-modified' =>
'Thu, 27 Feb 2014 10:30:37 GMT',
],
data => $message,
);
},
);
},
);
alarm 0;
};
is $@, '', "no errors";
}
};
done_testing;