line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::WebSocket::Parser; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=encoding utf-8 |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Net::WebSocket::Parser - Parse WebSocket from a filehandle |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $iof = IO::Framed::Read->new($fh); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $parse = Net::WebSocket::Parser->new($iof); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#See below for error responses |
16
|
|
|
|
|
|
|
my $frame = $parse->get_next_frame(); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
C<$iof> should normally be an instance of L. You’re free to |
19
|
|
|
|
|
|
|
pass in anything with a C method, but that method must implement |
20
|
|
|
|
|
|
|
the same behavior as C. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 METHODS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head2 I->get_next_frame() |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
A call to this method yields one of the following: |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=over |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=item * If a frame can be read, it will be returned. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=item * If only a partial frame is ready, undef is returned. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 I/O DETAILS |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
L was born out of work on this module; see that module’s |
37
|
|
|
|
|
|
|
documentation for the particulars of working with it. In particular, |
38
|
|
|
|
|
|
|
note the exceptions L and |
39
|
|
|
|
|
|
|
L. (As described in L’s |
40
|
|
|
|
|
|
|
documentation, you can use an equivalent interface for frame chunking if you |
41
|
|
|
|
|
|
|
wish.) |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 CUSTOM FRAMES SUPPORT |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
To support reception of custom frame types you’ll probably want to subclass |
46
|
|
|
|
|
|
|
this module and define a specific custom constant for each supported opcode, |
47
|
|
|
|
|
|
|
e.g.: |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
package My::WebSocket::Parser; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
use parent qw( Net::WebSocket::Parser ); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
use constant OPCODE_CLASS_3 => 'My::WebSocket::Frame::booya'; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
… where C is itself a subclass of |
56
|
|
|
|
|
|
|
C. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
You can also use this to override the default |
59
|
|
|
|
|
|
|
classes for built-in frame types; e.g., C will override |
60
|
|
|
|
|
|
|
L as the class will be used for pong frames |
61
|
|
|
|
|
|
|
that this module receives. That could be useful, e.g., for compression |
62
|
|
|
|
|
|
|
extensions, where you might want the C method to |
63
|
|
|
|
|
|
|
decompress so that that detail is abstracted away. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
66
|
|
|
|
|
|
|
|
67
|
6
|
|
|
6
|
|
394401
|
use strict; |
|
6
|
|
|
|
|
35
|
|
|
6
|
|
|
|
|
141
|
|
68
|
6
|
|
|
6
|
|
29
|
use warnings; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
120
|
|
69
|
|
|
|
|
|
|
|
70
|
6
|
|
|
6
|
|
272
|
use Module::Load (); |
|
6
|
|
|
|
|
1137
|
|
|
6
|
|
|
|
|
73
|
|
71
|
|
|
|
|
|
|
|
72
|
6
|
|
|
6
|
|
1183
|
use Net::WebSocket::Constants (); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
88
|
|
73
|
6
|
|
|
6
|
|
1066
|
use Net::WebSocket::X (); |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
180
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
use constant { |
76
|
6
|
|
|
|
|
3826
|
OPCODE_CLASS_0 => 'Net::WebSocket::Frame::continuation', |
77
|
|
|
|
|
|
|
OPCODE_CLASS_1 => 'Net::WebSocket::Frame::text', |
78
|
|
|
|
|
|
|
OPCODE_CLASS_2 => 'Net::WebSocket::Frame::binary', |
79
|
|
|
|
|
|
|
OPCODE_CLASS_8 => 'Net::WebSocket::Frame::close', |
80
|
|
|
|
|
|
|
OPCODE_CLASS_9 => 'Net::WebSocket::Frame::ping', |
81
|
|
|
|
|
|
|
OPCODE_CLASS_10 => 'Net::WebSocket::Frame::pong', |
82
|
6
|
|
|
6
|
|
29
|
}; |
|
6
|
|
|
|
|
10
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub new { |
85
|
21
|
|
|
21
|
0
|
18020
|
my ($class, $reader) = @_; |
86
|
|
|
|
|
|
|
|
87
|
21
|
50
|
|
|
|
133
|
if (!(ref $reader)->can('read')) { |
88
|
0
|
|
|
|
|
0
|
die "“$reader” needs a read() method!"; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
21
|
|
|
|
|
80
|
return bless { |
92
|
|
|
|
|
|
|
_reader => $reader, |
93
|
|
|
|
|
|
|
}, $class; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub get_next_frame { |
97
|
65908
|
|
|
65908
|
1
|
3127352
|
my ($self) = @_; |
98
|
|
|
|
|
|
|
|
99
|
65908
|
|
|
|
|
81967
|
local $@; |
100
|
|
|
|
|
|
|
|
101
|
65908
|
100
|
|
|
|
118582
|
if (!exists $self->{'_partial_frame'}) { |
102
|
21
|
|
|
|
|
44
|
$self->{'_partial_frame'} = q<>; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
#It is really, really inconvenient that Perl has no “or” operator |
106
|
|
|
|
|
|
|
#that considers q<> falsey but '0' truthy. :-/ |
107
|
|
|
|
|
|
|
#That aside, if indeed all we read is '0', then we know that’s not |
108
|
|
|
|
|
|
|
#enough, and we can return. |
109
|
65908
|
100
|
|
|
|
99894
|
my $first2 = $self->_read_with_buffer(2) or return undef; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
#Now that we’ve read our header bytes, we’ll read some more. |
112
|
|
|
|
|
|
|
#There may not actually be anything to read, though, in which case |
113
|
|
|
|
|
|
|
#some readers will error (e.g., EAGAIN from a non-blocking filehandle). |
114
|
|
|
|
|
|
|
#From a certain ideal we’d return #on each individual read to allow |
115
|
|
|
|
|
|
|
#the reader to wait until there is more data ready; however, for |
116
|
|
|
|
|
|
|
#practicality (and speed) let’s go ahead and try to read the rest of |
117
|
|
|
|
|
|
|
#the frame. That means we need to set some flag to let the reader know |
118
|
|
|
|
|
|
|
#not to die() if there’s no more data currently, as we’re probably |
119
|
|
|
|
|
|
|
#expecting more soon to complete the frame. |
120
|
65903
|
|
|
|
|
114728
|
local $self->{'_reading_frame'} = 1; |
121
|
|
|
|
|
|
|
|
122
|
65903
|
|
|
|
|
142348
|
my ($oct1, $oct2) = unpack('CC', $first2 ); |
123
|
|
|
|
|
|
|
|
124
|
65903
|
|
|
|
|
94803
|
my $len = $oct2 & 0x7f; |
125
|
|
|
|
|
|
|
|
126
|
65903
|
|
100
|
|
|
106110
|
my $mask_size = ($oct2 & 0x80) && 4; |
127
|
|
|
|
|
|
|
|
128
|
65903
|
100
|
|
|
|
116093
|
my $len_len = ($len == 0x7e) ? 2 : ($len == 0x7f) ? 8 : 0; |
|
|
100
|
|
|
|
|
|
129
|
65903
|
|
|
|
|
80414
|
my $len_buf = q<>; |
130
|
|
|
|
|
|
|
|
131
|
65903
|
|
|
|
|
78479
|
my ($longs, $long); |
132
|
|
|
|
|
|
|
|
133
|
65903
|
100
|
|
|
|
94740
|
if ($len_len) { |
134
|
65804
|
100
|
|
|
|
100629
|
$len_buf = $self->_read_with_buffer($len_len) or do { |
135
|
10
|
|
|
|
|
20
|
substr( $self->{'_partial_frame'}, 0, 0, $first2 ); |
136
|
10
|
|
|
|
|
31
|
return undef; |
137
|
|
|
|
|
|
|
}; |
138
|
|
|
|
|
|
|
|
139
|
65794
|
100
|
|
|
|
107219
|
if ($len_len == 2) { |
140
|
257
|
|
|
|
|
572
|
($longs, $long) = ( 0, unpack('n', $len_buf) ); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
else { |
143
|
65537
|
|
|
|
|
120921
|
($longs, $long) = ( unpack('NN', $len_buf) ); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
else { |
147
|
99
|
|
|
|
|
167
|
($longs, $long) = ( 0, $len ); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
65893
|
|
|
|
|
78546
|
my $mask_buf; |
151
|
65893
|
100
|
|
|
|
91887
|
if ($mask_size) { |
152
|
71
|
100
|
|
|
|
125
|
$mask_buf = $self->_read_with_buffer($mask_size) or do { |
153
|
4
|
|
|
|
|
14
|
substr( $self->{'_partial_frame'}, 0, 0, $first2 . $len_buf ); |
154
|
4
|
|
|
|
|
21
|
return undef; |
155
|
|
|
|
|
|
|
}; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
else { |
158
|
65822
|
|
|
|
|
83036
|
$mask_buf = q<>; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
65889
|
|
|
|
|
78519
|
my $payload = q<>; |
162
|
|
|
|
|
|
|
|
163
|
65889
|
|
|
|
|
113341
|
for ( 1 .. $longs ) { |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
#32-bit systems don’t know what 2**32 is. |
166
|
|
|
|
|
|
|
#MacOS, at least, also chokes on sysread( 2**31, … ) |
167
|
|
|
|
|
|
|
#(Is their size_t signed??), even on 64-bit. |
168
|
0
|
|
|
|
|
0
|
for ( 1 .. 4 ) { |
169
|
0
|
0
|
|
|
|
0
|
$self->_append_chunk( 2**30, \$payload ) or do { |
170
|
0
|
|
|
|
|
0
|
substr( $self->{'_partial_frame'}, 0, 0, $first2 . $len_buf . $mask_buf . $payload ); |
171
|
0
|
|
|
|
|
0
|
return undef; |
172
|
|
|
|
|
|
|
}; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
65889
|
100
|
|
|
|
104289
|
if ($long) { |
177
|
65881
|
100
|
|
|
|
110603
|
$self->_append_chunk( $long, \$payload ) or do { |
178
|
65806
|
|
|
|
|
125769
|
substr( $self->{'_partial_frame'}, 0, 0, $first2 . $len_buf . $mask_buf . $payload ); |
179
|
65806
|
|
|
|
|
177609
|
return undef; |
180
|
|
|
|
|
|
|
}; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
83
|
|
|
|
|
140
|
$self->{'_partial_frame'} = q<>; |
184
|
|
|
|
|
|
|
|
185
|
83
|
|
|
|
|
123
|
my $opcode = $oct1 & 0xf; |
186
|
|
|
|
|
|
|
|
187
|
83
|
|
66
|
|
|
211
|
my $frame_class = $self->{'_opcode_class'}{$opcode} ||= do { |
188
|
25
|
|
|
|
|
41
|
my $class; |
189
|
25
|
50
|
|
|
|
140
|
if (my $cr = $self->can("OPCODE_CLASS_$opcode")) { |
190
|
25
|
|
|
|
|
67
|
$class = $cr->(); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
else { |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
#Untyped because this is a coding error. |
195
|
0
|
|
|
|
|
0
|
die "$self: Unrecognized frame opcode: “$opcode”"; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
25
|
100
|
|
|
|
235
|
Module::Load::load($class) if !$class->can('new'); |
199
|
|
|
|
|
|
|
|
200
|
25
|
|
|
|
|
148
|
$class; |
201
|
|
|
|
|
|
|
}; |
202
|
|
|
|
|
|
|
|
203
|
83
|
|
|
|
|
320
|
return $frame_class->create_from_parse(\$first2, \$len_len, \$mask_buf, \$payload); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
#This will only return exactly the number of bytes requested. |
207
|
|
|
|
|
|
|
#If fewer than we want are available, then we return undef. |
208
|
|
|
|
|
|
|
sub _read_with_buffer { |
209
|
197664
|
|
|
197664
|
|
257471
|
my ($self, $length) = @_; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
#Prioritize the case where we read everything we need. |
212
|
|
|
|
|
|
|
|
213
|
197664
|
100
|
|
|
|
321831
|
if ( length($self->{'_partial_frame'}) < $length ) { |
214
|
66045
|
|
|
|
|
84878
|
my $deficit = $length - length($self->{'_partial_frame'}); |
215
|
66045
|
|
|
|
|
138862
|
my $read = $self->{'_reader'}->read($deficit); |
216
|
|
|
|
|
|
|
|
217
|
66044
|
100
|
|
|
|
1430842
|
if (!defined $read) { |
218
|
65824
|
|
|
|
|
96744
|
return undef; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
220
|
|
|
|
|
668
|
return substr($self->{'_partial_frame'}, 0, length($self->{'_partial_frame'}), q<>) . $read; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
131619
|
|
|
|
|
325779
|
return substr( $self->{'_partial_frame'}, 0, $length, q<> ); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub _append_chunk { |
228
|
65881
|
|
|
65881
|
|
91866
|
my ($self, $length, $buf_sr) = @_; |
229
|
|
|
|
|
|
|
|
230
|
65881
|
|
|
|
|
83086
|
my $start_buf_len = length $$buf_sr; |
231
|
|
|
|
|
|
|
|
232
|
65881
|
|
|
|
|
75711
|
my $cur_buf; |
233
|
|
|
|
|
|
|
|
234
|
65881
|
|
|
|
|
72366
|
while (1) { |
235
|
65881
|
|
|
|
|
79688
|
my $read_so_far = length($$buf_sr) - $start_buf_len; |
236
|
|
|
|
|
|
|
|
237
|
65881
|
|
|
|
|
107195
|
$cur_buf = $self->_read_with_buffer($length - $read_so_far); |
238
|
65881
|
100
|
|
|
|
141342
|
return undef if !defined $cur_buf; |
239
|
|
|
|
|
|
|
|
240
|
75
|
|
|
|
|
187
|
$$buf_sr .= $cur_buf; |
241
|
|
|
|
|
|
|
|
242
|
75
|
50
|
|
|
|
160
|
last if (length($$buf_sr) - $start_buf_len) >= $length; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
75
|
|
|
|
|
147
|
return 1; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
1; |