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
|
use strict;
use warnings;
use IO::Select;
use IO::Socket::SSL;
use Protocol::HTTP2::Server;
# TLS transport socket
my $srv = IO::Socket::SSL->new(
LocalAddr => '0.0.0.0:4443',
Listen => 10,
SSL_cert_file => 'test.crt',
SSL_key_file => 'test.key',
# openssl 1.0.1 support only NPN
SSL_npn_protocols => ['h2'],
# openssl 1.0.2 also have ALPN
#SSL_alpn_protocols => ['h2'],
) or die $!;
# Accept client connection
while ( my $client = $srv->accept ) {
# HTTP/2 server
my $h2_srv;
$h2_srv = Protocol::HTTP2::Server->new(
on_request => sub {
my ( $stream_id, $headers, $data ) = @_;
$h2_srv->response(
':status' => 200,
stream_id => $stream_id,
headers => [
'server' => 'Protocol::HTTP2::Server',
'content-type' => 'application/json',
],
data => '{ "hello" : "world" }',
);
}
);
# non-blocking
$client->blocking(0);
my $sel = IO::Select->new($client);
# send/recv frames until request/response is done
while ( !$h2_srv->shutdown ) {
$sel->can_write;
while ( my $frame = $h2_srv->next_frame ) {
syswrite $client, $frame;
}
$sel->can_read;
my $len;
while ( my $rd = sysread $client, my $data, 4096 ) {
$h2_srv->feed($data);
$len += $rd;
}
# check if client disconnects
last unless $len;
}
# destroy server object
undef $h2_srv;
}
|
