1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
use strict;
use warnings;
use Test::More;
use lib 't/lib';
use PH2ClientServerTest;
use Test::TCP;
use Protocol::HTTP2;
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;
|
