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