Mercurial > hg > nginx-tests

new file mode 100644
--- /dev/null
+++ b/spdy.t
@@ -0,0 +1,978 @@
+#!/usr/bin/perl
+
+# (C) Sergey Kandaurov
+# (C) Nginx, Inc.
+
+# Tests for SPDY protocol version 3.1.
+
+###############################################################################
+
+use warnings;
+use strict;
+
+use Test::More;
+
+use IO::Select;
+
+BEGIN { use FindBin; chdir($FindBin::Bin); }
+
+use lib 'lib';
+use Test::Nginx;
+
+###############################################################################
+
+select STDERR; $| = 1;
+select STDOUT; $| = 1;
+
+eval {
+	require Compress::Raw::Zlib;
+	Compress::Raw::Zlib->Z_OK;
+	Compress::Raw::Zlib->Z_SYNC_FLUSH;
+	Compress::Raw::Zlib->Z_NO_COMPRESSION;
+	Compress::Raw::Zlib->WANT_GZIP_OR_ZLIB;
+};
+plan(skip_all => 'Compress::Raw::Zlib not installed') if $@;
+plan(skip_all => 'win32') if $^O eq 'MSWin32';
+
+my $t = Test::Nginx->new()->has(qw/http proxy cache limit_conn rewrite spdy/);
+
+plan(skip_all => 'no SPDY/3.1') unless $t->has_version('1.5.10');
+
+$t->plan(72)->write_file_expand('nginx.conf', <<'EOF');
+
+%%TEST_GLOBALS%%
+
+daemon off;
+
+events {
+}
+
+http {
+    %%TEST_GLOBALS_HTTP%%
+
+    proxy_cache_path %%TESTDIR%%/cache    keys_zone=NAME:10m;
+    limit_conn_zone  $binary_remote_addr  zone=conn:1m;
+
+    server {
+        listen       127.0.0.1:8080 spdy;
+        listen       127.0.0.1:8081;
+        server_name  localhost;
+
+        location /s {
+            add_header X-Header X-Foo;
+            return 200 'body';
+        }
+        location /spdy {
+            return 200 $spdy;
+        }
+        location /prio {
+            return 200 $spdy_request_priority;
+        }
+        location /chunk_size {
+            spdy_chunk_size 1;
+            return 200 'body';
+        }
+        location /redirect {
+            error_page 405 /s;
+            return 405;
+        }
+        location /proxy {
+            add_header X-Body "$request_body";
+            proxy_pass http://127.0.0.1:8081/;
+            proxy_cache NAME;
+            proxy_cache_valid 1m;
+        }
+        location /t3.html {
+            limit_conn conn 1;
+        }
+    }
+}
+
+EOF
+
+$t->run();
+
+# file size is slightly beyond initial window size: 2**16 + 80 bytes
+
+$t->write_file('t1.html',
+	join('', map { sprintf "X%04dXXX", $_ } (1 .. 8202)));
+
+$t->write_file('t2.html', 'SEE-THIS');
+$t->write_file('t3.html', 'SEE-THIS');
+
+my %cframe = (
+	2 => \&syn_reply,
+	3 => \&rst_stream,
+	4 => \&settings,
+	6 => \&ping,
+	7 => \&goaway,
+	9 => \&window_update
+);
+
+###############################################################################
+
+# PING
+
+my $sess = new_session();
+spdy_ping($sess, 0x12345678);
+my $frames = spdy_read($sess);
+
+my ($frame) = grep { $_->{type} eq "PING" } @$frames;
+ok($frame, 'PING frame');
+is($frame->{value}, 0x12345678, 'PING payload');
+
+# GET
+
+$sess = new_session();
+my $sid1 = spdy_stream($sess, { path => '/s' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+ok($frame, 'SYN_REPLAY frame');
+is($frame->{sid}, $sid1, 'SYN_REPLAY stream');
+is($frame->{headers}->{':status'}, 200, 'SYN_REPLAY status');
+is($frame->{headers}->{'x-header'}, 'X-Foo', 'SYN_REPLAY header');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+ok($frame, 'DATA frame');
+is($frame->{length}, length 'body', 'DATA length');
+is($frame->{data}, 'body', 'DATA payload');
+
+# GET in new SPDY stream in same session
+
+my $sid2 = spdy_stream($sess, { path => '/s' });
+$frames = spdy_read($sess, all => [{ sid => $sid2, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{sid}, $sid2, 'SYN_REPLAY stream 2');
+is($frame->{headers}->{':status'}, 200, 'SYN_REPLAY status 2');
+is($frame->{headers}->{'x-header'}, 'X-Foo', 'SYN_REPLAY header 2');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+ok($frame, 'DATA frame 2');
+is($frame->{sid}, $sid2, 'SYN_REPLAY stream 2');
+is($frame->{length}, length 'body', 'DATA length 2');
+is($frame->{data}, 'body', 'DATA payload 2');
+
+# HEAD
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/s', method => 'HEAD' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{sid}, $sid1, 'SYN_REPLAY stream HEAD');
+is($frame->{headers}->{':status'}, 200, 'SYN_REPLAY status HEAD');
+is($frame->{headers}->{'x-header'}, 'X-Foo', 'SYN_REPLAY header HEAD');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame, undef, 'HEAD no body');
+
+# request header
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html',
+	headers => { "range" =>  "bytes=10-19" }
+});
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, 206, 'SYN_REPLAY status range');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{length}, 10, 'DATA length range');
+is($frame->{data}, '002XXXX000', 'DATA payload range');
+
+# $spdy
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/spdy' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{data}, '3.1', 'spdy variable');
+
+# spdy_chunk_size=1
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/chunk_size' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+my @data = grep { $_->{type} eq "DATA" } @$frames;
+is(@data, 4, 'chunk_size body chunks');
+is($data[0]->{data}, 'b', 'chunk_size body 1');
+is($data[1]->{data}, 'o', 'chunk_size body 2');
+is($data[2]->{data}, 'd', 'chunk_size body 3');
+is($data[3]->{data}, 'y', 'chunk_size body 4');
+
+# redirect
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/redirect' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, 405, 'SYN_REPLAY status with redirect');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+ok($frame, 'DATA frame with redirect');
+is($frame->{data}, 'body', 'DATA payload with redirect');
+
+# ensure that HEAD-like requests, i.e., without response body, do not lead to
+# client connection close due to cache filling up with upstream response body
+
+TODO: {
+local $TODO = 'premature client connection close';
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/proxy/t2.html', method => 'HEAD' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+$sid2 = spdy_stream($sess, { path => '/' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+ok(grep ({ $_->{type} eq "SYN_REPLY" } @$frames), 'proxy cache headers only');
+
+}
+
+# simple proxy cache test
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/proxy/t2.html' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, '200 OK', 'proxy cache unconditional');
+
+my $ims = $frame->{headers}->{'etag'};
+
+$sid2 = spdy_stream($sess, { path => '/proxy/t2.html',
+	headers => { "if-none-match" =>  $ims }
+});
+$frames = spdy_read($sess, all => [{ sid => $sid2, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, 304, 'proxy cache conditional');
+
+# request body (uses proxied response)
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/proxy/t2.html', body => 'TEST' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{'x-body'}, 'TEST', 'request body');
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{length}, length 'SEE-THIS', 'proxied response length');
+is($frame->{data}, 'SEE-THIS', 'proxied response');
+
+# WINDOW_UPDATE (client side)
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 0 }]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+my $sum = eval join '+', map { $_->{length} } @data;
+is($sum, 2**16, 'iws - stream blocked on initial window size');
+
+spdy_ping($sess, 0xf00ff00f);
+$frames = spdy_read($sess);
+
+($frame) = grep { $_->{type} eq "PING" } @$frames;
+ok($frame, 'iws - PING not blocked');
+
+spdy_window($sess, 2**16, $sid1);
+$frames = spdy_read($sess);
+is(@$frames, 0, 'iws - updated stream window');
+
+spdy_window($sess, 2**16);
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+$sum = eval join '+', map { $_->{length} } @data;
+is($sum, 80, 'iws - updated connection window');
+
+# SETTINGS (initial window size, client side)
+
+$sess = new_session();
+spdy_settings($sess, 7 => 2**17);
+spdy_window($sess, 2**17);
+
+$sid1 = spdy_stream($sess, { path => '/t1.html' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+$sum = eval join '+', map { $_->{length} } @data;
+is($sum, 2**16 + 80, 'increased initial window size');
+
+# probe for negative available space in a flow control window
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html' });
+spdy_read($sess, all => [{ sid => $sid1, fin => 0 }]);
+
+spdy_window($sess, 1);
+spdy_settings($sess, 7 => 42);
+spdy_window($sess, 1024, $sid1);
+
+$frames = spdy_read($sess);
+is(@$frames, 0, 'negative window - no data');
+
+spdy_window($sess, 2**16 - 42 - 1024, $sid1);
+$frames = spdy_read($sess);
+is(@$frames, 0, 'zero window - no data');
+
+spdy_window($sess, 1, $sid1);
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 0 }]);
+is(@$frames, 1, 'positive window - data');
+is(@$frames[0]->{length}, 1, 'positive window - data length');
+
+# stream multiplexing
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 0 }]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+$sum = eval join '+', map { $_->{length} } @data;
+is($sum, 2**16, 'multiple - stream1 data');
+
+$sid2 = spdy_stream($sess, { path => '/t1.html' });
+$frames = spdy_read($sess, all => [{ sid => $sid2, fin => 0 }]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+is(@data, 0, 'multiple - stream2 no data');
+
+spdy_window($sess, 2**17, $sid1);
+spdy_window($sess, 2**17, $sid2);
+spdy_window($sess, 2**17);
+
+$frames = spdy_read($sess, all => [
+	{ sid => $sid1, fin => 1 },
+	{ sid => $sid2, fin => 1 }
+]);
+
+@data = grep { $_->{type} eq "DATA" && $_->{sid} == $sid1 } @$frames;
+$sum = eval join '+', map { $_->{length} } @data;
+is($sum, 80, 'multiple - stream1 remain data');
+
+@data = grep { $_->{type} eq "DATA" && $_->{sid} == $sid2 } @$frames;
+$sum = eval join '+', map { $_->{length} } @data;
+is($sum, 2**16 + 80, 'multiple - stream2 full data');
+
+# request priority parsing in $spdy_request_priority
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/prio', prio => 0 });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{data}, 0, 'priority 0');
+
+$sid1 = spdy_stream($sess, { path => '/prio', prio => 1 });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{data}, 1, 'priority 1');
+
+$sid1 = spdy_stream($sess, { path => '/prio', prio => 7 });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "DATA" } @$frames;
+is($frame->{data}, 7, 'priority 7');
+
+# stream muliplexing + priority
+
+TODO: {
+local $TODO = 'reversed priority' unless $t->has_version('1.5.11');
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html', prio => 7 });
+$sid2 = spdy_stream($sess, { path => '/t2.html', prio => 0 });
+spdy_read($sess);
+
+spdy_window($sess, 2**17, $sid1);
+spdy_window($sess, 2**17, $sid2);
+spdy_window($sess, 2**17);
+
+$frames = spdy_read($sess, all => [
+	{ sid => $sid1, fin => 1 },
+	{ sid => $sid2, fin => 1 }
+]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+is(join (' ', map { $_->{sid} } @data), "$sid2 $sid1", 'multiple priority 1');
+
+# and vice versa
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/t1.html', prio => 0 });
+$sid2 = spdy_stream($sess, { path => '/t2.html', prio => 7 });
+spdy_read($sess);
+
+spdy_window($sess, 2**17, $sid1);
+spdy_window($sess, 2**17, $sid2);
+spdy_window($sess, 2**17);
+
+$frames = spdy_read($sess, all => [
+	{ sid => $sid1, fin => 1 },
+	{ sid => $sid2, fin => 1 }
+]);
+
+@data = grep { $_->{type} eq "DATA" } @$frames;
+is(join (' ', map { $_->{sid} } @data), "$sid1 $sid2", 'multiple priority 2');
+
+}
+
+# limit_conn
+
+$sess = new_session();
+spdy_settings($sess, 7 => 1);
+$sid1 = spdy_stream($sess, { path => '/t3.html' });
+$sid2 = spdy_stream($sess, { path => '/t3.html' });
+$frames = spdy_read($sess, all => [
+	{ sid => $sid1, fin => 0 },
+	{ sid => $sid2, fin => 0 }
+]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" && $_->{sid} == $sid1 } @$frames;
+is($frame->{headers}->{':status'}, 200, 'conn_limit 1');
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" && $_->{sid} == $sid2 } @$frames;
+is($frame->{headers}->{':status'}, 503, 'conn_limit 2');
+
+# limit_conn + client's RST_STREAM
+
+$sess = new_session();
+spdy_settings($sess, 7 => 1);
+$sid1 = spdy_stream($sess, { path => '/t3.html' });
+spdy_rst($sess, $sid1, 5);
+$sid2 = spdy_stream($sess, { path => '/t3.html' });
+$frames = spdy_read($sess, all => [
+	{ sid => $sid1, fin => 0 },
+	{ sid => $sid2, fin => 0 }
+]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" && $_->{sid} == $sid1 } @$frames;
+is($frame->{headers}->{':status'}, 200, 'RST_STREAM 1');
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" && $_->{sid} == $sid2 } @$frames;
+is($frame->{headers}->{':status'}, 200, 'RST_STREAM 2');
+
+# GOAWAY on SYN_STREAM with even StreamID
+
+TODO: {
+local $TODO = 'not yet';
+
+$sess = new_session();
+spdy_stream($sess, { path => '/s' }, 2);
+$frames = spdy_read($sess);
+
+($frame) = grep { $_->{type} eq "GOAWAY" } @$frames;
+ok($frame, 'even stream - GOAWAY frame');
+is($frame->{code}, 1, 'even stream - error code');
+is($frame->{sid}, 0, 'even stream - last used stream');
+
+}
+
+# GOAWAY on SYN_STREAM with backward StreamID
+
+TODO: {
+local $TODO = 'not yet';
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/s' }, 3);
+spdy_read($sess);
+
+$sid2 = spdy_stream($sess, { path => '/s' }, 1);
+$frames = spdy_read($sess);
+
+($frame) = grep { $_->{type} eq "GOAWAY" } @$frames;
+ok($frame, 'backward stream - GOAWAY frame');
+is($frame->{code}, 1, 'backward stream - error code');
+is($frame->{sid}, $sid1, 'backward stream - last used stream');
+
+}
+
+# RST_STREAM on the second SYN_STREAM with same StreamID
+
+TODO: {
+local $TODO = 'not yet';
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/s' }, 3);
+spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+$sid2 = spdy_stream($sess, { path => '/s' }, 3);
+$frames = spdy_read($sess);
+
+($frame) = grep { $_->{type} eq "RST_STREAM" } @$frames;
+ok($frame, 'dup stream - RST_STREAM frame');
+is($frame->{code}, 1, 'dup stream - error code');
+is($frame->{sid}, $sid1, 'dup stream - stream');
+
+}
+
+# awkward protocol version
+
+TODO: {
+local $TODO = 'not yet' unless $t->has_version('1.5.11');
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/s', version => 'HTTP/1.10' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, 200, 'awkward version');
+
+}
+
+# missing mandatory request header
+
+$sess = new_session();
+$sid1 = spdy_stream($sess, { path => '/s', version => '' });
+$frames = spdy_read($sess, all => [{ sid => $sid1, fin => 1 }]);
+
+($frame) = grep { $_->{type} eq "SYN_REPLY" } @$frames;
+is($frame->{headers}->{':status'}, 400, 'incomplete headers');
+
+# GOAWAY before closing a connection by server
+
+$t->stop();
+
+TODO: {
+local $TODO = 'not yet';
+
+$frames = spdy_read($sess);
+
+($frame) = grep { $_->{type} eq "GOAWAY" } @$frames;
+ok($frame, 'GOAWAY on connection close');
+
+}
+
+###############################################################################
+
+sub spdy_ping {
+	my ($sess, $payload) = @_;
+
+	raw_write($sess->{socket}, pack("N3", 0x80030006, 0x4, $payload));
+}
+
+sub spdy_rst {
+	my ($sess, $sid, $error) = @_;
+
+	raw_write($sess->{socket}, pack("N4", 0x80030003, 0x8, $sid, $error));
+}
+
+sub spdy_window {
+	my ($sess, $win, $stream) = @_;
+
+	$stream = 0 unless defined $stream;
+	raw_write($sess->{socket}, pack("N4", 0x80030009, 8, $stream, $win));
+}
+
+sub spdy_settings {
+	my ($sess, %extra) = @_;
+
+	my $cnt = keys %extra;
+	my $len = 4 + 8 * $cnt;
+
+	my $buf = pack "N3", 0x80030004, $len, $cnt;
+	$buf .= join '', map { pack "N2", $_, $extra{$_} } keys %extra;
+	raw_write($sess->{socket}, $buf);
+}
+
+sub spdy_read {
+	my ($sess, %extra) = @_;
+	my ($skip, $length, @got);
+
+again:
+	my $buf = raw_read($sess->{socket}) or return undef;
+
+	for ($skip = 0; $skip < length $buf; $skip += $length + 8) {
+		my $type = unpack("\@$skip B", $buf);
+		$length = hex unpack("\@$skip x5 H6", $buf);
+		if ($type == 0) {
+			push @got, dframe($skip, $buf);
+			test_fin($got[-1], $extra{all});
+			next;
+		}
+
+		my $ctype = unpack("\@$skip x2 n", $buf);
+		push @got, $cframe{$ctype}($sess, $skip, $buf);
+		test_fin($got[-1], $extra{all});
+	}
+	goto again if %extra && @{$extra{all}};
+	return \@got;
+}
+
+sub test_fin {
+	my ($frame, $all) = @_;
+
+	@{$all} = grep {
+		!($_->{sid} == $frame->{sid} && $_->{fin} == $frame->{fin})
+	} @{$all} if defined $frame->{fin};
+}
+
+sub dframe {
+	my ($skip, $buf) = @_;
+	my %frame;
+
+	my $stream = unpack "\@$skip B32", $buf; $skip += 4;
+	substr($stream, 0, 1) = 0;
+	$stream = unpack("N", pack("B32", $stream));
+	$frame{sid} = $stream;
+
+	my $flags = unpack "\@$skip B8", $buf; $skip += 1;
+	$frame{fin} = substr($flags, 7, 1);
+
+	my $length = hex (unpack "\@$skip H6", $buf); $skip += 3;
+	$frame{length} = $length;
+
+	$frame{data} = substr($buf, $skip, $length);
+	$frame{type} = "DATA";
+	return \%frame;
+}
+
+sub spdy_stream {
+	my ($ctx, $uri, $stream) = @_;
+	my ($input, $output, $buf);
+	my ($d, $status);
+
+	my $host = $uri->{host} || '127.0.0.1:8080';
+	my $method = $uri->{method} || 'GET';
+	my $headers = $uri->{headers} || {};
+	my $body = $uri->{body};
+	my $prio = defined $uri->{prio} ? $uri->{prio} : 4;
+	my $version = defined $uri->{version} ? $uri->{version} : "HTTP/1.1";
+
+	if ($stream) {
+		$ctx->{last_stream} = $stream;
+	} else {
+		$ctx->{last_stream} += 2;
+	}
+
+	$buf = pack("NC", 0x80030001, not $body);
+	$buf .= pack("xxx");			# Length stub
+	$buf .= pack("N", $ctx->{last_stream});	# Stream-ID
+	$buf .= pack("N", 0);			# Assoc. Stream-ID
+	$buf .= pack("n", $prio << 13);
+
+	my $ent = 4 + keys %{$headers};
+	$ent++ if $body;
+	$ent++ if $version;
+
+	$input = pack("N", $ent);
+	$input .= hpack(":host", $host);
+	$input .= hpack(":method", $method);
+	$input .= hpack(":path", $uri->{path});
+	$input .= hpack(":scheme", "http");
+	if ($version) {
+		$input .= hpack(":version", $version);
+	}
+	if ($body) {
+		$input .= hpack("content-length", length $body);
+	}
+	$input .= join '', map { hpack($_, $headers->{$_}) } keys %{$headers};
+
+	$d = $ctx->{zlib}->{d};
+	$status = $d->deflate($input => \my $start);
+	$status == Compress::Raw::Zlib->Z_OK or fail "deflate failed";
+	$status = $d->flush(\my $tail => Compress::Raw::Zlib->Z_SYNC_FLUSH);
+	$status == Compress::Raw::Zlib->Z_OK or fail "flush failed";
+	$output = $start . $tail;
+
+	my $len = '';
+	vec($len, 7, 8) = (length $output) + 10;
+	$buf |= $len;
+	$buf .= $output;
+
+	if (defined $body) {
+		$buf .= pack "NCxn", $ctx->{last_stream}, 0x01, length $body;
+		$buf .= $body;
+	}
+
+	raw_write($ctx->{socket}, $buf);
+	return $ctx->{last_stream};
+}
+
+sub syn_reply {
+	my ($ctx, $skip, $buf) = @_;
+	my ($i, $status);
+	my %payload;
+
+	$skip += 4;
+	my $flags = unpack "\@$skip B8", $buf; $skip += 1;
+	$payload{fin} = substr($flags, 7, 1);
+
+	my $length = hex unpack "\@$skip H6", $buf; $skip += 3;
+	$payload{length} = $length;
+	$payload{type} = 'SYN_REPLY';
+
+	my $stream = unpack "\@$skip B32", $buf; $skip += 4;
+	substr($stream, 0, 1) = 0;
+	$stream = unpack("N", pack("B32", $stream));
+	$payload{sid} = $stream;
+
+	my $input = substr($buf, $skip, $length - 4);
+	$i = $ctx->{zlib}->{i};
+
+	$status = $i->inflate($input => \my $out);
+	fail "Failed: $status" unless $status == Compress::Raw::Zlib->Z_OK;
+	$payload{headers} = hunpack($out);
+	return \%payload;
+}
+
+sub rst_stream {
+	my ($ctx, $skip, $buf) = @_;
+	my %payload;
+
+	$skip += 5;
+	$payload{length} = hex(unpack "\@$skip H6", $buf); $skip += 3;
+	$payload{type} = 'RST_STREAM';
+	$payload{sid} = unpack "\@$skip N", $buf; $skip += 4;
+	$payload{code} = unpack "\@$skip N", $buf;
+	return \%payload;
+}
+
+sub settings {
+	my ($ctx, $skip, $buf) = @_;
+	my %payload;
+
+	$skip += 4;
+	$payload{flags} = unpack "\@$skip H", $buf; $skip += 1;
+	$payload{length} = hex(unpack "\@$skip H6", $buf); $skip += 3;
+	$payload{type} = 'SETTINGS';
+
+	my $nent = unpack "\@$skip N", $buf; $skip += 4;
+	for (1 .. $nent) {
+		my $flags = hex unpack "\@$skip H2", $buf; $skip += 1;
+		my $id = hex unpack "\@$skip H6", $buf; $skip += 3;
+		$payload{$id}{flags} = $flags;
+		$payload{$id}{value} = unpack "\@$skip N", $buf; $skip += 4;
+	}
+	return \%payload;
+}
+
+sub ping {
+	my ($ctx, $skip, $buf) = @_;
+	my %payload;
+
+	$skip += 5;
+	$payload{length} = hex(unpack "\@$skip H6", $buf); $skip += 3;
+	$payload{type} = 'PING';
+	$payload{value} = unpack "\@$skip N", $buf;
+	return \%payload;
+}
+
+sub goaway {
+	my ($ctx, $skip, $buf) = @_;
+	my %payload;
+
+	$skip += 5;
+	$payload{length} = hex unpack "\@$skip H6", $buf; $skip += 3;
+	$payload{type} = 'GOAWAY';
+	$payload{sid} = unpack "\@$skip N", $buf; $skip += 4;
+	$payload{code} = unpack "\@$skip N", $buf;
+	return \%payload;
+}
+
+sub window_update {
+	my ($ctx, $skip, $buf) = @_;
+	my %payload;
+
+	$skip += 5;
+
+	$payload{length} = hex(unpack "\@$skip H6", $buf); $skip += 3;
+	$payload{type} = 'WINDOW_UPDATE';
+
+	my $stream = unpack "\@$skip B32", $buf; $skip += 4;
+	substr($stream, 0, 1) = 0;
+	$stream = unpack("N", pack("B32", $stream));
+	$payload{sid} = $stream;
+
+	my $value = unpack "\@$skip B32", $buf;
+	substr($value, 0, 1) = 0;
+	$payload{wdelta} = unpack("N", pack("B32", $value));
+	return \%payload;
+}
+
+sub hpack {
+	my ($name, $value) = @_;
+
+	pack("N", length($name)) . $name . pack("N", length($value)) . $value;
+}
+
+sub hunpack {
+	my ($data) = @_;
+	my %headers;
+	my $skip = 0;
+
+	my $nent = unpack "\@$skip N", $data; $skip += 4;
+	for (1 .. $nent) {
+		my $len = unpack("\@$skip N", $data); $skip += 4;
+		my $name = unpack("\@$skip A$len", $data); $skip += $len;
+
+		$len = unpack("\@$skip N", $data); $skip += 4;
+		my $value = unpack("\@$skip A$len", $data); $skip += $len;
+
+		$headers{$name} = $value;
+	}
+	return \%headers;
+}
+
+sub raw_read {
+	my ($s) = @_;
+	my ($got, $buf);
+
+	$s->blocking(0);
+	while (IO::Select->new($s)->can_read(0.4)) {
+		my $n = $s->sysread($buf, 1024);
+		last unless $n;
+		$got .= $buf;
+	};
+	log_in($got);
+	return $got;
+}
+
+sub raw_write {
+	my ($s, $message) = @_;
+
+	local $SIG{PIPE} = 'IGNORE';
+
+	$s->blocking(0);
+	while (IO::Select->new($s)->can_write(0.4)) {
+		log_out($message);
+		my $n = $s->syswrite($message);
+		last unless $n;
+		$message = substr($message, $n);
+		last unless length $message;
+	}
+}
+
+sub new_session {
+	my ($d, $i, $status);
+
+	($d, $status) = Compress::Raw::Zlib::Deflate->new(
+		-WindowBits => 12,
+		-Dictionary => dictionary(),
+		-Level => Compress::Raw::Zlib->Z_NO_COMPRESSION
+	);
+	fail "Zlib failure: $status" unless $d;
+
+	($i, $status) = Compress::Raw::Zlib::Inflate->new(
+		-WindowBits => Compress::Raw::Zlib->WANT_GZIP_OR_ZLIB,
+		-Dictionary => dictionary()
+	);
+	fail "Zlib failure: $status" unless $i;
+
+	return { zlib => { i => $i, d => $d },
+		socket => new_socket(), last_stream => -1 };
+}
+
+sub new_socket {
+	my $s;
+
+	eval {
+		local $SIG{ALRM} = sub { die "timeout\n" };
+		local $SIG{PIPE} = sub { die "sigpipe\n" };
+		alarm(2);
+		$s = IO::Socket::INET->new(
+			Proto => 'tcp',
+			PeerAddr => '127.0.0.1:8080',
+		);
+		alarm(0);
+	};
+	alarm(0);
+
+	if ($@) {
+		log_in("died: $@");
+		return undef;
+	}
+
+	return $s;
+}
+
+sub dictionary {
+	join('', (map pack('N/a*', $_), qw(
+		options
+		head
+		post
+		put
+		delete
+		trace
+		accept
+		accept-charset
+		accept-encoding
+		accept-language
+		accept-ranges
+		age
+		allow
+		authorization
+		cache-control
+		connection
+		content-base
+		content-encoding
+		content-language
+		content-length
+		content-location
+		content-md5
+		content-range
+		content-type
+		date
+		etag
+		expect
+		expires
+		from
+		host
+		if-match
+		if-modified-since
+		if-none-match
+		if-range
+		if-unmodified-since
+		last-modified
+		location
+		max-forwards
+		pragma
+		proxy-authenticate
+		proxy-authorization
+		range
+		referer
+		retry-after
+		server
+		te
+		trailer
+		transfer-encoding
+		upgrade
+		user-agent
+		vary
+		via
+		warning
+		www-authenticate
+		method
+		get
+		status), "200 OK",
+		qw(version HTTP/1.1 url public set-cookie keep-alive origin)),
+		"100101201202205206300302303304305306307402405406407408409410",
+		"411412413414415416417502504505",
+		"203 Non-Authoritative Information",
+		"204 No Content",
+		"301 Moved Permanently",
+		"400 Bad Request",
+		"401 Unauthorized",
+		"403 Forbidden",
+		"404 Not Found",
+		"500 Internal Server Error",
+		"501 Not Implemented",
+		"503 Service Unavailable",
+		"Jan Feb Mar Apr May Jun Jul Aug Sept Oct Nov Dec",
+		" 00:00:00",
+		" Mon, Tue, Wed, Thu, Fri, Sat, Sun, GMT",
+		"chunked,text/html,image/png,image/jpg,image/gif,",
+		"application/xml,application/xhtml+xml,text/plain,",
+		"text/javascript,public", "privatemax-age=gzip,deflate,",
+		"sdchcharset=utf-8charset=iso-8859-1,utf-,*,enq=0."
+	);
+}
+
+###############################################################################