r1832 - trunk/varnish-tools/regress/lib/Varnish/Test

des at projects.linpro.no des at projects.linpro.no
Mon Aug 13 15:52:29 CEST 2007


Author: des
Date: 2007-08-13 15:52:29 +0200 (Mon, 13 Aug 2007)
New Revision: 1832

Modified:
   trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm
   trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm
Log:
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).


Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm	2007-08-10 14:05:32 UTC (rev 1831)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Case.pm	2007-08-13 13:52:29 UTC (rev 1832)
@@ -134,10 +134,12 @@
     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_timeout($$) {
     my ($self, $client) = @_;
 
-    $client->shutdown(2);
+    $client->shutdown();
     return $client;
 }
 
@@ -221,6 +223,13 @@
     $connection->send_response($response);
 }
 
+sub ev_server_timeout($$) {
+    my ($self, $srvconn) = @_;
+
+    $srvconn->shutdown();
+    return $srvconn;
+}
+
 #
 # Client utilities
 #
@@ -241,15 +250,21 @@
 	    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;
 }

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm	2007-08-10 14:05:32 UTC (rev 1831)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Client.pm	2007-08-13 13:52:29 UTC (rev 1832)
@@ -63,40 +63,51 @@
     $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 @@
 		# 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 @@
 	    # 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_timeout($$$) {
     my ($self, $mux, $fh) = @_;
 
+    $self->{'mux'}->set_timeout($fh, undef);
     $self->{'engine'}->ev_client_timeout($self);
 }
 

Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm	2007-08-10 14:05:32 UTC (rev 1831)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Server.pm	2007-08-13 13:52:29 UTC (rev 1832)
@@ -79,6 +79,12 @@
     $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 @@
     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 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 @@
 	    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_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) = @_;
 




More information about the varnish-commit mailing list