/usr/share/doc/libprotocol-http2-perl/examples/server-anyevent.pl is in libprotocol-http2-perl 1.08-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | use strict;
use warnings;
use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Handle;
use Protocol::HTTP2::Server;
use Protocol::HTTP2::Constants qw(const_name);
my $host = '127.0.0.1';
my $port = 8000;
my $w = AnyEvent->condvar;
tcp_server $host, $port, sub {
my ( $fh, $host, $port ) = @_;
my $handle;
$handle = AnyEvent::Handle->new(
fh => $fh,
autocork => 1,
on_error => sub {
$_[0]->destroy;
print "connection error\n";
},
on_eof => sub {
$handle->destroy;
}
);
my $server;
$server = Protocol::HTTP2::Server->new(
on_change_state => sub {
my ( $stream_id, $previous_state, $current_state ) = @_;
printf "Stream %i changed state from %s to %s\n",
$stream_id, const_name( "states", $previous_state ),
const_name( "states", $current_state );
},
on_error => sub {
my $error = shift;
printf "Error occured: %s\n", const_name( "errors", $error );
},
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/0.01',
'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,
);
},
# Accept HTTP/1.1 Upgrade header
upgrade => 1,
);
# First send settings to peer
while ( my $frame = $server->next_frame ) {
$handle->push_write($frame);
}
$handle->on_read(
sub {
my $handle = shift;
$server->feed( $handle->{rbuf} );
$handle->{rbuf} = undef;
while ( my $frame = $server->next_frame ) {
$handle->push_write($frame);
}
$handle->push_shutdown if $server->shutdown;
}
);
};
$w->recv;
|