From 1054672e0e4429da03a6446ffac142e5bbbd6c31 Mon Sep 17 00:00:00 2001 From: Reyk Floeter Date: Thu, 16 Jul 2015 21:07:51 +0200 Subject: Add regress tests --- regress/tests/Client.pm | 75 +++++ regress/tests/Httpd.pm | 93 ++++++ regress/tests/LICENSE | 14 + regress/tests/Makefile | 105 +++++++ regress/tests/Proc.pm | 200 +++++++++++++ regress/tests/README | 20 ++ regress/tests/args-default.pl | 11 + regress/tests/args-get-1048576.pl | 15 + regress/tests/args-get-1073741824.pl | 16 + regress/tests/args-get-512.pl | 16 + regress/tests/args-get-slash.pl | 20 ++ regress/tests/args-log-user-agent.pl | 17 ++ regress/tests/args-tls-get-1073741824.pl | 18 ++ regress/tests/args-tls.pl | 18 ++ regress/tests/funcs.pl | 487 +++++++++++++++++++++++++++++++ regress/tests/httpd.pl | 73 +++++ 16 files changed, 1198 insertions(+) create mode 100644 regress/tests/Client.pm create mode 100644 regress/tests/Httpd.pm create mode 100644 regress/tests/LICENSE create mode 100644 regress/tests/Makefile create mode 100644 regress/tests/Proc.pm create mode 100644 regress/tests/README create mode 100644 regress/tests/args-default.pl create mode 100644 regress/tests/args-get-1048576.pl create mode 100644 regress/tests/args-get-1073741824.pl create mode 100644 regress/tests/args-get-512.pl create mode 100644 regress/tests/args-get-slash.pl create mode 100644 regress/tests/args-log-user-agent.pl create mode 100644 regress/tests/args-tls-get-1073741824.pl create mode 100644 regress/tests/args-tls.pl create mode 100644 regress/tests/funcs.pl create mode 100644 regress/tests/httpd.pl diff --git a/regress/tests/Client.pm b/regress/tests/Client.pm new file mode 100644 index 0000000..9c27296 --- /dev/null +++ b/regress/tests/Client.pm @@ -0,0 +1,75 @@ +# $OpenBSD: Client.pm,v 1.1 2015/07/16 16:35:57 reyk Exp $ + +# Copyright (c) 2010-2015 Alexander Bluhm +# Copyright (c) 2015 Reyk Floeter +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; + +package Client; +use parent 'Proc'; +use Carp; +use Socket; +use Socket6; +use IO::Socket; +use IO::Socket::INET6; +use IO::Socket::SSL; + +sub new { + my $class = shift; + my %args = @_; + $args{chroot} ||= "."; + $args{logfile} ||= $args{chroot}."/client.log"; + $args{up} ||= "Connected"; + $args{timefile} //= "time.log"; + my $self = Proc::new($class, %args); + $self->{connectdomain} + or croak "$class connect domain not given"; + $self->{connectaddr} + or croak "$class connect addr not given"; + $self->{connectport} + or croak "$class connect port not given"; + return $self; +} + +sub child { + my $self = shift; + + # in case we redo the connect, shutdown the old one + shutdown(\*STDOUT, SHUT_WR); + delete $self->{cs}; + + $SSL_ERROR = ""; + my $iosocket = $self->{tls} ? "IO::Socket::SSL" : "IO::Socket::INET6"; + my $cs = $iosocket->new( + Proto => "tcp", + Domain => $self->{connectdomain}, + PeerAddr => $self->{connectaddr}, + PeerPort => $self->{connectport}, + SSL_verify_mode => SSL_VERIFY_NONE, + ) or die ref($self), " $iosocket socket connect failed: $!,$SSL_ERROR"; + print STDERR "connect sock: ",$cs->sockhost()," ",$cs->sockport(),"\n"; + print STDERR "connect peer: ",$cs->peerhost()," ",$cs->peerport(),"\n"; + if ($self->{tls}) { + print STDERR "tls version: ",$cs->get_sslversion(),"\n"; + print STDERR "tls cipher: ",$cs->get_cipher(),"\n"; + print STDERR "tls peer certificate:\n", + $cs->dump_peer_certificate(); + } + + *STDIN = *STDOUT = $self->{cs} = $cs; +} + +1; diff --git a/regress/tests/Httpd.pm b/regress/tests/Httpd.pm new file mode 100644 index 0000000..d5b9df0 --- /dev/null +++ b/regress/tests/Httpd.pm @@ -0,0 +1,93 @@ +# $OpenBSD: Httpd.pm,v 1.1 2015/07/16 16:35:57 reyk Exp $ + +# Copyright (c) 2010-2015 Alexander Bluhm +# Copyright (c) 2015 Reyk Floeter +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; + +package Httpd; +use parent 'Proc'; +use Carp; +use File::Basename; + +sub new { + my $class = shift; + my %args = @_; + $args{chroot} ||= "."; + $args{logfile} ||= $args{chroot}."/httpd.log"; + $args{up} ||= $args{dryrun} || "server_launch: "; + $args{down} ||= $args{dryrun} ? "httpd.conf:" : "parent terminating"; + $args{func} = sub { Carp::confess "$class func may not be called" }; + $args{conffile} ||= "httpd.conf"; + my $self = Proc::new($class, %args); + ref($self->{http}) eq 'ARRAY' + or $self->{http} = [ split("\n", $self->{http} || "") ]; + $self->{listenaddr} + or croak "$class listen addr not given"; + $self->{listenport} + or croak "$class listen port not given"; + + my $test = basename($self->{testfile} || ""); + # tls does not allow a too long session id, so truncate it + substr($test, 25, length($test) - 25, "") if length($test) > 25; + open(my $fh, '>', $self->{conffile}) + or die ref($self), " conf file $self->{conffile} create failed: $!"; + + # substitute variables in config file + my $curdir = dirname($0) || "."; + my $connectport = $self->{connectport}; + my $connectaddr = $self->{connectaddr}; + my $listenaddr = $self->{listenaddr}; + my $listenport = $self->{listenport}; + + print $fh "prefork 1\n"; # only crashes of first child are observed + print $fh "chroot \"".$args{chroot}."\"\n"; + print $fh "logdir \"".$args{chroot}."\"\n"; + + my @http = @{$self->{http}}; + print $fh "server \"www.$test.local\" {"; + my $tls = $self->{listentls} ? "tls " : ""; + print $fh "\n\tlisten on $self->{listenaddr} ". + "${tls}port $self->{listenport}" unless grep { /^listen / } @http; + # substitute variables in config file + foreach (@http) { + s/(\$[a-z]+)/$1/eeg; + } + print $fh map { "\n\t$_" } @http; + if ($self->{listentls}) { + print $fh "\n"; + print $fh "\ttls certificate \"".$args{chroot}."/server.crt\"\n"; + print $fh "\ttls key \"".$args{chroot}."/server.key\""; + } + print $fh "\n\troot \"/\""; + print $fh "\n\tlog style combined"; + print $fh "\n}\n"; + + return $self; +} + +sub child { + my $self = shift; + my @sudo = $ENV{SUDO} ? $ENV{SUDO} : (); + my @ktrace = $ENV{KTRACE} ? ($ENV{KTRACE}, "-i") : (); + my $httpd = $ENV{HTTPD} ? $ENV{HTTPD} : "httpd"; + my @cmd = (@sudo, @ktrace, $httpd, "-dvv", "-f", $self->{conffile}); + print STDERR "execute: @cmd\n"; + exec @cmd; + die ref($self), " exec '@cmd' failed: $!"; +} + +1; diff --git a/regress/tests/LICENSE b/regress/tests/LICENSE new file mode 100644 index 0000000..8f60827 --- /dev/null +++ b/regress/tests/LICENSE @@ -0,0 +1,14 @@ +# Copyright (c) 2010-2015 Alexander Bluhm +# Copyright (c) 2014,2015 Reyk Floeter +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/regress/tests/Makefile b/regress/tests/Makefile new file mode 100644 index 0000000..5298c7c --- /dev/null +++ b/regress/tests/Makefile @@ -0,0 +1,105 @@ +# $OpenBSD: Makefile,v 1.2 2015/07/16 17:00:41 reyk Exp $ + +# The following ports must be installed for the regression tests: +# p5-IO-Socket-INET6 object interface for AF_INET and AF_INET6 domain sockets +# p5-Socket6 Perl defines relating to AF_INET6 sockets +# p5-IO-Socket-SSL perl interface to SSL sockets +# +# Check wether all required perl packages are installed. If some +# are missing print a warning and skip the tests, but do not fail. + +PERL_REQUIRE != perl -Mstrict -Mwarnings -e ' \ + eval { require IO::Socket::INET6 } or print $@; \ + eval { require Socket6 } or print $@; \ + eval { require IO::Socket::SSL } or print $@; \ +' +.if ! empty (PERL_REQUIRE) +regress: + @echo "${PERL_REQUIRE}" + @echo install these perl packages for additional tests +.endif + +# Fill out these variables if you want to test httpd with +# the httpd process running on a remote machine. You have to specify +# a local and remote ip address for the tcp connections. To control +# the remote machine you need a hostname for ssh to log in. All the +# test files must be in the same directory local and remote. + +LOCAL_ADDR ?= +REMOTE_ADDR ?= +REMOTE_SSH ?= + +# Automatically generate regress targets from test cases in directory. + +ARGS != cd ${.CURDIR} && ls args-*.pl +TARGETS ?= ${ARGS} +REGRESS_TARGETS = ${TARGETS:S/^/run-regress-/} +CLEANFILES += *.log httpd.conf ktrace.out stamp-* +CLEANFILES += *.pem *.req *.crt *.key *.srl md5-* + +HTDOCS = 512 1048576 1073741824 +HTDOCS_MD5 = ${HTDOCS:S/^/${.OBJDIR}\/md5-/} +HTDOCS_SPARSE = yes +CLEANFILES += ${HTDOCS} + +# Set variables so that make runs with and without obj directory. +# Only do that if necessary to keep visible output short. + +.if ${.CURDIR} == ${.OBJDIR} +PERLINC = +PERLPATH = +.else +PERLINC = -I${.CURDIR} +PERLPATH = ${.CURDIR}/ +.endif + +# The arg tests take a perl hash with arguments controlling the +# test parameters. Generally they consist of client, httpd, server. + +.for a in ${ARGS} +run-regress-$a: $a ${HTDOCS_MD5} + @echo '\n======== $@ ========' + time SUDO=${SUDO} KTRACE=${KTRACE} HTTPD=${HTTPD} perl ${PERLINC} ${PERLPATH}httpd.pl ${.OBJDIR} ${PERLPATH}$a +.endfor + +# htdocs + +.for d in ${HTDOCS} +${.OBJDIR}/$d: + @echo '\n======== file: $d ========' +.if (${HTDOCS_SPARSE} != "yes") + @dd if=/dev/arandom of=$@ count=$$(($d / 512)) bs=512 +.else + @dd of=$@ seek=$$(($d / 512)) bs=512 count=0 status=none +.endif + +${.OBJDIR}/md5-$d: ${.OBJDIR}/$d + @md5 -q ${.OBJDIR}/$d > $@ +.endfor + +# create certificates for TLS + +ca.crt: + openssl req -batch -new -subj /L=OpenBSD/O=httpd-regress/OU=ca/CN=root/ -nodes -newkey rsa -keyout ca.key -x509 -out ca.crt + +server.req: + openssl req -batch -new -subj /L=OpenBSD/O=httpd-regress/OU=server/CN=localhost/ -nodes -newkey rsa -keyout server.key -out server.req + +server.crt: ca.crt server.req + openssl x509 -CAcreateserial -CAkey ca.key -CA ca.crt -req -in server.req -out server.crt + +${REGRESS_TARGETS:M*tls*} ${REGRESS_TARGETS:M*https*}: server.crt + +# make perl syntax check for all args files + +.PHONY: syntax + +syntax: stamp-syntax + +stamp-syntax: ${ARGS} +.for a in ${ARGS} + @perl -c ${PERLPATH}$a +.endfor + @date >$@ + +.include diff --git a/regress/tests/Proc.pm b/regress/tests/Proc.pm new file mode 100644 index 0000000..8f46012 --- /dev/null +++ b/regress/tests/Proc.pm @@ -0,0 +1,200 @@ +# $OpenBSD: Proc.pm,v 1.1 2015/07/16 16:35:57 reyk Exp $ + +# Copyright (c) 2010-2014 Alexander Bluhm +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; + +package Proc; +use Carp; +use Errno; +use File::Basename; +use IO::File; +use POSIX; +use Time::HiRes qw(time alarm sleep); + +my %CHILDREN; + +sub kill_children { + my @pids = @_ ? @_ : keys %CHILDREN + or return; + my @perms; + foreach my $pid (@pids) { + if (kill(TERM => $pid) != 1 and $!{EPERM}) { + push @perms, $pid; + } + } + if (my $sudo = $ENV{SUDO} and @perms) { + local $?; # do not modify during END block + my @cmd = ($sudo, '/bin/kill', '-TERM', @perms); + system(@cmd); + } + delete @CHILDREN{@pids}; +} + +BEGIN { + $SIG{TERM} = $SIG{INT} = sub { + my $sig = shift; + kill_children(); + $SIG{TERM} = $SIG{INT} = 'DEFAULT'; + POSIX::raise($sig); + }; +} + +END { + kill_children(); + $SIG{TERM} = $SIG{INT} = 'DEFAULT'; +} + +sub new { + my $class = shift; + my $self = { @_ }; + $self->{down} ||= "Shutdown"; + $self->{func} && ref($self->{func}) eq 'CODE' + or croak "$class func not given"; + $self->{logfile} + or croak "$class log file not given"; + open(my $fh, '>', $self->{logfile}) + or die "$class log file $self->{logfile} create failed: $!"; + $fh->autoflush; + $self->{log} = $fh; + return bless $self, $class; +} + +sub run { + my $self = shift; + + pipe(my $reader, my $writer) + or die ref($self), " pipe to child failed: $!"; + defined(my $pid = fork()) + or die ref($self), " fork child failed: $!"; + if ($pid) { + $CHILDREN{$pid} = 1; + $self->{pid} = $pid; + close($reader); + $self->{pipe} = $writer; + return $self; + } + %CHILDREN = (); + $SIG{TERM} = $SIG{INT} = 'DEFAULT'; + $SIG{__DIE__} = sub { + die @_ if $^S; + warn @_; + IO::Handle::flush(\*STDERR); + POSIX::_exit(255); + }; + open(STDERR, '>&', $self->{log}) + or die ref($self), " dup STDERR failed: $!"; + close($writer); + open(STDIN, '<&', $reader) + or die ref($self), " dup STDIN failed: $!"; + close($reader); + + do { + $self->child(); + print STDERR $self->{up}, "\n"; + $self->{begin} = time(); + $self->{func}->($self); + } while ($self->{redo}); + $self->{end} = time(); + print STDERR "Shutdown", "\n"; + if ($self->{timefile}) { + open(my $fh, '>>', $self->{timefile}) + or die ref($self), " open $self->{timefile} failed: $!"; + printf $fh "time='%s' duration='%.10g' ". + "test='%s'\n", + scalar(localtime(time())), $self->{end} - $self->{begin}, + basename($self->{testfile}); + } + + IO::Handle::flush(\*STDOUT); + IO::Handle::flush(\*STDERR); + POSIX::_exit(0); +} + +sub wait { + my $self = shift; + my $flags = shift; + + my $pid = $self->{pid} + or croak ref($self), " no child pid"; + my $kid = waitpid($pid, $flags); + if ($kid > 0) { + my $status = $?; + my $code; + $code = "exit: ". WEXITSTATUS($?) if WIFEXITED($?); + $code = "signal: ". WTERMSIG($?) if WIFSIGNALED($?); + $code = "stop: ". WSTOPSIG($?) if WIFSTOPPED($?); + delete $CHILDREN{$pid} if WIFEXITED($?) || WIFSIGNALED($?); + return wantarray ? ($kid, $status, $code) : $kid; + } + return $kid; +} + +sub loggrep { + my $self = shift; + my($regex, $timeout) = @_; + + my $end = time() + $timeout if $timeout; + + do { + my($kid, $status, $code) = $self->wait(WNOHANG); + if ($kid > 0 && $status != 0 && !$self->{dryrun}) { + # child terminated with failure + die ref($self), " child status: $status $code"; + } + open(my $fh, '<', $self->{logfile}) + or die ref($self), " log file open failed: $!"; + my @match = grep { /$regex/ } <$fh>; + return wantarray ? @match : $match[0] if @match; + close($fh); + # pattern not found + if ($kid == 0) { + # child still running, wait for log data + sleep .1; + } else { + # child terminated, no new log data possible + return; + } + } while ($timeout and time() < $end); + + return; +} + +sub up { + my $self = shift; + my $timeout = shift || 10; + $self->loggrep(qr/$self->{up}/, $timeout) + or croak ref($self), " no '$self->{up}' in $self->{logfile} ". + "after $timeout seconds"; + return $self; +} + +sub down { + my $self = shift; + my $timeout = shift || 300; + $self->loggrep(qr/$self->{down}/, $timeout) + or croak ref($self), " no '$self->{down}' in $self->{logfile} ". + "after $timeout seconds"; + return $self; +} + +sub kill_child { + my $self = shift; + kill_children($self->{pid}); + return $self; +} + +1; diff --git a/regress/tests/README b/regress/tests/README new file mode 100644 index 0000000..c9c7836 --- /dev/null +++ b/regress/tests/README @@ -0,0 +1,20 @@ +Run httpd regressions tests. The framework runs a client and a httpd. +Each test creates a special httpd.conf and starts those two processes. +All processes write log files that are checked for certain messages. +The test arguments are kept in the args-*.pl files. + +SUDO=sudo +As httpd needs root privileges either run the tests as root or set +this variable and run make as a regular user. Only the code that +requires it, is run as root. + +KTRACE=ktrace +Set this variable if you want a ktrace output from httpd. Note that +ktrace is invoked after sudo as sudo would disable it. + +HTTPD=/usr/src/usr.sbin/httpd/obj/httpd +Start an alternative httpd program that is not in the path. + +HTDOCS_SPARSE=no +Set to anything other than "yes" to create real test files instead of +sparse files. This needs more than 1G of free disk space. diff --git a/regress/tests/args-default.pl b/regress/tests/args-default.pl new file mode 100644 index 0000000..3820fdd --- /dev/null +++ b/regress/tests/args-default.pl @@ -0,0 +1,11 @@ +# test default values + +use strict; +use warnings; + +our %args = ( + len => 512, + md5 => path_md5("512") +); + +1; diff --git a/regress/tests/args-get-1048576.pl b/regress/tests/args-get-1048576.pl new file mode 100644 index 0000000..9253aec --- /dev/null +++ b/regress/tests/args-get-1048576.pl @@ -0,0 +1,15 @@ +use strict; +use warnings; + +my $len = 1048576; +our %args = ( + client => { + path => "$len", + len => $len, + http_vers => [ "1.0" ], + }, + len => 1048576, + md5 => path_md5("$len") +); + +1; diff --git a/regress/tests/args-get-1073741824.pl b/regress/tests/args-get-1073741824.pl new file mode 100644 index 0000000..2b4c5f4 --- /dev/null +++ b/regress/tests/args-get-1073741824.pl @@ -0,0 +1,16 @@ +use strict; +use warnings; + +my $len = 1073741824; +my @lengths = ($len, $len); +our %args = ( + client => { + path => "$len", + http_vers => [ "1.0" ], + lengths => \@lengths, + }, + md5 => path_md5("$len"), + lengths => \@lengths, +); + +1; diff --git a/regress/tests/args-get-512.pl b/regress/tests/args-get-512.pl new file mode 100644 index 0000000..20e92c4 --- /dev/null +++ b/regress/tests/args-get-512.pl @@ -0,0 +1,16 @@ +use strict; +use warnings; + +my $len = 512; +my @lengths = ($len, $len, $len); +our %args = ( + client => { + path => "$len", + http_vers => [ "1.0" ], + lengths => \@lengths, + }, + md5 => path_md5("$len"), + lengths => \@lengths, +); + +1; diff --git a/regress/tests/args-get-slash.pl b/regress/tests/args-get-slash.pl new file mode 100644 index 0000000..9406f4b --- /dev/null +++ b/regress/tests/args-get-slash.pl @@ -0,0 +1,20 @@ +use strict; +use warnings; + +our %args = ( + client => { + func => sub { + my $self = shift; + print "GET /\r\n\r\n"; + }, + nocheck => 1 + }, + httpd => { + loggrep => { + qr/"GET \/" 500 0/ => 1, + }, + }, +); + +1; + diff --git a/regress/tests/args-log-user-agent.pl b/regress/tests/args-log-user-agent.pl new file mode 100644 index 0000000..a8dec17 --- /dev/null +++ b/regress/tests/args-log-user-agent.pl @@ -0,0 +1,17 @@ +use strict; +use warnings; + +our %args = ( + client => { + header => { + "User-Agent" => "regress\t\n\nGET / HTTP/1.0\r\n" + } + }, + httpd => { + loggrep => { + qr/\"regress\\t\\n\\nGET \/ HTTP\/1\.0\"/ => 1, + }, + }, +); + +1; diff --git a/regress/tests/args-tls-get-1073741824.pl b/regress/tests/args-tls-get-1073741824.pl new file mode 100644 index 0000000..12af833 --- /dev/null +++ b/regress/tests/args-tls-get-1073741824.pl @@ -0,0 +1,18 @@ +use strict; +use warnings; + +my $len = 1073741824; +our %args = ( + client => { + tls => 1, + path => "$len", + len => $len, + }, + httpd => { + listentls => 1, + }, + len => $len, + md5 => path_md5("$len"), +); + +1; diff --git a/regress/tests/args-tls.pl b/regress/tests/args-tls.pl new file mode 100644 index 0000000..29321a2 --- /dev/null +++ b/regress/tests/args-tls.pl @@ -0,0 +1,18 @@ +# test https connection + +use strict; +use warnings; + +our %args = ( + client => { + tls => 1, + loggrep => 'Issuer.*/OU=ca/', + }, + httpd => { + listentls => 1, + }, + len => 512, + md5 => path_md5("512") +); + +1; diff --git a/regress/tests/funcs.pl b/regress/tests/funcs.pl new file mode 100644 index 0000000..2738d41 --- /dev/null +++ b/regress/tests/funcs.pl @@ -0,0 +1,487 @@ +# $OpenBSD: funcs.pl,v 1.4 2015/07/16 18:50:09 reyk Exp $ + +# Copyright (c) 2010-2015 Alexander Bluhm +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; +no warnings 'experimental::smartmatch'; +use feature 'switch'; +use Errno; +use Digest::MD5; +use Socket; +use Socket6; +use IO::Socket; +use IO::Socket::INET6; + +sub find_ports { + my %args = @_; + my $num = delete $args{num} // 1; + my $domain = delete $args{domain} // AF_INET; + my $addr = delete $args{addr} // "127.0.0.1"; + + my @sockets = (1..$num); + foreach my $s (@sockets) { + $s = IO::Socket::INET6->new( + Proto => "tcp", + Domain => $domain, + $addr ? (LocalAddr => $addr) : (), + ) or die "find_ports: create and bind socket failed: $!"; + } + my @ports = map { $_->sockport() } @sockets; + + return @ports; +} + +sub path_md5 { + my $name = shift; + my $val = `cat md5-$name`; +} + +######################################################################## +# Client funcs +######################################################################## + +sub write_char { + my $self = shift; + my $len = shift // $self->{len} // 512; + my $sleep = $self->{sleep}; + + my $ctx = Digest::MD5->new(); + my $char = '0'; + for (my $i = 1; $i < $len; $i++) { + $ctx->add($char); + print $char + or die ref($self), " print failed: $!"; + given ($char) { + when(/9/) { $char = 'A' } + when(/Z/) { $char = 'a' } + when(/z/) { $char = "\n" } + when(/\n/) { print STDERR "."; $char = '0' } + default { $char++ } + } + if ($self->{sleep}) { + IO::Handle::flush(\*STDOUT); + sleep $self->{sleep}; + } + } + if ($len) { + $char = "\n"; + $ctx->add($char); + print $char + or die ref($self), " print failed: $!"; + print STDERR ".\n"; + } + IO::Handle::flush(\*STDOUT); + + print STDERR "LEN: ", $len, "\n"; + print STDERR "MD5: ", $ctx->hexdigest, "\n"; +} + +sub http_client { + my $self = shift; + + unless ($self->{lengths}) { + # only a single http request + my $len = shift // $self->{len} // 512; + my $cookie = $self->{cookie}; + http_request($self, $len, "1.0", $cookie); + http_response($self, $len); + return; + } + + $self->{http_vers} ||= ["1.1", "1.0"]; + my $vers = $self->{http_vers}[0]; + my @lengths = @{$self->{redo}{lengths} || $self->{lengths}}; + my @cookies = @{$self->{redo}{cookies} || $self->{cookies} || []}; + while (defined (my $len = shift @lengths)) { + my $cookie = shift @cookies || $self->{cookie}; + eval { + http_request($self, $len, $vers, $cookie); + http_response($self, $len); + }; + warn $@ if $@; + if (@lengths && ($@ || $vers eq "1.0")) { + # reconnect and redo the outstanding requests + $self->{redo} = { + lengths => \@lengths, + cookies => \@cookies, + }; + return; + } + } + delete $self->{redo}; + shift @{$self->{http_vers}}; + if (@{$self->{http_vers}}) { + # run the tests again with other persistence + $self->{redo} = { + lengths => [@{$self->{lengths}}], + cookies => [@{$self->{cookies} || []}], + }; + } +} + +sub http_request { + my ($self, $len, $vers, $cookie) = @_; + my $method = $self->{method} || "GET"; + my %header = %{$self->{header} || {}}; + + # encode the requested length or chunks into the url + my $path = ref($len) eq 'ARRAY' ? join("/", @$len) : $len; + # overwrite path with custom path + if (defined($self->{path})) { + $path = $self->{path}; + } + my @request = ("$method /$path HTTP/$vers"); + push @request, "Host: foo.bar" unless defined $header{Host}; + if ($vers eq "1.1" && $method eq "PUT") { + if (ref($len) eq 'ARRAY') { + push @request, "Transfer-Encoding: chunked" + if !defined $header{'Transfer-Encoding'}; + } else { + push @request, "Content-Length: $len" + if !defined $header{'Content-Length'}; + } + } + foreach my $key (sort keys %header) { + my $val = $header{$key}; + if (ref($val) eq 'ARRAY') { + push @request, "$key: $_" + foreach @{$val}; + } else { + push @request, "$key: $val"; + } + } + push @request, "Cookie: $cookie" if $cookie; + push @request, ""; + print STDERR map { ">>> $_\n" } @request; + print map { "$_\r\n" } @request; + if ($method eq "PUT") { + if (ref($len) eq 'ARRAY') { + if ($vers eq "1.1") { + write_chunked($self, @$len); + } else { + write_char($self, $_) foreach (@$len); + } + } else { + write_char($self, $len); + } + } + IO::Handle::flush(\*STDOUT); + # XXX client shutdown seems to be broken in httpd + #shutdown(\*STDOUT, SHUT_WR) + # or die ref($self), " shutdown write failed: $!" + # if $vers ne "1.1"; +} + +sub http_response { + my ($self, $len) = @_; + my $method = $self->{method} || "GET"; + + my $vers; + my $chunked = 0; + { + local $/ = "\r\n"; + local $_ = ; + defined + or die ref($self), " missing http $len response"; + chomp; + print STDERR "<<< $_\n"; + m{^HTTP/(\d\.\d) 200 OK$} + or die ref($self), " http response not ok" + unless $self->{httpnok}; + $vers = $1; + while () { + chomp; + print STDERR "<<< $_\n"; + last if /^$/; + if (/^Content-Length: (.*)/) { + if ($self->{httpnok}) { + $len = $1; + } else { + $1 == $len or die ref($self), + " bad content length $1"; + } + } + if (/^Transfer-Encoding: chunked$/) { + $chunked = 1; + } + } + } + if ($chunked) { + read_chunked($self); + } else { + #$len = $vers eq "1.1" ? $len : undef; + read_char($self, $len) + if $method eq "GET"; + } +} + +sub read_chunked { + my $self = shift; + + for (;;) { + my $len; + { + local $/ = "\r\n"; + local $_ = ; + defined or die ref($self), " missing chunk size"; + chomp; + print STDERR "<<< $_\n"; + /^[[:xdigit:]]+$/ + or die ref($self), " chunk size not hex: $_"; + $len = hex; + } + last unless $len > 0; + read_char($self, $len); + { + local $/ = "\r\n"; + local $_ = ; + defined or die ref($self), " missing chunk data end"; + chomp; + print STDERR "<<< $_\n"; + /^$/ or die ref($self), " no chunk data end: $_"; + } + } + { + local $/ = "\r\n"; + while () { + chomp; + print STDERR "<<< $_\n"; + last if /^$/; + } + defined or die ref($self), " missing chunk trailer"; + } +} + +sub errignore { + $SIG{PIPE} = 'IGNORE'; + $SIG{__DIE__} = sub { + die @_ if $^S; + warn "Error ignored"; + warn @_; + IO::Handle::flush(\*STDERR); + POSIX::_exit(0); + }; +} + +######################################################################## +# Server funcs +######################################################################## + +sub read_char { + my $self = shift; + my $max = shift // $self->{max}; + + my $ctx = Digest::MD5->new(); + my $len = 0; + if (defined($max) && $max == 0) { + print STDERR "Max\n"; + } else { + while ((my $r = sysread(STDIN, my $buf, POSIX::BUFSIZ))) { + my $pct; + $_ = $buf; + $len += $r; + $ctx->add($_); + $pct = ($len / $max) * 100.0; + printf(STDERR "%.2f%%\n", $pct); + if (defined($max) && $len >= $max) { + print STDERR "\nMax"; + last; + } + } + print STDERR "\n"; + } + + print STDERR "LEN: ", $len, "\n"; + print STDERR "MD5: ", $ctx->hexdigest, "\n"; +} + +sub http_server { + my $self = shift; + my %header = %{$self->{header} || { Server => "Perl/".$^V }}; + my $cookie = $self->{cookie} || ""; + + my($method, $url, $vers); + do { + my $len; + { + local $/ = "\r\n"; + local $_ = ; + return unless defined $_; + chomp; + print STDERR "<<< $_\n"; + ($method, $url, $vers) = m{^(\w+) (.*) HTTP/(1\.[01])$} + or die ref($self), " http request not ok"; + $method =~ /^(GET|PUT)$/ + or die ref($self), " unknown method: $method"; + ($len, my @chunks) = $url =~ /(\d+)/g; + $len = [ $len, @chunks ] if @chunks; + while () { + chomp; + print STDERR "<<< $_\n"; + last if /^$/; + if ($method eq "PUT" && + /^Content-Length: (.*)/) { + $1 == $len or die ref($self), + " bad content length $1"; + } + $cookie ||= $1 if /^Cookie: (.*)/; + } + } + if ($method eq "PUT" ) { + if (ref($len) eq 'ARRAY') { + read_chunked($self); + } else { + read_char($self, $len); + } + } + + my @response = ("HTTP/$vers 200 OK"); + $len = defined($len) ? $len : scalar(split /|/,$url); + if ($vers eq "1.1" && $method eq "GET") { + if (ref($len) eq 'ARRAY') { + push @response, "Transfer-Encoding: chunked"; + } else { + push @response, "Content-Length: $len"; + } + } + foreach my $key (sort keys %header) { + my $val = $header{$key}; + if (ref($val) eq 'ARRAY') { + push @response, "$key: $_" + foreach @{$val}; + } else { + push @response, "$key: $val"; + } + } + push @response, "Set-Cookie: $cookie" if $cookie; + push @response, ""; + + print STDERR map { ">>> $_\n" } @response; + print map { "$_\r\n" } @response; + + if ($method eq "GET") { + if (ref($len) eq 'ARRAY') { + if ($vers eq "1.1") { + write_chunked($self, @$len); + } else { + write_char($self, $_) foreach (@$len); + } + } else { + write_char($self, $len); + } + } + IO::Handle::flush(\*STDOUT); + } while ($vers eq "1.1"); + $self->{redo}-- if $self->{redo}; +} + +sub write_chunked { + my $self = shift; + my @chunks = @_; + + foreach my $len (@chunks) { + printf STDERR ">>> %x\n", $len; + printf "%x\r\n", $len; + write_char($self, $len); + printf STDERR ">>> \n"; + print "\r\n"; + } + my @trailer = ("0", "X-Chunk-Trailer: @chunks", ""); + print STDERR map { ">>> $_\n" } @trailer; + print map { "$_\r\n" } @trailer; +} + +######################################################################## +# Script funcs +######################################################################## + +sub check_logs { + my ($c, $r, %args) = @_; + + return if $args{nocheck}; + + check_len($c, $r, %args); + check_md5($c, $r, %args); + check_loggrep($c, $r, %args); + $r->loggrep("lost child") + and die "httpd lost child"; +} + +sub check_len { + my ($c, $r, %args) = @_; + + $args{len} ||= 512 unless $args{lengths}; + + my @clen = $c->loggrep(qr/^LEN: /) or die "no client len" + unless $args{client}{nocheck}; +# !@clen +# or die "client: @clen", "len mismatch"; + !defined($args{len}) || !$clen[0] || $clen[0] eq "LEN: $args{len}\n" + or die "client: $clen[0]", "len $args{len} expected"; + my @lengths = map { ref eq 'ARRAY' ? @$_ : $_ } + @{$args{lengths} || []}; + foreach my $len (@lengths) { + unless ($args{client}{nocheck}) { + my $clen = shift @clen; + $clen eq "LEN: $len\n" + or die "client: $clen", "len $len expected"; + } + } +} + +sub check_md5 { + my ($c, $r, %args) = @_; + + my @cmd5 = $c->loggrep(qr/^MD5: /) unless $args{client}{nocheck}; + my @md5 = ref($args{md5}) eq 'ARRAY' ? @{$args{md5}} : $args{md5} || () + or return; + foreach my $md5 (@md5) { + unless ($args{client}{nocheck}) { + my $cmd5 = shift @cmd5 + or die "too few md5 in client log"; + $cmd5 =~ /^MD5: ($md5)$/ + or die "client: $cmd5", "md5 $md5 expected"; + } + } + @cmd5 && ref($args{md5}) eq 'ARRAY' + and die "too many md5 in client log"; +} + +sub check_loggrep { + my ($c, $r, %args) = @_; + + my %name2proc = (client => $c, httpd => $r); + foreach my $name (qw(client httpd)) { + my $p = $name2proc{$name} or next; + my $pattern = $args{$name}{loggrep} or next; + $pattern = [ $pattern ] unless ref($pattern) eq 'ARRAY'; + foreach my $pat (@$pattern) { + if (ref($pat) eq 'HASH') { + while (my($re, $num) = each %$pat) { + my @matches = $p->loggrep($re); + @matches == $num + or die "$name matches '@matches': ", + "'$re' => $num"; + } + } else { + $p->loggrep($pat) + or die "$name log missing pattern: '$pat'"; + } + } + } +} + +1; diff --git a/regress/tests/httpd.pl b/regress/tests/httpd.pl new file mode 100644 index 0000000..481a587 --- /dev/null +++ b/regress/tests/httpd.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl +# $OpenBSD: httpd.pl,v 1.1 2015/07/16 16:35:57 reyk Exp $ + +# Copyright (c) 2010-2015 Alexander Bluhm +# Copyright (c) 2015 Reyk Floeter +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; +use Socket; +use Socket6; + +use Client; +use Httpd; +require 'funcs.pl'; + +sub usage { + die "usage: httpd.pl chroot [test-args.pl]\n"; +} + +my $testfile; +our %args; +if (@ARGV and -f $ARGV[-1]) { + $testfile = pop; + do $testfile + or die "Do test file $testfile failed: ", $@ || $!; +} +@ARGV == 1 or usage(); + +my $redo = $args{lengths} && @{$args{lengths}}; +$redo = 0 if $args{client}{http_vers}; # run only one persistent connection +my($sport, $rport) = find_ports(num => 2); +my $d = Httpd->new( + chroot => $ARGV[0], + listendomain => AF_INET, + listenaddr => "127.0.0.1", + listenport => $rport, + connectdomain => AF_INET, + connectaddr => "127.0.0.1", + connectport => $sport, + %{$args{httpd}}, + testfile => $testfile, +); +my $c = Client->new( + chroot => $ARGV[0], + func => \&http_client, + connectdomain => AF_INET, + connectaddr => "127.0.0.1", + connectport => $rport, + %{$args{client}}, + testfile => $testfile, +) unless $args{client}{noclient}; + +$d->run; +$d->up; +$c->run->up unless $args{client}{noclient}; + +$c->down unless $args{client}{noclient}; +$d->kill_child; +$d->down; + +check_logs($c, $d, %args); -- cgit v1.2.3-54-g00ecf