From 4ad743db989fbd62e541c15ab3e65c6ac8d7715d Mon Sep 17 00:00:00 2001 From: mtortonesi Date: Tue, 24 Jan 2006 04:15:58 -0800 Subject: [PATCH] [svn] Major improvement of testing suite. --- tests/ChangeLog | 18 +++++ tests/HTTPServer.pm | 61 +++++++++-------- tests/HTTPTest.pm | 75 +++------------------ tests/Test.pm | 156 +++++++++++++++++++++++++++++++++++++++++++- tests/Test1.px | 7 +- tests/Test2.px | 7 +- tests/Test3.px | 43 ++++++++++++ tests/Test4.px | 43 ++++++++++++ 8 files changed, 311 insertions(+), 99 deletions(-) create mode 100755 tests/Test3.px create mode 100755 tests/Test4.px diff --git a/tests/ChangeLog b/tests/ChangeLog index e1d7dd66..02d64010 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,21 @@ +2006-01-24 Mauro Tortonesi + + * HTTPServer.pm: Enhanced logging support. + + * HTTPTest.pm: Updated to new test format. + + * Test.pm: Improved test setup, verification and cleanup. Major + refactoring. + + * Test1.px: Updated to new test format. + + * Test2.px: Updated to new test format. + + * Test3.px: Added new test for quiet download of nonexistent URL. + + * Test4.px: Added new test for quiet download of nonexistent URL with + --output-document option. + 2005-12-05 Mauro Tortonesi * HTTPServer.pm: Refactored as a subclass of HTTP::Daemon. diff --git a/tests/HTTPServer.pm b/tests/HTTPServer.pm index 072cd39e..19375eff 100755 --- a/tests/HTTPServer.pm +++ b/tests/HTTPServer.pm @@ -10,51 +10,60 @@ use HTTP::Headers; use HTTP::Response; our @ISA=qw(HTTP::Daemon); +my $VERSION = 0.01; my $CRLF = "\015\012"; # "\r\n" is not portable +my $log = undef; sub run { my ($self, $urls) = @_; while (my $con = $self->accept) { while (my $req = $con->get_request) { - # print STDERR "method: ", $req->method, "\n"; + print STDERR "Method: ", $req->method, "\n" if $log; + print STDERR "Path: ", $req->url->path, "\n" if $log; + foreach my $key (keys %{HTTPServer::urls}) { + print STDERR $key, '\n'; + } if (exists($urls->{$req->url->path})) { + print STDERR "Serving requested URL: ", $req->url->path, "\n" if $log; next unless ($req->method eq "HEAD" || $req->method eq "GET"); - # print STDERR "requested URL: ", $req->url->path, "\n"; - + # create response my $tmp = $urls->{$req->url->path}; my $resp = HTTP::Response->new ($tmp->{code}, $tmp->{msg}); - # print STDERR "HTTP::Response: \n", $resp->as_string; + print STDERR "HTTP::Response: \n", $resp->as_string if $log; - # fill in headers - while (my ($name, $value) = each %{$tmp->{headers}}) { - # print STDERR "setting header: $name = $value\n"; - $resp->header($name => $value); - } - # print STDERR "HTTP::Response with headers: \n", $resp->as_string; - - if ($req->method eq "GET") { - if (exists($tmp->{headers}{"Content-Length"})) { - # Content-Length and length($tmp->{content}) don't match - # manually prepare the HTTP response - $con->send_basic_header($tmp->{code}, $resp->message, $resp->protocol); - print $con $resp->headers_as_string($CRLF); - print $con $CRLF; - print $con $tmp->{content}; - next; + #if (is_dynamic_url) { # dynamic resource + #} else { # static resource + # fill in headers + while (my ($name, $value) = each %{$tmp->{headers}}) { + # print STDERR "setting header: $name = $value\n"; + $resp->header($name => $value); + } + print STDERR "HTTP::Response with headers: \n", $resp->as_string if $log; + + if ($req->method eq "GET") { + if (exists($tmp->{headers}{"Content-Length"})) { + # Content-Length and length($tmp->{content}) don't match + # manually prepare the HTTP response + $con->send_basic_header($tmp->{code}, $resp->message, $resp->protocol); + print $con $resp->headers_as_string($CRLF); + print $con $CRLF; + print $con $tmp->{content}; + next; + } + # fill in content + $resp->content($tmp->{content}); + print STDERR "HTTP::Response with content: \n", $resp->as_string if $log; } - # fill in content - $resp->content($tmp->{content}); - # print STDERR "HTTP::Response with content: \n", $resp->as_string; - } + #} $con->send_response($resp); - # print STDERR "HTTP::Response sent: \n", $resp->as_string; + print STDERR "HTTP::Response sent: \n", $resp->as_string if $log; } else { - # print STDERR "requested wrong URL: ", $req->url->path, "\n"; + print STDERR "Requested wrong URL: ", $req->url->path, "\n" if $log; $con->send_error($HTTP::Status::RC_FORBIDDEN); } } diff --git a/tests/HTTPTest.pm b/tests/HTTPTest.pm index f1748659..20e9442f 100755 --- a/tests/HTTPTest.pm +++ b/tests/HTTPTest.pm @@ -1,22 +1,18 @@ #!/usr/bin/perl -w -use Test; - package HTTPTest; -our @ISA = qw(Test); -$VERSION = 0.01; use strict; use HTTPServer; +use Test; + +our @ISA = qw(Test); +my $VERSION = 0.01; { my %_attr_data = ( # DEFAULT - _urls => {}, - _cmdline => "", - _errcode => 0, - _downloads => {}, ); sub _default_for @@ -34,67 +30,16 @@ use HTTPServer; } -sub run { - my $self = shift; - - my $pid = fork(); - - if($pid == 0) { - my $server = HTTPServer->new (LocalAddr => 'localhost', - LocalPort => '8080', - ReuseAddr => 1) or die "Cannot create server!!!"; - $server->run ($self->{_urls}); - } - - # print "Spawned HTTP server with pid: $pid\n"; - - # print "Calling $self->{_cmdline}\n"; - my $errcode = system ($self->{_cmdline}); +sub _setup_server {} - kill ('TERM', $pid); - # print "Killed HTTP server\n"; - - $errcode == $self->{_errcode} - or die "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})"; - - if (my $error_str = $self->_verify_download()) { - die $error_str; - } - - print "Test successful.\n" -} - - -sub _verify_download { +sub _launch_server { my $self = shift; - # use slurp mode to read file content - my $old_input_record_separator = $/; - undef $/; - - while (my ($filename, $filedata) = each %{$self->{_downloads}}) { - open (FILE, $filename) - or return "Test failed: file $filename not downloaded"; - - my $content = ; - $content eq $filedata->{'content'} - or return "Test failed: wrong content for file $filename"; - - if (exists($filedata->{'timestamp'})) { - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) = stat FILE; - - $mtime == $filedata->{'timestamp'} - or return "Test failed: wrong timestamp for file $filename"; - } - - close (FILE); - } - - $/ = $old_input_record_separator; - - return ""; + my $server = HTTPServer->new (LocalAddr => 'localhost', + LocalPort => '8080', + ReuseAddr => 1) or die "Cannot create server!!!"; + $server->run ($self->{_input}); } 1; diff --git a/tests/Test.pm b/tests/Test.pm index a84f8624..930c54e9 100755 --- a/tests/Test.pm +++ b/tests/Test.pm @@ -5,9 +5,19 @@ $VERSION = 0.01; use strict; +use Cwd; +use File::Path; + +my @unexpected_downloads = (); { my %_attr_data = ( # DEFAULT + _cmdline => "", + _cwd => Cwd::getcwd(), + _errcode => 0, + _input => {}, + _name => "", + _output => {}, ); sub _default_for @@ -22,27 +32,169 @@ use strict; } } + sub new { my ($caller, %args) = @_; my $caller_is_obj = ref($caller); my $class = $caller_is_obj || $caller; + #print STDERR "class = ", $class, "\n"; + #print STDERR "_attr_data {cwd} = ", $Test::_attr_data{_cwd}, "\n"; my $self = bless {}, $class; foreach my $attrname ($self->_standard_keys()) { + #print STDERR "attrname = ", $attrname, " value = "; my ($argname) = ($attrname =~ /^_(.*)/); if (exists $args{$argname}) { #printf STDERR "Setting up $attrname\n"; $self->{$attrname} = $args{$argname}; } elsif ($caller_is_obj) { #printf STDERR "Copying $attrname\n"; - $self->{$attrname} = $caller->{$argname}; + $self->{$attrname} = $caller->{$attrname}; } else { #printf STDERR "Using default for $attrname\n"; - $self->{$attrname} = $self->_default_for($argname); + $self->{$attrname} = $self->_default_for($attrname); } + #print STDERR $attrname, '=', $self->{$attrname}, "\n"; } + #printf STDERR "_cwd default = ", $self->_default_for("_cwd"); return $self; } + +sub run { + my $self = shift; + my $result_message = "Test successful.\n"; + + printf "Running test $self->{_name}\n"; + + # Setup + $self->_setup(); + chdir ("$self->{_cwd}/$self->{_name}/input"); + + # Launch server + my $pid = fork(); + if($pid == 0) { + $self->_launch_server(); + } + # print STDERR "Spawned server with pid: $pid\n"; + + # Call wget + chdir ("$self->{_cwd}/$self->{_name}/output"); + # print "Calling $self->{_cmdline}\n"; + my $errcode = system ("$self->{_cwd}/../src/$self->{_cmdline}"); + + # Shutdown server + kill ('TERM', $pid); + # print "Killed server\n"; + + # Verify download + unless ($errcode == $self->{_errcode}) { + $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n"; + } + if (my $error_str = $self->_verify_download()) { + $result_message = $error_str; + } + + # Cleanup + $self->_cleanup(); + + print $result_message; +} + + +sub _setup { + my $self = shift; + + #print $self->{_name}, "\n"; + chdir ($self->{_cwd}); + + # Create temporary directory + mkdir ($self->{_name}); + chdir ($self->{_name}); + mkdir ("input"); + mkdir ("output"); + chdir ("input"); + + $self->_setup_server(); + + chdir ($self->{_cwd}); +} + + +sub _cleanup { + my $self = shift; + + chdir ($self->{_cwd}); + File::Path::rmtree ($self->{_name}); +} + + +sub _verify_download { + my $self = shift; + + chdir ("$self->{_cwd}/$self->{_name}/output"); + + # use slurp mode to read file content + my $old_input_record_separator = $/; + undef $/; + + while (my ($filename, $filedata) = each %{$self->{_output}}) { + open (FILE, $filename) + or return "Test failed: file $filename not downloaded\n"; + + my $content = ; + $content eq $filedata->{'content'} + or return "Test failed: wrong content for file $filename\n"; + + if (exists($filedata->{'timestamp'})) { + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, + $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE; + + $mtime == $filedata->{'timestamp'} + or return "Test failed: wrong timestamp for file $filename\n"; + } + + close (FILE); + } + + $/ = $old_input_record_separator; + + # make sure no unexpected files were downloaded + chdir ("$self->{_cwd}/$self->{_name}/output"); + + __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } ); + if (@unexpected_downloads) { + return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n"; + } + + return ""; +} + + +sub __dir_walk { + my ($top, $filefunc, $dirfunc) = @_; + + my $DIR; + + if (-d $top) { + my $file; + unless (opendir $DIR, $top) { + warn "Couldn't open directory $DIR: $!; skipping.\n"; + return; + } + + my @results; + while ($file = readdir $DIR) { + next if $file eq '.' || $file eq '..'; + my $nextdir = $top eq '.' ? $file : "$top/$file"; + push @results, __dir_walk($nextdir, $filefunc, $dirfunc); + } + + return $dirfunc ? $dirfunc->($top, @results) : () ; + } else { + return $filefunc ? $filefunc->($top) : () ; + } +} + 1; # vim: et ts=4 sw=4 diff --git a/tests/Test1.px b/tests/Test1.px index c60454a0..40cdef55 100755 --- a/tests/Test1.px +++ b/tests/Test1.px @@ -23,7 +23,7 @@ my %urls = ( }, ); -my $cmdline = "../src/wget -vd http://localhost:8080/dummy.html"; +my $cmdline = "../src/wget http://localhost:8080/dummy.html"; my $expected_error_code = 0; @@ -35,10 +35,11 @@ my %expected_downloaded_files = ( ############################################################################### -my $the_test = HTTPTest->new (urls => \%urls, +my $the_test = HTTPTest->new (name => "Test1", + input => \%urls, cmdline => $cmdline, errcode => $expected_error_code, - downloads => \%expected_downloaded_files); + output => \%expected_downloaded_files); $the_test->run(); # vim: et ts=4 sw=4 diff --git a/tests/Test2.px b/tests/Test2.px index 4473a44a..bf39936e 100755 --- a/tests/Test2.px +++ b/tests/Test2.px @@ -24,7 +24,7 @@ my %urls = ( }, ); -my $cmdline = "../src/wget -vd -N http://localhost:8080/dummy.html"; +my $cmdline = "../src/wget -N http://localhost:8080/dummy.html"; my $expected_error_code = 0; @@ -37,10 +37,11 @@ my %expected_downloaded_files = ( ############################################################################### -my $the_test = HTTPTest->new (urls => \%urls, +my $the_test = HTTPTest->new (name => "Test2", + input => \%urls, cmdline => $cmdline, errcode => $expected_error_code, - downloads => \%expected_downloaded_files); + output => \%expected_downloaded_files); $the_test->run(); # vim: et ts=4 sw=4 diff --git a/tests/Test3.px b/tests/Test3.px new file mode 100755 index 00000000..c8869b3f --- /dev/null +++ b/tests/Test3.px @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w + +use strict; + +use HTTPTest; + + +############################################################################### + +my $dummyfile = < { + code => "200", + msg => "Dontcare", + headers => { + "Content-type" => "text/plain", + }, + content => $dummyfile + }, +); + +my $cmdline = "../src/wget --quiet http://localhost:8080/nonexistent"; + +my $expected_error_code = 256; + +my %expected_downloaded_files = ( +); + +############################################################################### + +my $the_test = HTTPTest->new (name => "Test3", + input => \%urls, + cmdline => $cmdline, + errcode => $expected_error_code, + output => \%expected_downloaded_files); +$the_test->run(); + +# vim: et ts=4 sw=4 + diff --git a/tests/Test4.px b/tests/Test4.px new file mode 100755 index 00000000..3c259b46 --- /dev/null +++ b/tests/Test4.px @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w + +use strict; + +use HTTPTest; + + +############################################################################### + +my $dummyfile = < { + code => "200", + msg => "Dontcare", + headers => { + "Content-type" => "text/plain", + }, + content => $dummyfile + }, +); + +my $cmdline = "../src/wget --quiet -O out http://localhost:8080/nonexistent"; + +my $expected_error_code = 11; + +my %expected_downloaded_files = ( +); + +############################################################################### + +my $the_test = HTTPTest->new (name => "Test4", + input => \%urls, + cmdline => $cmdline, + errcode => $expected_error_code, + output => \%expected_downloaded_files); +$the_test->run(); + +# vim: et ts=4 sw=4 + -- 2.39.2