]> Sergey Matveev's repositories - public-inbox.git/blob - t/httpd-corner.t
qspawn: retry sysread when parsing headers, too
[public-inbox.git] / t / httpd-corner.t
1 # Copyright (C) 2016-2019 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 # note: our HTTP server should be standalone and capable of running
4 # generic PSGI/Plack apps.
5 use strict;
6 use warnings;
7 use Test::More;
8 use Time::HiRes qw(gettimeofday tv_interval);
9
10 foreach my $mod (qw(Plack::Util Plack::Builder
11                         HTTP::Date HTTP::Status IPC::Run)) {
12         eval "require $mod";
13         plan skip_all => "$mod missing for httpd-corner.t" if $@;
14 }
15
16 use Digest::SHA qw(sha1_hex);
17 use File::Temp qw/tempdir/;
18 use IO::Socket;
19 use IO::Socket::UNIX;
20 use Fcntl qw(:seek);
21 use Socket qw(IPPROTO_TCP TCP_NODELAY SOL_SOCKET);
22 use POSIX qw(mkfifo);
23 require './t/common.perl';
24 my $tmpdir = tempdir('httpd-corner-XXXXXX', TMPDIR => 1, CLEANUP => 1);
25 my $fifo = "$tmpdir/fifo";
26 ok(defined mkfifo($fifo, 0777), 'created FIFO');
27 my $err = "$tmpdir/stderr.log";
28 my $out = "$tmpdir/stdout.log";
29 my $httpd = 'blib/script/public-inbox-httpd';
30 my $psgi = "./t/httpd-corner.psgi";
31 my $sock = tcp_server();
32
33 # Make sure we don't clobber socket options set by systemd or similar
34 # using socket activation:
35 my ($defer_accept_val, $accf_arg);
36 if ($^O eq 'linux') {
37         setsockopt($sock, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT(), 5) or die;
38         my $x = getsockopt($sock, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT());
39         defined $x or die "getsockopt: $!";
40         $defer_accept_val = unpack('i', $x);
41         if ($defer_accept_val <= 0) {
42                 die "unexpected TCP_DEFER_ACCEPT value: $defer_accept_val";
43         }
44 } elsif ($^O eq 'freebsd' && system('kldstat -m accf_data >/dev/null') == 0) {
45         require PublicInbox::Daemon;
46         my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
47         $accf_arg = pack('a16a240', 'dataready', '');
48         setsockopt($sock, SOL_SOCKET, $var, $accf_arg) or die "setsockopt: $!";
49 }
50
51 my $upath = "$tmpdir/s";
52 my $unix = unix_server($upath);
53 ok($unix, 'UNIX socket created');
54 my $pid;
55 END { kill 'TERM', $pid if defined $pid };
56 my $spawn_httpd = sub {
57         my (@args) = @_;
58         my $cmd = [ $httpd, @args, "--stdout=$out", "--stderr=$err", $psgi ];
59         $pid = spawn_listener(undef, $cmd, [ $sock, $unix ]);
60         ok(defined $pid, 'forked httpd process successfully');
61 };
62
63 {
64         ok($sock, 'sock created');
65         $spawn_httpd->('-W0');
66 }
67
68 {
69         my $conn = conn_for($sock, 'streaming callback');
70         $conn->write("GET /callback HTTP/1.0\r\n\r\n");
71         ok($conn->read(my $buf, 8192), 'read response');
72         my ($head, $body) = split(/\r\n\r\n/, $buf);
73         is($body, "hello world\n", 'callback body matches expected');
74 }
75
76 {
77         my $conn = conn_for($sock, 'getline-die');
78         $conn->write("GET /getline-die HTTP/1.1\r\nHost: example.com\r\n\r\n");
79         ok($conn->read(my $buf, 8192), 'read some response');
80         like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header');
81         is($conn->read(my $nil, 8192), 0, 'read EOF');
82         $conn = undef;
83         my $after = capture($err);
84         is(scalar(grep(/GETLINE FAIL/, @$after)), 1, 'failure logged');
85         is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
86 }
87
88 {
89         my $conn = conn_for($sock, 'close-die');
90         $conn->write("GET /close-die HTTP/1.1\r\nHost: example.com\r\n\r\n");
91         ok($conn->read(my $buf, 8192), 'read some response');
92         like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header');
93         is($conn->read(my $nil, 8192), 0, 'read EOF');
94         $conn = undef;
95         my $after = capture($err);
96         is(scalar(grep(/GETLINE FAIL/, @$after)), 0, 'getline not failed');
97         is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
98 }
99
100 SKIP: {
101         my $conn = conn_for($sock, 'excessive header');
102         $SIG{PIPE} = 'IGNORE';
103         $conn->write("GET /callback HTTP/1.0\r\n");
104         foreach my $i (1..500000) {
105                 last unless $conn->write("X-xxxxxJunk-$i: omg\r\n");
106         }
107         ok(!$conn->write("\r\n"), 'broken request');
108         ok($conn->read(my $buf, 8192), 'read response');
109         my ($head, $body) = split(/\r\n\r\n/, $buf);
110         like($head, qr/\b400\b/, 'got 400 response');
111 }
112
113 {
114         my $conn = conn_for($sock, 'excessive body Content-Length');
115         $SIG{PIPE} = 'IGNORE';
116         my $n = (10 * 1024 * 1024) + 1;
117         $conn->write("PUT /sha1 HTTP/1.0\r\nContent-Length: $n\r\n\r\n");
118         ok($conn->read(my $buf, 8192), 'read response');
119         my ($head, $body) = split(/\r\n\r\n/, $buf);
120         like($head, qr/\b413\b/, 'got 413 response');
121 }
122
123 {
124         my $conn = conn_for($sock, 'excessive body chunked');
125         $SIG{PIPE} = 'IGNORE';
126         my $n = (10 * 1024 * 1024) + 1;
127         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: chunked\r\n");
128         $conn->write("\r\n".sprintf("%x\r\n", $n));
129         ok($conn->read(my $buf, 8192), 'read response');
130         my ($head, $body) = split(/\r\n\r\n/, $buf);
131         like($head, qr/\b413\b/, 'got 413 response');
132 }
133
134 {
135         my $conn = conn_for($sock, 'chunk with pipeline');
136         my $n = 10;
137         my $payload = 'b'x$n;
138         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: chunked\r\n");
139         $conn->write("\r\n".sprintf("%x\r\n", $n));
140         $conn->write($payload . "\r\n0\r\n\r\nGET /empty HTTP/1.0\r\n\r\n");
141         $conn->read(my $buf, 4096);
142         my $lim = 0;
143         $lim++ while ($conn->read($buf, 4096, bytes::length($buf)) && $lim < 9);
144         my $exp = sha1_hex($payload);
145         like($buf, qr!\r\n\r\n${exp}HTTP/1\.0 200 OK\r\n!s,
146                 'chunk parser can handled pipelined requests');
147 }
148
149 # Unix domain sockets
150 {
151         my $u = IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $upath);
152         ok($u, 'unix socket connected');
153         $u->write("GET /host-port HTTP/1.0\r\n\r\n");
154         $u->read(my $buf, 4096);
155         like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!,
156                 'set REMOTE_ADDR and REMOTE_PORT for Unix socket');
157 }
158
159 sub conn_for {
160         my ($sock, $msg) = @_;
161         my $conn = IO::Socket::INET->new(
162                                 PeerAddr => $sock->sockhost,
163                                 PeerPort => $sock->sockport,
164                                 Proto => 'tcp',
165                                 Type => SOCK_STREAM);
166         ok($conn, "connected for $msg");
167         $conn->autoflush(1);
168         setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1);
169         return $conn;
170 }
171
172 {
173         my $conn = conn_for($sock, 'host-port');
174         $conn->write("GET /host-port HTTP/1.0\r\n\r\n");
175         $conn->read(my $buf, 4096);
176         my ($head, $body) = split(/\r\n\r\n/, $buf);
177         my ($addr, $port) = split(/:/, $body);
178         is($addr, $conn->sockhost, 'host matches addr');
179         is($port, $conn->sockport, 'port matches');
180 }
181
182 # graceful termination
183 {
184         my $conn = conn_for($sock, 'graceful termination via slow header');
185         $conn->write("GET /slow-header HTTP/1.0\r\n" .
186                         "X-Check-Fifo: $fifo\r\n\r\n");
187         open my $f, '>', $fifo or die "open $fifo: $!\n";
188         $f->autoflush(1);
189         ok(print($f "hello\n"), 'wrote something to fifo');
190         my $kpid = $pid;
191         $pid = undef;
192         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
193         ok(print($f "world\n"), 'wrote else to fifo');
194         close $f or die "close fifo: $!\n";
195         $conn->read(my $buf, 8192);
196         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
197         like($head, qr!\AHTTP/1\.[01] 200 OK!, 'got 200 for slow-header');
198         is($body, "hello\nworld\n", 'read expected body');
199         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
200         is($?, 0, 'no error');
201         $spawn_httpd->('-W0');
202 }
203
204 {
205         my $conn = conn_for($sock, 'graceful termination via slow-body');
206         $conn->write("GET /slow-body HTTP/1.0\r\n" .
207                         "X-Check-Fifo: $fifo\r\n\r\n");
208         open my $f, '>', $fifo or die "open $fifo: $!\n";
209         $f->autoflush(1);
210         my $buf;
211         $conn->sysread($buf, 8192);
212         like($buf, qr!\AHTTP/1\.[01] 200 OK!, 'got 200 for slow-body');
213         like($buf, qr!\r\n\r\n!, 'finished HTTP response header');
214
215         foreach my $c ('a'..'c') {
216                 $c .= "\n";
217                 ok(print($f $c), 'wrote line to fifo');
218                 $conn->sysread($buf, 8192);
219                 is($buf, $c, 'got trickle for reading');
220         }
221         my $kpid = $pid;
222         $pid = undef;
223         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
224         ok(print($f "world\n"), 'wrote else to fifo');
225         close $f or die "close fifo: $!\n";
226         $conn->sysread($buf, 8192);
227         is($buf, "world\n", 'read expected body');
228         is($conn->sysread($buf, 8192), 0, 'got EOF from server');
229         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
230         is($?, 0, 'no error');
231         $spawn_httpd->('-W0');
232 }
233
234 sub delay { select(undef, undef, undef, shift || rand(0.02)) }
235
236 my $str = 'abcdefghijklmnopqrstuvwxyz';
237 my $len = length $str;
238 is($len, 26, 'got the alphabet');
239 my $check_self = sub {
240         my ($conn) = @_;
241         $conn->read(my $buf, 4096);
242         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
243         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
244         is($body, sha1_hex($str), 'read expected body');
245 };
246
247 SKIP: {
248         my $have_curl = 0;
249         foreach my $p (split(':', $ENV{PATH})) {
250                 -x "$p/curl" or next;
251                 $have_curl = 1;
252                 last;
253         }
254         my $ntest = 4;
255         $have_curl or skip('curl(1) missing', $ntest);
256         my $base = 'http://' . $sock->sockhost . ':' . $sock->sockport;
257         my $url = "$base/sha1";
258         my ($r, $w);
259         pipe($r, $w) or die "pipe: $!";
260         my $cmd = [qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url];
261         my ($out, $err) = ('', '');
262         my $h = IPC::Run::start($cmd, $r, \$out, \$err);
263         $w->autoflush(1);
264         foreach my $c ('a'..'z') {
265                 print $w $c or die "failed to write to curl: $!";
266                 delay();
267         }
268         close $w or die "close write pipe: $!";
269         close $r or die "close read pipe: $!";
270         IPC::Run::finish($h);
271         is($?, 0, 'curl exited successfully');
272         is($err, '', 'no errors from curl');
273         is($out, sha1_hex($str), 'read expected body');
274
275         open my $fh, '-|', qw(curl -sS), "$base/async-big" or die $!;
276         my $n = 0;
277         my $non_zero = 0;
278         while (1) {
279                 my $r = sysread($fh, my $buf, 4096) or last;
280                 $n += $r;
281                 $buf =~ /\A\0+\z/ or $non_zero++;
282         }
283         is($n, 30 * 1024 * 1024, 'got expected output from curl');
284         is($non_zero, 0, 'read all zeros');
285 }
286
287 {
288         my $conn = conn_for($sock, '1.1 pipeline together');
289         $conn->write("PUT /sha1 HTTP/1.1\r\nUser-agent: hello\r\n\r\n" .
290                         "PUT /sha1 HTTP/1.1\r\n\r\n");
291         my $buf = '';
292         my @r;
293         until (scalar(@r) >= 2) {
294                 my $r = $conn->sysread(my $tmp, 4096);
295                 die $! unless defined $r;
296                 die "EOF <$buf>" unless $r;
297                 $buf .= $tmp;
298                 @r = ($buf =~ /\r\n\r\n([a-f0-9]{40})/g);
299         }
300         is(2, scalar @r, 'got 2 responses');
301         my $i = 3;
302         foreach my $hex (@r) {
303                 is($hex, sha1_hex(''), "read expected body $i");
304                 $i++;
305         }
306 }
307
308 {
309         my $conn = conn_for($sock, 'no TCP_CORK on empty body');
310         $conn->write("GET /empty HTTP/1.1\r\nHost:example.com\r\n\r\n");
311         my $buf = '';
312         my $t0 = [ gettimeofday ];
313         until ($buf =~ /\r\n\r\n/s) {
314                 $conn->sysread($buf, 4096, length($buf));
315         }
316         my $elapsed = tv_interval($t0, [ gettimeofday ]);
317         ok($elapsed < 0.190, 'no 200ms TCP cork delay on empty body');
318 }
319
320 {
321         my $conn = conn_for($sock, 'graceful termination during slow request');
322         $conn->write("PUT /sha1 HTTP/1.0\r\n");
323         delay();
324         $conn->write("Content-Length: $len\r\n");
325         delay();
326         $conn->write("\r\n");
327         my $kpid = $pid;
328         $pid = undef;
329         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
330         delay();
331         my $n = 0;
332         foreach my $c ('a'..'z') {
333                 $n += $conn->write($c);
334         }
335         is($n, $len, 'wrote alphabet');
336         $check_self->($conn);
337         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
338         is($?, 0, 'no error');
339         $spawn_httpd->('-W0');
340 }
341
342 # various DoS attacks against the chunk parser:
343 {
344         local $SIG{PIPE} = 'IGNORE';
345         my $conn = conn_for($sock, '1.1 chunk header excessive');
346         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
347         my $n = 0;
348         my $w;
349         while ($w = $conn->write('ffffffff')) {
350                 $n += $w;
351         }
352         ok($!, 'got error set in $!');
353         is($w, undef, 'write error happened');
354         ok($n > 0, 'was able to write');
355         my $r = $conn->read(my $buf, 66666);
356         ok($r > 0, 'got non-empty response');
357         like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
358
359         $conn = conn_for($sock, '1.1 chunk trailer excessive');
360         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
361         is($conn->syswrite("1\r\na"), 4, 'wrote first header + chunk');
362         delay();
363         $n = 0;
364         while ($w = $conn->write("\r")) {
365                 $n += $w;
366         }
367         ok($!, 'got error set in $!');
368         ok($n > 0, 'wrote part of chunk end (\r)');
369         $r = $conn->read($buf, 66666);
370         ok($r > 0, 'got non-empty response');
371         like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
372 }
373
374 {
375         my $conn = conn_for($sock, '1.1 chunked close trickle');
376         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
377         $conn->write("Transfer-encoding: chunked\r\n\r\n");
378         foreach my $x ('a'..'z') {
379                 delay();
380                 $conn->write('1');
381                 delay();
382                 $conn->write("\r");
383                 delay();
384                 $conn->write("\n");
385                 delay();
386                 $conn->write($x);
387                 delay();
388                 $conn->write("\r");
389                 delay();
390                 $conn->write("\n");
391         }
392         $conn->write('0');
393         delay();
394         $conn->write("\r");
395         delay();
396         $conn->write("\n");
397         delay();
398         $conn->write("\r");
399         delay();
400         $conn->write("\n");
401         delay();
402         $check_self->($conn);
403 }
404
405 {
406         my $conn = conn_for($sock, '1.1 chunked close');
407         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
408         my $xlen = sprintf('%x', $len);
409         $conn->write("Transfer-Encoding: chunked\r\n\r\n$xlen\r\n" .
410                 "$str\r\n0\r\n\r\n");
411         $check_self->($conn);
412 }
413
414 {
415         my $conn = conn_for($sock, 'chunked body + pipeline');
416         $conn->write("PUT /sha1 HTTP/1.1\r\n" .
417                         "Transfer-Encoding: chunked\r\n");
418         delay();
419         $conn->write("\r\n1\r\n");
420         delay();
421         $conn->write('a');
422         delay();
423         $conn->write("\r\n0\r\n\r\nPUT /sha1 HTTP/1.1\r\n");
424         delay();
425
426         my $buf = '';
427         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
428                 $conn->sysread(my $tmp, 4096);
429                 $buf .= $tmp;
430         }
431         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
432         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
433         is($body, sha1_hex('a'), 'read expected body');
434
435         $conn->write("Connection: close\r\n");
436         $conn->write("Content-Length: $len\r\n\r\n$str");
437         $check_self->($conn);
438 }
439
440 {
441         my $conn = conn_for($sock, 'trickle header, one-shot body + pipeline');
442         $conn->write("PUT /sha1 HTTP/1.0\r\n" .
443                         "Connection: keep-alive\r\n");
444         delay();
445         $conn->write("Content-Length: $len\r\n\r\n${str}PUT");
446         my $buf = '';
447         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
448                 $conn->sysread(my $tmp, 4096);
449                 $buf .= $tmp;
450         }
451         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
452         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
453         is($body, sha1_hex($str), 'read expected body');
454
455         $conn->write(" /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n$str");
456         $check_self->($conn);
457 }
458
459 {
460         my $conn = conn_for($sock, 'trickle body');
461         $conn->write("PUT /sha1 HTTP/1.0\r\n");
462         $conn->write("Content-Length: $len\r\n\r\n");
463         my $beg = substr($str, 0, 10);
464         my $end = substr($str, 10);
465         is($beg . $end, $str, 'substr setup correct');
466         delay();
467         $conn->write($beg);
468         delay();
469         $conn->write($end);
470         $check_self->($conn);
471 }
472
473 {
474         my $conn = conn_for($sock, 'one-shot write');
475         $conn->write("PUT /sha1 HTTP/1.0\r\n" .
476                         "Content-Length: $len\r\n\r\n$str");
477         $check_self->($conn);
478 }
479
480 {
481         my $conn = conn_for($sock, 'trickle header, one-shot body');
482         $conn->write("PUT /sha1 HTTP/1.0\r\n");
483         delay();
484         $conn->write("Content-Length: $len\r\n\r\n$str");
485         $check_self->($conn);
486 }
487
488 {
489         my $conn = conn_for($sock, '1.1 Connnection: close');
490         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
491         delay();
492         $conn->write("Content-Length: $len\r\n\r\n$str");
493         $check_self->($conn);
494 }
495
496 {
497         my $conn = conn_for($sock, '1.1 pipeline start');
498         $conn->write("PUT /sha1 HTTP/1.1\r\n\r\nPUT");
499         my $buf = '';
500         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
501                 $conn->sysread(my $tmp, 4096);
502                 $buf .= $tmp;
503         }
504         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
505         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
506         is($body, sha1_hex(''), 'read expected body');
507
508         # 2nd request
509         $conn->write(" /sha1 HTTP/1.1\r\n\r\n");
510         $buf = '';
511         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
512                 $conn->sysread(my $tmp, 4096);
513                 $buf .= $tmp;
514         }
515         ($head, $body) = split(/\r\n\r\n/, $buf, 2);
516         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
517         is($body, sha1_hex(''), 'read expected body #2');
518 }
519
520 SKIP: {
521         skip 'TCP_DEFER_ACCEPT is Linux-only', 1 if $^O ne 'linux';
522         my $var = Socket::TCP_DEFER_ACCEPT();
523         defined(my $x = getsockopt($sock, IPPROTO_TCP, $var)) or die;
524         is(unpack('i', $x), $defer_accept_val,
525                 'TCP_DEFER_ACCEPT unchanged if previously set');
526 };
527 SKIP: {
528         skip 'SO_ACCEPTFILTER is FreeBSD-only', 1 if $^O ne 'freebsd';
529         skip 'accf_data not loaded: kldload accf_data' if !defined $accf_arg;
530         my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
531         defined(my $x = getsockopt($sock, SOL_SOCKET, $var)) or die;
532         is($x, $accf_arg, 'SO_ACCEPTFILTER unchanged if previously set');
533 };
534
535 done_testing();
536
537 sub capture {
538         my ($f) = @_;
539         open my $fh, '+<', $f or die "failed to open $f: $!\n";
540         local $/ = "\n";
541         my @r = <$fh>;
542         truncate($fh, 0) or die "truncate failed on $f: $!\n";
543         \@r
544 }
545
546 1;