From 2e3647cc791f651a2f7bec1ef9e19300227b4326 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?P=C3=A4r=20Karlsson?=
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 = );
- 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 = );
- 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