2 # Copyright (C) all contributors <meta@public-inbox.org>
3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
5 use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET);
6 use PublicInbox::TestCommon;
8 # IO::Poll is part of the standard library, but distros may split them off...
9 require_mods(qw(IO::Socket::SSL IO::Poll Plack::Util));
10 my @certs = qw(certs/server-cert.pem certs/server-key.pem
11 certs/server2-cert.pem certs/server2-key.pem);
12 if (scalar(grep { -r $_ } @certs) != scalar(@certs)) {
14 "certs/ missing for $0, run $^X ./create-certs.perl in certs/";
16 use_ok 'PublicInbox::TLS';
17 use_ok 'IO::Socket::SSL';
18 my $psgi = "./t/httpd-corner.psgi";
19 my ($tmpdir, $for_destroy) = tmpdir();
20 my $err = "$tmpdir/stderr.log";
21 my $out = "$tmpdir/stdout.log";
22 my $https = tcp_server();
24 my $https_addr = tcp_host_port($https);
25 my $cert = "$tmpdir/cert.pem";
26 my $key = "$tmpdir/key.pem";
27 cp('certs/server-cert.pem', $cert) or xbail $!;
28 cp('certs/server-key.pem', $key) or xbail $!;
30 my $check_url_scheme = sub {
32 $s->print("GET /url_scheme HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n")
33 or xbail "failed to write HTTP request: $! (line $line)";
35 sysread($s, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\nhttps?/;
36 like($buf, qr!\AHTTP/1\.1 200!, "read HTTPS response (line $line)");
37 like($buf, qr!\r\nhttps\z!, "psgi.url_scheme is 'https' (line $line)");
41 [ "-lhttps://$https_addr/?key=$key,cert=$cert" ],
44 open my $fh, '>', $_ or die "truncate: $!";
46 my $cmd = [ '-httpd', '-W0', @$args,
47 "--stdout=$out", "--stderr=$err", $psgi ];
48 $td = start_script($cmd, undef, { 3 => $https });
50 SSL_hostname => 'server.local',
51 SSL_verifycn_name => 'server.local',
52 SSL_verify_mode => SSL_VERIFY_PEER(),
53 SSL_ca_file => 'certs/test-ca.pem',
55 # start negotiating a slow TLS connection
56 my $slow = tcp_connect($https, Blocking => 0);
57 $slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o);
58 my @poll = (fileno($slow));
59 my $slow_done = $slow->connect_SSL;
61 diag('W: connect_SSL early OK, slow client test invalid');
62 push @poll, PublicInbox::Syscall::EPOLLOUT();
64 push @poll, PublicInbox::TLS::epollbit();
68 my $c = tcp_connect($https);
69 IO::Socket::SSL->start_SSL($c, %o);
70 $check_url_scheme->($c, __LINE__);
72 # HTTPS with bad hostname
73 $c = tcp_connect($https);
74 $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.fail';
75 $c = IO::Socket::SSL->start_SSL($c, %o);
76 is($c, undef, 'HTTPS fails with bad hostname');
78 $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server.local';
79 $c = tcp_connect($https);
80 IO::Socket::SSL->start_SSL($c, %o);
81 ok($c, 'HTTPS succeeds again with valid hostname');
83 # slow TLS connection did not block the other fast clients while
84 # connecting, finish it off:
86 IO::Poll::_poll(-1, @poll);
87 $slow_done = $slow->connect_SSL and last;
88 @poll = (fileno($slow), PublicInbox::TLS::epollbit());
91 ok($slow->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"),
92 'wrote HTTP request from slow');
94 sysread($slow, $buf, 666, length($buf)) until $buf =~ /\r\n\r\n/;
95 like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response from slow');
99 skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
100 my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
101 defined(my $x = getsockopt($https, IPPROTO_TCP, $var)) or die;
102 ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on https');
105 skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd';
106 if (system('kldstat -m accf_data >/dev/null')) {
107 skip 'accf_data not loaded? kldload accf_data', 2;
109 require PublicInbox::Daemon;
110 ok(defined($PublicInbox::Daemon::SO_ACCEPTFILTER),
111 'SO_ACCEPTFILTER defined');
112 my $x = getsockopt($https, SOL_SOCKET,
113 $PublicInbox::Daemon::SO_ACCEPTFILTER);
114 like($x, qr/\Adataready\0+\z/, 'got dataready accf for https');
117 # switch cert and key:
118 cp('certs/server2-cert.pem', $cert) or xbail $!;
119 cp('certs/server2-key.pem', $key) or xbail $!;
120 $td->kill('HUP') or xbail "kill: $!";
121 tick(); # wait for SIGHUP to take effect (hopefully :x)
123 my $d = tcp_connect($https);
124 $d = IO::Socket::SSL->start_SSL($d, %o);
125 is($d, undef, 'HTTPS fails with bad hostname after new cert on HUP');
127 $d = tcp_connect($https);
128 $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server2.local';
129 is(IO::Socket::SSL->start_SSL($d, %o), $d,
130 'new hostname to match cert works after HUP');
131 $check_url_scheme->($d, __LINE__);
133 # existing connection w/ old cert still works:
134 $check_url_scheme->($c, __LINE__);
140 is($?, 0, 'no error in exited process');