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__ |