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