File Coverage

blib/lib/Protocol/HTTP2/HeaderCompression.pm
Criterion Covered Total %
statement 158 199 79.4
branch 42 72 58.3
condition 13 25 52.0
subroutine 15 15 100.0
pod 0 8 0.0
total 228 319 71.4


line stmt bran cond sub pod time code
1             package Protocol::HTTP2::HeaderCompression;
2 12     12   42 use strict;
  12         10  
  12         330  
3 12     12   35 use warnings;
  12         15  
  12         1676  
4 12     12   4842 use Protocol::HTTP2::Huffman;
  12         18  
  12         501  
5 12     12   3844 use Protocol::HTTP2::StaticTable;
  12         16  
  12         924  
6 12     12   49 use Protocol::HTTP2::Constants qw(:errors :settings :limits);
  12         13  
  12         2289  
7 12     12   49 use Protocol::HTTP2::Trace qw(tracer bin2hex);
  12         14  
  12         461  
8 12     12   44 use Exporter qw(import);
  12         14  
  12         17998  
9             our @EXPORT_OK = qw(int_encode int_decode str_encode str_decode headers_decode
10             headers_encode);
11              
12             sub int_encode {
13 344     344 0 24007 my ( $int, $N ) = @_;
14 344   50     22401 $N ||= 7;
15 344         22369 my $ff = ( 1 << $N ) - 1;
16              
17 344 100       22485 if ( $int < $ff ) {
18 341         45088 return pack 'C', $int;
19             }
20              
21 3         8 my $res = pack 'C', $ff;
22 3         3 $int -= $ff;
23              
24 3         8 while ( $int >= 0x80 ) {
25 1         3 $res .= pack( 'C', ( $int & 0x7f ) | 0x80 );
26 1         2 $int >>= 7;
27             }
28              
29 3         11 return $res . pack( 'C', $int );
30             }
31              
32             # int_decode()
33             #
34             # arguments:
35             # buf_ref - ref to buffer with encoded data
36             # buf_offset - offset in buffer
37             # int_ref - ref to scalar where result will be stored
38             # N - bits in first byte
39             #
40             # returns: count of readed bytes of encoded integer
41             # or undef on error (malformed data)
42              
43             sub int_decode {
44 322     322 0 23545 my ( $buf_ref, $buf_offset, $int_ref, $N ) = @_;
45 322 50       22937 return undef if length($$buf_ref) - $buf_offset <= 0;
46 322   50     22582 $N ||= 7;
47 322         22649 my $ff = ( 1 << $N ) - 1;
48              
49 322         22423 $$int_ref = $ff & vec( $$buf_ref, $buf_offset, 8 );
50 322 100       45370 return 1 if $$int_ref < $ff;
51              
52 1         2 my $l = length($$buf_ref) - $buf_offset - 1;
53              
54 1         3 for my $i ( 1 .. $l ) {
55 2 50       5 return undef if $i > MAX_INT_SIZE;
56 2         3 my $s = vec( $$buf_ref, $i + $buf_offset, 8 );
57 2         3 $$int_ref += ( $s & 0x7f ) << ( $i - 1 ) * 7;
58 2 100       8 return $i + 1 if $s < 0x80;
59             }
60              
61 0         0 return undef;
62             }
63              
64             sub str_encode {
65 79     79 0 9085 my $str = shift;
66 79         8036 my $huff_str = huffman_encode($str);
67 79         7920 my $pack;
68 79 100       8125 if ( length($huff_str) < length($str) ) {
69 69         7217 $pack = int_encode( length($huff_str), 7 );
70 69         7499 vec( $pack, 7, 1 ) = 1;
71 69         14294 $pack .= $huff_str;
72             }
73             else {
74 10         793 $pack = int_encode( length($str), 7 );
75 10         1564 $pack .= $str;
76             }
77 79         15813 return $pack;
78             }
79              
80             # str_decode()
81             # arguments:
82             # buf_ref - ref to buffer with encoded data
83             # buf_offset - offset in buffer
84             # str_ref - ref to scalar where result will be stored
85             # returns: count of readed bytes of encoded data
86              
87             sub str_decode {
88 75     75 0 9167 my ( $buf_ref, $buf_offset, $str_ref ) = @_;
89 75         8008 my $offset = int_decode( $buf_ref, $buf_offset, \my $l, 7 );
90             return undef
91 75 50 33     8213 unless defined $offset
92             && length($$buf_ref) - $buf_offset - $offset >= $l;
93              
94 75         8034 $$str_ref = substr $$buf_ref, $offset + $buf_offset, $l;
95 75 100       8202 $$str_ref = huffman_decode($$str_ref)
96             if vec( $$buf_ref, $buf_offset * 8 + 7, 1 ) == 1;
97 75         15955 return $offset + $l;
98             }
99              
100             sub evict_ht {
101 150     150 0 15907 my ( $context, $size ) = @_;
102 150         15908 my @evicted;
103              
104 150         15934 my $ht = $context->{header_table};
105              
106 150         15980 while ( $context->{ht_size} + $size > $context->{max_ht_size} ) {
107 5         2 my $n = $#$ht;
108 5         5 my $kv_ref = pop @$ht;
109             $context->{ht_size} -=
110 5         7 32 + length( $kv_ref->[0] ) + length( $kv_ref->[1] );
111 5         7 tracer->debug( sprintf "Evicted header [%i] %s = %s\n",
112             $n + 1, @$kv_ref );
113 5         14 push @evicted, [ $n, @$kv_ref ];
114             }
115 150         31985 return @evicted;
116             }
117              
118             sub add_to_ht {
119 150     150 0 16057 my ( $context, $key, $value ) = @_;
120 150         16000 my $size = length($key) + length($value) + 32;
121 150 50       16085 return () if $size > $context->{max_ht_size};
122              
123 150         16021 my @evicted = evict_ht( $context, $size );
124              
125 150         15966 my $ht = $context->{header_table};
126 150         16009 my $kv_ref = [ $key, $value ];
127              
128 150         15963 unshift @$ht, $kv_ref;
129 150         15868 $context->{ht_size} += $size;
130 150         39639 return @evicted;
131             }
132              
133             sub headers_decode {
134 75     75 0 3358 my ( $con, $buf_ref, $buf_offset, $length, $stream_id ) = @_;
135              
136 75         3344 my $context = $con->decode_context;
137              
138 75         3224 my $ht = $context->{header_table};
139 75         3240 my $eh = $context->{emitted_headers};
140              
141 75         3247 my $offset = 0;
142              
143 75         3299 while ( $offset < $length ) {
144              
145 247         14798 my $f = vec( $$buf_ref, $buf_offset + $offset, 8 );
146 247         14700 tracer->debug( sprintf "\toffset: %d, byte: %02x\n", $offset, $f );
147              
148             # Indexed Header
149 247 100 66     15077 if ( $f & 0x80 ) {
    100 66        
    50 33        
    0 33        
150 174         6583 my $size =
151             int_decode( $buf_ref, $buf_offset + $offset, \my $index, 7 );
152 174 50       6604 last unless $size;
153              
154             # DECODING ERROR
155 174 50       6583 if ( $index == 0 ) {
156 0         0 tracer->error("Indexed header with zero index\n");
157 0         0 $con->error(COMPRESSION_ERROR);
158 0         0 return undef;
159             }
160              
161 174         6601 tracer->debug("\tINDEXED($index) HEADER\t");
162              
163             # Static table or Header Table entry
164 174 100       6632 if ( $index <= @stable ) {
    50          
165 148         6370 my ( $key, $value ) = @{ $stable[ $index - 1 ] };
  148         12903  
166 148         6590 push @$eh, $key, $value;
167 148         6561 tracer->debug("$key = $value\n");
168             }
169             elsif ( $index > @stable + @$ht ) {
170 0         0 tracer->error(
171             "Indexed header with index out of header table: "
172             . $index
173             . "\n" );
174 0         0 $con->error(COMPRESSION_ERROR);
175 0         0 return undef;
176             }
177             else {
178 26         32 my $kv_ref = $ht->[ $index - @stable - 1 ];
179              
180 26         39 push @$eh, @$kv_ref;
181 26         36 tracer->debug("$kv_ref->[0] = $kv_ref->[1]\n");
182             }
183              
184 174         12932 $offset += $size;
185             }
186              
187             # Literal Header Field - New Name
188             elsif ( $f == 0x40 || $f == 0x00 || $f == 0x10 ) {
189 1         3 my $key_size =
190             str_decode( $buf_ref, $buf_offset + $offset + 1, \my $key );
191 1 50       3 last unless $key_size;
192              
193 1 50       5 if ( $key_size == 1 ) {
194 0         0 tracer->error("Empty literal header name");
195 0         0 $con->error(COMPRESSION_ERROR);
196 0         0 return undef;
197             }
198              
199 1 50 33     5 if ( $key =~ /[^a-z0-9\!\#\$\%\&\'\*\+\-\^\_\`]/ && $key !~ /^\:/ )
200             {
201 0         0 tracer->warning("Illegal characters in header name");
202 0         0 $con->stream_error( $stream_id, PROTOCOL_ERROR );
203 0         0 return undef;
204             }
205              
206 1         3 my $value_size =
207             str_decode( $buf_ref, $buf_offset + $offset + 1 + $key_size,
208             \my $value );
209 1 50       3 last unless $value_size;
210              
211             # Emitting header
212 1         2 push @$eh, $key, $value;
213              
214             # Add to index
215 1 50       3 if ( $f == 0x40 ) {
216 1         3 add_to_ht( $context, $key, $value );
217             }
218 1         2 tracer->debug( sprintf "\tLITERAL(new) HEADER\t%s: %s\n",
219             $key, substr( $value, 0, 30 ) );
220              
221 1         3 $offset += 1 + $key_size + $value_size;
222             }
223              
224             # Literal Header Field - Indexed Name
225             elsif (( $f & 0xC0 ) == 0x40
226             || ( $f & 0xF0 ) == 0x00
227             || ( $f & 0xF0 ) == 0x10 )
228             {
229 72 50       8161 my $size = int_decode( $buf_ref, $buf_offset + $offset,
230             \my $index, ( $f & 0xC0 ) == 0x40 ? 6 : 4 );
231 72 50       8083 last unless $size;
232              
233 72         8006 my $value_size =
234             str_decode( $buf_ref, $buf_offset + $offset + $size, \my $value );
235 72 50       7990 last unless $value_size;
236              
237 72         7945 my $key;
238              
239 72 50       8037 if ( $index <= @stable ) {
    0          
240 72         15988 $key = $stable[ $index - 1 ]->[0];
241             }
242             elsif ( $index > @stable + @$ht ) {
243 0         0 tracer->error(
244             "Literal header with index out of header table: "
245             . $index
246             . "\n" );
247 0         0 $con->error(COMPRESSION_ERROR);
248 0         0 return undef;
249             }
250             else {
251 0         0 $key = $ht->[ $index - @stable - 1 ]->[0];
252             }
253              
254             # Emitting header
255 72         8009 push @$eh, $key, $value;
256              
257             # Add to index
258 72 50       8031 if ( ( $f & 0xC0 ) == 0x40 ) {
259 72         8014 add_to_ht( $context, $key, $value );
260             }
261 72         8015 tracer->debug("\tLITERAL($index) HEADER\t$key: $value\n");
262              
263 72         19099 $offset += $size + $value_size;
264             }
265              
266             # Encoding Context Update - Maximum Header Table Size change
267             elsif ( ( $f & 0xE0 ) == 0x20 ) {
268 0         0 my $size =
269             int_decode( $buf_ref, $buf_offset + $offset, \my $ht_size, 5 );
270 0 0       0 last unless $size;
271              
272             # It's not possible to increase size of HEADER_TABLE
273 0 0       0 if (
274             $ht_size > $context->{settings}->{&SETTINGS_HEADER_TABLE_SIZE} )
275             {
276             tracer->error( "Peer attempt to increase "
277             . "maximum header table size higher than current size: "
278             . "$ht_size > "
279 0         0 . $context->{settings}->{&SETTINGS_HEADER_TABLE_SIZE} );
280 0         0 $con->error(COMPRESSION_ERROR);
281 0         0 return undef;
282             }
283 0 0       0 if (@$eh) {
284 0         0 tracer->error(
285             "Attempt to change header table size after headers");
286 0         0 $con->error(COMPRESSION_ERROR);
287 0         0 return undef;
288             }
289             tracer->debug( "Update header table size from "
290 0         0 . $context->{max_ht_size} . " to "
291             . $ht_size );
292 0         0 $context->{max_ht_size} = $ht_size;
293 0         0 evict_ht( $context, 0 );
294 0         0 $offset += $size;
295             }
296              
297             # Encoding Error
298             else {
299 0         0 tracer->error( sprintf( "Unknown header type: %08b", $f ) );
300 0         0 $con->error(COMPRESSION_ERROR);
301 0         0 return undef;
302             }
303             }
304              
305 75 50       3317 if ( $offset != $length ) {
306 0         0 tracer->error(
307             "Headers decoding stopped at offset $offset of $length\n");
308 0         0 $con->error(COMPRESSION_ERROR);
309 0         0 return undef;
310             }
311              
312 75         6479 return $offset;
313             }
314              
315             sub headers_encode {
316 78     78 0 5030 my ( $context, $headers ) = @_;
317 78         3252 my $res = '';
318 78         3230 my $ht = $context->{header_table};
319 78         3300 my $sht = $context->{settings}->{&SETTINGS_HEADER_TABLE_SIZE};
320              
321             # Encode dynamic table size update
322 78 50       3260 if ( $context->{max_ht_size} != $sht ) {
323 0         0 $res .= int_encode( $sht, 5 );
324 0         0 vec( $res, 3, 2 ) = 0;
325 0         0 vec( $res, 5, 1 ) = 1;
326 0         0 $context->{max_ht_size} = $sht;
327             }
328              
329             HLOOP:
330 78         3375 for my $n ( 0 .. $#$headers / 2 ) {
331 261         14558 my $header = lc( $headers->[ 2 * $n ] );
332 261         14415 my $value = $headers->[ 2 * $n + 1 ];
333 261         14225 my $hdr;
334              
335 261         14573 tracer->debug("Encoding header: $header = $value\n");
336              
337 261         14575 for my $i ( 0 .. $#$ht ) {
338             next
339 262 100 100     25729 unless $ht->[$i]->[0] eq $header
340             && $ht->[$i]->[1] eq $value;
341 31         59 $hdr = int_encode( $i + @stable + 1, 7 );
342 31         61 vec( $hdr, 7, 1 ) = 1;
343 31         34 $res .= $hdr;
344 31         59 tracer->debug(
345             "\talready in header table, index " . ( $i + 1 ) . "\n" );
346 31         56 next HLOOP;
347             }
348              
349             # 7.1 Indexed header field representation
350 230 100       14729 if ( exists $rstable{ $header . ' ' . $value } ) {
    100          
351 153         6593 $hdr = int_encode( $rstable{ $header . ' ' . $value }, 7 );
352 153         6495 vec( $hdr, 7, 1 ) = 1;
353             tracer->debug( "\tIndexed header "
354 153         6567 . $rstable{ $header . ' ' . $value }
355             . " from table\n" );
356             }
357              
358             # 7.2.1 Literal Header Field with Incremental Indexing
359             # (Indexed Name)
360             elsif ( exists $rstable{ $header . ' ' } ) {
361 76         8024 $hdr = int_encode( $rstable{ $header . ' ' }, 6 );
362 76         8030 vec( $hdr, 3, 2 ) = 1;
363 76         7987 $hdr .= str_encode($value);
364 76         8003 add_to_ht( $context, $header, $value );
365             tracer->debug( "\tLiteral header "
366 76         8056 . $rstable{ $header . ' ' }
367             . " indexed name\n" );
368             }
369              
370             # 7.2.1 Literal Header Field with Incremental Indexing
371             # (New Name)
372             else {
373 1         1 $hdr = pack( 'C', 0x40 );
374 1         2 $hdr .= str_encode($header) . str_encode($value);
375 1         2 add_to_ht( $context, $header, $value );
376 1         2 tracer->debug("\tLiteral header new name\n");
377             }
378              
379 230         17638 $res .= $hdr;
380             }
381              
382 78         6501 return $res;
383             }
384              
385             1;