File Coverage

blib/lib/Net/WebSocket/PMCE/deflate.pm
Criterion Covered Total %
statement 76 91 83.5
branch 17 28 60.7
condition 4 6 66.6
subroutine 22 24 91.6
pod 9 9 100.0
total 128 158 81.0


line stmt bran cond sub pod time code
1             package Net::WebSocket::PMCE::deflate;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Net::WebSocket::PMCE::deflate - WebSocket’s C extension
8              
9             =head1 SYNOPSIS
10              
11             See L or
12             L for usage examples.
13              
14             =head1 DESCRIPTION
15              
16             This class implements C as defined in
17             L.
18              
19             This is a base class, not to be instantiated directly.
20              
21             This class implements a L-compatible
22             extension interface.
23              
24             =head1 STATUS
25              
26             This module is an ALPHA release. Changes to the API are not unlikely;
27             be sure to check the changelog before updating, and please report any
28             issues you find.
29              
30             =cut
31              
32 4     4   1434 use strict;
  4         7  
  4         85  
33 4     4   15 use warnings;
  4         5  
  4         83  
34              
35 4     4   362 use parent qw( Net::WebSocket::PMCE::deflate::Constants );
  4         241  
  4         17  
36              
37 4     4   1635 use Module::Load ();
  4         3377  
  4         67  
38              
39 4     4   1309 use Net::WebSocket::Handshake::Extension ();
  4         16  
  4         63  
40 4     4   20 use Net::WebSocket::PMCE::deflate::Constants ();
  4         6  
  4         44  
41 4     4   1224 use Net::WebSocket::X ();
  4         15  
  4         1976  
