File Coverage

blib/lib/AnyEvent/WebSocket/Server.pm
Criterion Covered Total %
statement 75 92 81.5
branch 24 36 66.6
condition 4 6 66.6
subroutine 16 17 94.1
pod 3 3 100.0
total 122 154 79.2


line stmt bran cond sub pod time code
1             package AnyEvent::WebSocket::Server;
2 9     9   1024766 use strict;
  9         20  
  9         365  
3 9     9   48 use warnings;
  9         15  
  9         327  
4 9     9   49 use Carp;
  9         20  
  9         791  
5 9     9   8016 use AnyEvent::Handle;
  9         126475  
  9         426  
6 9     9   6832 use Protocol::WebSocket::Handshake::Server;
  9         1576071  
  9         433  
7 9     9   111 use Try::Tiny;
  9         19  
  9         858  
8 9     9   7200 use AnyEvent::WebSocket::Connection;
  9         87670  
  9         9146  
9              
10             our $VERSION = "0.09";
11              
12             sub new {
13 54     54 1 918885 my ($class, %args) = @_;
14 54         171 my $validator = $args{validator};
15 54 50 66     337 if(defined($validator) && ref($validator) ne "CODE") {
16 0         0 croak "validator parameter must be a code-ref";
17             }
18             my $handshake = defined($args{handshake}) ? $args{handshake}
19 9     9   75 : defined($validator) ? sub { my ($req, $res) = @_; return ($res, $validator->($req)); }
  9         51  
20 54 100   168   1764 : sub { $_[1] };
  168 100       1246  
21 54 50       290 if(ref($handshake) ne "CODE") {
22 0         0 croak "handshake parameter must be a code-ref";
23             }
24             my $self = bless {
25             handshake => $handshake,
26 54         144 map { ($_ => $args{$_}) } qw(ssl_key_file ssl_cert_file max_payload_size),
  162         601  
27             }, $class;
28 54         266 return $self;
29             }
30              
31             sub _create_on_error {
32 212     212   441 my ($cv) = @_;
33             return sub {
34 4     4   611 my ($handle, $fatal, $message) = @_;
35 4 50       17 if($fatal) {
36 4         31 $cv->croak("connection error: $message");
37             }else {
38 0         0 warn $message;
39             }
40 212         2117 };
41             }
42              
43             sub _handle_args_tls {
44 212     212   334 my ($self) = @_;
45 212 100 66     1154 if(!defined($self->{ssl_key_file}) && !defined($self->{ssl_cert_file})) {
46 71         231 return ();
47             }
48 141 50       561 if(!defined($self->{ssl_cert_file})) {
49 0         0 croak "Only ssl_key_file is specified. You need to specify ssl_cert_file, too.";
50             }
51             return (
52             tls => "accept",
53             tls_ctx => {
54             cert_file => $self->{ssl_cert_file},
55 141 100       1448 defined($self->{ssl_key_file}) ? (key_file => $self->{ssl_key_file}) : ()
56             }
57             );
58             }
59              
60             sub _do_handshake {
61 212     212   434 my ($self, $cv_connection, $fh, $handshake) = @_;
62 212         541 my $handshake_code = $self->{handshake};
63 212         723 my $handle = AnyEvent::Handle->new(
64             $self->_handle_args_tls,
65             fh => $fh, on_error => _create_on_error($cv_connection)
66             );
67             my $read_cb = sub {
68             ## We don't receive handle object as an argument here. $handle
69             ## is imported in this closure so that $handle becomes
70             ## half-immortal.
71             try {
72 423 100       23340 if(!defined($handshake->parse($handle->{rbuf}))) {
73 4         1198 die "handshake error: " . $handshake->error . "\n";
74             }
75 419 100       176152 return if !$handshake->is_done;
76 204 50       2702 if($handshake->version ne "draft-ietf-hybi-17") {
77 0         0 die "handshake error: unsupported WebSocket protocol version " . $handshake->version . "\n";
78             }
79 204         2179 my ($res, @other_results) = $handshake_code->($handshake->req, $handshake->res);
80 195 100       5571 if(!defined($res)) {
81 3         594 croak "handshake response was undef";
82             }
83 192 100       661 if(ref($res) eq "Protocol::WebSocket::Response") {
84 189         778 $res = $res->to_string;
85             }
86 192         72117 $handle->push_write("$res");
87             $cv_connection->send(
88 192         29255 AnyEvent::WebSocket::Connection->new(handle => $handle, max_payload_size => $self->{max_payload_size}),
89             @other_results
90             );
91 192         121863 undef $handle;
92 192         905 undef $cv_connection;
93             }catch {
94 16         760 my $e = shift;
95 16         331 $cv_connection->croak($e);
96 16         14127 undef $handle;
97 16         83 undef $cv_connection;
98 423     423   4302054 };
99 212         150299 };
100 212         594 $handle->{rbuf} = "";
101 212         729 $read_cb->(); ## in case the whole request is already consumed
102 212 50       7850 $handle->on_read($read_cb) if defined $handle;
103             }
104              
105             sub establish {
106 213     213 1 714186 my ($self, $fh) = @_;
107 213         8037 my $cv_connection = AnyEvent->condvar;
108 213 100       2469 if(!defined($fh)) {
109 1         13 $cv_connection->croak("fh parameter is mandatory for establish() method");
110 1         79 return $cv_connection;
111             }
112 212         2859 my $handshake = Protocol::WebSocket::Handshake::Server->new;
113 212         2116 $self->_do_handshake($cv_connection, $fh, $handshake);
114 212         8123 return $cv_connection;
115             }
116              
117             sub establish_psgi {
118 0     0 1   my ($self, $env, $fh) = @_;
119 0           my $cv_connection = AnyEvent->condvar;
120 0 0         if(!defined($env)) {
121 0           $cv_connection->croak("psgi_env parameter is mandatory");
122 0           return $cv_connection;
123             }
124 0 0         $fh = $env->{"psgix.io"} if not defined $fh;
125 0 0         if(!defined($fh)) {
126 0           $cv_connection->croak("No connection file handle provided. Maybe the PSGI server does not support psgix.io extension.");
127 0           return $cv_connection;
128             }
129 0           my $handshake = Protocol::WebSocket::Handshake::Server->new_from_psgi($env);
130 0           $self->_do_handshake($cv_connection, $fh, $handshake);
131 0           return $cv_connection;
132             }
133              
134             1;
135              
136             __END__