File Coverage

blib/lib/Net/WebSocket/PMCE/deflate/Data.pm
Criterion Covered Total %
statement 74 82 90.2
branch 10 18 55.5
condition 8 18 44.4
subroutine 17 19 89.4
pod 4 4 100.0
total 113 141 80.1


line stmt bran cond sub pod time code
1             package Net::WebSocket::PMCE::deflate::Data;
2              
3 3     3   1379 use strict;
  3         8  
  3         85  
4 3     3   16 use warnings;
  3         5  
  3         82  
5              
6 3     3   14 use parent qw( Net::WebSocket::PMCE::Data );
  3         6  
  3         35  
7              
8 3     3   1316 use Net::WebSocket::FrameTypeName ();
  3         8  
  3         59  
9 3     3   389 use Net::WebSocket::Message ();
  3         7  
  3         49  
10 3     3   855 use Net::WebSocket::PMCE::deflate::Constants ();
  3         27  
  3         104  
11              
12             use constant {
13 3         3715 _ZLIB_SYNC_TAIL => "\0\0\xff\xff",
14             _DEBUG => 0,
15 3     3   16 };
  3         7  
16              
17             =encoding utf-8
18              
19             =head2 I->new( %OPTS )
20              
21             %OPTS is:
22              
23             =over
24              
25             =item C - optional; the number of window bits to use
26             for compressing messages. This should correspond with the local endpoint’s
27             behavior; i.e., for a server, this should match the C
28             extension parameter in the WebSocket handshake.
29              
30             =item C - optional; the number of window bits to use
31             for decompressing messages. This should correspond with the remote peer’s
32             behavior; i.e., for a server, this should match the C
33             extension parameter in the WebSocket handshake.
34              
35             =item C - corresponds to either the
36             C or C parameter,
37             to match the local endpoint’s role. When this flag is set, the object
38             will do a full flush at the end of each C call.
39              
40             =back
41              
42             =cut
43              
44             sub new {
45 3     3 1 2650 my ($class, %opts) = @_;
46              
47             #Validate deflate_max_window_bits/inflate_max_window_bits?
48              
49 3         10 my $compress_func = '_compress_';
50 3 100       18 $compress_func .= $opts{'deflate_no_context_takeover'} ? 'full' : 'sync';
51 3         8 $compress_func .= '_flush_chomp';
52              
53 3         8 $opts{'final_frame_compress_func'} = $compress_func;
54              
55 3         13 return bless \%opts, $class;
56             }
57              
58             #----------------------------------------------------------------------
59              
60             =head2 $msg = I->create_message( FRAME_TYPE, PAYLOAD )
61              
62             Creates an unfragmented, compressed message. The message will be an
63             instance of L.
64              
65             FRAME_TYPE can be either C or C (for Net::WebSocket’s
66             default frame classes) or full package names (e.g., to use a custom
67             frame class).
68              
69             This method cannot be called while a streamer object has yet to create its
70             final frame.
71              
72             B This function alters PAYLOAD.
73              
74             =cut
75              
76             sub create_message {
77 0     0 1 0 my ($self, $frame_type) = @_; #$_[2] = payload
78              
79 0 0       0 die "A streamer is active!" if $self->{'_streamer_mode'};
80              
81 0         0 my $compress_func = $self->{'final_frame_compress_func'};
82              
83 0         0 my $payload_sr = \($self->$compress_func( $_[2] ));
84              
85 0         0 my $frame_class = Net::WebSocket::FrameTypeName::get_module($frame_type);
86              
87 0         0 return Net::WebSocket::Message->new(
88             $frame_class->new(
89             payload => $payload_sr,
90             rsv => $self->INITIAL_FRAME_RSV(),
91             $self->FRAME_MASK_ARGS(),
92             ),
93             );
94             }
95              
96             #----------------------------------------------------------------------
97              
98             =head2 $msg = I->create_streamer( FRAME_TYPE )
99              
100             FRAME_TYPE can be either C or C (for Net::WebSocket’s
101             default frame classes) or full package names (e.g., to use a custom
102             frame class).
103              
104             Returns an instance of L based
105             on this object.
106              
107             =cut
108              
109             sub create_streamer {
110 5     5 1 1413 my ($self, $frame_type) = @_;
111              
112 5         29 $self->{'_streamer_mode'} = 1;
113              
114 5         1611 require Net::WebSocket::PMCE::deflate::Data::Streamer;
115              
116 5         24 my $frame_class = Net::WebSocket::FrameTypeName::get_module($frame_type);
117              
118 5         41 return Net::WebSocket::PMCE::deflate::Data::Streamer->new($self, $frame_class);
119             }
120              
121             #----------------------------------------------------------------------
122              
123             =head2 $decompressed = I->decompress( COMPRESSED_PAYLOAD )
124              
125             Decompresses the given string and returns the result.
126              
127             B This function alters COMPRESSED_PAYLOAD, such that
128             it’s probably not useful afterward.
129              
130             =cut
131              
132             #cf. RFC 7692, 7.2.2
133             sub decompress {
134 5     5 1 16 my ($self) = @_; #$_[1] = payload
135              
136 5   66     37 $self->{'i'} ||= $self->_create_inflate_obj();
137              
138 5         9 _DEBUG && _debug(sprintf "inflating: %v.02x\n", $_[1]);
139              
140 5         15 $_[1] .= _ZLIB_SYNC_TAIL;
141              
142 5         6388 my $status = $self->{'i'}->inflate($_[1], my $v);
143 5 50       27 die $status if $status != Compress::Raw::Zlib::Z_OK();
144              
145 5         26 _DEBUG && _debug(sprintf "inflate output: [%v.02x]\n", $v);
146              
147 5         10109 return $v;
148             }
149              
150             #----------------------------------------------------------------------
151              
152             my $_payload_sr;
153              
154             #cf. RFC 7692, 7.2.1
155             #Use for non-final fragments.
156             sub _compress_non_final_fragment {
157 41   66 41   148 $_[0]->{'d'} ||= $_[0]->_create_deflate_obj();
158              
159 41         127 return $_[0]->_compress( $_[1] );
160             }
161              
162             #Preserves sliding window to the next message.
163             #Use for final fragments when deflate_no_context_takeover is OFF
164             sub _compress_sync_flush_chomp {
165 2   33 2   7 $_[0]->{'d'} ||= $_[0]->_create_deflate_obj();
166              
167 2         7 return _chomp_0000ffff_or_die( $_[0]->_compress( $_[1], Compress::Raw::Zlib::Z_SYNC_FLUSH() ) );
168             }
169              
170             #Flushes the sliding window.
171             #Use for final fragments when deflate_no_context_takeover is ON
172             sub _compress_full_flush_chomp {
173 3   33 3   12 $_[0]->{'d'} ||= $_[0]->_create_deflate_obj();
174              
175 3         18 return _chomp_0000ffff_or_die( $_[0]->_compress( $_[1], Compress::Raw::Zlib::Z_FULL_FLUSH() ) );
176             }
177              
178             sub _chomp_0000ffff_or_die {
179 5 50   5   25 if ( rindex( $_[0], _ZLIB_SYNC_TAIL ) == length($_[0]) - 4 ) {
180 5         14 substr($_[0], -4) = q<>;
181             }
182             else {
183 0         0 die sprintf('deflate/flush didn’t end with expected SYNC tail (00.00.ff.ff): %v.02x', $_[0]);
184             }
185              
186 5         17 return $_[0];
187             }
188              
189             sub _compress {
190 46     46   181 my ($self) = @_; # $_[1] = payload; $_[2] = flush method
191              
192 46         82 $_payload_sr = \$_[1];
193              
194 46         71 _DEBUG && _debug(sprintf "to deflate: [%v.02x]", $$_payload_sr);
195              
196 46         60 my $out;
197              
198 46         53045 my $dstatus = $self->{'d'}->deflate( $$_payload_sr, $out );
199 46 50       214 die "deflate: $dstatus" if $dstatus != Compress::Raw::Zlib::Z_OK();
200              
201 46         219 _DEBUG && _debug(sprintf "post-deflate output: [%v.02x]", $out);
202              
203 46 100       120 if ($_[2]) {
204 5         474 $dstatus = $self->{'d'}->flush($out, $_[2]);
205 5 50       24 die "deflate flush: $dstatus" if $dstatus != Compress::Raw::Zlib::Z_OK();
206              
207 5         29 undef $self->{'_streamer_mode'};
208              
209 5         7 _DEBUG && _debug(sprintf "post-flush output: [%v.02x]", $out);
210             }
211              
212             #NB: The RFC directs at this point that:
213             #
214             #If the resulting data does not end with an empty DEFLATE block
215             #with no compression (the "BTYPE" bits are set to 00), append an
216             #empty DEFLATE block with no compression to the tail end.
217             #
218             #… but I don’t know the protocol well enough to detect that??
219             #
220             #NB:
221             #> perl -MCompress::Raw::Zlib -e' my $deflate = Compress::Raw::Zlib::Deflate->new( -WindowBits => -8, -AppendOutput => 1, -Level => Compress::Raw::Zlib::Z_NO_COMPRESSION ); $deflate->deflate( "", my $out ); $deflate->flush( $out, Compress::Raw::Zlib::Z_SYNC_FLUSH()); print $out' | xxd
222             #00000000: 0000 00ff ff .....
223              
224             # if ( $_[2] == Compress::Raw::Zlib::Z_FULL_FLUSH() ) {
225             # if ( substr($out, -4) eq _ZLIB_SYNC_TAIL ) {
226             # substr($out, -4) = q<>;
227             # }
228             # else {
229             # die sprintf('deflate/flush didn’t end with expected SYNC tail (00.00.ff.ff): %v.02x', $out);
230             # }
231             # }
232              
233 46         224 return $out;
234             }
235              
236             #----------------------------------------------------------------------
237              
238             sub _create_inflate_obj {
239 3     3   11 my ($self) = @_;
240              
241 3   33     36 my $window_bits = $self->{'inflate_max_window_bits'} || ( Net::WebSocket::PMCE::deflate::Constants::VALID_MAX_WINDOW_BITS() )[-1];
242              
243 3         28 require Compress::Raw::Zlib;
244              
245 3         34 my ($inflate, $istatus) = Compress::Raw::Zlib::Inflate->new(
246             -WindowBits => -$window_bits,
247             -AppendOutput => 1,
248             );
249 3 50       1448 die "Inflate: $istatus" if $istatus != Compress::Raw::Zlib::Z_OK();
250              
251 3         45 return $inflate;
252             }
253              
254             sub _create_deflate_obj {
255 3     3   12 my ($self) = @_;
256              
257 3   33     25 my $window_bits = $self->{'deflate_max_window_bits'} || ( Net::WebSocket::PMCE::deflate::Constants::VALID_MAX_WINDOW_BITS() )[-1];
258              
259 3         2081 require Compress::Raw::Zlib;
260              
261 3         15960 my ($deflate, $dstatus) = Compress::Raw::Zlib::Deflate->new(
262             -WindowBits => -$window_bits,
263             -AppendOutput => 1,
264             );
265 3 50       2169 die "Deflate: $dstatus" if $dstatus != Compress::Raw::Zlib::Z_OK();
266              
267 3         103 return $deflate;
268             }
269              
270             sub _debug {
271 0     0     print STDERR "$_[0]$/";
272             }
273              
274             1;