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