--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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;
+
+use strict;
+use base 'Varnish::Test::Context';
+use Varnish::Test::Accelerator;
+use Varnish::Test::Case;
+use Varnish::Test::Client;
+use Varnish::Test::Server;
+use Varnish::Test::Tokenizer;
+
+sub new($;$) {
+ my $this = shift;
+ my $class = ref($this) || $this;
+
+ my $self = Varnish::Test::Context->new();
+ bless($self, $class);
+ $self->parse($_[0])
+ if (@_);
+
+ return $self;
+}
+
+sub _parse_ticket($$) {
+ my $self = shift;
+ my $t = shift;
+
+ $t->shift_keyword("ticket");
+ push(@{$self->{'ticket'}}, $t->shift("Integer"));
+ $t->shift("SemiColon");
+}
+
+sub _parse_test($$) {
+ my $self = shift;
+ my $t = shift;
+
+ my $token = $t->shift_keyword("test");
+ $token = $t->shift("String");
+ $self->{'descr'} = $token->value;
+ $token = $t->shift("LeftBrace");
+ for (;;) {
+ $token = $t->peek();
+ last if $token->is("RightBrace");
+ if (!$token->is("Keyword")) {
+ $t->die("expected keyword, got " . ref($token));
+ } elsif ($token->value eq 'ticket') {
+ $self->_parse_ticket($t);
+ } elsif ($token->value eq 'accelerator') {
+ my $x = Varnish::Test::Accelerator->new($self, $t);
+ $t->die("duplicate declaration of " . $x->name)
+ if exists($self->{'vars'}->{$x->name});
+ $self->set($x->name, $x);
+ } elsif ($token->value eq 'client') {
+ my $x = Varnish::Test::Client->new($self, $t);
+ $t->die("duplicate declaration of " . $x->name)
+ if exists($self->{'vars'}->{$x->name});
+ $self->set($x->name, $x);
+ } elsif ($token->value eq 'server') {
+ my $x = Varnish::Test::Server->new($self, $t);
+ $t->die("duplicate declaration of " . $x->name)
+ if exists($self->{'vars'}->{$x->name});
+ $self->set($x->name, $x);
+ } elsif ($token->value eq 'case') {
+ my $x = Varnish::Test::Case->new($self, $t);
+ } else {
+ $t->die("unexpected keyword " . $token->value);
+ }
+ }
+ $token = $t->shift("RightBrace");
+}
+
+sub parse($$) {
+ my $self = shift;
+ my $fn = shift;
+
+ my $t = Varnish::Test::Tokenizer->new($fn);
+ $self->_parse_test($t);
+}
+
+sub run($) {
+ my $self = shift;
+
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Accelerator;
+
+use strict;
+use base 'Varnish::Test::Object';
+use POSIX;
+
+sub _init($) {
+ my $self = shift;
+
+ # Default address / port
+ $self->vars->{'address'} = 'localhost';
+ $self->vars->{'port'} = '8001';
+}
+
+sub start($) {
+ my $self = shift;
+
+ my $backend = $self->vars->{'backend'};
+ (defined($backend) &&
+ $backend->isa('Varnish::Test::Server'))
+ or die("invalid server\n");
+
+ my ($stdinx, $stdin) = POSIX::pipe()
+ or die("pipe(): $!\n");
+ my ($stdout, $stdoutx) = POSIX::pipe()
+ or die("pipe(): $!\n");
+ my ($stderr, $stderrx) = POSIX::pipe()
+ or die("pipe(): $!\n");
+ my $pid = fork();
+ if (!defined($pid)) {
+ # fail
+ die("fork(): $!\n");
+ } elsif ($pid == 0) {
+ # child
+ POSIX::dup2($stdinx, 0);
+ POSIX::close($stdin);
+ POSIX::close($stdinx);
+ POSIX::dup2($stdoutx, 1);
+ POSIX::close($stdout);
+ POSIX::close($stdoutx);
+ POSIX::dup2($stderrx, 2);
+ POSIX::close($stderr);
+ POSIX::close($stderrx);
+ # XXX must be in path
+ exec('varnishd',
+ '-d', '-d',
+ '-b', $backend->get('address') . ":" . $backend->get('port'));
+ exit(1);
+ }
+ # parent
+ $self->{'pid'} = $pid;
+ $self->{'stdin'} = $stdin;
+ POSIX::close($stdinx);
+ $self->{'stdout'} = $stdout;
+ POSIX::close($stdoutx);
+ $self->{'stderr'} = $stderr;
+ POSIX::close($stderrx);
+}
+
+sub stop($) {
+ my $self = shift;
+
+ POSIX::close($self->{'stdin'})
+ if ($self->{'stdin'});
+ POSIX::close($self->{'stdout'})
+ if ($self->{'stdout'});
+ POSIX::close($self->{'stderr'})
+ if ($self->{'stderr'});
+ sleep(1);
+ kill(15, $self->{'pid'})
+ if ($self->{'pid'});
+ delete($self->{'stdin'});
+ delete($self->{'stdout'});
+ delete($self->{'stderr'});
+ delete($self->{'pid'});
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Case;
+
+use strict;
+use base 'Varnish::Test::Object';
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Client;
+
+use strict;
+use base 'Varnish::Test::Object';
+use IO::Socket;
+use URI;
+
+sub request($$$) {
+ my $self = shift;
+ my $server = shift;
+ my $url = shift;
+
+ (defined($server) &&
+ ($server->isa('Varnish::Test::Accelerator') ||
+ $server->isa('Varnish::Test::Server')))
+ or die("invalid server\n");
+ $url = URI->new($url)
+ or die("invalid URL\n");
+
+ # GET $uri->path_query HTTP/$self->{'protocol'}
+ # Host: $uri->host_port
+ # Connection: xxx
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Code;
+
+use strict;
+
+sub new($$$) {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $context = shift;
+
+ my $self = {
+ 'context' => $context,
+ };
+ bless($self, $class);
+
+ $self->_parse(shift)
+ if (@_);
+
+ return $self;
+}
+
+sub _parse($$) {
+ my $self = shift;
+ my $t = shift;
+
+ print STDERR "\t";
+ while (!$t->peek()->is("SemiColon")) {
+ print STDERR " " . $t->peek()->value();
+ $t->shift();
+ }
+ $t->shift("SemiColon");
+ print STDERR ";\n";
+}
+
+sub run($) {
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Context;
+
+use strict;
+
+#
+# A Context is an object that has a name, a type, and a set of named
+# variables and procedures associated with it. A context may have a
+# parent, from which it inherits variables and procedures.
+#
+
+sub new($;$) {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $parent = shift;
+
+ my $self = {
+ 'parent' => $parent,
+ 'vars' => { },
+ 'procs' => { },
+ };
+ bless($self, $class);
+
+ return $self;
+}
+
+sub parent($) {
+ my $self = shift;
+
+ return $self->{'parent'};
+}
+
+sub vars($) {
+ my $self = shift;
+
+ return $self->{'vars'};
+}
+
+sub procs($) {
+ my $self = shift;
+
+ return $self->{'procs'};
+}
+
+sub set($$$) {
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ if (!exists($self->vars->{$key}) &&
+ $self->parent && $self->parent->has($key)) {
+ $self->parent->set($key, $value);
+ } else {
+ $self->vars->{$key} = $value;
+ }
+ return $value;
+}
+
+sub has($$) {
+ my $self = shift;
+ my $key = shift;
+
+ return exists($self->{'vars'}->{$key}) ||
+ $self->parent->has($key);
+}
+
+sub get($$) {
+ my $self = shift;
+ my $key = shift;
+
+ return exists($self->vars->{$key}) ? $self->vars->{$key} :
+ ($self->parent && $self->parent->get($key));
+}
+
+sub type($) {
+ my $self = shift;
+
+ if (!defined($self->{'type'})) {
+ ($self->{'type'} = ref($self)) =~ s/^(\w+::)*(\w+)$/$2/;
+ print STDERR "$self->{'type'}\n";
+ }
+ return $self->{'type'};
+}
+
+sub name($;$) {
+ my $self = shift;
+
+ $self->{'name'} = shift
+ if (@_);
+ return $self->{'name'};
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Object;
+
+use strict;
+use base 'Varnish::Test::Context';
+use Varnish::Test::Code;
+
+sub new($$;$) {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $parent = shift;
+
+ my $self = Varnish::Test::Context->new($parent);
+ $self->{'code'} = [];
+ bless($self, $class);
+
+ $self->_init();
+
+ $self->_parse($_[0])
+ if (@_);
+
+ return $self;
+}
+
+sub _init($) {
+ my $self = shift;
+
+ # nothing
+}
+
+sub _parse($$) {
+ my $self = shift;
+ my $t = shift;
+
+ $t->shift_keyword(lc($self->type));
+ $self->name($t->shift("Identifier")->value);
+ $t->shift("LeftBrace");
+ while (!$t->peek()->is("RightBrace")) {
+ push(@{$self->{'code'}}, Varnish::Test::Code->new($self, $t));
+# $token = $t->shift("Identifier");
+# my $key = $token->value;
+# $token = $t->shift("Assign");
+# $token = $t->shift("Integer", "Real", "String");
+# my $value = $token->value;
+# $token = $t->shift("SemiColon");
+# $t->warn("multiple assignments to $self->{'name'}.$key")
+# if ($self->has($key));
+# $self->set($key, $value);
+ }
+ $t->shift("RightBrace");
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Request;
+
+use strict;
+use base 'Varnish::Test::Object';
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Response;
+
+use strict;
+use base 'Varnish::Test::Object';
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Server;
+
+use strict;
+use base 'Varnish::Test::Object';
+
+sub _init($) {
+ my $self = shift;
+
+ $self->vars->{'address'} = 'localhost';
+ $self->vars->{'port'} = '9001';
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Token;
+
+use strict;
+
+# Common constructor
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $pos = shift;
+
+ my $self = {
+ 'pos' => $pos,
+ 'value' => '???',
+ };
+ bless($self, $class);
+
+ # hack: use eval to avoid clobbering @_
+ eval { ($self->{'type'} = $class) =~ s/^(\w+::)*(\w+)$/$2/; };
+
+ $self->init(@_);
+
+ return $self;
+}
+
+# Default initializer
+sub init($;$) {
+ my $self = shift;
+
+ $self->value(@_);
+}
+
+sub type($;$) {
+ my $self = shift;
+
+ $self->{'type'} = shift
+ if (@_);
+ return $self->{'type'};
+}
+
+sub value($;$) {
+ my $self = shift;
+
+ $self->{'value'} = shift
+ if (@_);
+ return $self->{'value'};
+}
+
+sub is($$) {
+ my $self = shift;
+ my $type = shift;
+
+ return ($self->{'type'} eq $type);
+}
+
+sub equals($$) {
+ my $self = shift;
+ my $other = shift;
+
+ return ($self->type() eq $other->type() &&
+ $self->value() eq $other->value());
+}
+
+package Varnish::Test::Token::Assign;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Comma;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Compare;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::EOF;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Identifier;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Integer;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Keyword;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::LeftBrace;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::LeftParen;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Period;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::Real;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::RightBrace;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::RightParen;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::SemiColon;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+package Varnish::Test::Token::String;
+
+use strict;
+use base 'Varnish::Test::Token';
+
+1;
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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::Tokenizer;
+
+use strict;
+use Varnish::Test::Token;
+
+sub new($$) {
+ my $this = shift;
+ my $class = ref($this) || $this;
+
+ my $self = {};
+ bless($self, $class);
+ $self->tokenize($_[0])
+ if (@_);
+
+ return $self;
+}
+
+sub tokenize($$) {
+ my $self = shift;
+ my $fn = shift;
+
+ local *FILE;
+ local $/;
+
+ $self->{'fn'} = $fn;
+ $self->{'tokens'} = ();
+
+ open(FILE, "<", $self->{'fn'})
+ or die("$self->{'fn'}: $!\n");
+ my $spec = <FILE>;
+ close(FILE);
+
+ # tokenize
+ my @tokens = ();
+ for (;;) {
+ my $type = undef;
+ if ($spec =~ m/\G\s*$/gc) {
+ # EOF
+ push(@tokens, Varnish::Test::Token::EOF->new(pos($spec)));
+ last;
+ } elsif ($spec =~ m/\G\s*(\*\/\*([^\*]|\*[^\/])+\*\/)/gc) {
+ # multiline comment
+ } elsif ($spec =~ m/\G\s*((?:\/\/|\#).*?)\n/gc) {
+ # single-line comment
+ } elsif ($spec =~ m/\G\s*\b(\d+\.\d+)\b/gc) {
+ # real literal
+ push(@tokens, Varnish::Test::Token::Real->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*\b(\d+)\b/gc) {
+ # integer literal
+ push(@tokens, Varnish::Test::Token::Integer->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*\"((?:\\.|[^\"])*)\"/gc) {
+ # string literal
+ push(@tokens, Varnish::Test::Token::String->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*\b(accelerator|client|init|server|case|test|ticket)\b/gc) {
+ # keyword
+ push(@tokens, Varnish::Test::Token::Keyword->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*\b(\w+)\b/gc) {
+ # identifier
+ push(@tokens, Varnish::Test::Token::Identifier->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\{)/gc) {
+ # opening brace
+ push(@tokens, Varnish::Test::Token::LeftBrace->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\})/gc) {
+ # closing brace
+ push(@tokens, Varnish::Test::Token::RightBrace->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\()/gc) {
+ # opening paren
+ push(@tokens, Varnish::Test::Token::LeftParen->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\))/gc) {
+ # closing paren
+ push(@tokens, Varnish::Test::Token::RightParen->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\;)/gc) {
+ # semicolon
+ push(@tokens, Varnish::Test::Token::SemiColon->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\.)/gc) {
+ # period
+ push(@tokens, Varnish::Test::Token::Period->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*(\,)/gc) {
+ # comma
+ push(@tokens, Varnish::Test::Token::Comma->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*([\<\>\=\!]=)/gc) {
+ # comparison operator
+ push(@tokens, Varnish::Test::Token::Compare->new(pos($spec), $1));
+ } elsif ($spec =~ m/\G\s*([\+\-\*\/]?=)/gc) {
+ # assignment operator
+ push(@tokens, Varnish::Test::Token::Assign->new(pos($spec), $1));
+# } elsif ($spec =~ m/\G\s*([\+\-\*\/])/gc) {
+# # arithmetic operator
+# push(@tokens, Varnish::Test::Token::ArOp->new(pos($spec), $1));
+ } else {
+ die "$self->{'fn'}: syntax error\n" . substr($spec, pos($spec)) . "\n";
+ }
+ }
+
+ $self->{'tokens'} = \@tokens;
+ return @tokens;
+}
+
+sub die($$) {
+ my $self = shift;
+ my $msg = shift;
+
+ CORE::die("$self->{'fn'}: $msg\n");
+}
+
+sub warn($$) {
+ my $self = shift;
+ my $msg = shift;
+
+ CORE::warn("$self->{'fn'}: $msg\n");
+}
+
+
+# Return the next token from the input queue, but do not remove it
+# from the queue. Fatal if the queue is empty.
+sub peek($) {
+ my $self = shift;
+
+ $self->die("premature end of input")
+ unless @{$self->{'tokens'}};
+ return $self->{'tokens'}->[0];
+}
+
+# Remove the next token from the input queue and return it.
+# Additional (optional) arguments are token types which the next token
+# must match. Fatal if the queue is empty, or arguments were provided
+# but none matched.
+sub shift($;@) {
+ my $self = CORE::shift;
+ my @expect = @_;
+
+ $self->die("premature end of input")
+ unless @{$self->{'tokens'}};
+ my $token = shift @{$self->{'tokens'}};
+ if (@expect) {
+ return $token
+ if grep({ $token->is($_) } @expect);
+ $self->die("expected " . join(", ", @expect) . ", got " . $token->type);
+ }
+ return $token;
+}
+
+# As shift(), but next token must be a keyword and the arguments are
+# matched against the token's value rather than its type.
+sub shift_keyword($@) {
+ my $self = CORE::shift;
+ my @expect = @_;
+
+ my $token = $self->shift("Keyword");
+ return $token
+ if grep({ $token->value eq $_ } @expect);
+ $self->die("expected " . join(", ", @expect) . ", got " . $token->value);
+}
+
+1;
--- /dev/null
+test "Preserve HTTP protocol version in PASS mode" {
+ ticket 56;
+
+ client c1 {
+ }
+
+ server s1 {
+ data = "This is a test.";
+ }
+
+ accelerator a1 {
+ backend = s1;
+ vcl = "
+sub vcl_recv {
+ pass;
+}
+";
+ }
+
+ case c10_s10 {
+ comment = "client 1.0, server 1.0";
+ c1.protocol = "1.0";
+ s1.protocol = "1.0";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.0");
+ }
+
+ case c10_s11 {
+ comment = "client 1.0, server 1.1";
+ c1.protocol = "1.0";
+ s1.protocol = "1.1";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.0");
+ }
+
+ case c11_s10 {
+ comment = "client 1.1, server 1.0";
+ c1.protocol = "1.1";
+ s1.protocol = "1.0";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.1");
+ }
+
+ case c11_s11 {
+ comment = "client 1.1, server 1.1";
+ c1.protocol = "1.1";
+ s1.protocol = "1.1";
+ c1.request(a1, "http://www.example.com/");
+ assert(c1.response.protocol == "1.1");
+ }
+}
--- /dev/null
+#!/usr/bin/perl -Tw
+#-
+# 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$
+#
+
+use strict;
+use lib './lib';
+use Varnish::Test;
+use Data::Dumper;
+
+MAIN:{
+ my $test = Varnish::Test->new($ARGV[0]);
+ #print STDERR Dumper($test);
+}
projects / varnish / commitdiff