github-repos/wget
1
0
Fork 0
mirror of https://github.com/mirror/wget.git synced 2026-08-19 09:23:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

Automated merge.

Browse Source
This commit is contained in:
Micah Cowan
2008-12-01 07:05:29 -08:00
parent 66dd4bda74 78a7657395
commit 1b4ed7dcb7
84 changed files with 1023 additions and 514 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
tests/ChangeLog
View File

@@ -1,3 +1,84 @@
2008-11-26 Micah Cowan <micah@cowan.name> (not copyrightable)
* Test-ftp-iri-disabled.px, Test-ftp-iri-fallback.px,
Test-ftp-iri.px, Test-idn-cmd.px, Test-idn-headers.px,
Test-idn-meta.px, Test-iri-disabled.px,
Test-iri-forced-remote.px, Test-iri-list.px, Test-iri.px: More
module-scope warnings.
2008-11-25 Steven Schubiger <stsc@members.fsf.org>
* WgetTest.pm.in: Remove the magic interpreter line;
replace -w with lexical warnings.
2008-11-13 Steven Schubiger <stsc@members.fsf.org>
* FTPServer.pm, FTPTest.pm, HTTPServer.pm, HTTPTest.pm,
WgetTest.pm.in: Clean up leftover whitespace.
2008-11-12 Steven Schubiger <stsc@members.fsf.org>
* Test-auth-basic.px, Test-auth-no-challenge.px,
Test-auth-no-challenge-url.px, Test-c-full.px,
Test-c-partial.px, Test-c.px, Test-c-shorter.px,
Test-E-k-K.px, Test-E-k.px, Test-ftp.px,
Test-HTTP-Content-Disposition-1.px,
Test-HTTP-Content-Disposition-2.px,
Test-HTTP-Content-Disposition.px, Test-N-current.px,
Test-N-HTTP-Content-Disposition.px,
Test-N--no-content-disposition.px,
Test-N--no-content-disposition-trivial.px,
Test-N-no-info.px, Test--no-content-disposition.px,
Test--no-content-disposition-trivial.px, Test-N-old.px,
Test-nonexisting-quiet.px, Test-noop.px, Test-np.px,
Test-N.px, Test-N-smaller.px,
Test-O-HTTP-Content-Disposition.px, Test-O-nc.px,
Test-O--no-content-disposition.px,
Test-O--no-content-disposition-trivial.px,
Test-O-nonexisting.px, Test-O.px,
Test-proxy-auth-basic.px, Test-Restrict-Lowercase.px,
Test-Restrict-Uppercase.px,
Test--spider-fail.pxm, Test--spider.px,
Test--spider-r-HTTP-Content-Disposition.px,
Test--spider-r--no-content-disposition.px,
Test--spider-r--no-content-disposition-trivial.px,
Test--spider-r.px: Enforce lexically scoped warnings.
* Test-proxied-https-auth.px, run-px: Place use strict
before use warnings.
2008-11-12 Steven Schubiger <stsc@members.fsf.org>
* FTPServer.pm, FTPTest.pm, HTTPServer.pm, HTTPTest.pm:
Remove the magic interpreter line, because it cannot be
used fully. Substitute -w with use warnings.
2008-11-11 Micah Cowan <micah@cowan.name>
* HTTPServer.pm (handle_auth): Allow testing of
--auth-no-challenge.
* Test-auth-no-challenge.px, Test-auth-no-challenge-url.px:
Added.
* run-px: Add Test-auth-no-challenge.px,
Test-auth-no-challenge-url.px.
2008-11-07 Steven Schubiger <stsc@members.fsf.org>
* run-px: Use some colors for the summary part of the test
output to strengthen the distinction between a successful
or failing run.
2008-11-06 Steven Schubiger <stsc@members.fsf.org>
* run-px: When executing test scripts, invoke them with the
current perl executable name as determined by env.
2008-11-06 Micah Cowan <micah@cowan.name>
* run-px: Use strict (thanks Steven Schubiger!).
2008-09-09 Micah Cowan <micah@cowan.name>
* Test-idn-cmd.px: Added.

109
tests/FTPServer.pm
View File

