Mailing List Archive

Author: des
Date: 2007-07-28 11:23:52 +0200 (Sat, 28 Jul 2007)
New Revision: 1779

Modified:
trunk/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm
Log:
Refactor this test case. Note that it still fails; there seems to be
something wrong with the synthetic response code in varnishd.


Modified: trunk/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm
===================================================================
--- trunk/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm 2007-07-27 14:16:39 UTC (rev 1778)
+++ trunk/varnish-tools/regress/lib/Varnish/Test/Case/RePurge.pm 2007-07-28 09:23:52 UTC (rev 1779)
@@ -44,79 +44,74 @@
}
EOVCL

-our $body_p = "Hello World! -> purge\n";
-our $body_k = "Hello World! -> keep\n";
+our $KEEP_URL = '/will-be-kept';
+our $PURGE_URL = '/will-be-purged';
+our $PURGE_RE = 'purge';

-sub testPagePurged($) {
- my ($self) = @_;
+sub get($$$) {
+ my ($self, $client, $url) = @_;

- my $client = $self->new_client;
- my $get_p_request = HTTP::Request->new('GET', '/purge');
- $get_p_request->protocol('HTTP/1.1');
- my $get_k_request = HTTP::Request->new('GET', '/keep');
- $get_k_request->protocol('HTTP/1.1');
- my $purge_request = HTTP::Request->new('REPURGE', '/purge');
- $purge_request->protocol('HTTP/1.1');
+ my $req = HTTP::Request->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) = @_;

- # Fetch the two pages, so they'll get cached
- $client->send_request($get_p_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 "Empty body\n"
- if $response->content eq '';
+ my $resp = $self->get($client, $url);
+ die "$url should be cached but isn't\n"
+ unless $resp->header('x-varnish') =~ /^\d+ \d+$/;
+}

- $client->send_request($get_k_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 "Empty body\n"
- if $response->content eq '';
+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+$/;
+}

- # Check that the purge page is cached
- $client->send_request($get_p_request, 2);
- ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout');
+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 $event eq 'ev_client_timeout';
- die "Empty body\n"
- if $response->content eq '';
- die "Not cached\n"
- if $response->header('x-varnish') !~ /\d+ \d+/;
+ if $ev eq 'ev_client_timeout';
+}

+sub testPagePurged($) {
+ my ($self) = @_;

- # Purge the purge page
- $client->send_request($purge_request, 2);
- ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout');
- # For some reason it times out on the first attempt, so we have to run the
- # loop an extra time to get the response. Could this be a bug in the framework?
- ($event, $response) = $self->run_loop('ev_client_response', 'ev_client_timeout')
- if $event eq 'ev_client_timeout';
+ my $client = $self->new_client;
+ my $resp;

+ # Warm up the cache
+ $self->get($client, $KEEP_URL);
+ $self->get($client, $PURGE_URL);

- # Check that the purge page is no longer cached
- $client->send_request($get_p_request, 2);
- ($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 "Empty body\n"
- if $response->content eq '';
- die "Still Cached\n"
- if $response->header('x-varnish') =~ /\d+ \d+/;
+ # Verify the state of the cache
+ $self->get_cached($client, $KEEP_URL);
+ $self->get_cached($client, $PURGE_URL);

+ # Send the purge request
+ $self->purge($client, $PURGE_RE);

- # Check that the keep page is still cached
- $client->send_request($get_k_request, 2);
- ($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 "Empty body\n"
- if $response->content eq '';
- die "Still Cached\n"
- if $response->header('x-varnish') !~ /\d+ \d+/;
+ # Verify the state of the cache
+ $self->get_cached($client, $KEEP_URL);
+ $self->get_uncached($client, $PURGE_URL);

-
$client->shutdown();

return 'OK';
@@ -124,16 +119,8 @@

sub ev_server_request($$$$) {
my ($self, $server, $connection, $request) = @_;
- my $body = "";

- # Return the right content
- if ($request->uri =~ /purge/) {
- $body = $body_p;
- }
- elsif ($request->uri =~ /keep/) {
- $body = $body_k;
- }
-
+ my $body = $request->url;
my $response = HTTP::Response->new(200, undef,
[ 'Content-Length', length($body),
'Connection', 'Keep-Alive' ],