42              
43             =head1 METHODS
44              
45             =head2 I->new( %OPTS )
46              
47             Returns a new instance of this class.
48              
49             C<%OPTS> is:
50              
51             =over
52              
53             =item C - optional; the maximum number of window bits
54             that this endpoint will use to compress messages. See C
55             in L for valid values.
56              
57             =item C - optional; the number of window bits to use
58             to decompress messages. Valid values are the same as for
59             C.
60              
61             =item C - boolean; whether the compressor
62             will forgo context takeover. (See below.)
63              
64             =item C - boolean; whether the decompressor
65             can forgo context takeover.
66              
67             =back
68              
69             This interface uses C/C prefixes rather than
70             C/C as the RFC uses because the module author
71             has found C/C easier to conceptualize.
72              
73             =head1 CONTEXT TAKEOVER: THE MISSING EXPLANATION
74              
75             As best I can tell, the term “context takeover” is indigenous to
76             permessage-deflate. The term appears all over the RFC but isn’t explained
77             very clearly, in my opinion. Here, then, is an attempt to provide that
78             explanation.
79              
80             As a DEFLATE compressor receives bytes of the stream, it “remembers”
81             common sequences of past parts of the stream in a “window” that
82             “slides” along with the data stream: this is the LZ77 ”sliding window”.
83              
84             By default, permessage-deflate retains the previous message’s sliding
85             window and uses it to compress the start of the next message;
86             this is called “context takeover” because the new message “takes over”
87             the “context” (i.e., sliding window) from the previous message. Setting
88             one or the other peer to “no context takeover” mode, then, tells that
89             peer to empty out its sliding window at the end of each message. This
90             means that peer won’t need to retain the sliding window between messages,
91             which can reduce memory consumption.
92              
93             In DEFLATE terms, a compressor does a SYNC flush at the end of each
94             message when using context takeover; otherwise the compressor does a
95             FULL flush.
96              
97             Maybe a better term for this behavior would have been “window retention”.
98             Anyway, there it is.
99              
100             =cut
101              
102             sub new {
103 25     25 1 5886 my ($class, %opts) = @_;
104              
105 25         80 my @errs = $class->_get_parameter_errors(%opts);
106 25 100       114 die "@errs" if @errs;
107              
108 17         50 return bless \%opts, $class;
109             }
110              
111             =head2 I->deflate_max_window_bits()
112              
113             The effective value of this setting. If unspecified or if the peer doesn’t
114             support this feature, the returned value will be the RFC’s default value.
115              
116             =cut
117              
118             sub deflate_max_window_bits {
119 5     5 1 19 my ($self) = @_;
120              
121 5   66     34 return $self->{'deflate_max_window_bits'} || ( $self->VALID_MAX_WINDOW_BITS() )[-1];
122             }
123              
124             =head2 I->inflate_max_window_bits()
125              
126             The effective value of this setting. If unspecified or if the peer doesn’t
127             support this feature, the returned value will be the RFC’s default value.
128              
129             =cut
130              
131             sub inflate_max_window_bits {
132 7     7 1 17 my ($self) = @_;
133              
134 7   66     38 return $self->{'inflate_max_window_bits'} || ( $self->VALID_MAX_WINDOW_BITS() )[-1];
135             }
136              
137             =head2 I->deflate_no_context_takeover()
138              
139             Whether to drop the LZ77 sliding window between messages (i.e.,
140             to do a full DEFLATE flush with each FIN frame).
141              
142             =cut
143              
144             sub deflate_no_context_takeover {
145 4     4 1 12 my ($self) = @_;
146              
147 4         14 return !!$self->{'deflate_no_context_takeover'};
148             }
149              
150             =head2 I->inflate_no_context_takeover()
151              
152             Whether to ask the peer drop the LZ77 sliding window between messages.
153              
154             =cut
155              
156             sub inflate_no_context_takeover {
157 6     6 1 356 my ($self) = @_;
158              
159 6         29 return !!$self->{'inflate_no_context_takeover'};
160             }
161              
162             =head2 I->create_data_object()
163              
164             A convenience method that returns an instance of the appropriate
165             subclass of L.
166              
167             =cut
168              
169             sub create_data_object {
170 0     0 1 0 my ($self) = @_;
171              
172 0         0 my $class = __PACKAGE__ . '::Data::' . $self->_ENDPOINT_CLASS();
173 0 0       0 Module::Load::load($class) if !$class->can('new');
174              
175 0         0 return $class->new( %$self );
176             }
177              
178             #----------------------------------------------------------------------
179              
180             =head2 I->token()
181              
182             As described in L’s documentation.
183              
184             =cut
185              
186             #====== INHERITED from an undocumented base class
187              
188             =head2 I->get_handshake_object()
189              
190             As described in L’s documentation.
191              
192             =cut
193              
194             sub get_handshake_object {
195 4     4 1 15 my ($self) = @_;
196              
197 4         18 return Net::WebSocket::Handshake::Extension->new(
198             $self->_create_extension_header_parts(),
199             );
200             }
201              
202             =head2 I->consume_parameters( KEY1 => VALUE1, .. )
203              
204             As described in L’s documentation. After
205             this function runs, you can inspect the I to ensure that the
206             configuration that the peer allows is one that your application
207             finds acceptable. (It likely is, but hey.)
208              
209             See this module’s subclasses’ documentation for more details about
210             how they handle each parameter.
211              
212             =cut
213              
214             sub consume_parameters {
215 12     12 1 169 my ($self, @params) = @_;
216              
217 12         27 my %opts = @params;
218              
219 12         30 $self->_consume_extension_options(\%opts);
220              
221 11 50       20 if (%opts) {
222 0         0 my $token = $self->token();
223 0         0 die "Unrecognized for “$token”: @params";
224             }
225              
226 11         18 $self->{'_use_ok'}++;
227              
228 11         26 return;
229             }
230              
231             =head2 I->ok_to_use()
232              
233             As described in L’s documentation.
234              
235             =cut
236              
237             sub ok_to_use {
238 0     0 1 0 my ($self) = @_;
239              
240 0         0 return !!$self->{'_use_ok'};
241             }
242              
243             #----------------------------------------------------------------------
244              
245             # 7. .. A server MUST decline an extension negotiation offer for this
246             # extension if any of the following conditions are met:
247             sub _get_parameter_errors {
248 25     25   45 my ($class, @params_kv) = @_;
249              
250 25         42 my %params;
251              
252             my @errors;
253              
254 25         76 while ( my ($k, $v) = splice( @params_kv, 0, 2 ) ) {
255              
256             #The negotiation (offer/response) contains multiple extension
257             #parameters with the same name.
258 23 50       45 if ( exists $params{$k} ) {
259 0 0       0 if (defined $v) {
260 0         0 push @errors, "Duplicate parameter /$k/ ($v)";
261             }
262             else {
263 0         0 push @errors, "Duplicate parameter /$k/, no value";
264             }
265             }
266              
267             #The negotiation (offer/response) contains an extension parameter
268             #with an invalid value.
269 23 50       130 if ( my $cr = $class->can("_validate_$k") ) {
270 23         60 push @errors, $cr->($class, $v);
271             }
272              
273             #The negotiation (offer/response) contains an extension parameter
274             #not defined for use in an (offer/response).
275             else {
276 0 0       0 if (defined $v) {
277 0         0 push @errors, "Unknown parameter /$k/ ($v)";
278             }
279             else {
280 0         0 push @errors, "Unknown parameter /$k/, no value";
281             }
282             }
283             }
284              
285 25         4130 return @errors;
286             }
287              
288             #Define these as no-ops because all we care about is their truthiness.
289 4     4   26 use constant _validate_deflate_no_context_takeover => ();
  4         8  
  4         196  
