+2005-12-05 Mauro Tortonesi <mauro@ferrara.linux.it>
+
+ * HTTPServer.pm: Refactored as a subclass of HTTP::Daemon.
+ Removed the old run method and renamed the old run_daemon
+ method to run. Added support for partial
+
+ * Testing.pm: Renamed to HTTPTest.pm.
+
+ * HTTPTest.pm: Refactored as a subclass of Test. Renamed
+ Run_HTTP_Test to run, verify_download to _verify_download
+ and added support for timestamp checking.
+
+ * Test.pm: Added Test class as the super class of every
+ testcase.
+
+ * test1: Renamed to Test1.px.
+
+ * Test1.px: Refactored as an instance of the HTTPTest class.
+
+ * Test2.px: Added -N HTTP test.
+
2005-11-02 Mauro Tortonesi <mauro@ferrara.linux.it>
* HTTPServer.pm: Added basic support for HTTP testing.
#!/usr/bin/perl -w
+package HTTPServer;
+
+use strict;
+
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Headers;
use HTTP::Response;
-use strict;
+our @ISA=qw(HTTP::Daemon);
-package HTTPServer;
+my $CRLF = "\015\012"; # "\r\n" is not portable
-sub run_daemon {
- my %urls = @_;
- my $server = HTTP::Daemon->new (LocalAddr => 'localhost',
- LocalPort => '8080',
- ReuseAddr => 1) or die "Cannot create server!!!";
+sub run {
+ my ($self, $urls) = @_;
- while (my $con = $server->accept) {
+ while (my $con = $self->accept) {
while (my $req = $con->get_request) {
# print STDERR "method: ", $req->method, "\n";
- if ($req->method eq "GET" and $urls{$req->url->path}) {
+ if (exists($urls->{$req->url->path})) {
+ 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'});
+ my $tmp = $urls->{$req->url->path};
+ my $resp = HTTP::Response->new ($tmp->{code},
+ $tmp->{msg});
# print STDERR "HTTP::Response: \n", $resp->as_string;
# fill in headers
$resp->header($name => $value);
}
# print STDERR "HTTP::Response with headers: \n", $resp->as_string;
-
- # fill in content
- $resp->content($tmp->{content});
- # print STDERR "HTTP::Response with content: \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;
+ }
+ # 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;
} else {
- print STDERR "requested wrong URL: ", $req->url->path, "\n";
+ # print STDERR "requested wrong URL: ", $req->url->path, "\n";
$con->send_error($HTTP::Status::RC_FORBIDDEN);
}
}
}
}
-sub run {
- my $pid = fork();
-
- if($pid == 0) {
- run_daemon(@_);
- }
-
- return $pid;
-}
-
1;
# vim: et ts=4 sw=4
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+
+package HTTPTest;
+our @ISA = qw(Test);
+$VERSION = 0.01;
+
+use strict;
+
+use HTTPServer;
+
+
+{
+ my %_attr_data = ( # DEFAULT
+ _urls => {},
+ _cmdline => "",
+ _errcode => 0,
+ _downloads => {},
+ );
+
+ sub _default_for
+ {
+ my ($self, $attr) = @_;
+ return $_attr_data{$attr} if exists $_attr_data{$attr};
+ return $self->SUPER::_default_for($attr);
+ }
+
+ sub _standard_keys
+ {
+ my ($self) = @_;
+ ($self->SUPER::_standard_keys(), keys %_attr_data);
+ }
+}
+
+
+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});
+
+ 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 {
+ 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 = <FILE>;
+ $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 "";
+}
+
+1;
+
+# vim: et ts=4 sw=4
+
--- /dev/null
+#!/usr/bin/perl -w
+
+package Test;
+$VERSION = 0.01;
+
+use strict;
+
+
+{
+ my %_attr_data = ( # DEFAULT
+ );
+
+ sub _default_for
+ {
+ my ($self, $attr) = @_;
+ $_attr_data{$attr};
+ }
+
+ sub _standard_keys
+ {
+ keys %_attr_data;
+ }
+}
+
+sub new {
+ my ($caller, %args) = @_;
+ my $caller_is_obj = ref($caller);
+ my $class = $caller_is_obj || $caller;
+ my $self = bless {}, $class;
+ foreach my $attrname ($self->_standard_keys()) {
+ 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};
+ } else {
+ #printf STDERR "Using default for $attrname\n";
+ $self->{$attrname} = $self->_default_for($argname);
+ }
+ }
+ return $self;
+}
+
+1;
+
+# vim: et ts=4 sw=4
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use HTTPTest;
+
+
+###############################################################################
+
+my $dummyfile = <<EOF;
+Content
+EOF
+
+# code, msg, headers, content
+my %urls = (
+ '/dummy.html' => {
+ code => "200",
+ msg => "Dontcare",
+ headers => {
+ "Content-type" => "text/plain",
+ },
+ content => $dummyfile
+ },
+);
+
+my $cmdline = "../src/wget -vd http://localhost:8080/dummy.html";
+
+my $expected_error_code = 0;
+
+my %expected_downloaded_files = (
+ 'dummy.html' => {
+ content => $dummyfile,
+ }
+);
+
+###############################################################################
+
+my $the_test = HTTPTest->new (urls => \%urls,
+ cmdline => $cmdline,
+ errcode => $expected_error_code,
+ downloads => \%expected_downloaded_files);
+$the_test->run();
+
+# vim: et ts=4 sw=4
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use HTTPTest;
+
+
+###############################################################################
+
+my $dummyfile = <<EOF;
+Content
+EOF
+
+# code, msg, headers, content
+my %urls = (
+ '/dummy.html' => {
+ code => "200",
+ msg => "Dontcare",
+ headers => {
+ "Content-type" => "text/plain",
+ "Last-Modified" => "Sat, 09 Oct 2004 08:30:00 GMT",
+ },
+ content => $dummyfile
+ },
+);
+
+my $cmdline = "../src/wget -vd -N http://localhost:8080/dummy.html";
+
+my $expected_error_code = 0;
+
+my %expected_downloaded_files = (
+ 'dummy.html' => {
+ content => $dummyfile,
+ timestamp => 1097310600, # "Sat, 09 Oct 2004 08:30:00 GMT"
+ }
+);
+
+###############################################################################
+
+my $the_test = HTTPTest->new (urls => \%urls,
+ cmdline => $cmdline,
+ errcode => $expected_error_code,
+ downloads => \%expected_downloaded_files);
+$the_test->run();
+
+# vim: et ts=4 sw=4
+
+++ /dev/null
-#!/usr/bin/perl -w
-
-use HTTPServer;
-
-use strict;
-
-package Testing;
-
-sub Run_HTTP_Test {
-
- my ($urls, $cmdline, $expected_error_code, $expected_downloaded_files) = @_;
-
- my $pid = HTTPServer::run (%{$urls});
-
- print "Spawned HTTP server with pid: $pid\n";
-
- my $returned_error_code = system ($cmdline);
-
- kill ('TERM', $pid);
-
- print "Killed HTTP server\n";
-
- $returned_error_code == $expected_error_code
- or die "Test failed: wrong code returned (was: $returned_error_code, expected: $expected_error_code)";
-
- if (my $str = verify_download (%{$expected_downloaded_files})) {
- die $str;
- }
-
- print "Test successful."
-}
-
-
-sub verify_download {
- my (%expected_downloaded_files) = @_;
-
- # use slurp mode to read file content
- my $old_input_record_separator = $/;
- undef $/;
-
- while (my ($filename, $expected_content) = each %expected_downloaded_files) {
- open (FILE, $filename) or return "Test failed: file $filename not downloaded";
-
- my $content = <FILE>;
- $content eq $expected_content or return "Test failed: wrong content for file $filename";
-
- close (FILE);
- }
-
- $/ = $old_input_record_separator;
-
- return "";
-}
-
-1;
-
-# vim: et ts=4 sw=4
-
+++ /dev/null
-#!/usr/bin/perl -w
-
-use Testing;
-
-use strict;
-
-###############################################################################
-
-my $dummyfile = <<EOF;
-Content
-EOF
-
-# code, msg, headers, content
-my %urls = (
- '/dummy.html' => {
- code => "200",
- msg => "Dontcare",
- headers => {
- "Content-type" => "text/plain",
- },
- content => $dummyfile
- },
-);
-
-my $cmdline = "wget -vd http://localhost:8080/dummy.html";
-
-my $expected_error_code = 0;
-
-my %expected_downloaded_files = (
- 'dummy.html' => $dummyfile,
-);
-
-###############################################################################
-
-Testing::Run_HTTP_Test (\%urls, $cmdline, $expected_error_code, \%expected_downloaded_files);
-
-# vim: et ts=4 sw=4
-