1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use WgetFeature qw(https);
7use WgetTest;  # For $WGETPATH.
8
9my $cert_path;
10my $key_path;
11
12if (@ARGV) {
13    my $top_srcdir = shift @ARGV;
14    $key_path = "$top_srcdir/tests/certs/server-key.pem";
15    $cert_path = "$top_srcdir/tests/certs/server-cert.pem";
16}
17
18use HTTP::Daemon;
19use HTTP::Request;
20use IO::Socket::SSL;
21
22my $SOCKET = HTTP::Daemon->new (LocalAddr => 'localhost',
23    ReuseAddr => 1) or die "Cannot create server!!!";
24
25sub get_request {
26    my $conn = shift;
27    my $content = '';
28    my $line;
29
30    while (defined ($line = <$conn>)) {
31        $content .= $line;
32        last if $line eq "\r\n";
33    }
34
35    my $rqst = HTTP::Request->parse($content)
36        or die "Couldn't parse request:\n$content\n";
37
38    return $rqst;
39}
40
41sub do_server {
42    my $alrm = alarm 10;
43
44    my $s = $SOCKET;
45    my $conn;
46    my $rqst;
47    my $rspn;
48    for my $expect_inner_auth (0, 1) {
49        $conn = $s->accept;
50        $rqst = $conn->get_request;
51
52        # TODO: expect no auth the first time, request it, expect it the second
53        #   time.
54
55        die "Method not CONNECT\n" if ($rqst->method ne 'CONNECT');
56        $rspn = HTTP::Response->new(200, 'OK');
57        $conn->send_response($rspn);
58
59        my %options = (
60            SSL_server => 1,
61            SSL_passwd_cb => sub { return "Hello"; });
62
63        $options{SSL_cert_file} = $cert_path if ($cert_path);
64        $options{SSL_key_file} = $key_path if ($key_path);
65
66        my @options = %options;
67
68        $conn = IO::Socket::SSL->new_from_fd($conn->fileno, @options)
69            or die "Couldn't initiate SSL";
70
71        $rqst = &get_request($conn)
72            or die "Didn't get proxied request\n";
73
74        unless ($expect_inner_auth) {
75            die "Early proxied auth\n" if $rqst->header('Authorization');
76
77            # TODO: handle non-persistent connection here.
78            $rspn = HTTP::Response->new(401, 'Unauthorized', [
79                'WWW-Authenticate' => 'Basic realm="gondor"',
80                Connection => 'close'
81                ]);
82            $rspn->protocol('HTTP/1.0');
83            print $rspn->as_string;
84            print $conn $rspn->as_string;
85        } else {
86            die "No proxied auth\n" unless $rqst->header('Authorization');
87
88            $rspn = HTTP::Response->new(200, 'OK', [
89                'Content-Type' => 'text/plain',
90                'Connection' => 'close',
91                ], "foobarbaz\n");
92            $rspn->protocol('HTTP/1.0');
93            print "=====\n";
94            print $rspn->as_string;
95            print "\n=====\n";
96            print $conn $rspn->as_string;
97        }
98        $conn->close;
99    }
100    undef $conn;
101    undef $s;
102    alarm $alrm;
103}
104
105sub fork_server {
106    my $pid = fork;
107    die "Couldn't fork" if ($pid < 0);
108    return $pid if $pid;
109
110    &do_server;
111    exit;
112}
113
114system ('rm -f needs-auth.txt');
115my $pid = &fork_server;
116
117sleep 1;
118my $cmdline = $WgetTest::WGETPATH . " --user=fiddle-dee-dee"
119    . " --password=Dodgson -e https_proxy=localhost:{{port}}"
120    . " --no-check-certificate"
121    . " https://no.such.domain/needs-auth.txt";
122$cmdline =~ s/{{port}}/$SOCKET->sockport()/e;
123
124my $code = system($cmdline);
125system ('rm -f needs-auth.txt');
126
127warn "Got code: $code\n" if $code;
128kill ('TERM', $pid);
129exit ($code >> 8);
130