290 4     4   20 use constant _validate_inflate_no_context_takeover => ();
  4         12  
  4         1259  
291              
292             sub _validate_deflate_max_window_bits {
293 7     7   22 return $_[0]->__validate_max_window_bits( 'deflate', $_[1] );
294             }
295              
296             sub _validate_inflate_max_window_bits {
297 10     10   22 return $_[0]->__validate_max_window_bits( 'inflate', $_[1] );
298             }
299              
300             sub __validate_no_context_takeover {
301 5     5   9 my ($self, $endpoint, $value) = @_;
302              
303 5 50       12 if (defined $value) {
304 0         0 return "/${endpoint}_no_context_takeover/ must not have a value.";
305             }
306              
307 5         8 return;
308             }
309              
310             sub __validate_max_window_bits {
311 23     23   40 my ($self, $ept, $bits) = @_;
312              
313 23         54 my @VALID_MAX_WINDOW_BITS = $self->VALID_MAX_WINDOW_BITS();
314              
315 23 50       40 if (defined $bits) {
316 23 100       34 return if grep { $_ eq $bits } @VALID_MAX_WINDOW_BITS;
  184         337  
317             }
318              
319 8         57 return Net::WebSocket::X->create( 'BadArg', "${ept}_max_window_bits" => $bits, "Must be one of: [@VALID_MAX_WINDOW_BITS]" );
320             }
321              
322             sub _create_extension_header_parts {
323 4     4   6 my ($self) = @_;
324              
325 4         12 my @parts = $self->token();
326              
327 4 100       10 if (defined $self->{'deflate_max_window_bits'}) {
328 1         3 push @parts, $self->_DEFLATE_MAX_WINDOW_BITS_PARAM() => $self->{'deflate_max_window_bits'};
329             }
330              
331 4 100       8 if (defined $self->{'inflate_max_window_bits'}) {
332 2         4 push @parts, $self->_INFLATE_MAX_WINDOW_BITS_PARAM() => $self->{'inflate_max_window_bits'};
333             }
334              
335 4 100       8 if ($self->{'deflate_no_context_takeover'}) {
336 1         3 push @parts, $self->_LOCAL_NO_CONTEXT_TAKEOVER_PARAM() => undef;
337             }
338 4 100       8 if ($self->{'inflate_no_context_takeover'}) {
339 3         7 push @parts, $self->_PEER_NO_CONTEXT_TAKEOVER_PARAM() => undef;
340             }
341              
342 4         10 return @parts;
343             }
344              
345             #----------------------------------------------------------------------
346              
347             1;
348              
349             =head1 REPOSITORY
350              
351             L
352              
353             =head1 AUTHOR
354              
355             Felipe Gasper (FELIPE)
356              
357             =head1 COPYRIGHT
358              
359             Copyright 2017 by L
360              
361             =head1 LICENSE
362              
363             This distribution is released under the same license as Perl.