From 14982490073f968c77bc19994b8bb7913dae53a0 Mon Sep 17 00:00:00 2001 From: des Date: Sat, 28 Jul 2007 15:29:31 +0000 Subject: [PATCH] Add a slew of utilities to simplify the writing of test cases. Rewrite the existing test cases to take advantage of these utilities. git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1782 d4fa192b-c00b-0410-8231-f00ffab90ce4 --- .../regress/lib/Varnish/Test/Case.pm | 158 ++++++++++++++++++ .../regress/lib/Varnish/Test/Case/LRU.pm | 31 +--- .../regress/lib/Varnish/Test/Case/RePurge.pm | 69 +++----- .../lib/Varnish/Test/Case/Ticket056.pm | 16 +- .../lib/Varnish/Test/Case/Ticket102.pm | 38 ++--- .../lib/Varnish/Test/Case/Ticket128.pm | 18 +- .../regress/lib/Varnish/Test/Case/Vary.pm | 46 +++-- 7 files changed, 234 insertions(+), 142 deletions(-) diff --git a/varnish-tools/regress/lib/Varnish/Test/Case.pm b/varnish-tools/regress/lib/Varnish/Test/Case.pm index 3fdd2546..1293b792 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case.pm @@ -51,6 +51,7 @@ use strict; use Varnish::Test::Client; use HTTP::Request; use HTTP::Response; +use POSIX qw(strftime); use Time::HiRes qw(gettimeofday tv_interval); sub new($$) { @@ -175,6 +176,10 @@ sub results($) { }; } +# +# Default event handlers +# + sub ev_client_response($$$) { my ($self, $client, $response) = @_; @@ -188,6 +193,159 @@ sub ev_client_timeout($$) { return $client; } +sub ev_server_request($$$$) { + my ($self, $server, $connection, $request) = @_; + + no strict 'refs'; + my $method = $request->method(); + my $handler; + if ($self->can("server_$method")) { + $handler = ref($self) . "::server_$method"; + } elsif ($self->can("server")) { + $handler = ref($self) . "::server"; + } else { + die "No server callback defined\n"; + } + + my $response = HTTP::Response->new(); + $response->code(200); + $response->header('Date' => + strftime("%a, %d %b %Y %T GMT", gmtime(time()))); + $response->header('Server' => ref($self)); + $response->header('Connection' => 'keep-alive'); + $response->content(''); + $response->protocol('HTTP/1.1'); + $self->$handler($request, $response); + $response->header('Content-Length' => + length($response->content())); + $connection->send_response($response); +} + +# +# Client utilities +# + +sub request($$$$;$$) { + my ($self, $client, $method, $uri, $header, $content) = @_; + + my $req = HTTP::Request->new($method, $uri, $header, $content); + $req->protocol('HTTP/1.1'); + $client->send_request($req, 2); + my ($ev, $resp) = + $self->run_loop('ev_client_response', 'ev_client_timeout'); + die "Internal error\n" + unless $resp && ref($resp) && $resp->isa('HTTP::Response'); + die "Client time-out before receiving a (complete) response\n" + if $ev eq 'ev_client_timeout'; + die "No X-Varnish header\n" + unless $resp->header('X-Varnish'); + $resp->request($req); + return $self->{'cached_response'} = $resp; +} + +sub head($$$;$) { + my ($self, $client, $uri, $header) = @_; + + return $self->request($client, 'HEAD', $uri, $header); +} + +sub get($$$;$) { + my ($self, $client, $uri, $header) = @_; + + return $self->request($client, 'GET', $uri, $header); +} + +sub post($$$;$$) { + my ($self, $client, $uri, $header, $body) = @_; + + $header = [] + unless defined($header); + push(@{$header}, 'content-length', length($body)) + if defined($body); + return $self->request($client, 'POST', $uri, $header, $body); +} + +sub assert_code($$;$) { + my ($self, $code, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + die "Expected $code, got @{[$resp->code]}\n" + unless $resp->code == $code; +} + +sub assert_ok($;$) { + my ($self, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + + $self->assert_code(200, $resp); +} + +sub assert_cached($;$) { + my ($self, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + + my $uri = $resp->request->uri; + die "$uri should be cached but isn't\n" + unless $resp->header('X-Varnish') =~ /^\d+ \d+$/; +} + +sub assert_uncached($;$) { + my ($self, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + + my $uri = $resp->request->uri; + die "$uri shouldn't be cached but is\n" + if $resp->header('X-Varnish') =~ /^\d+ \d+$/; +} + +sub assert_header($$;$$) { + my ($self, $header, $re, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + + die "$header: header missing\n" + unless defined($resp->header($header)); + if (defined($re)) { + die "$header: header does not match\n" + unless $resp->header($header) =~ m/$re/; + } +} + +sub assert_body($;$$) { + my ($self, $re, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + + die "Response has no body\n" + unless defined($resp->content()); + if (defined($re)) { + die "Response body does not match\n" + unless $resp->content() =~ m/$re/; + } +} + +sub assert_no_body($;$) { + my ($self, $resp) = @_; + + $resp = $self->{'cached_response'} + unless defined($resp); + die "Response shouldn't have a body, but does\n" + if defined($resp->content()) && length($resp->content()); +} + +# +# Miscellaneous +# + sub usleep($$) { my ($self, $usec) = @_; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/LRU.pm b/varnish-tools/regress/lib/Varnish/Test/Case/LRU.pm index 3b6abc45..6491a081 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/LRU.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/LRU.pm @@ -51,19 +51,8 @@ sub _testLRU($$) { my $client = $self->new_client(); my $uri = __PACKAGE__ . "::$n"; - my $request = HTTP::Request->new('GET', $uri); - $request->protocol('HTTP/1.1'); - $client->send_request($request, 2); - my ($event, $response) = - $self->run_loop('ev_client_response', 'ev_client_timeout'); - die "Timed out\n" - if ($event eq 'ev_client_timeout'); - die "No (complete) response received\n" - unless defined($response); - die "Empty body\n" - if $response->content() eq ''; - die "Incorrect body\n" - if $response->content() !~ m/^(?:\Q$uri\E){$repeat}$/; + my $response = $self->get($client, $uri); + $self->assert_body(qr/^(?:\Q$uri\E){$repeat}$/); $client->shutdown(); return $response; } @@ -107,17 +96,11 @@ sub testLRU($) { return 'OK'; } -sub ev_server_request($$$$) { - my ($self, $server, $connection, $request) = @_; - - my $body = $request->uri() x $repeat; - my $response = HTTP::Response->new(200, undef, - [ 'Content-Type', 'text/plain', - 'Content-Length', length($body), - 'Cache-Control', 'max-age=3600', ], - $body); - $response->protocol('HTTP/1.1'); - $connection->send_response($response); +sub server($$$) { + my ($self, $request, $response) = @_; + + $response->content($request->uri() x $repeat); + $response->header('Cache-Control' => 'max-age=3600'); } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm b/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm index d07a3517..bdf6d78b 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm @@ -33,7 +33,10 @@ package Varnish::Test::Case::RePurge; use strict; use base 'Varnish::Test::Case'; -use Data::Dumper; +our $DESCR = "Tests the VCL purge() function by warming up the cache," . + " then submitting a request that causes part of it to be purged," . + " before finally verifying that the objects that should have been" . + " purged were and those that shouldn't weren't."; our $VCL = <new('GET', $url); - $req->protocol('HTTP/1.1'); - $client->send_request($req, 2); - my ($ev, $resp) = - $self->run_loop('ev_client_response', 'ev_client_timeout'); - die "Client time-out before receiving a (complete) response\n" - if $ev eq 'ev_client_timeout'; - die "Request failed\n" - unless $resp->code == 200; - return $resp; -} - -sub get_cached($$$) { - my ($self, $client, $url) = @_; - - my $resp = $self->get($client, $url); - die "$url should be cached but isn't\n" - unless $resp->header('x-varnish') =~ /^\d+ \d+$/; -} - -sub get_uncached($$$) { - my ($self, $client, $url) = @_; - - my $resp = $self->get($client, $url); - die "$url shouldn't be cached but is\n" - if $resp->header('x-varnish') =~ /^\d+ \d+$/; -} - -sub purge($$$) { - my ($self, $client, $re) = @_; - - my $req = HTTP::Request->new('REPURGE', $re); - $req->protocol('HTTP/1.1'); - $client->send_request($req, 2); - my ($ev, $resp) = - $self->run_loop('ev_client_response', 'ev_client_timeout'); - die "Client time-out before receiving a (complete) response\n" - if $ev eq 'ev_client_timeout'; -} - sub testPagePurged($) { my ($self) = @_; my $client = $self->new_client; - my $resp; # Warm up the cache $self->get($client, $KEEP_URL); + $self->assert_ok(); $self->get($client, $PURGE_URL); + $self->assert_ok(); # Verify the state of the cache - $self->get_cached($client, $KEEP_URL); - $self->get_cached($client, $PURGE_URL); + $self->get($client, $KEEP_URL); + $self->assert_ok(); + $self->assert_cached(); + $self->get($client, $PURGE_URL); + $self->assert_ok(); + $self->assert_cached(); # Send the purge request - $self->purge($client, $PURGE_RE); + $self->request($client, 'REPURGE', $PURGE_RE); # Verify the state of the cache - $self->get_cached($client, $KEEP_URL); - $self->get_uncached($client, $PURGE_URL); + $self->get($client, $KEEP_URL); + $self->assert_ok(); + $self->assert_cached(); + $self->get($client, $PURGE_URL); + $self->assert_ok(); + $self->assert_uncached(); $client->shutdown(); diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket056.pm b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket056.pm index 8a2d6d51..17ee3c23 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket056.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket056.pm @@ -33,6 +33,9 @@ package Varnish::Test::Case::Ticket056; use strict; use base 'Varnish::Test::Case'; +our $DESCR = "Checks that Varnish passes the correct HTTP version" . + " to both server and client in pass mode."; + our $VCL = " sub vcl_recv { pass; @@ -53,7 +56,8 @@ sub testVersionMatch($) { $request->protocol($cv); $client->send_request($request, 2); - my ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout'); + my ($event, $response) = + $self->run_loop('ev_client_response', 'ev_client_timeout'); die "Client time-out before receiving a (complete) response\n" if $event eq 'ev_client_timeout'; @@ -82,14 +86,12 @@ sub run($) { delete $self->{'cv', 'sv'}; } -sub ev_server_request($$$$) { - my ($self, $server, $connection, $request) = @_; +sub server($$$) { + my ($self, $request, $response) = @_; - my $response = HTTP::Response->new(404, undef, undef, - sprintf ("%s not found\n", $request->uri)); + $response->code(404); + $response->content(sprintf("%s not found\n", $request->uri)); $response->protocol($self->{'sv'}); - $connection->send_response($response); - $connection->shutdown; } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket102.pm b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket102.pm index e023d7bc..03851f17 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket102.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket102.pm @@ -33,6 +33,9 @@ package Varnish::Test::Case::Ticket102; use strict; use base 'Varnish::Test::Case'; +our $DESCR = "Checks that Varnish includes the response body when" . + " handling GET and POST, but not when handling HEAD."; + our $VCL = <new_client; - for (my $i = 0; $i < 2; $i++) { - my $request = HTTP::Request->new('POST', '/'); - $request->protocol('HTTP/1.1'); - $client->send_request($request, 2); - my ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout'); + $self->get($client, '/'); + $self->assert_body($BODY); + $self->assert_uncached(); + + $self->post($client, '/'); + $self->assert_body($BODY); + $self->assert_cached(); - die "Client time-out before receiving a (complete) response\n" - if $event eq 'ev_client_timeout'; - die "Empty body\n" - if $response->content eq ''; - die "Incorrect body\n" - if $response->content ne $body; - } + $self->head($client, '/'); + $self->assert_no_body(); + $self->assert_cached(); $client->shutdown(); return 'OK'; } -sub ev_server_request($$$$) { - my ($self, $server, $connection, $request) = @_; +sub server($$$) { + my ($self, $request, $response) = @_; - my $response = HTTP::Response->new(200, undef, - [ 'Content-Length', length($body), - 'Connection', 'Keep-Alive' ], - $body); - $response->protocol('HTTP/1.1'); - $connection->send_response($response); + $response->content($BODY); } 1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket128.pm b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket128.pm index 71a25290..54dd3be2 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/Ticket128.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/Ticket128.pm @@ -33,6 +33,8 @@ package Varnish::Test::Case::Ticket128; use strict; use base 'Varnish::Test::Case'; +our $DESCR = "Tests the synthetic error response code."; + our $CODE = 400; our $MESSAGE = "These are not the droids you are looking for"; @@ -46,19 +48,9 @@ sub testSyntheticError($) { my ($self) = @_; my $client = $self->new_client; - my $request = HTTP::Request->new('GET', '/'); - $request->protocol('HTTP/1.0'); - $client->send_request($request, 2); - - my ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout'); - - die "Client time-out before receiving a (complete) response\n" - if $event eq 'ev_client_timeout'; - die "Incorrect response code\n" - if $response->code != $CODE; - die "Incorrect response message\n" - unless $response->content =~ m/\Q$MESSAGE\E/o; - + $self->get($client, '/'); + $self->assert_code($CODE); + $self->assert_body(qr/\Q$MESSAGE\E/); $client->shutdown(); return 'OK'; diff --git a/varnish-tools/regress/lib/Varnish/Test/Case/Vary.pm b/varnish-tools/regress/lib/Varnish/Test/Case/Vary.pm index 72179a4a..d24fd110 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case/Vary.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case/Vary.pm @@ -33,6 +33,10 @@ package Varnish::Test::Case::Vary; use strict; use base 'Varnish::Test::Case'; +our $DESCR = "Tests Vary: support by requesting the same document" . + " in different languages and verifying that the correct version" . + " is returned and cached."; + our %languages = ( 'en' => "Hello World!\n", 'no' => "Hallo Verden!\n", @@ -41,48 +45,36 @@ our %languages = ( sub testVary($) { my ($self) = @_; - my $client = $self->new_client; - my $request = HTTP::Request->new('GET', '/'); + my $client = $self->new_client(); foreach my $lang (keys %languages) { - $request->header('Accept-Language', $lang); - $request->protocol('HTTP/1.1'); - $client->send_request($request, 2); - my ($event, $response) = - $self->run_loop('ev_client_response', 'ev_client_timeout'); - die "No (complete) response received\n" - unless defined($response); - die "Empty body\n" - if $response->content() eq ''; - die "Incorrect body\n" - if $response->content() ne $languages{$lang}; + $self->get($client, '/', [ 'Accept-Language', $lang]); + # $self->assert_uncached(); + $self->assert_header('Language', $lang); + $self->assert_body($languages{$lang}); + } + foreach my $lang (keys %languages) { + $self->get($client, '/', [ 'Accept-Language', $lang]); + $self->assert_cached(); + $self->assert_body($languages{$lang}); } $client->shutdown(); return 'OK'; } -sub ev_server_request($$$$) { - my ($self, $server, $connection, $request) = @_; +sub server($$$) { + my ($self, $request, $response) = @_; - my $body; - my @headers; if (my $lang = $request->header("Accept-Language")) { $lang = 'en' unless ($lang && $languages{$lang}); - $body = $languages{$lang}; - push(@headers, ('Language', $lang)); + $response->content($languages{$lang}); + $response->header('Language' => $lang); + $response->header('Vary' => 'Accept-Language'); } else { die 'Not ready for this!'; } - - my $response = HTTP::Response->new(200, undef, - [ 'Content-Length', length($body), - 'Vary', 'Accept-Language', - @headers ], - $body); - $response->protocol('HTTP/1.1'); - $connection->send_response($response); } 1; -- 2.39.5