comparison h2.t @ 694:3eba6e1b8313

Tests: finished HPACK coding in HTTP/2 tests.
author Sergey Kandaurov <pluknet@nginx.com>
date Mon, 14 Sep 2015 18:30:03 +0300
parents a16d4a768197
children beab9da9b731
comparison
equal deleted inserted replaced
693:875900f02f15 694:3eba6e1b8313
1776 hpack($ctx, $_->{name}, $_->{value}, 1776 hpack($ctx, $_->{name}, $_->{value},
1777 mode => $_->{mode}, huff => $_->{huff}) 1777 mode => $_->{mode}, huff => $_->{huff})
1778 } @$headers if $headers; 1778 } @$headers if $headers;
1779 } 1779 }
1780 1780
1781 # 5.1. Integer Representation 1781 $input = pack("B*", '001' . ipack(5, $uri->{table_size})) . $input
1782
1783 sub intpack {
1784 my $d = shift;
1785 return pack('B8', '001' . sprintf("%5b", $d)) if $d < 31;
1786
1787 my $o = '00111111';
1788 $d -= 31;
1789 while ($d >= 128) {
1790 $o .= sprintf("%8b", $d % 128 + 128);
1791 $d /= 128;
1792 }
1793 $o .= sprintf("%08b", $d);
1794 return pack('B*', $o);
1795 }
1796
1797 $input = intpack($uri->{table_size}) . $input
1798 if defined $uri->{table_size}; 1782 if defined $uri->{table_size};
1799 1783
1800 # set length, attach headers, padding, priority 1784 # set length, attach headers, padding, priority
1801 1785
1802 my $hlen = length($input) + $pad + $padlen; 1786 my $hlen = length($input) + $pad + $padlen;
2099 [ 'vary', '' ], 2083 [ 'vary', '' ],
2100 [ 'via', '' ], 2084 [ 'via', '' ],
2101 [ 'www-authenticate', '' ], 2085 [ 'www-authenticate', '' ],
2102 } 2086 }
2103 2087
2088 # RFC 7541, 5.1. Integer Representation
2089
2090 sub ipack {
2091 my ($base, $d) = @_;
2092 return sprintf("%.*b", $base, $d) if $d < 2**$base - 1;
2093
2094 my $o = sprintf("%${base}b", 2**$base - 1);
2095 $d -= 2**$base - 1;
2096 while ($d >= 128) {
2097 $o .= sprintf("%8b", $d % 128 + 128);
2098 $d /= 128;
2099 }
2100 $o .= sprintf("%08b", $d);
2101 return $o;
2102 }
2103
2104 sub iunpack {
2105 my ($base, $b, $s) = @_;
2106
2107 my $len = unpack("\@$s B8", $b); $s++;
2108 my $prefix = substr($len, 0, 8 - $base);
2109 $len = '0' x (8 - $base) . substr($len, 8 - $base);
2110 $len = unpack("C", pack("B8", $len));
2111
2112 return ($len, $s, $prefix) if $len < 2**$base - 1;
2113
2114 my $m = 0;
2115 my $d;
2116
2117 do {
2118 $d = unpack("\@$s C", $b); $s++;
2119 $len += ($d & 127) * 2**$m;
2120 $m += $base;
2121 } while (($d & 128) == 128);
2122
2123 return ($len, $s, $prefix);
2124 }
2125
2104 sub hpack { 2126 sub hpack {
2105 my ($ctx, $name, $value, %extra) = @_; 2127 my ($ctx, $name, $value, %extra) = @_;
2106 my $table = $ctx->{dynamic_encode}; 2128 my $table = $ctx->{dynamic_encode};
2107 my $mode = defined $extra{mode} ? $extra{mode} : 1; 2129 my $mode = defined $extra{mode} ? $extra{mode} : 1;
2108 my $huff = $extra{huff}; 2130 my $huff = $extra{huff};
2113 2135
2114 if ($mode == 0) { 2136 if ($mode == 0) {
2115 ++$index until $index > $#$table 2137 ++$index until $index > $#$table
2116 or $table->[$index][0] eq $name 2138 or $table->[$index][0] eq $name
2117 and $table->[$index][1] eq $value; 2139 and $table->[$index][1] eq $value;
2118 $buf = pack('B*', '1' . sprintf("%7b", $index)); 2140 $buf = pack('B*', '1' . ipack(7, $index));
2119 } 2141 }
2120 2142
2121 # 6.2.1. Literal Header Field with Incremental Indexing 2143 # 6.2.1. Literal Header Field with Incremental Indexing
2122 2144
2123 if ($mode == 1) { 2145 if ($mode == 1) {
2125 2147
2126 ++$index until $index > $#$table 2148 ++$index until $index > $#$table
2127 or $table->[$index][0] eq $name; 2149 or $table->[$index][0] eq $name;
2128 my $value = $huff ? huff($value) : $value; 2150 my $value = $huff ? huff($value) : $value;
2129 2151
2130 $buf = pack('B*', '01' . sprintf("%6b", $index) 2152 $buf = pack('B*', '01' . ipack(6, $index)
2131 . ($huff ? '1' : '0') . sprintf("%7b", length($value))); 2153 . ($huff ? '1' : '0') . ipack(7, length($value)));
2132 $buf .= $value; 2154 $buf .= $value;
2133 } 2155 }
2134 2156
2135 # 6.2.1. Literal Header Field with Incremental Indexing -- New Name 2157 # 6.2.1. Literal Header Field with Incremental Indexing -- New Name
2136 2158
2140 my $name = $huff ? huff($name) : $name; 2162 my $name = $huff ? huff($name) : $name;
2141 my $value = $huff ? huff($value) : $value; 2163 my $value = $huff ? huff($value) : $value;
2142 my $hbit = ($huff ? '1' : '0'); 2164 my $hbit = ($huff ? '1' : '0');
2143 2165
2144 $buf = pack('B*', '01000000'); 2166 $buf = pack('B*', '01000000');
2145 $buf .= pack('B*', $hbit . sprintf("%7b", length($name))); 2167 $buf .= pack('B*', $hbit . ipack(7, length($name)));
2146 $buf .= $name; 2168 $buf .= $name;
2147 $buf .= pack('B*', $hbit . sprintf("%7b", length($value))); 2169 $buf .= pack('B*', $hbit . ipack(7, length($value)));
2148 $buf .= $value; 2170 $buf .= $value;
2149 } 2171 }
2150 2172
2151 # 6.2.2. Literal Header Field without Indexing 2173 # 6.2.2. Literal Header Field without Indexing
2152 2174
2153 if ($mode == 3) { 2175 if ($mode == 3) {
2154 ++$index until $index > $#$table 2176 ++$index until $index > $#$table
2155 or $table->[$index][0] eq $name; 2177 or $table->[$index][0] eq $name;
2156 my $value = $huff ? huff($value) : $value; 2178 my $value = $huff ? huff($value) : $value;
2157 2179
2158 $buf = pack('B*', '0000' . sprintf("%4b", $index) 2180 $buf = pack('B*', '0000' . ipack(4, $index)
2159 . ($huff ? '1' : '0') . sprintf("%7b", length($value))); 2181 . ($huff ? '1' : '0') . ipack(7, length($value)));
2160 $buf .= $value; 2182 $buf .= $value;
2161 } 2183 }
2162 2184
2163 # 6.2.2. Literal Header Field without Indexing -- New Name 2185 # 6.2.2. Literal Header Field without Indexing -- New Name
2164 2186
2166 my $name = $huff ? huff($name) : $name; 2188 my $name = $huff ? huff($name) : $name;
2167 my $value = $huff ? huff($value) : $value; 2189 my $value = $huff ? huff($value) : $value;
2168 my $hbit = ($huff ? '1' : '0'); 2190 my $hbit = ($huff ? '1' : '0');
2169 2191
2170 $buf = pack('B*', '00000000'); 2192 $buf = pack('B*', '00000000');
2171 $buf .= pack('B*', $hbit . sprintf("%7b", length($name))); 2193 $buf .= pack('B*', $hbit . ipack(7, length($name)));
2172 $buf .= $name; 2194 $buf .= $name;
2173 $buf .= pack('B*', $hbit . sprintf("%7b", length($value))); 2195 $buf .= pack('B*', $hbit . ipack(7, length($value)));
2174 $buf .= $value; 2196 $buf .= $value;
2175 } 2197 }
2176 2198
2177 # 6.2.3. Literal Header Field Never Indexed 2199 # 6.2.3. Literal Header Field Never Indexed
2178 2200
2179 if ($mode == 5) { 2201 if ($mode == 5) {
2180 ++$index until $index > $#$table 2202 ++$index until $index > $#$table
2181 or $table->[$index][0] eq $name; 2203 or $table->[$index][0] eq $name;
2182 my $value = $huff ? huff($value) : $value; 2204 my $value = $huff ? huff($value) : $value;
2183 2205
2184 $buf = pack('B*', '0001' . sprintf("%4b", $index) 2206 $buf = pack('B*', '0001' . ipack(4, $index)
2185 . ($huff ? '1' : '0') . sprintf("%7b", length($value))); 2207 . ($huff ? '1' : '0') . ipack(7, length($value)));
2186 $buf .= $value; 2208 $buf .= $value;
2187 } 2209 }
2188 2210
2189 # 6.2.3. Literal Header Field Never Indexed -- New Name 2211 # 6.2.3. Literal Header Field Never Indexed -- New Name
2190 2212
2192 my $name = $huff ? huff($name) : $name; 2214 my $name = $huff ? huff($name) : $name;
2193 my $value = $huff ? huff($value) : $value; 2215 my $value = $huff ? huff($value) : $value;
2194 my $hbit = ($huff ? '1' : '0'); 2216 my $hbit = ($huff ? '1' : '0');
2195 2217
2196 $buf = pack('B*', '00010000'); 2218 $buf = pack('B*', '00010000');
2197 $buf .= pack('B*', $hbit . sprintf("%7b", length($name))); 2219 $buf .= pack('B*', $hbit . ipack(7, length($name)));
2198 $buf .= $name; 2220 $buf .= $name;
2199 $buf .= pack('B*', $hbit . sprintf("%7b", length($value))); 2221 $buf .= pack('B*', $hbit . ipack(7, length($value)));
2200 $buf .= $value; 2222 $buf .= $value;
2201 } 2223 }
2202 2224
2203 return $buf; 2225 return $buf;
2204 } 2226 }
2206 sub hunpack { 2228 sub hunpack {
2207 my ($ctx, $data, $length) = @_; 2229 my ($ctx, $data, $length) = @_;
2208 my $table = $ctx->{dynamic_decode}; 2230 my $table = $ctx->{dynamic_decode};
2209 my %headers; 2231 my %headers;
2210 my $skip = 0; 2232 my $skip = 0;
2211 my ($name, $value); 2233 my ($index, $name, $value);
2212
2213 sub index {
2214 my ($b, $i) = @_;
2215 unpack("C", pack("B8", '0' x $i . substr($b, $i, 8 - $i)));
2216 }
2217 2234
2218 sub field { 2235 sub field {
2219 my ($b, $s) = @_; 2236 my ($b) = @_;
2220 my $len = unpack("\@$s B8", $b); 2237 my ($len, $s, $huff) = iunpack(7, @_);
2221 my $huff = substr($len, 0, 1) ? 1 : 0;
2222 $len = unpack("C", pack("B8", '0' . substr($len, 1, 8)));
2223 $s++;
2224 2238
2225 my $field = substr($b, $s, $len); 2239 my $field = substr($b, $s, $len);
2226 $field = $huff ? dehuff($field) : $field; 2240 $field = $huff ? dehuff($field) : $field;
2227 $s += $len; 2241 $s += $len;
2228 return ($field, $s); 2242 return ($field, $s);
2237 2251
2238 while ($skip < $length) { 2252 while ($skip < $length) {
2239 my $ib = unpack("\@$skip B8", $data); 2253 my $ib = unpack("\@$skip B8", $data);
2240 2254
2241 if (substr($ib, 0, 1) eq '1') { 2255 if (substr($ib, 0, 1) eq '1') {
2242 my $index = &index($ib, 1); 2256 ($index, $skip) = iunpack(7, $data, $skip);
2243 add(\%headers, 2257 add(\%headers,
2244 $table->[$index][0], $table->[$index][1]); 2258 $table->[$index][0], $table->[$index][1]);
2245 $skip += 1;
2246 next; 2259 next;
2247 } 2260 }
2248 2261
2249 if (substr($ib, 0, 2) eq '01') { 2262 if (substr($ib, 0, 2) eq '01') {
2250 $name = $table->[&index($ib, 2)][0]; 2263 ($index, $skip) = iunpack(6, $data, $skip);
2251 $skip++; 2264 $name = $table->[$index][0];
2252 2265
2253 ($name, $skip) = field($data, $skip) unless $name; 2266 ($name, $skip) = field($data, $skip) unless $name;
2254 ($value, $skip) = field($data, $skip); 2267 ($value, $skip) = field($data, $skip);
2255 2268
2256 splice @$table, 2269 splice @$table,
2258 add(\%headers, $name, $value); 2271 add(\%headers, $name, $value);
2259 next; 2272 next;
2260 } 2273 }
2261 2274
2262 if (substr($ib, 0, 4) eq '0000') { 2275 if (substr($ib, 0, 4) eq '0000') {
2263 $name = $table->[&index($ib, 4)][0]; 2276 ($index, $skip) = iunpack(4, $data, $skip);
2264 $skip++; 2277 $name = $table->[$index][0];
2265 2278
2266 ($name, $skip) = field($data, $skip) unless $name; 2279 ($name, $skip) = field($data, $skip) unless $name;
2267 ($value, $skip) = field($data, $skip); 2280 ($value, $skip) = field($data, $skip);
2268 2281
2269 add(\%headers, $name, $value); 2282 add(\%headers, $name, $value);