Here is a suggested patch. I don't know if it will solve the problem, but at least there should be diagnostics in the log if something fails.
Best regards, /pär 2015-06-15 13:37 GMT+02:00 Pär Karlsson <[email protected]>: > I quickly looked at the code in question, and one obvious quick test would > be to check the return value of the "unlink" calls (and $! / $ERRNO > afterwards) at the two places in the respective .px files where > 'needs-auth.txt' is handled. > > I've been cleaning up the two tests mentioned but so far have been unable > to reproduce the problem with the test file being left over, and I'd be > happy to come up with a patch when I'm finished. > > Until then, I would suggest a quick change to > > if (-e 'needs-auth.txt') { > unlink 'needs-auth.txt' or warn "Cannot remove 'needs-auth.txt: $!"; > } > > would be enough to at least pinpoint the problem if it has to do with file > permissions. > > There are some other potentially problematic constructs in the tests too, > (the pipe()/select() calls, for instance, which _might_ cause race > conditions in conjunction with the unlink() call), but this is all > conjecture on my part; I have not managed to get the tests to fail yet. > > /Pär > > 2015-06-15 11:56 GMT+02:00 Darshit Shah <[email protected]>: > >> The two proxied https tests: >> Test-proxied-https-auth-keepalive.px >> Test-proxied-https-auth.px >> >> Implement a second HTTPS server inside the test itself and do not use >> the standard WgetTest.pm class. In these implementations, we do not >> actually chdir() to the correct test directory. I've been seeing some >> failures in make distcheck, because the file needs-auth.txt sometimes >> is left over after the test is run. Currently, I haven't been able to >> debug the issue for why the file remains around, but I guess we should >> fix the test directory for it first. >> >> My Perl is ridiculously horrible. So if someone who knows a bit of >> Perl can help, I'd be very grateful! Else, I'll sit down over the >> coming weekend and make the changes. >> >> -- >> Thanking You, >> Darshit Shah >> >> >
From 2e3647cc791f651a2f7bec1ef9e19300227b4326 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?P=C3=A4r=20Karlsson?= <[email protected]> Date: Mon, 15 Jun 2015 14:34:45 +0200 Subject: [PATCH] Make tests tell us more about failures * tests/tests/Test-proxied-https-auth-keepalive.px: check return values of flagged functions, general cleanups and safer calls to pipe I/O * tests/Test-proxied-https-auth.px: check return values of flagged functions, general cleanups and safer calls to pipe I/O --- tests/Test-proxied-https-auth-keepalive.px | 184 ++++++++++++++++----------- tests/Test-proxied-https-auth.px | 193 ++++++++++++++++++----------- 2 files changed, 236 insertions(+), 141 deletions(-) diff --git a/tests/Test-proxied-https-auth-keepalive.px b/tests/Test-proxied-https-auth-keepalive.px index 349778a..75dc877 100755 --- a/tests/Test-proxied-https-auth-keepalive.px +++ b/tests/Test-proxied-https-auth-keepalive.px @@ -6,51 +6,62 @@ use strict; use warnings; use WgetFeature qw(https); -use WgetTests; # For $WGETPATH. +use WgetTests; # For $WGETPATH. my $cert_path; my $key_path; my $srcdir; -if (@ARGV) { +if (@ARGV) +{ $srcdir = shift @ARGV; -} elsif (defined $ENV{srcdir}) { +} +elsif (defined $ENV{srcdir}) +{ $srcdir = $ENV{srcdir}; } -if (defined $srcdir) { - $key_path = "$srcdir/certs/server-key.pem"; +if (defined $srcdir) +{ + $key_path = "$srcdir/certs/server-key.pem"; $cert_path = "$srcdir/certs/server-cert.pem"; -} else { - $key_path = "certs/server-key.pem"; - $cert_path = "certs/server-cert.pem"; +} +else +{ + $key_path = 'certs/server-key.pem'; + $cert_path = 'certs/server-cert.pem'; } - +use English qw(-no_match_vars); use HTTP::Daemon; use HTTP::Request; +use IO::Handle; use IO::Socket::SSL; -my $SOCKET = HTTP::Daemon->new (LocalAddr => 'localhost', - ReuseAddr => 1) or die "Cannot create server!!!"; +my $SOCKET = HTTP::Daemon->new(LocalAddr => 'localhost', + ReuseAddr => 1) + or die 'Cannot create server!!!'; -sub get_request { - my $conn = shift; - my $content = ''; +sub get_request +{ + my $conn = shift; + my $content = q{}; my $line; - while (defined ($line = <$conn>)) { + while (defined($line = <$conn>)) + { $content .= $line; last if $line eq "\r\n"; } my $rqst = HTTP::Request->parse($content) - or die "Couldn't parse request:\n$content\n"; + or die "Couldn't parse request:\n$content\n"; return $rqst; } -sub do_server { +sub do_server +{ my ($synch_callback) = @_; my $s = $SOCKET; my $conn; @@ -72,92 +83,127 @@ sub do_server { # to an HTTPS server). my %options = ( - SSL_server => 1, - SSL_passwd_cb => sub { return "Hello"; }); + SSL_server => 1, + SSL_passwd_cb => sub { return 'Hello'; } + ); $options{SSL_cert_file} = $cert_path if ($cert_path); - $options{SSL_key_file} = $key_path if ($key_path); + $options{SSL_key_file} = $key_path if ($key_path); my @options = %options; $conn = IO::Socket::SSL->new_from_fd($conn->fileno, @options) - or die "Couldn't initiate SSL"; + or die 'Couldn\'t initiate SSL'; - for my $expect_inner_auth (0, 1) { + for my $expect_inner_auth (0, 1) + { # TODO: expect no auth the first time, request it, expect it the second # time. - $rqst = &get_request($conn) - or die "Didn't get proxied request\n"; - - unless ($expect_inner_auth) { - die "Early proxied auth\n" if $rqst->header('Authorization'); - - $rspn = HTTP::Response->new(401, 'Unauthorized', [ - 'WWW-Authenticate' => 'Basic realm="gondor"', - Connection => 'keep-alive' - ]); - } else { - die "No proxied auth\n" unless $rqst->header('Authorization'); - - $rspn = HTTP::Response->new(200, 'OK', [ - 'Content-Type' => 'text/plain', - 'Connection' => 'close', - ], "foobarbaz\n"); + $rqst = get_request($conn) + or die 'Didn\'t get proxied request'; + + if (not $expect_inner_auth) + { + die 'Early proxied auth' if $rqst->header('Authorization'); + + $rspn = HTTP::Response->new( + 401, + 'Unauthorized', + [ + 'WWW-Authenticate' => 'Basic realm="gondor"', + Connection => 'keep-alive' + ] + ); + } + else + { + die 'No proxied auth' unless $rqst->header('Authorization'); + + $rspn = HTTP::Response->new( + 200, 'OK', + [ + 'Content-Type' => 'text/plain', + 'Connection' => 'close', + ], + "foobarbaz\n" + ); } $rspn->protocol('HTTP/1.0'); - print STDERR "=====\n"; - print STDERR $rspn->as_string; - print STDERR "\n=====\n"; - print $conn $rspn->as_string; + print {*STDERR} "=====\n"; + print {*STDERR} $rspn->as_string; + print {*STDERR} "\n=====\n"; + print {$conn} $rspn->as_string; } $conn->close; undef $conn; undef $s; + return 1; } -sub fork_server { - pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!"; - select((select(TO_PARENT), $| = 1)[0]); +sub fork_server +{ + pipe my ($from_child, $to_parent) or die 'Cannot create pipe!'; + $to_parent->autoflush(); my $pid = fork(); - if ($pid < 0) { - die "Cannot fork"; - } elsif ($pid == 0) { + if ($pid < 0) + { + die 'Cannot fork'; + } + elsif ($pid == 0) + { # child - close FROM_CHILD; + close $from_child or warn "Cannot close child: $ERRNO"; do_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); exit 0; - } else { + } + else + { # parent - close TO_PARENT; + close $to_parent or warn "Cannot close parent: $ERRNO"; chomp(my $line = <FROM_CHILD>); - close FROM_CHILD; + close $from_child or warn "Cannot close child: $ERRNO"; } return $pid; } -unlink "needs-auth.txt"; -my $pid = &fork_server; - -my $cmdline = $WgetTest::WGETPATH . " --user=fiddle-dee-dee" - . " --password=Dodgson -e https_proxy=localhost:{{port}}" - . " --no-check-certificate" - . " https://no.such.domain/needs-auth.txt";; +if (-e 'needs-auth.txt') +{ + unlink 'needs-auth.txt' or warn "Cannot unlink 'needs-auth.txt': $ERRNO"; +} +my $pid = fork_server(); + +my $cmdline = + $WgetTest::WGETPATH + . ' --user=fiddle-dee-dee' + . ' --password=Dodgson -e https_proxy=localhost:{{port}}' + . ' --no-check-certificate' + . ' https://no.such.domain/needs-auth.txt'; $cmdline =~ s/{{port}}/$SOCKET->sockport()/e; my $valgrind = $ENV{VALGRIND_TESTS}; -if (!defined $valgrind || $valgrind eq "" || $valgrind == 0) { +if (!defined $valgrind || $valgrind eq q{} || $valgrind == 0) +{ # Valgrind not requested - leave $cmdline as it is -} elsif ($valgrind == 1) { - $cmdline = "valgrind --error-exitcode=301 --leak-check=yes --track-origins=yes " . $cmdline; -} else { - $cmdline = $valgrind . " " . $cmdline; +} +elsif ($valgrind == 1) +{ + $cmdline = + 'valgrind --error-exitcode=301 --leak-check=yes --track-origins=yes ' + . $cmdline; +} +else +{ + $cmdline = $valgrind . q{ } . $cmdline; } -my $code = system($cmdline . " 2>&1") >> 8; -unlink "needs-auth.txt"; +my $code = system($cmdline . ' 2>&1') >> 8; +if (-e 'needs-auth.txt') +{ + unlink 'needs-auth.txt' or warn "Cannot unlink 'needs-auth.txt': $ERRNO"; +} warn "Got code: $code\n" if $code; -kill ('TERM', $pid); -exit ($code != 0); +kill 'TERM', $pid or warn "Cannot kill PID $pid: $ERRNO"; +exit($code != 0); diff --git a/tests/Test-proxied-https-auth.px b/tests/Test-proxied-https-auth.px index d2c710a..2a817c2 100755 --- a/tests/Test-proxied-https-auth.px +++ b/tests/Test-proxied-https-auth.px @@ -6,51 +6,62 @@ use strict; use warnings; use WgetFeature qw(https); -use WgetTests; # For $WGETPATH. +use WgetTests; # For $WGETPATH. my $cert_path; my $key_path; my $srcdir; -if (@ARGV) { +if (@ARGV) +{ $srcdir = shift @ARGV; -} elsif (defined $ENV{srcdir}) { +} +elsif (defined $ENV{srcdir}) +{ $srcdir = $ENV{srcdir}; } -if (defined $srcdir) { - $key_path = "$srcdir/certs/server-key.pem"; +if (defined $srcdir) +{ + $key_path = "$srcdir/certs/server-key.pem"; $cert_path = "$srcdir/certs/server-cert.pem"; -} else { - $key_path = "certs/server-key.pem"; - $cert_path = "certs/server-cert.pem"; +} +else +{ + $key_path = 'certs/server-key.pem'; + $cert_path = 'certs/server-cert.pem'; } - +use English qw(-no_match_vars); use HTTP::Daemon; use HTTP::Request; +use IO::Handle; use IO::Socket::SSL; -my $SOCKET = HTTP::Daemon->new (LocalAddr => 'localhost', - ReuseAddr => 1) or die "Cannot create server!!!"; +my $SOCKET = HTTP::Daemon->new(LocalAddr => 'localhost', + ReuseAddr => 1) + or die 'Cannot create server!!!'; -sub get_request { - my $conn = shift; - my $content = ''; +sub get_request +{ + my $conn = shift; + my $content = q{}; my $line; - while (defined ($line = <$conn>)) { + while (defined($line = <$conn>)) + { $content .= $line; last if $line eq "\r\n"; } my $rqst = HTTP::Request->parse($content) - or die "Couldn't parse request:\n$content\n"; + or die "Couldn't parse request:\n$content\n"; return $rqst; } -sub do_server { +sub do_server +{ my ($synch_callback) = @_; my $s = $SOCKET; my $conn; @@ -58,10 +69,11 @@ sub do_server { my $rspn; my %options = ( - SSL_server => 1, - SSL_passwd_cb => sub { return "Hello"; }); + SSL_server => 1, + SSL_passwd_cb => sub { return 'Hello'; } + ); $options{SSL_cert_file} = $cert_path if ($cert_path); - $options{SSL_key_file} = $key_path if ($key_path); + $options{SSL_key_file} = $key_path if ($key_path); my @options = %options; # sync with the parent @@ -69,7 +81,8 @@ sub do_server { # Simulate a HTTPS proxy server with tunneling. - for my $expect_inner_auth (0, 1) { + for my $expect_inner_auth (0, 1) + { $conn = $s->accept; $rqst = $conn->get_request; die "Method not CONNECT\n" if ($rqst->method ne 'CONNECT'); @@ -80,83 +93,119 @@ sub do_server { # to an HTTPS server). $conn = IO::Socket::SSL->new_from_fd($conn->fileno, @options) - or die "Couldn't initiate SSL"; - - $rqst = &get_request($conn) - or die "Didn't get proxied request\n"; - - unless ($expect_inner_auth) { - die "Early proxied auth\n" if $rqst->header('Authorization'); - - $rspn = HTTP::Response->new(401, 'Unauthorized', [ - 'WWW-Authenticate' => 'Basic realm="gondor"', - Connection => 'close' - ]); - } else { - die "No proxied auth\n" unless $rqst->header('Authorization'); - - $rspn = HTTP::Response->new(200, 'OK', [ - 'Content-Type' => 'text/plain', - 'Connection' => 'close', - ], "foobarbaz\n"); + or die 'Couldn\'t initiate SSL'; + + $rqst = get_request($conn) + or die 'Didn\'t get proxied request'; + + if (not $expect_inner_auth) + { + die 'Early proxied auth' if $rqst->header('Authorization'); + + $rspn = HTTP::Response->new( + 401, + 'Unauthorized', + [ + 'WWW-Authenticate' => 'Basic realm="gondor"', + Connection => 'close' + ] + ); + } + else + { + die 'No proxied auth' unless $rqst->header('Authorization'); + + $rspn = HTTP::Response->new( + 200, 'OK', + [ + 'Content-Type' => 'text/plain', + 'Connection' => 'close', + ], + "foobarbaz\n" + ); } $rspn->protocol('HTTP/1.0'); - print STDERR "=====\n"; - print STDERR $rspn->as_string; - print STDERR "\n=====\n"; - print $conn $rspn->as_string; + print {*STDERR} "=====\n"; + print {*STDERR} $rspn->as_string; + print {*STDERR} "\n=====\n"; + print {$conn} $rspn->as_string; $conn->close; } undef $conn; undef $s; + return 1; } -sub fork_server { - pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!"; - select((select(TO_PARENT), $| = 1)[0]); +sub fork_server +{ + pipe my ($from_child, $to_parent) or die 'Cannot create pipe!'; + $to_parent->autoflush(); my $pid = fork(); - if ($pid < 0) { - die "Cannot fork"; - } elsif ($pid == 0) { + if ($pid < 0) + { + die 'Cannot fork'; + } + elsif ($pid == 0) + { # child - close FROM_CHILD; - do_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); + close $from_child or warn "Cannot close child: $ERRNO"; + + do_server( + sub { + print {$to_parent} "SYNC\n"; + close $to_parent or warn 'Cannot close parent'; + } + ); exit 0; - } else { + } + else + { # parent - close TO_PARENT; - chomp(my $line = <FROM_CHILD>); - close FROM_CHILD; + close $to_parent or warn "Cannot close parent: $ERRNO"; + chomp(my $line = <$from_child>); + close $from_child or warn "Cannot close child: $ERRNO"; } return $pid; } -unlink "needs-auth.txt"; -my $pid = &fork_server; - -my $cmdline = $WgetTest::WGETPATH . " --user=fiddle-dee-dee" - . " --password=Dodgson -e https_proxy=localhost:{{port}}" - . " --no-check-certificate" - . " https://no.such.domain/needs-auth.txt";; +if (-e 'needs-auth.txt') +{ + unlink 'needs-auth.txt' or warn "Cannot unlink 'needs-auth.txt': $ERRNO"; +} +my $pid = fork_server(); + +my $cmdline = + $WgetTest::WGETPATH + . ' --user=fiddle-dee-dee' + . ' --password=Dodgson -e https_proxy=localhost:{{port}}' + . ' --no-check-certificate' + . ' https://no.such.domain/needs-auth.txt'; $cmdline =~ s/{{port}}/$SOCKET->sockport()/e; my $valgrind = $ENV{VALGRIND_TESTS}; -if (!defined $valgrind || $valgrind eq "" || $valgrind == 0) { +if (!defined $valgrind || $valgrind eq q{} || $valgrind == 0) +{ # Valgrind not requested - leave $cmdline as it is -} elsif ($valgrind == 1) { - $cmdline = "valgrind --error-exitcode=301 --leak-check=yes --track-origins=yes " . $cmdline; -} else { - $cmdline = $valgrind . " " . $cmdline; +} +elsif ($valgrind == 1) +{ + $cmdline = + 'valgrind --error-exitcode=301 --leak-check=yes --track-origins=yes ' + . $cmdline; +} +else +{ + $cmdline = $valgrind . q{ } . $cmdline; } -my $code = system($cmdline . " 2>&1") >> 8; -unlink "needs-auth.txt"; +my $code = system($cmdline . ' 2>&1') >> 8; +unlink 'needs-auth.txt' or die "Cannot unlink 'needs-auth.txt': $ERRNO"; warn "Got code: $code\n" if $code; -kill ('TERM', $pid); -exit ($code != 0); +kill 'TERM', $pid or warn "Cannot kill PID $pid: $ERRNO"; +exit($code != 0); -- 2.3.6
