/t/32-pipelining.t

  1#!/usr/bin/perl
  2#
  3# For now we don't support pipelining, so these tests verify we handle it
  4# properly, notably not poisoning the backend by injecting two when we only
  5# know of one, and also dealing okay with POSTs with an extra \r\n, which
  6# happen in the real world, without disconnecting those users thinking
  7# they're bogus-pipeline-flooding us.
  8#
  9
 10use strict;
 11use Perlbal::Test;
 12use Perlbal::Test::WebServer;
 13use Perlbal::Test::WebClient;
 14
 15use Test::More tests => 12;
 16require HTTP::Request;
 17
 18my $port = new_port();
 19my $dir = tempdir();
 20
 21# setup a few web servers that we can work with
 22my $start_servers = 1; # web servers to start
 23my @web_ports = map { start_webserver() } 1..$start_servers;
 24@web_ports = grep { $_ > 0 } map { $_ += 0 } @web_ports;
 25ok(scalar(@web_ports) == $start_servers, 'web servers started');
 26
 27my $conf = qq{
 28CREATE POOL a
 29
 30CREATE SERVICE test
 31SET test.role = reverse_proxy
 32SET test.listen = 127.0.0.1:$port
 33SET test.persist_client = 1
 34SET test.persist_backend = 1
 35SET test.pool = a
 36SET test.connect_ahead = 0
 37ENABLE test
 38};
 39
 40my $http = "http://127.0.0.1:$port";
 41
 42my $msock = start_server($conf);
 43ok($msock, "manage sock");
 44add_all();
 45
 46my $sock;
 47my $get_sock = sub {
 48    return IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port")
 49        or die "Failed to connect to perlbal";
 50};
 51
 52$sock = $get_sock->();
 53print $sock "POST /sleep:0.2,status HTTP/1.0\r\nContent-Length: 10\r\n\r\nfoo=56789a";
 54like(scalar <$sock>, qr/200 OK/, "200 OK on post w/ correct len");
 55
 56$sock = $get_sock->();
 57print $sock "POST /sleep:0.2,status HTTP/1.0\r\nContent-Length: 10\r\n\r\nfoo=56789a\r\n";
 58like(scalar <$sock>, qr/200 OK/, "200 OK on post w/ extra rn not in length");
 59
 60# test that signal sending works
 61{
 62    my $gotsig = 0;
 63    local $SIG{USR1} = sub { $gotsig = 1; };
 64    $sock = $get_sock->();
 65    print $sock "GET /kill:$$:USR1,status HTTP/1.0\r\n\r\n";
 66    like(scalar <$sock>, qr/200 OK/, "single GET okay");
 67    ok($gotsig, "got signal");
 68}
 69
 70# check that somebody can't sneak extra request to backend w/ both \r\n and nothing in between requests
 71foreach my $sep ("\r\n", "") {
 72    diag("separator length " . length($sep));
 73    my $gotsig = 0;
 74    local $SIG{USR1} = sub { $gotsig = 1; };
 75    $sock = $get_sock->();
 76    print $sock "POST /sleep:0.5,status HTTP/1.0\r\nConnection: keep-alive\r\nContent-Length: 10\r\n\r\nfoo=569789a${sep}GET /kill:$$:USR1,status HTTP/1.0\r\n\r\n";
 77    like(scalar <$sock>, qr/200 OK/, "200 to POST w/ pipelined GET after");
 78    select undef, undef, undef, 0.25;
 79    ok(!$gotsig, "didn't get signal from GET after POST");
 80}
 81
 82$sock = $get_sock->();
 83print $sock "GET /status HTTP/1.0\r\n\r\n";
 84like(scalar <$sock>, qr/200 OK/, "single GET okay");
 85
 86$sock = $get_sock->();
 87print $sock "GET /status HTTP/1.0\r\n\r\nGET /status HTTP/1.0\r\n\r\n";
 88like(scalar <$sock>, qr/\b400\b/, "pipelined when not expecting it");
 89
 90
 91
 92
 93
 94sub add_all {
 95    foreach (@web_ports) {
 96        manage("POOL a ADD 127.0.0.1:$_") or die;
 97    }
 98}
 99
1001;