@@ -1,11 +1,10 @@
#!/usr/bin/perl -w
# Part of this code was borrowed from Richard Jones's Net::FTPServer
# http://www.annexia.org/freeware/netftpserver
package FTPServer;
use strict;
use warnings;
use Cwd;
use Socket;
@@ -20,36 +19,36 @@ my $GOT_SIGURG = 0;
# connection states
my %_connection_states = (
'NEWCONN' => 0x01,
'WAIT4PWD' => 0x02,
'NEWCONN' => 0x01,
'WAIT4PWD' => 0x02,
'LOGGEDIN' => 0x04,
'TWOSOCKS' => 0x08,
);
# subset of FTP commands supported by these server and the respective
# connection states in which they are allowed
my %_commands = (
my %_commands = (
# Standard commands from RFC 959.
'CWD' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
$_connection_states{TWOSOCKS},
# 'EPRT' => $_connection_states{LOGGEDIN},
# 'EPSV' => $_connection_states{LOGGEDIN},
'LIST' => $_connection_states{TWOSOCKS},
# 'EPSV' => $_connection_states{LOGGEDIN},
'LIST' => $_connection_states{TWOSOCKS},
# 'LPRT' => $_connection_states{LOGGEDIN},
# 'LPSV' => $_connection_states{LOGGEDIN},
'PASS' => $_connection_states{WAIT4PWD},
'PASV' => $_connection_states{LOGGEDIN},
'PORT' => $_connection_states{LOGGEDIN},
# 'LPSV' => $_connection_states{LOGGEDIN},
'PASS' => $_connection_states{WAIT4PWD},
'PASV' => $_connection_states{LOGGEDIN},
'PORT' => $_connection_states{LOGGEDIN},
'PWD' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
$_connection_states{TWOSOCKS},
'QUIT' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
'REST' => $_connection_states{TWOSOCKS},
'RETR' => $_connection_states{TWOSOCKS},
$_connection_states{TWOSOCKS},
'REST' => $_connection_states{TWOSOCKS},
'RETR' => $_connection_states{TWOSOCKS},
'SYST' => $_connection_states{LOGGEDIN},
'TYPE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
'USER' => $_connection_states{NEWCONN},
'USER' => $_connection_states{NEWCONN},
# From ftpexts Internet Draft.
'SIZE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
@@ -76,7 +75,7 @@ sub _CWD_command
my @elems = split /\//, $path;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
if ($_ eq "" || $_ eq ".") {
# Ignore these.
next;
} elsif ($_ eq "..") {
@@ -117,7 +116,7 @@ sub _LIST_command
$dir = "/";
$path =~ s,^/+,,;
}
# Parse the first elements of the path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
@@ -142,10 +141,10 @@ sub _LIST_command
}
$dir .= $_;
} else { # It's the last element: check if it's a file, directory or wildcard.
if (-f $conn->{rootdir} . $dir . $_) {
if (-f $conn->{rootdir} . $dir . $_) {
# It's a file.
$filename = $_;
} elsif (-d $conn->{rootdir} . $dir . $_) {
} elsif (-d $conn->{rootdir} . $dir . $_) {
# It's a directory.
$dir .= $_;
} elsif (/\*/ || /\?/) {
@@ -158,9 +157,9 @@ sub _LIST_command
}
}
}
print STDERR "_LIST_command - dir is: $dir\n" if $log;
print {$conn->{socket}} "150 Opening data connection for file listing.\r\n";
# Open a path back to the client.
@@ -174,7 +173,7 @@ sub _LIST_command
# If the path contains a directory name, extract it so that
# we can prefix it to every filename listed.
my $prefix = (($filename || $wildcard) && $path =~ /(.*\/).*/) ? $1 : "";
print STDERR "_LIST_command - prefix is: $prefix\n" if $log;
# OK, we're either listing a full directory, listing a single
@@ -191,7 +190,7 @@ sub _LIST_command
__list_file ($sock, $prefix . $_);
}
}
unless ($sock->close) {
print {$conn->{socket}} "550 Error closing data connection: $!\r\n";
return;
@@ -208,7 +207,7 @@ sub _PASS_command
print STDERR "switching to LOGGEDIN state\n" if $log;
$conn->{state} = $_connection_states{LOGGEDIN};
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "202 Anonymous user access is always granted.\r\n";
} else {
@@ -219,7 +218,7 @@ sub _PASS_command
sub _PASV_command
{
my ($conn, $cmd, $rest) = @_;
# Open a listening socket - but don't actually accept on it yet.
"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
my $sock = IO::Socket::INET->new (LocalHost => '127.0.0.1',
@@ -246,7 +245,7 @@ sub _PASV_command
my $p2 = $sockport % 256;
$conn->{state} = $_connection_states{TWOSOCKS};
# We only accept connections from localhost.
print {$conn->{socket}} "227 Entering Passive Mode (127,0,0,1,$p1,$p2)\r\n";
}
@@ -294,7 +293,7 @@ sub _PORT_command
sub _PWD_command
{
my ($conn, $cmd, $rest) = @_;
# See RFC 959 Appendix II and draft-ietf-ftpext-mlst-11.txt section 6.2.1.
my $pathname = $conn->{dir};
$pathname =~ s,/+$,, unless $pathname eq "/";
@@ -306,7 +305,7 @@ sub _PWD_command
sub _REST_command
{
my ($conn, $cmd, $restart_from) = @_;
unless ($restart_from =~ /^([1-9][0-9]*|0)$/) {
print {$conn->{socket}} "501 REST command needs a numeric argument.\r\n";
return;
@@ -320,7 +319,7 @@ sub _REST_command
sub _RETR_command
{
my ($conn, $cmd, $path) = @_;
my $dir = $conn->{dir};
# Absolute path?
@@ -336,7 +335,7 @@ sub _RETR_command
my $filename = pop @elems;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
@@ -354,14 +353,14 @@ sub _RETR_command
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
return;
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
return;
return;
}
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
@@ -483,7 +482,7 @@ sub _RETR_command
sub _SIZE_command
{
my ($conn, $cmd, $path) = @_;
my $dir = $conn->{dir};
# Absolute path?
@@ -499,7 +498,7 @@ sub _SIZE_command
my $filename = pop @elems;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
@@ -517,12 +516,12 @@ sub _SIZE_command
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
return;
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
return;
return;
}
my $fullname = $conn->{rootdir} . $dir . $filename;
@@ -551,14 +550,14 @@ sub _SIZE_command
sub _SYST_command
{
my ($conn, $cmd, $dummy) = @_;
print {$conn->{socket}} "215 UNIX Type: L8\r\n";
}
sub _TYPE_command
{
my ($conn, $cmd, $type) = @_;
# See RFC 959 section 5.3.2.
if ($type =~ /^([AI])$/i) {
$conn->{type} = 'A';
@@ -583,7 +582,7 @@ sub _USER_command
print STDERR "switching to WAIT4PWD state\n" if $log;
$conn->{state} = $_connection_states{WAIT4PWD};
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "230 Anonymous user access granted.\r\n";
} else {
@@ -709,11 +708,11 @@ sub __get_file_list
my @allfiles = readdir DIRHANDLE;
my @filenames = ();
if ($wildcard) {
# Get rid of . and ..
@allfiles = grep !/^\.{1,2}$/, @allfiles;
# Convert wildcard to a regular expression.
$wildcard = __wildcard_to_regex ($wildcard);
@@ -752,7 +751,7 @@ sub __wildcard_to_regex
_reuseAddr => 1,
_rootDir => Cwd::getcwd(),
);
sub _default_for
{
my ($self, $attr) = @_;
@@ -795,7 +794,7 @@ sub new {
}
sub run
sub run
{
my ($self, $synch_callback) = @_;
my $initialized = 0;
@@ -823,11 +822,11 @@ sub run
# the accept loop
while (my $client_addr = accept (my $socket, $server_sock))
{
{
# turn buffering off on $socket
select((select($socket), $|=1)[0]);
# find out who connected
# find out who connected
my ($client_port, $client_ip) = sockaddr_in ($client_addr);
my $client_ipnum = inet_ntoa ($client_ip);
@@ -845,8 +844,8 @@ sub run
if (1) { # Child process.
# install signals
$SIG{URG} = sub {
$GOT_SIGURG = 1;
$SIG{URG} = sub {
$GOT_SIGURG = 1;
};
$SIG{PIPE} = sub {
@@ -858,7 +857,7 @@ sub run
print STDERR "Connection idle timeout expired. Closing server.\n";
exit;
};
#$SIG{CHLD} = 'IGNORE';
@@ -872,7 +871,7 @@ sub run
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
};
print {$conn->{socket}} "220 GNU Wget Testing FTP Server ready.\r\n";
# command handling loop
@@ -913,7 +912,7 @@ sub run
print {$conn->{socket}} "530 Not logged in.\r\n";
next;
}
# Handle the QUIT command specially.
if ($cmd eq "QUIT") {
print {$conn->{socket}} "221 Goodbye. Service closing connection.\r\n";
@@ -926,7 +925,7 @@ sub run
} else { # Father
close $socket;
}
}
}
$/ = $old_ils;
}

7
tests/FTPTest.pm
View File

@@ -1,8 +1,7 @@
#!/usr/bin/perl -w
package FTPTest;
use strict;
use warnings;
use FTPServer;
use WgetTest;
@@ -14,7 +13,7 @@ my $VERSION = 0.01;
{
my %_attr_data = ( # DEFAULT
);
sub _default_for
{
my ($self, $attr) = @_;
@@ -28,7 +27,7 @@ my $VERSION = 0.01;
($self->SUPER::_standard_keys(), keys %_attr_data);
}
}
sub _setup_server {
my $self = shift;

15
tests/HTTPServer.pm
View File

@@ -1,8 +1,7 @@
#!/usr/bin/perl -w
package HTTPServer;
use strict;
use warnings;
use HTTP::Daemon;
use HTTP::Status;
@@ -23,7 +22,7 @@ sub run {
if (!$initialized) {
$synch_callback->();
$initialized = 1;
}
}
my $con = $self->accept();
print STDERR "Accepted a new connection\n" if $log;
while (my $req = $con->get_request) {
@@ -46,14 +45,14 @@ sub run {
if (exists($urls->{$url_path})) {
print STDERR "Serving requested URL: ", $url_path, "\n" if $log;
next unless ($req->method eq "HEAD" || $req->method eq "GET");
my $url_rec = $urls->{$url_path};
$self->send_response($req, $url_rec, $con);
} else {
print STDERR "Requested wrong URL: ", $url_path, "\n" if $log;
$con->send_error($HTTP::Status::RC_FORBIDDEN);
last;
}
}
}
print STDERR "Closing connection\n" if $log;
$con->close;
@@ -145,8 +144,7 @@ sub handle_auth {
my $authhdr = $req->header('Authorization');
# Have we sent the challenge yet?
unless (defined $url_rec->{auth_challenged}
&& $url_rec->{auth_challenged}) {
unless ($url_rec->{auth_challenged} || $url_rec->{auth_no_challenge}) {
# Since we haven't challenged yet, we'd better not
# have received authentication (for our testing purposes).
if ($authhdr) {
@@ -167,6 +165,9 @@ sub handle_auth {
# failed it.
$code = 400;
$msg = "You didn't send auth after I sent challenge";
if ($url_rec->{auth_no_challenge}) {
$msg = "--auth-no-challenge but no auth sent."
}
} else {
my ($sent_method) = ($authhdr =~ /^(\S+)/g);
unless ($sent_method eq $url_rec->{'auth_method'}) {

9
tests/HTTPTest.pm
View File

@@ -1,8 +1,7 @@
#!/usr/bin/perl -w
package HTTPTest;
use strict;
use warnings;
use HTTPServer;
use WgetTest;
@@ -14,7 +13,7 @@ my $VERSION = 0.01;
{
my %_attr_data = ( # DEFAULT
);
sub _default_for
{
my ($self, $attr) = @_;
@@ -22,13 +21,13 @@ my $VERSION = 0.01;
return $self->SUPER::_default_for($attr);
}
sub _standard_keys
sub _standard_keys
{
my ($self) = @_;
($self->SUPER::_standard_keys(), keys %_attr_data);
}
}
sub _setup_server {
my $self = shift;

3
tests/Test--no-content-disposition-trivial.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--no-content-disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider-fail.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider-r--no-content-disposition-trivial.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider-r--no-content-disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider-r-HTTP-Content-Disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider-r.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test--spider.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-E-k-K.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-E-k.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-HTTP-Content-Disposition-1.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-HTTP-Content-Disposition-2.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-HTTP-Content-Disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N--no-content-disposition-trivial.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N--no-content-disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N-HTTP-Content-Disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N-current.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N-no-info.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N-old.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N-smaller.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-N.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O--no-content-disposition-trivial.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O--no-content-disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O-HTTP-Content-Disposition.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O-nc.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O-nonexisting.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-O.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-Restrict-Lowercase.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-Restrict-Uppercase.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-auth-basic.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

50
tests/Test-auth-no-challenge-url.px Executable file
View File

@@ -0,0 +1,50 @@
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;
###############################################################################
my $wholefile = "You're all authenticated.\n";
# code, msg, headers, content
my %urls = (
'/needs-auth.txt' => {
auth_no_challenge => 1,
auth_method => 'Basic',
user => 'fiddle-dee-dee',
passwd => 'Dodgson',
code => "200",
msg => "You want fries with that?",
headers => {
"Content-type" => "text/plain",
},
content => $wholefile,
},
);
my $cmdline = $WgetTest::WGETPATH . " --auth-no-challenge "
. "http://fiddle-dee-dee:Dodgson\@localhost:{{port}}/needs-auth.txt";
my $expected_error_code = 0;
my %expected_downloaded_files = (
'needs-auth.txt' => {
content => $wholefile,
},
);
###############################################################################
my $the_test = HTTPTest->new (name => "Test-auth-no-challenge-url",
input => \%urls,
cmdline => $cmdline,
errcode => $expected_error_code,
output => \%expected_downloaded_files);
exit $the_test->run();
# vim: et ts=4 sw=4

51
tests/Test-auth-no-challenge.px Executable file
View File

@@ -0,0 +1,51 @@
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;
###############################################################################
my $wholefile = "You're all authenticated.\n";
# code, msg, headers, content
my %urls = (
'/needs-auth.txt' => {
auth_no_challenge => 1,
auth_method => 'Basic',
user => 'fiddle-dee-dee',
passwd => 'Dodgson',
code => "200",
msg => "You want fries with that?",
headers => {
"Content-type" => "text/plain",
},
content => $wholefile,
},
);
my $cmdline = $WgetTest::WGETPATH . " --auth-no-challenge"
. " --user=fiddle-dee-dee --password=Dodgson"
. " http://localhost:{{port}}/needs-auth.txt";
my $expected_error_code = 0;
my %expected_downloaded_files = (
'needs-auth.txt' => {
content => $wholefile,
},
);
###############################################################################
my $the_test = HTTPTest->new (name => "Test-auth-no-challenge",
input => \%urls,
cmdline => $cmdline,
errcode => $expected_error_code,
output => \%expected_downloaded_files);
exit $the_test->run();
# vim: et ts=4 sw=4

3
tests/Test-c-full.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-c-partial.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-c-shorter.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-c.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-ftp-iri-disabled.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;

3
tests/Test-ftp-iri-fallback.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;

3
tests/Test-ftp-iri.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;

3
tests/Test-ftp.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;

3
tests/Test-idn-cmd.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-idn-headers.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-idn-meta.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-iri-disabled.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-iri-forced-remote.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-iri-list.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-iri.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-nonexisting-quiet.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-noop.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-np.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

3
tests/Test-proxied-https-auth.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl
use warnings;
use strict;
use warnings;
use WgetTest; # For $WGETPATH.

3
tests/Test-proxy-auth-basic.px
View File

@@ -1,6 +1,7 @@
#!/usr/bin/perl -w
#!/usr/bin/perl
use strict;
use warnings;
use HTTPTest;

57
tests/WgetTest.pm.in
View File

@@ -1,5 +1,3 @@
#!/usr/bin/perl -w
# WARNING!
# WgetTest.pm is a generated file! Do not edit! Edit WgetTest.pm.in
# instead.
@@ -8,6 +6,7 @@ package WgetTest;
$VERSION = 0.01;
use strict;
use warnings;
use Cwd;
use File::Path;
@@ -26,14 +25,14 @@ my @unexpected_downloads = ();
_name => "",
_output => {},
);
sub _default_for
{
my ($self, $attr) = @_;
$_attr_data{$attr};
}
sub _standard_keys
sub _standard_keys
{
keys %_attr_data;
}
@@ -70,29 +69,29 @@ sub new {
sub run {
my $self = shift;
my $result_message = "Test successful.\n";
printf "Running test $self->{_name}\n";
# Setup
# Setup
$self->_setup();
chdir ("$self->{_workdir}/$self->{_name}/input");
# Launch server
my $pid = $self->_fork_and_launch_server();
# Call wget
chdir ("$self->{_workdir}/$self->{_name}/output");
my $cmdline = $self->{_cmdline};
$cmdline = $self->_substitute_port($cmdline);
print "Calling $cmdline\n";
my $errcode =
($cmdline =~ m{^/.*})
my $errcode =
($cmdline =~ m{^/.*})
? system ($cmdline)
: system ("$self->{_workdir}/../src/$cmdline");
# Shutdown server
# if we didn't explicitely kill the server, we would have to call
# waitpid ($pid, 0) here in order to wait for the child process to
# if we didn't explicitely kill the server, we would have to call
# waitpid ($pid, 0) here in order to wait for the child process to
# terminate
kill ('TERM', $pid);
@@ -124,11 +123,11 @@ sub _setup {
chdir ($self->{_name});
mkdir ("input");
mkdir ("output");
# Setup existing files
chdir ("output");
foreach my $filename (keys %{$self->{_existing}}) {
open (FILE, ">$filename")
open (FILE, ">$filename")
or return "Test failed: cannot open pre-existing file $filename\n";
my $file = $self->{_existing}->{$filename};
@@ -141,8 +140,8 @@ sub _setup {
utime $file->{timestamp}, $file->{timestamp}, $filename
or return "Test failed: cannot set timestamp on pre-existing file $filename\n";
}
}
}
chdir ("../input");
$self->_setup_server();
@@ -162,15 +161,15 @@ sub _verify_download {
my $self = shift;
chdir ("$self->{_workdir}/$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)
open (FILE, $filename)
or return "Test failed: file $filename not downloaded\n";
my $content = <FILE>;
my $expected_content = $filedata->{'content'};
$expected_content = $self->_substitute_port($expected_content);
@@ -181,20 +180,20 @@ sub _verify_download {
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
$mtime == $filedata->{'timestamp'}
$mtime == $filedata->{'timestamp'}
or return "Test failed: wrong timestamp for file $filename\n";
}
close (FILE);
}
$/ = $old_input_record_separator;
}
$/ = $old_input_record_separator;
# make sure no unexpected files were downloaded
chdir ("$self->{_workdir}/$self->{_name}/output");
__dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
if (@unexpected_downloads) {
if (@unexpected_downloads) {
return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
}
@@ -228,7 +227,7 @@ sub __dir_walk {
}
sub _fork_and_launch_server
sub _fork_and_launch_server
{
my $self = shift;
@@ -239,7 +238,7 @@ sub _fork_and_launch_server
if ($pid < 0) {
die "Cannot fork";
} elsif ($pid == 0) {
# child
# child
close FROM_CHILD;
$self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT });
} else {

72
tests/run-px
View File

@@ -1,11 +1,19 @@
#!/usr/bin/env perl
use 5.006;
use strict;
use warnings;
use Term::ANSIColor ':constants';
$Term::ANSIColor::AUTORESET = 1;
die "Please specify the top source directory.\n" if (!@ARGV);
my $top_srcdir = shift @ARGV;
my @tests = (
'Test-auth-basic.px',
'Test-auth-no-challenge.px',
'Test-auth-no-challenge-url.px',
'Test-proxy-auth-basic.px',
'Test-proxied-https-auth.px',
'Test-N-HTTP-Content-Disposition.px',
@@ -57,26 +65,56 @@ my @tests = (
'Test--spider-r.px',
);
my @results;
my @tested;
for my $test (@tests) {
foreach my $test (@tests) {
print "Running $test\n\n";
system("$top_srcdir/tests/$test");
push @results, $?;
}
for (my $i=0; $i != @tests; ++$i) {
if ($results[$i] == 0) {
print "pass: ";
} else {
print "FAIL: ";
}
print "$tests[$i]\n";
system("$^X $top_srcdir/tests/$test");
push @tested, { name => $test, result => $? };
}
print "\n";
print scalar(@results) . " tests were run\n";
print scalar(grep $_ == 0, @results) . " PASS\n";
print scalar(grep $_ != 0, @results) . " FAIL\n";
foreach my $test (@tested) {
($test->{result} == 0)
? print GREEN 'pass: '
: print RED 'FAIL: ';
print $test->{name}, "\n";
}
exit scalar (grep $_ != 0, @results);
my $count = sub
{
return {
pass => sub { scalar grep $_->{result} == 0, @tested },
fail => sub { scalar grep $_->{result} != 0, @tested },
}->{$_[0]}->();
};
my $summary = sub
{
my @lines = (
"${\scalar @tested} tests were run",
"${\$count->('pass')} PASS, ${\$count->('fail')} FAIL",
);
my $len_longest = sub
{
local $_ = 0;
foreach my $line (@lines) {
if (length $line > $_) {
$_ = length $line;
}
}
return $_;
}->();
return join "\n",
'=' x $len_longest,
@lines,
'=' x $len_longest;
}->();
print "\n";
print $count->('fail')
? RED $summary
: GREEN $summary;
print "\n";
exit $count->('fail');