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