moparisthebest/wget
1
0
Fork 0
mirror of https://github.com/moparisthebest/wget synced 2024-07-03 16:38:41 -04:00
Code Issues Releases Wiki Activity

Purge orphaned whitespace in test libraries.

Browse Source
This commit is contained in:
Steven Schubiger 2008-11-13 12:29:59 +01:00
parent 02c211d47c
commit a6de4721d1
6 changed files with 93 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
tests/ChangeLog
View File

@ -1,3 +1,8 @@
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> 2008-11-12 Steven Schubiger <stsc@members.fsf.org>
* Test-auth-basic.px, Test-auth-no-challenge.px, * Test-auth-basic.px, Test-auth-no-challenge.px,

106
tests/FTPServer.pm
View File

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

4
tests/FTPTest.pm
View File

@ -13,7 +13,7 @@ my $VERSION = 0.01;
{ {
my %_attr_data = ( # DEFAULT my %_attr_data = ( # DEFAULT
); );
sub _default_for sub _default_for
{ {
my ($self, $attr) = @_; my ($self, $attr) = @_;
@ -27,7 +27,7 @@ my $VERSION = 0.01;
($self->SUPER::_standard_keys(), keys %_attr_data); ($self->SUPER::_standard_keys(), keys %_attr_data);
} }
} }
sub _setup_server { sub _setup_server {
my $self = shift; my $self = shift;

6
tests/HTTPServer.pm
View File

@ -22,7 +22,7 @@ sub run {
if (!$initialized) { if (!$initialized) {
$synch_callback->(); $synch_callback->();
$initialized = 1; $initialized = 1;
} }
my $con = $self->accept(); my $con = $self->accept();
print STDERR "Accepted a new connection\n" if $log; print STDERR "Accepted a new connection\n" if $log;
while (my $req = $con->get_request) { while (my $req = $con->get_request) {
@ -44,14 +44,14 @@ sub run {
if (exists($urls->{$url_path})) { if (exists($urls->{$url_path})) {
print STDERR "Serving requested URL: ", $url_path, "\n" if $log; print STDERR "Serving requested URL: ", $url_path, "\n" if $log;
next unless ($req->method eq "HEAD" || $req->method eq "GET"); next unless ($req->method eq "HEAD" || $req->method eq "GET");
my $url_rec = $urls->{$url_path}; my $url_rec = $urls->{$url_path};
$self->send_response($req, $url_rec, $con); $self->send_response($req, $url_rec, $con);
} else { } else {
print STDERR "Requested wrong URL: ", $url_path, "\n" if $log; print STDERR "Requested wrong URL: ", $url_path, "\n" if $log;
$con->send_error($HTTP::Status::RC_FORBIDDEN); $con->send_error($HTTP::Status::RC_FORBIDDEN);
last; last;
} }
} }
print STDERR "Closing connection\n" if $log; print STDERR "Closing connection\n" if $log;
$con->close; $con->close;

6
tests/HTTPTest.pm
View File

@ -13,7 +13,7 @@ my $VERSION = 0.01;
{ {
my %_attr_data = ( # DEFAULT my %_attr_data = ( # DEFAULT
); );
sub _default_for sub _default_for
{ {
my ($self, $attr) = @_; my ($self, $attr) = @_;
@ -21,13 +21,13 @@ my $VERSION = 0.01;
return $self->SUPER::_default_for($attr); return $self->SUPER::_default_for($attr);
} }
sub _standard_keys sub _standard_keys
{ {
my ($self) = @_; my ($self) = @_;
($self->SUPER::_standard_keys(), keys %_attr_data); ($self->SUPER::_standard_keys(), keys %_attr_data);
} }
} }
sub _setup_server { sub _setup_server {
my $self = shift; my $self = shift;

54
tests/WgetTest.pm.in
View File

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