From aa10bb057f08f0cd1576676507922bb8c1360f25 Mon Sep 17 00:00:00 2001 From: knutroy Date: Fri, 15 Jun 2007 17:04:16 +0000 Subject: [PATCH] Added some documentation. git-svn-id: svn+ssh://projects.linpro.no/svn/varnish/trunk@1529 d4fa192b-c00b-0410-8231-f00ffab90ce4 --- varnish-tools/regress/TODO | 1 - varnish-tools/regress/lib/Varnish/Test.pm | 67 ++++++++++++++----- .../regress/lib/Varnish/Test/Case.pm | 19 +++++- .../regress/lib/Varnish/Test/Client.pm | 44 ++++++++++++ .../regress/lib/Varnish/Test/Engine.pm | 55 ++++++++++++++- .../regress/lib/Varnish/Test/Logger.pm | 55 --------------- .../regress/lib/Varnish/Test/Server.pm | 47 +++++++++++++ .../regress/lib/Varnish/Test/Varnish.pm | 38 +++++++++-- 8 files changed, 244 insertions(+), 82 deletions(-) delete mode 100644 varnish-tools/regress/lib/Varnish/Test/Logger.pm diff --git a/varnish-tools/regress/TODO b/varnish-tools/regress/TODO index b18e677d..36e44f3d 100644 --- a/varnish-tools/regress/TODO +++ b/varnish-tools/regress/TODO @@ -1,3 +1,2 @@ -* Ticket 55. * Completely POD-ify Perl-code. * Detect and act upon unexpected death of Varnish grandchild process. diff --git a/varnish-tools/regress/lib/Varnish/Test.pm b/varnish-tools/regress/lib/Varnish/Test.pm index 5d269b2c..93d0829a 100644 --- a/varnish-tools/regress/lib/Varnish/Test.pm +++ b/varnish-tools/regress/lib/Varnish/Test.pm @@ -38,30 +38,65 @@ The varnish regression test framework works by starting up a Varnish process and then communicating with this process as both client and server. + +---------------------------------------------------------+ + | TEST FRAMEWORK | + | | + | Controller | + | +-----------------------------------+ | + | | | C ^ | | + | | configuration | L | status | | + | | v I | | | + | | requests +---------+ requests | | + | | =========> | | =========> | | + | Client | HTTP | VARNISH | HTTP | Server | + | emulator | <========= | | <========= | emulator | + | | responses +---------+ responses | | + +----------+ +----------+ + =head1 STRUCTURE -When regressions tests start, an instance of Varnish is forked off as -a child process, and its I/O channels (std{in,out,err}) are controlled -by the parent process which also performs the test by playing the role +When regression tests start, an instance of Varnish is forked off as a +child process, and its I/O channels (std{in,out,err} which are +connected to the command-line interface of Varnish) are controlled by +the parent process which also performs the tests by playing the role of both HTTP client and server. A single select(2)-driven loop is used to handle all activity on both server and client side, as well on Varnish's I/O-channels. This is done using IO::Multiplex. -As a result of using a select-loop, the framework has an event-driven -design in order to cope with unpredictable sequence of processing on -either server og client side. To drive a test-case forward, the -select-loop is paused when certain events occur, and control returns -to the "main program" which can then inspect the situation. This -results in certain structural constraints. It is essential to be aware -of whether a piece of code is going to run inside or outside the -select-loop. - -The framework uses Perl objects to represent instances of servers and -clients as well as the Varnish instance itself. In addition, there is -an "engine" object which propagates events and controls the program -flow related to the select-loop. +As a result of using a select-loop (as opposed to a multi-threaded or +multi-process approach), the framework has an event-driven design in +order to cope with the unpredictable sequence of I/O on server or +client side (or Varnish's I/O-channels for that matter) . To drive a +test-case forward, the select-loop is paused when certain events +occur, and control returns to the "main program" which can then +inspect the situation. This results in certain structural constraints, +and it is essential to be aware of whether a piece of code is going to +run inside (event handler) or outside (main program) the select-loop. + +The framework uses Perl objects to represent instances of servers +(Varnish::Test::Server) and clients (Varnish::Test::Client) as well as +the Varnish instance itself (Varnish::Test::Varnish). In addition, +there is an engine object (Varnish::Test::Engine) which dispatches +events and controls the program flow related to the select-loop. +Futhermore, each test case is represented by an object +(Varnish::Test::Case subclass). HTTP requests and responses are +represented by objects of HTTP::Request and HTTP::Response, +respectively. Finally, there is an overall test-case controller object +(Varnish::Test) which accumulates test-case results. + +=head1 EVENT PROCESSING + +Events typically occur in the call-back routines (mux_*) of client, +server, and Varnish objects. An event is created by calling an ev_* +method of the engine object. These calls are handled by Perl's +AUTOLOAD mechanism since Engine does not define any ev_* methods +explicitly. The AUTOLOAD routine works as the event dispatcher by +looking for an event handler in the currently running test-case +object, and also determines whether the event being processed is +supposed to pause the select-loop and return control back to the main +program. =cut diff --git a/varnish-tools/regress/lib/Varnish/Test/Case.pm b/varnish-tools/regress/lib/Varnish/Test/Case.pm index 61310d9a..22868ac1 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Case.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Case.pm @@ -28,12 +28,27 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Case - test-case superclass + +=head1 DESCRIPTION + +Varnish::Test::Case is meant to be the superclass of specific +test-case clases. It provides functionality to run a number of tests +defined in methods whose names start with "test", as well as keeping +track of the number of successful or failed tests. + +It also provides default event handlers for "ev_client_response" and +"ev_client_timeout", which are standard for most test-cases. + +=cut + package Varnish::Test::Case; use strict; -use Varnish::Test::Logger; - +use Varnish::Test::Client; use HTTP::Request; use HTTP::Response; use Time::HiRes qw(gettimeofday tv_interval); diff --git a/varnish-tools/regress/lib/Varnish/Test/Client.pm b/varnish-tools/regress/lib/Varnish/Test/Client.pm index 8d35aab6..aed6c994 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Client.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Client.pm @@ -28,6 +28,17 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Client - HTTP-client emulator + +=head1 DESCRIPTION + +Varnish::Test::Client objects have the capability of establishing HTTP +connections, sending requests and receiving responses. + +=cut + package Varnish::Test::Client; use strict; @@ -86,7 +97,18 @@ sub shutdown($) { sub mux_input($$$$) { my ($self, $mux, $fh, $data) = @_; + # 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") or + # if connection is closed ("mux_eof"). + 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 + # content-length and decide what to do. + my $response = HTTP::Response->parse($$data); my $content_length = $response->content_length; @@ -94,25 +116,47 @@ sub mux_input($$$$) { my $content_ref = $response->content_ref; my $data_length = length($$content_ref); if ($data_length == $content_length) { + # We found exactly content-length amount of data, so + # empty input buffer and send response to event + # handling. $$data = ''; $self->got_response($response); } elsif ($data_length < $content_length) { + # We only received the first part of an HTTP message, + # so break out of loop and wait for more. $self->log(sprintf('Partial response. Bytes in body: %d received, %d expected, %d remaining', $data_length, $content_length, $content_length - $data_length)); last; } else { + # We have more than content-length data, which means + # more than just one HTTP message. The extra data + # (beyond content-length) is now at the end of + # $$content_ref, so move it back to the input buffer + # so we can parse it on the next iteration. Note that + # this "substr" also removes this data from + # $$content_ref (the message body of $response + # itself). $$data = substr($$content_ref, $content_length, $data_length - $content_length, ''); + + # Send response to event handling. $self->got_response($response); } } else { + # There is no content-length among the headers, so break + # 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.'); last; } } + + # At this point, what remains in the input buffer is either + # nothing at all or a partial HTTP message. } sub mux_eof($$$$) { diff --git a/varnish-tools/regress/lib/Varnish/Test/Engine.pm b/varnish-tools/regress/lib/Varnish/Test/Engine.pm index b09f4f3b..7c5d742b 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Engine.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Engine.pm @@ -28,13 +28,29 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Engine - select-loop wrapper and event dispatcher + +=head1 DESCRIPTION + +Varnish::Test::Engine is primarily a wrapper around a +IO::Multiplex-based select-loop which monitors activity on +client-side, server-side and Varnish's I/O-channels. On startup, it +automatically creates an associated Server object and a Varnish +objects whoses sockets/filehandles are registered in the +IO::Multiplex-object. + +Additionally, event dispatching is performed by the AUTOLOAD method. + +=cut + package Varnish::Test::Engine; use strict; use Varnish::Test::Server; use Varnish::Test::Varnish; -use Varnish::Test::Client; use IO::Multiplex; sub new($$;%) { @@ -68,32 +84,53 @@ sub log($$$) { sub run_loop($@) { my ($self, @wait_for) = @_; + # Sanity-check to help the novice test-case writer. die "Engine::run_loop: Already inside select-loop. Your code is buggy.\n" if exists($self->{'in_loop'}); + # We need to wait for at least one event. die "Engine::run_loop: No events to wait for.\n" if @wait_for == 0; + # Check the queue for pending events which occurred between the + # last pausing event and the time the loop actually paused. If we + # are waiting for any of these events (which already occurred), + # return the first one we find immediately. while (@{$self->{'pending'}} > 0) { my ($event, @args) = @{shift @{$self->{'pending'}}}; return ($event, @args) if grep({ $_ eq $event } @wait_for); } + # At this point, the queue of pending events is always empty. + # Prepare and run IO::Multiplex::loop. + $self->{'wait_for'} = \@wait_for; $self->{'in_loop'} = 1; $self->{'mux'}->loop; delete $self->{'in_loop'}; delete $self->{'wait_for'}; + # Loop has now been paused due to the occurrence of an event we + # were waiting for. This event is always found in the front of the + # pending events queue at this point, so return it. return @{shift @{$self->{'pending'}}} if @{$self->{'pending'}} > 0; + + # Hm... we should usually not reach this point. The pending queue + # is empty. Either someone (erroneously) requested a loop pause by + # calling IO::Multiplex::endloop and forgot to put any event in + # the queue, or the loop ended itself because all registered + # filehandles/sockets closed. return undef; } sub shutdown($) { my ($self) = @_; + # Shutdown varnish and server. $self->{'varnish'}->shutdown if defined $self->{'varnish'}; $self->{'server'}->shutdown if defined $self->{'server'}; + + # Close any lingering sockets registered with IO::Multiplex. foreach my $fh ($self->{'mux'}->handles) { $self->{'mux'}->close($fh); } @@ -106,18 +143,32 @@ sub AUTOLOAD ($;@) { return if $event eq 'DESTROY'; + # For the sake of readability, we want all method names we handle + # to start with "ev_". die sprintf("Unknown method '%s'\n", $event) unless $event =~ /^ev_(.*)$/; $self->log($self, 'ENG: ', sprintf('EVENT "%s"', $1)); + # Check to see if the active case object defines an event handler + # for this event. If so, call it and bring the event arguments + # along. This will also replace @args, which is significant if + # this event will pause and return. @args = $self->{'case'}->$event(@args) if (defined($self->{'case'}) and $self->{'case'}->can($event)); if (@{$self->{'pending'}} > 0) { - push(@{$self->{'pending'}}, [ $event, @args ]); + # Pending event queue is NOT empty, meaning this is an event + # arriving after a pausing (wait_for) event, but before the + # pause is in effect. We queue this event unconditionally + # because it might be the one we are waiting for on the next + # call to run_loop. + push(@{$self->{'pending'}}, [ $event, @args ]); } elsif (grep({ $_ eq $event} @{$self->{'wait_for'}}) > 0) { + # Pending event queue is empty and this event is one of those + # we are waiting for, so put it in the front of the queue and + # signal loop pause by calling IO::Multiplex::endloop. push(@{$self->{'pending'}}, [ $event, @args ]); $self->{'mux'}->endloop; } diff --git a/varnish-tools/regress/lib/Varnish/Test/Logger.pm b/varnish-tools/regress/lib/Varnish/Test/Logger.pm deleted file mode 100644 index 4276d48a..00000000 --- a/varnish-tools/regress/lib/Varnish/Test/Logger.pm +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w -#- -# Copyright (c) 2006 Linpro AS -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer -# in this position and unchanged. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# $Id$ -# - -package Varnish::Test::Logger; - -sub new($;$) { - my ($this, $prefix) = @_; - my $class = ref($this) || $this; - - my $self = bless({ 'prefix' => $prefix || '' }, $class); -} - -sub write($$;$) { - my ($self, $data, $extra_prefix) = @_; - - my $prefix = $self->{'prefix'}; - $prefix .= ': ' . $extra_prefix if defined($extra_prefix); - - if ($prefix) { - $data =~ s/^/$prefix: /gm; - } - - $data =~ s/\n?$/\n/; - - print STDERR $data; -} - -1; diff --git a/varnish-tools/regress/lib/Varnish/Test/Server.pm b/varnish-tools/regress/lib/Varnish/Test/Server.pm index 6ff3f6fc..2b6f49a7 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Server.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Server.pm @@ -28,6 +28,20 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Server - HTTP-server emulator + +=head1 DESCRIPTION + +A Varnish::Test::Server object has the capability of listening on a +TCP socket, receiving HTTP requests and sending responses. + +Every established connection is handled by an associated object of +type Varnish::Test::Server::Connection. + +=cut + package Varnish::Test::Server; use strict; @@ -127,7 +141,17 @@ sub shutdown($) { sub mux_input($$$$) { my ($self, $mux, $fh, $data) = @_; + # 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 + # content-length and decide what to do. + my $request = HTTP::Request->parse($$data); my $content_ref = $request->content_ref; my $content_length = $request->content_length; @@ -135,19 +159,38 @@ sub mux_input($$$$) { if (defined($content_length)) { my $data_length = length($$content_ref); if ($data_length == $content_length) { + # We found exactly content-length amount of data, so + # empty input buffer and send request to event + # handling. $$data = ''; $self->{'server'}->got_request($self, $request); } elsif ($data_length < $content_length) { + # We only received the first part of an HTTP message, + # so break out of loop and wait for more. last; } else { + # We have more than content-length data, which means + # more than just one HTTP message. The extra data + # (beyond content-length) is now at the end of + # $$content_ref, so move it back to the input buffer + # so we can parse it on the next iteration. Note that + # this "substr" also removes this data from + # $$content_ref (the message body of $request itself). $$data = substr($$content_ref, $content_length, $data_length - $content_length, ''); + # Send request to event handling. $self->{'server'}->got_request($self, $request); } } else { + # HTTP requests without a content-length has no body by + # definition, so whatever was parsed as content must be + # the start of another request. Hence, move this back to + # input buffer and empty the body of this $request. Then, + # send $request to event handling. + $$data = $$content_ref; $$content_ref = ''; $self->{'server'}->got_request($self, $request); @@ -158,6 +201,10 @@ sub mux_input($$$$) { sub mux_eof($$$$) { my ($self, $mux, $fh, $data) = @_; + # On server side, HTTP does not use EOF from client to signal end + # of request, so if there is anything left in input buffer, it + # must be incomplete because "mux_input" left it there. + die "Junk or incomplete request\n" unless $$data eq ''; } diff --git a/varnish-tools/regress/lib/Varnish/Test/Varnish.pm b/varnish-tools/regress/lib/Varnish/Test/Varnish.pm index 96ad16af..4140815d 100644 --- a/varnish-tools/regress/lib/Varnish/Test/Varnish.pm +++ b/varnish-tools/regress/lib/Varnish/Test/Varnish.pm @@ -28,14 +28,27 @@ # $Id$ # +=head1 NAME + +Varnish::Test::Varnish - Varnish child-process controller + +=head1 DESCRIPTION + +A Varnish::Test::Varnish object is used to fork off a Varnish child +process and control traffic going into and coming out of the Varnish +(management process) command-line interface (CLI). + +Various events are generated when certain strings are identified in +the output from the CLI. + +=cut + package Varnish::Test::Varnish; use strict; use Socket; -use Varnish::Test::Logger; - sub new($$;$) { my ($this, $engine, $attrs) = @_; my $class = ref($this) || $this; @@ -44,6 +57,9 @@ sub new($$;$) { 'mux' => $engine->{'mux'}, 'state' => 'init' }, $class); + # Create pipes (actually socket pairs) for communication between + # parent and child. + socketpair(STDIN_READ, STDIN_WRITE, AF_UNIX, SOCK_STREAM, PF_UNSPEC); shutdown(STDIN_READ, 1); shutdown(STDIN_WRITE, 0); @@ -54,7 +70,8 @@ sub new($$;$) { shutdown(STDERR_READ, 1); shutdown(STDERR_WRITE, 0); - delete $SIG{CHLD}; + # Ignore SIGCHLD. + $SIG{CHLD} = 'IGNORE'; my $pid = fork; die "fork(): $!\n" @@ -67,6 +84,9 @@ sub new($$;$) { close STDOUT_READ; close STDERR_READ; + # dup2(2) the I/O-channels to std{in,out,err} and close the + # original file handles before transforming into Varnish. + open STDIN, '<&', \*STDIN_READ; close STDIN_READ; open STDOUT, '>&', \*STDOUT_WRITE; @@ -80,14 +100,17 @@ sub new($$;$) { print STDERR sprintf("Starting Varnish with options: %s\n", join(' ', @opts)); + # Unset ignoring of SIGCHLD, so Varnish will get signals from + # its children. + + delete $SIG{CHLD}; + + # Transform into Varnish. Goodbye Perl-code! exec('varnishd', @opts); exit(1); } else { # Parent - - $SIG{CHLD} = 'IGNORE'; - $self->log('PID: ' . $pid); close STDIN_READ; @@ -99,6 +122,9 @@ sub new($$;$) { $self->{'stdout'} = \*STDOUT_READ; $self->{'stderr'} = \*STDERR_READ; + # Register the Varnish I/O-channels with the IO::Multiplex + # loop object. + $self->{'mux'}->add($self->{'stdin'}); $self->{'mux'}->set_callback_object($self, $self->{'stdin'}); $self->{'mux'}->add($self->{'stdout'}); -- 2.39.5