wget/tests/Test-proxied-https-auth.px

#!/usr/bin/perl

use strict;
use warnings;

use WgetTest;  # For $WGETPATH.

# Have we even built an HTTPS-supporting Wget?
{
    my @version_lines = `${WgetTest::WGETPATH} --version`;
    unless (grep /\+(openssl|gnutls)/, @version_lines) {
        print "Not running test: Wget under test doesn't support HTTPS.\n";
        exit 0;
    }
}

use HTTP::Daemon;
use HTTP::Request;
use IO::Socket::SSL;

my $SOCKET = HTTP::Daemon->new (LocalAddr => 'localhost',
    ReuseAddr => 1) or die "Cannot create server!!!";

sub get_request {
    my $conn = shift;
    my $content = '';
    my $line;

    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";

    return $rqst;
}

sub do_server {
    my $alrm = alarm 10;

    my $s = $SOCKET;
    my $conn;
    my $rqst;
    my $rspn;
    for my $expect_inner_auth (0, 1) {
        $conn = $s->accept;
        $rqst = $conn->get_request;

        # TODO: expect no auth the first time, request it, expect it the second
        #   time.

        die "Method not CONNECT\n" if ($rqst->method ne 'CONNECT');
        $rspn = HTTP::Response->new(200, 'OK');
        $conn->send_response($rspn);

        $conn = IO::Socket::SSL->new_from_fd($conn->fileno, SSL_server => 1,
            SSL_passwd_cb => sub { return "Hello"; })
            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');

            # TODO: handle non-persistent connection here.
            $rspn = HTTP::Response->new(401, 'Unauthorized', [
                'WWW-Authenticate' => 'Basic realm="gondor"',
                Connection => 'close'
                ]);
            $rspn->protocol('HTTP/1.0');
            print $rspn->as_string;
            print $conn $rspn->as_string;
        } else {
            die "No proxied auth\n" unless $rqst->header('Authorization');

            $rspn = HTTP::Response->new(200, 'OK', [
                'Content-Type' => 'text/plain',
                'Connection' => 'close',
                ], "foobarbaz\n");
            $rspn->protocol('HTTP/1.0');
            print "=====\n";
            print $rspn->as_string;
            print "\n=====\n";
            print $conn $rspn->as_string;
        }
        $conn->close;
    }
    undef $conn;
    undef $s;
    alarm $alrm;
}

sub fork_server {
    my $pid = fork;
    die "Couldn't fork" if ($pid < 0);
    return $pid if $pid;

    &do_server;
    exit;
}

system ('rm -f needs-auth.txt');
my $pid = &fork_server;

sleep 1;
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 $code = system($cmdline);
system ('rm -f needs-auth.txt');

warn "Got code: $code\n" if $code;
kill ('TERM', $pid);
exit ($code >> 8);