public-inbox.git  about / heads / tags
an "archives first" approach to mailing lists
blob 410ae658325596196128326ddee7d435dd207fbc 4277 bytes (raw)
$ git show p516-leak:t/httpd-https.t	# shows this blob on the CLI

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
 
# Copyright (C) 2019 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET);
# IO::Poll is part of the standard library, but distros may split them off...
foreach my $mod (qw(IO::Socket::SSL IO::Poll)) {
	eval "require $mod";
	plan skip_all => "$mod missing for $0" if $@;
}
my $cert = 'certs/server-cert.pem';
my $key = 'certs/server-key.pem';
unless (-r $key && -r $cert) {
	plan skip_all =>
		"certs/ missing for $0, run ./create-certs.perl in certs/";
}
use_ok 'PublicInbox::TLS';
use_ok 'IO::Socket::SSL';
require './t/common.perl';
my $psgi = "./t/httpd-corner.psgi";
my $tmpdir = tempdir('pi-httpd-https-XXXXXX', TMPDIR => 1, CLEANUP => 1);
my $err = "$tmpdir/stderr.log";
my $out = "$tmpdir/stdout.log";
my $httpd = 'blib/script/public-inbox-httpd';
my $https = tcp_server();
my ($pid, $tail_pid);
END {
	foreach ($pid, $tail_pid) {
		kill 'TERM', $_ if defined $_;
	}
};
my $https_addr = $https->sockhost . ':' . $https->sockport;

for my $args (
	[ "-lhttps://$https_addr/?key=$key,cert=$cert" ],
) {
	for ($out, $err) {
		open my $fh, '>', $_ or die "truncate: $!";
	}
	if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail
		$tail_pid = fork;
		if (defined $tail_pid && $tail_pid == 0) {
			exec(split(' ', $tail_cmd), $out, $err);
		}
	}
	my $cmd = [ $httpd, '-W0', @$args,
			"--stdout=$out", "--stderr=$err", $psgi ];
	$pid = spawn_listener(undef, $cmd, [ $https ]);
	my %o = (
		SSL_hostname => 'server.local',
		SSL_verifycn_name => 'server.local',
		SSL_verify_mode => SSL_VERIFY_PEER(),
		SSL_ca_file => 'certs/test-ca.pem',
	);
	# start negotiating a slow TLS connection
	my $slow = tcp_connect($https, Blocking => 0);
	$slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o);
	my @poll = (fileno($slow));
	my $slow_done = $slow->connect_SSL;
	if ($slow_done) {
		diag('W: connect_SSL early OK, slow client test invalid');
		push @poll, PublicInbox::Syscall::EPOLLOUT();
	} else {
		push @poll, PublicInbox::TLS::epollbit();
	}

	# normal HTTPS
	my $c = tcp_connect($https);
	IO::Socket::SSL->start_SSL($c, %o);
	ok($c->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"),
		'wrote HTTP request');
	my $buf = '';
	sysread($c, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\n/;
	like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response');

	# HTTPS with bad hostname
	$c = tcp_connect($https);
	$o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.fail';
	$c = IO::Socket::SSL->start_SSL($c, %o);
	is($c, undef, 'HTTPS fails with bad hostname');

	$o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.local';
	$c = tcp_connect($https);
	IO::Socket::SSL->start_SSL($c, %o);
	ok($c, 'HTTPS succeeds again with valid hostname');

	# slow TLS connection did not block the other fast clients while
	# connecting, finish it off:
	until ($slow_done) {
		IO::Poll::_poll(-1, @poll);
		$slow_done = $slow->connect_SSL and last;
		@poll = (fileno($slow), PublicInbox::TLS::epollbit());
	}
	$slow->blocking(1);
	ok($slow->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"),
		'wrote HTTP request from slow');
	$buf = '';
	sysread($slow, $buf, 666, length($buf)) until $buf =~ /\r\n\r\n/;
	like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response from slow');
	$slow = undef;

	SKIP: {
		skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
		my $var = Socket::TCP_DEFER_ACCEPT();
		defined(my $x = getsockopt($https, IPPROTO_TCP, $var)) or die;
		ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on https');
	};
	SKIP: {
		skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd';
		if (system('kldstat -m accf_data >/dev/null')) {
			skip 'accf_data not loaded? kldload accf_data', 2;
		}
		require PublicInbox::Daemon;
		my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
		my $x = getsockopt($https, SOL_SOCKET, $var);
		like($x, qr/\Adataready\0+\z/, 'got dataready accf for https');
	};

	$c = undef;
	kill('TERM', $pid);
	is($pid, waitpid($pid, 0), 'httpd exited successfully');
	is($?, 0, 'no error in exited process');
	$pid = undef;
	if (defined $tail_pid) {
		kill 'TERM', $tail_pid;
		waitpid($tail_pid, 0);
		$tail_pid = undef;
	}
}
done_testing();
1;

git clone https://public-inbox.org/public-inbox.git
git clone http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/public-inbox.git