File Coverage

blib/lib/Net/WebSocket/PMCE/deflate.pm
Criterion Covered Total %
statement 58 91 63.7
branch 13 26 50.0
condition 0 6 0.0
subroutine 16 24 66.6
pod 9 9 100.0
total 96 156 61.5


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 2     2   541 use strict;
  2         3  
  2         45  
33 2     2   8 use warnings;
  2         4  
  2         42  
34              
35 2     2   206 use parent qw( Net::WebSocket::PMCE::deflate::Constants );
  2         214  
  2         9  
36              
37 2     2   529 use Module::Load ();
  2         1561  
  2         32  
38              
39 2     2   467 use Net::WebSocket::Handshake::Extension ();
  2         5  
  2         31  
40 2     2   10 use Net::WebSocket::PMCE::deflate::Constants ();
  2         4  
  2         22  
41 2     2   433 use Net::WebSocket::X ();
  2         14  
  2         889  
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 4     4 1 1644 my ($class, %opts) = @_;
104              
105 4         15 my @errs = $class->_get_parameter_errors(%opts);
106 4 50       9 die "@errs" if @errs;
107              
108 4         10 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 0     0 1 0 my ($self) = @_;
120              
121 0   0     0 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 0     0 1 0 my ($self) = @_;
133              
134 0   0     0 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 0     0 1 0 my ($self) = @_;
146              
147 0         0 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 0     0 1 0 my ($self) = @_;
158              
159 0         0 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 Module::Load::load($class);
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 17 my ($self) = @_;
196              
197 4         11 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 0     0 1 0 my ($self, @params) = @_;
216              
217 0         0 my %opts = @params;
218              
219 0         0 $self->_consume_extension_options(\%opts);
220              
221 0 0       0 if (%opts) {
222 0         0 my $token = $self->token();
223 0         0 die "Unrecognized for “$token”: @params";
224             }
225              
226 0         0 $self->{'_use_ok'}++;
227              
228 0         0 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 4     4   10 my ($class, @params_kv) = @_;
249              
250 4         6 my %params;
251              
252             my @errors;
253              
254 4         14 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 7 50       14 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 7 50       44 if ( my $cr = $class->can("_validate_$k") ) {
270 7         22 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 4         8 return @errors;
286             }
287              
288             #Define these as no-ops because all we care about is their truthiness.
289 2     2   12 use constant _validate_deflate_no_context_takeover => ();
  2         4  
  2         102  
290 2     2   9 use constant _validate_inflate_no_context_takeover => ();
  2         3  
  2         546  
291              
292             sub _validate_deflate_max_window_bits {
293 1     1   3 return $_[0]->__validate_max_window_bits( 'deflate', $_[1] );
294             }
295              
296             sub _validate_inflate_max_window_bits {
297 2     2   6 return $_[0]->__validate_max_window_bits( 'inflate', $_[1] );
298             }
299              
300             sub __validate_no_context_takeover {
301 0     0   0 my ($self, $endpoint, $value) = @_;
302              
303 0 0       0 if (defined $value) {
304 0         0 return "/${endpoint}_no_context_takeover/ must not have a value.";
305             }
306              
307 0         0 return;
308             }
309              
310             sub __validate_max_window_bits {
311 3     3   6 my ($self, $ept, $bits) = @_;
312              
313 3         9 my @VALID_MAX_WINDOW_BITS = $self->VALID_MAX_WINDOW_BITS();
314              
315 3 50       7 if (defined $bits) {
316 3 50       4 return if grep { $_ eq $bits } @VALID_MAX_WINDOW_BITS;
  24         51  
317             }
318              
319 0         0 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       12 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         5 push @parts, $self->_INFLATE_MAX_WINDOW_BITS_PARAM() => $self->{'inflate_max_window_bits'};
333             }
334              
335 4 100       9 if ($self->{'deflate_no_context_takeover'}) {
336 1         3 push @parts, $self->_LOCAL_NO_CONTEXT_TAKEOVER_PARAM() => undef;
337             }
338 4 100       6 if ($self->{'inflate_no_context_takeover'}) {
339 3         7 push @parts, $self->_PEER_NO_CONTEXT_TAKEOVER_PARAM() => undef;
340             }
341              
342 4         13 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.