mirror of
https://github.com/moparisthebest/wget
synced 2024-07-03 16:38:41 -04:00
130 lines
3.2 KiB
Perl
Executable File
130 lines
3.2 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use WgetFeature qw(https);
|
|
use WgetTest; # For $WGETPATH.
|
|
|
|
my $cert_path;
|
|
my $key_path;
|
|
|
|
if (@ARGV) {
|
|
my $top_srcdir = shift @ARGV;
|
|
$key_path = "$top_srcdir/tests/certs/server-key.pem";
|
|
$cert_path = "$top_srcdir/tests/certs/server-cert.pem";
|
|
}
|
|
|
|
use HTTP::Daemon;
|
|
use HTTP::Request;
|
|
use IO::Socket::SSL;
|
|
|
|
my $SOCKET = HTTP::Daemon->new (LocalAddr => 'localhost',
|
|
ReuseAddr => 1) or die "Cannot create server!!!";
|
|
|
|
sub get_request {
|
|
my $conn = shift;
|
|
my $content = '';
|
|
my $line;
|
|
|
|
while (defined ($line = <$conn>)) {
|
|
$content .= $line;
|
|
last if $line eq "\r\n";
|
|
}
|
|
|
|
my $rqst = HTTP::Request->parse($content)
|
|
or die "Couldn't parse request:\n$content\n";
|
|
|
|
return $rqst;
|
|
}
|
|
|
|
sub do_server {
|
|
my $alrm = alarm 10;
|
|
|
|
my $s = $SOCKET;
|
|
my $conn;
|
|
my $rqst;
|
|
my $rspn;
|
|
for my $expect_inner_auth (0, 1) {
|
|
$conn = $s->accept;
|
|
$rqst = $conn->get_request;
|
|
|
|
# TODO: expect no auth the first time, request it, expect it the second
|
|
# time.
|
|
|
|
die "Method not CONNECT\n" if ($rqst->method ne 'CONNECT');
|
|
$rspn = HTTP::Response->new(200, 'OK');
|
|
$conn->send_response($rspn);
|
|
|
|
my %options = (
|
|
SSL_server => 1,
|
|
SSL_passwd_cb => sub { return "Hello"; });
|
|
|
|
$options{SSL_cert_file} = $cert_path if ($cert_path);
|
|
$options{SSL_key_file} = $key_path if ($key_path);
|
|
|
|
my @options = %options;
|
|
|
|
$conn = IO::Socket::SSL->new_from_fd($conn->fileno, @options)
|
|
or die "Couldn't initiate SSL";
|
|
|
|
$rqst = &get_request($conn)
|
|
or die "Didn't get proxied request\n";
|
|
|
|
unless ($expect_inner_auth) {
|
|
die "Early proxied auth\n" if $rqst->header('Authorization');
|
|
|
|
# TODO: handle non-persistent connection here.
|
|
$rspn = HTTP::Response->new(401, 'Unauthorized', [
|
|
'WWW-Authenticate' => 'Basic realm="gondor"',
|
|
Connection => 'close'
|
|
]);
|
|
$rspn->protocol('HTTP/1.0');
|
|
print $rspn->as_string;
|
|
print $conn $rspn->as_string;
|
|
} else {
|
|
die "No proxied auth\n" unless $rqst->header('Authorization');
|
|
|
|
$rspn = HTTP::Response->new(200, 'OK', [
|
|
'Content-Type' => 'text/plain',
|
|
'Connection' => 'close',
|
|
], "foobarbaz\n");
|
|
$rspn->protocol('HTTP/1.0');
|
|
print "=====\n";
|
|
print $rspn->as_string;
|
|
print "\n=====\n";
|
|
print $conn $rspn->as_string;
|
|
}
|
|
$conn->close;
|
|
}
|
|
undef $conn;
|
|
undef $s;
|
|
alarm $alrm;
|
|
}
|
|
|
|
sub fork_server {
|
|
my $pid = fork;
|
|
die "Couldn't fork" if ($pid < 0);
|
|
return $pid if $pid;
|
|
|
|
&do_server;
|
|
exit;
|
|
}
|
|
|
|
system ('rm -f needs-auth.txt');
|
|
my $pid = &fork_server;
|
|
|
|
sleep 1;
|
|
my $cmdline = $WgetTest::WGETPATH . " --user=fiddle-dee-dee"
|
|
. " --password=Dodgson -e https_proxy=localhost:{{port}}"
|
|
. " --no-check-certificate"
|
|
. " https://no.such.domain/needs-auth.txt";
|
|
$cmdline =~ s/{{port}}/$SOCKET->sockport()/e;
|
|
|
|
my $code = system($cmdline);
|
|
system ('rm -f needs-auth.txt');
|
|
|
|
warn "Got code: $code\n" if $code;
|
|
kill ('TERM', $pid);
|
|
exit ($code >> 8);
|