Improve timeout handling, and add a server timeout which starts running when

the server gets a partial response.  Similarly, on the client side, cancel
the timeout as soon as we get data, but restart it if we have to wait for
more.  Also stop logging the full content of requests and responses; it
clutters the output and can easily be obtained using varnishlog(1).

git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1832 d4fa192b-c00b-0410-8231-f00ffab90ce4

diff --git a/varnish-tools/regress/lib/Varnish/Test/Case.pm b/varnish-tools/regress/lib/Varnish/Test/Case.pm
index b7cee4da30c1b484a43fae235cd7a3a390f36e85..d7ac5feb3f4cd0cde37c41f0ea67675f547fa483 100644 (file)
--- a/varnish-tools/regress/lib/Varnish/Test/Case.pm
+++ b/varnish-tools/regress/lib/Varnish/Test/Case.pm
@@ -134,10 +134,12 @@ sub run($;@) {
     foreach my $method (@tests) {
        eval {
            $self->{'count'} += 1;
+           $self->log(sprintf("%d: TRY: %s",
+                              $self->{'count'}, $method));
            my $result = $self->$method(@args);
            $self->{'successful'} += 1;
            $self->log(sprintf("%d: PASS: %s: %s\n",
-                              $self->{'count'}, $method, $result || ''));
+                              $self->{'count'}, $method, $result || 'OK'));
        };
        if ($@) {
            $self->{'failed'} += 1;
@@ -189,7 +191,7 @@ sub ev_client_response($$$) {
 sub ev_client_timeout($$) {
     my ($self, $client) = @_;
 
-    $client->shutdown(2);
+    $client->shutdown();
     return $client;
 }
 
@@ -221,6 +223,13 @@ sub ev_server_request($$$$) {
     $connection->send_response($response);
 }
 
+sub ev_server_timeout($$) {
+    my ($self, $srvconn) = @_;
+
+    $srvconn->shutdown();
+    return $srvconn;
+}
+
 #
 # Client utilities
 #
@@ -241,15 +250,21 @@ sub request($$$$;$$) {
            unless ($req->header('Content-Length'));
        $req->content($content);
     }
-    $client->send_request($req, 2);
+    $client->send_request($req, 4);
     my ($ev, $resp) =
-       $self->run_loop('ev_client_response', 'ev_client_timeout');
-    die "Client time-out before receiving a (complete) response\n"
+       $self->run_loop('ev_server_timeout',
+                       'ev_client_timeout',
+                       'ev_client_response');
+    die "Server timed out before receiving a complete request\n"
+       if $ev eq 'ev_server_timeout';
+    die "Client timed out before receiving a complete response\n"
        if $ev eq 'ev_client_timeout';
     die "Internal error\n"
        unless $resp && ref($resp) && $resp->isa('HTTP::Response');
     die "No X-Varnish header\n"
-       unless $resp->header('X-Varnish');
+       unless (!$resp->header('X-Varnish'));
+    die "Invalid X-Varnish header\n"
+       unless ($resp->header('X-Varnish') =~ m/^\d+(?: \d+)?$/);
     $resp->request($req);
     return $self->{'cached_response'} = $resp;
 }

diff --git a/varnish-tools/regress/lib/Varnish/Test/Client.pm b/varnish-tools/regress/lib/Varnish/Test/Client.pm
index 8f025d998e9e61060ef6d3d41c48b3d66fe6ca6d..4c1e0fd11caa29704e9172946634e67b110aafb8 100644 (file)
--- a/varnish-tools/regress/lib/Varnish/Test/Client.pm
+++ b/varnish-tools/regress/lib/Varnish/Test/Client.pm
@@ -63,40 +63,51 @@ sub log($$;$) {
     $self->{'engine'}->log($self, 'CLI: ' . ($extra_prefix || ''), $str);
 }
 
+sub logf($$;@) {
+    my ($self, $fmt, @args) = @_;
+
+    $self->{'engine'}->log($self, 'CLI: ', sprintf($fmt, @args));
+}
+
 sub send_request($$;$) {
     my ($self, $request, $timeout) = @_;
 
-    my $fh = IO::Socket::INET->new('Proto'    => 'tcp',
-                                  'PeerAddr' => 'localhost',
-                                  'PeerPort' => '8080')
-      or die "socket(): $!\n";
-
-    $self->{'fh'} = $fh;
-    $self->{'mux'}->add($fh);
-    $self->{'mux'}->set_timeout($fh, $timeout) if defined($timeout);
-    $self->{'mux'}->set_callback_object($self, $fh);
-    $self->{'mux'}->write($fh, $request->as_string);
+    if (!defined($self->{'fh'})) {
+       my $fh = IO::Socket::INET->new('Proto'    => 'tcp',
+                                      'PeerAddr' => 'localhost',
+                                      'PeerPort' => '8080')
+           or die "socket(): $!\n";
+       $self->{'fh'} = $fh;
+       $self->{'mux'}->add($fh);
+       $self->{'mux'}->set_callback_object($self, $fh);
+    }
+    $self->{'timeout'} = $timeout;
+    $self->{'mux'}->set_timeout($fh, $timeout);
+    $self->{'mux'}->write($self->{'fh'}, $request->as_string);
     $self->{'requests'} += 1;
-    $self->log($request->as_string, 'Tx| ');
+    $self->logf("%s %s %s", $request->method(), $request->uri(), $request->protocol());
 }
 
 sub got_response($$) {
     my ($self, $response) = @_;
 
     $self->{'responses'} += 1;
-    $self->log($response->as_string, 'Rx| ');
+    $self->logf("%s %s", $response->code(), $response->message());
     $self->{'engine'}->ev_client_response($self, $response);
 }
 
 sub shutdown($) {
-    my ($self) = @_;
+    my ($self, $how) = @_;
 
-    $self->{'mux'}->shutdown($self->{'fh'}, 1);
+    $self->{'mux'}->close($self->{'fh'});
+    $self->{'fh'} = undef;
 }
 
 sub mux_input($$$$) {
     my ($self, $mux, $fh, $data) = @_;
 
+    $mux->set_timeout($fh, undef);
+
     # Iterate through the input buffer ($$data) and identify HTTP
     # messages, one per iteration. Break out of the loop when there
     # are no complete HTTP messages left in the buffer, and let
@@ -135,6 +146,7 @@ sub mux_input($$$$) {
                # so break out of loop and wait for more.
                $self->log("Partial body received" .
                           " ($data_length of $content_length bytes)");
+               $mux->set_timeout($fh, $self->{'timeout'});
                last;
            }
            else {
@@ -158,7 +170,9 @@ sub mux_input($$$$) {
            # out of loop and wait for EOF, in which case mux_eof will
            # reparse the input buffer as a HTTP message and send it
            # to event handling from there.
-           $self->log('Partial response. Content-Length unknown. Expecting CLOSE as end-of-response.');
+           $self->log("Partial response. Content-Length unknown." .
+                      " Expecting CLOSE as end-of-response.");
+           $mux->set_timeout($fh, $self->{'timeout'});
            last;
        }
     }
@@ -183,6 +197,7 @@ sub mux_eof($$$$) {
 sub mux_timeout($$$) {
     my ($self, $mux, $fh) = @_;
 
+    $self->{'mux'}->set_timeout($fh, undef);
     $self->{'engine'}->ev_client_timeout($self);
 }
 

diff --git a/varnish-tools/regress/lib/Varnish/Test/Server.pm b/varnish-tools/regress/lib/Varnish/Test/Server.pm
index 6da4b1135e6f8c4138575936a5b6cf8074464357..337041dbaad6e92ad7fc0310b5f704eb4cc1374c 100644 (file)
--- a/varnish-tools/regress/lib/Varnish/Test/Server.pm
+++ b/varnish-tools/regress/lib/Varnish/Test/Server.pm
@@ -79,6 +79,12 @@ sub log($$;$) {
     $self->{'engine'}->log($self, 'SRV: ' . ($extra_prefix || ''), $str);
 }
 
+sub logf($$;@) {
+    my ($self, $fmt, @args) = @_;
+
+    $self->{'engine'}->log($self, 'SRV: ', sprintf($fmt, @args));
+}
+
 sub shutdown($) {
     my ($self) = @_;
 
@@ -104,19 +110,21 @@ sub got_request($$) {
     my ($self, $connection, $request) = @_;
 
     $self->{'requests'} += 1;
-    $self->log($request->as_string, 'Rx| ');
+    $self->logf("%s %s %s", $request->method(), $request->uri(), $request->protocol());
     $self->{'engine'}->ev_server_request($self, $connection, $request);
 }
 
 package Varnish::Test::Server::Connection;
 
 use strict;
+use HTTP::Status;
 
 sub new($$) {
     my ($this, $server, $fh) = @_;
     my $class = ref($this) || $this;
 
     my $self = bless({ 'server' => $server,
+                      'engine' => $server->{'engine'},
                       'fh' => $fh,
                       'mux' => $server->{'mux'},
                       'data' => '' }, $class);
@@ -127,26 +135,29 @@ sub new($$) {
 sub send_response($$) {
     my ($self, $response) = @_;
 
+    $response->message(status_message($response->code()))
+       unless $response->message();
     $self->{'mux'}->write($self->{'fh'}, $response->as_string);
     $self->{'server'}->{'responses'} += 1;
-    $self->{'server'}->log($response->as_string, 'Tx| ');
+    $self->{'server'}->logf("%s %s", $response->code(), $response->message());
 }
 
 sub shutdown($) {
     my ($self) = @_;
 
-    $self->{'mux'}->shutdown($self->{'fh'}, 1);
+    $self->{'mux'}->close($self->{'fh'});
 }
 
 sub mux_input($$$$) {
     my ($self, $mux, $fh, $data) = @_;
 
+    $mux->set_timeout($fh, undef);
+
     # Iterate through the input buffer ($$data) and identify HTTP
     # messages, one per iteration. Break out of the loop when there
     # are no complete HTTP messages left in the buffer, and let
     # whatever data remains stay in the buffer, as we will get a new
     # chance to parse it next time we get more data ("mux_input").
-
     while ($$data =~ /\n\r?\n/) {
        # If we find a double (CR)LF in the input data, we have at
        # least a complete header section of a message, so look for
@@ -168,6 +179,7 @@ sub mux_input($$$$) {
            elsif ($data_length < $content_length) {
                # We only received the first part of an HTTP message,
                # so break out of loop and wait for more.
+               $mux->set_timeout($fh, 2);
                last;
            }
            else {
@@ -198,6 +210,13 @@ sub mux_input($$$$) {
     }
 }
 
+sub mux_timeout($$$) {
+    my ($self, $mux, $fh) = @_;
+
+    $self->{'mux'}->set_timeout($fh, undef);
+    $self->{'engine'}->ev_server_timeout($self);
+}
+
 sub mux_eof($$$$) {
     my ($self, $mux, $fh, $data) = @_;