]> Sergey Matveev's repositories - public-inbox.git/blob - t/httpd-corner.t
http: do not allow bad getline+close responses to kill us
[public-inbox.git] / t / httpd-corner.t
1 # Copyright (C) 2016 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 Rack 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 Danga::Socket
11                         HTTP::Date HTTP::Status)) {
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 Cwd qw/getcwd/;
19 use IO::Socket;
20 use IO::Socket::UNIX;
21 use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD :seek);
22 use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY);
23 use POSIX qw(dup2 mkfifo :sys_wait_h);
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 = getcwd()."/t/httpd-corner.psgi";
31 my %opts = (
32         LocalAddr => '127.0.0.1',
33         ReuseAddr => 1,
34         Proto => 'tcp',
35         Type => SOCK_STREAM,
36         Listen => 1024,
37 );
38 my $sock = IO::Socket::INET->new(%opts);
39 my $upath = "$tmpdir/s";
40 my $unix = IO::Socket::UNIX->new(
41         Listen => 1024,
42         Type => SOCK_STREAM,
43         Local => $upath
44 );
45 ok($unix, 'UNIX socket created');
46 my $pid;
47 END { kill 'TERM', $pid if defined $pid };
48 my $spawn_httpd = sub {
49         my (@args) = @_;
50         $! = 0;
51         my $fl = fcntl($sock, F_GETFD, 0);
52         ok(! $!, 'no error from fcntl(F_GETFD)');
53         is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)');
54         $pid = fork;
55         if ($pid == 0) {
56                 # pretend to be systemd
57                 dup2(fileno($sock), 3) or die "dup2 failed: $!\n";
58                 dup2(fileno($unix), 4) or die "dup2 failed: $!\n";
59                 my $t = IO::Handle->new_from_fd(3, 'r');
60                 $t->fcntl(F_SETFD, 0);
61                 my $u = IO::Handle->new_from_fd(4, 'r');
62                 $u->fcntl(F_SETFD, 0);
63                 $ENV{LISTEN_PID} = $$;
64                 $ENV{LISTEN_FDS} = 2;
65                 exec $httpd, @args, "--stdout=$out", "--stderr=$err", $psgi;
66                 die "FAIL: $!\n";
67         }
68         ok(defined $pid, 'forked httpd process successfully');
69 };
70
71 {
72         ok($sock, 'sock created');
73         $! = 0;
74         my $fl = fcntl($sock, F_GETFD, 0);
75         ok(! $!, 'no error from fcntl(F_GETFD)');
76         is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)');
77         $spawn_httpd->('-W0');
78 }
79
80 {
81         my $conn = conn_for($sock, 'streaming callback');
82         $conn->write("GET /callback HTTP/1.0\r\n\r\n");
83         ok($conn->read(my $buf, 8192), 'read response');
84         my ($head, $body) = split(/\r\n\r\n/, $buf);
85         is($body, "hello world\n", 'callback body matches expected');
86 }
87
88 {
89         my $conn = conn_for($sock, 'getline-die');
90         $conn->write("GET /getline-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)), 1, 'failure logged');
97         is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
98 }
99
100 {
101         my $conn = conn_for($sock, 'close-die');
102         $conn->write("GET /close-die HTTP/1.1\r\nHost: example.com\r\n\r\n");
103         ok($conn->read(my $buf, 8192), 'read some response');
104         like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header');
105         is($conn->read(my $nil, 8192), 0, 'read EOF');
106         $conn = undef;
107         my $after = capture($err);
108         is(scalar(grep(/GETLINE FAIL/, @$after)), 0, 'getline not failed');
109         is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
110 }
111
112 {
113         my $conn = conn_for($sock, 'excessive header');
114         $SIG{PIPE} = 'IGNORE';
115         $conn->write("GET /callback HTTP/1.0\r\n");
116         foreach my $i (1..500000) {
117                 last unless $conn->write("X-xxxxxJunk-$i: omg\r\n");
118         }
119         ok(!$conn->write("\r\n"), 'broken request');
120         ok($conn->read(my $buf, 8192), 'read response');
121         my ($head, $body) = split(/\r\n\r\n/, $buf);
122         like($head, qr/\b400\b/, 'got 400 response');
123 }
124
125 {
126         my $conn = conn_for($sock, 'excessive body Content-Length');
127         $SIG{PIPE} = 'IGNORE';
128         my $n = (10 * 1024 * 1024) + 1;
129         $conn->write("PUT /sha1 HTTP/1.0\r\nContent-Length: $n\r\n\r\n");
130         ok($conn->read(my $buf, 8192), 'read response');
131         my ($head, $body) = split(/\r\n\r\n/, $buf);
132         like($head, qr/\b413\b/, 'got 413 response');
133 }
134
135 {
136         my $conn = conn_for($sock, 'excessive body chunked');
137         $SIG{PIPE} = 'IGNORE';
138         my $n = (10 * 1024 * 1024) + 1;
139         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: chunked\r\n");
140         $conn->write("\r\n".sprintf("%x\r\n", $n));
141         ok($conn->read(my $buf, 8192), 'read response');
142         my ($head, $body) = split(/\r\n\r\n/, $buf);
143         like($head, qr/\b413\b/, 'got 413 response');
144 }
145
146 # Unix domain sockets
147 {
148         my $u = IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $upath);
149         ok($u, 'unix socket connected');
150         $u->write("GET /host-port HTTP/1.0\r\n\r\n");
151         $u->read(my $buf, 4096);
152         like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!,
153                 'set REMOTE_ADDR and REMOTE_PORT for Unix socket');
154 }
155
156 sub conn_for {
157         my ($sock, $msg) = @_;
158         my $conn = IO::Socket::INET->new(
159                                 PeerAddr => $sock->sockhost,
160                                 PeerPort => $sock->sockport,
161                                 Proto => 'tcp',
162                                 Type => SOCK_STREAM);
163         ok($conn, "connected for $msg");
164         $conn->autoflush(1);
165         setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1);
166         return $conn;
167 }
168
169 {
170         my $conn = conn_for($sock, 'host-port');
171         $conn->write("GET /host-port HTTP/1.0\r\n\r\n");
172         $conn->read(my $buf, 4096);
173         my ($head, $body) = split(/\r\n\r\n/, $buf);
174         my ($addr, $port) = split(/:/, $body);
175         is($addr, $conn->sockhost, 'host matches addr');
176         is($port, $conn->sockport, 'port matches');
177 }
178
179 # graceful termination
180 {
181         my $conn = conn_for($sock, 'graceful termination via slow header');
182         $conn->write("GET /slow-header HTTP/1.0\r\n" .
183                         "X-Check-Fifo: $fifo\r\n\r\n");
184         open my $f, '>', $fifo or die "open $fifo: $!\n";
185         $f->autoflush(1);
186         ok(print($f "hello\n"), 'wrote something to fifo');
187         my $kpid = $pid;
188         $pid = undef;
189         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
190         ok(print($f "world\n"), 'wrote else to fifo');
191         close $f or die "close fifo: $!\n";
192         $conn->read(my $buf, 8192);
193         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
194         like($head, qr!\AHTTP/1\.[01] 200 OK!, 'got 200 for slow-header');
195         is($body, "hello\nworld\n", 'read expected body');
196         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
197         is($?, 0, 'no error');
198         $spawn_httpd->('-W0');
199 }
200
201 {
202         my $conn = conn_for($sock, 'graceful termination via slow-body');
203         $conn->write("GET /slow-body HTTP/1.0\r\n" .
204                         "X-Check-Fifo: $fifo\r\n\r\n");
205         open my $f, '>', $fifo or die "open $fifo: $!\n";
206         $f->autoflush(1);
207         my $buf;
208         $conn->sysread($buf, 8192);
209         like($buf, qr!\AHTTP/1\.[01] 200 OK!, 'got 200 for slow-body');
210         like($buf, qr!\r\n\r\n!, 'finished HTTP response header');
211
212         foreach my $c ('a'..'c') {
213                 $c .= "\n";
214                 ok(print($f $c), 'wrote line to fifo');
215                 $conn->sysread($buf, 8192);
216                 is($buf, $c, 'got trickle for reading');
217         }
218         my $kpid = $pid;
219         $pid = undef;
220         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
221         ok(print($f "world\n"), 'wrote else to fifo');
222         close $f or die "close fifo: $!\n";
223         $conn->sysread($buf, 8192);
224         is($buf, "world\n", 'read expected body');
225         is($conn->sysread($buf, 8192), 0, 'got EOF from server');
226         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
227         is($?, 0, 'no error');
228         $spawn_httpd->('-W0');
229 }
230
231 sub delay { select(undef, undef, undef, shift || rand(0.02)) }
232
233 my $str = 'abcdefghijklmnopqrstuvwxyz';
234 my $len = length $str;
235 is($len, 26, 'got the alphabet');
236 my $check_self = sub {
237         my ($conn) = @_;
238         $conn->read(my $buf, 4096);
239         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
240         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
241         is($body, sha1_hex($str), 'read expected body');
242 };
243
244 SKIP: {
245         use POSIX qw(dup2);
246         use IO::File;
247         my $have_curl = 0;
248         foreach my $p (split(':', $ENV{PATH})) {
249                 -x "$p/curl" or next;
250                 $have_curl = 1;
251                 last;
252         }
253         my $ntest = 2;
254         $have_curl or skip('curl(1) missing', $ntest);
255         my $url = 'http://' . $sock->sockhost . ':' . $sock->sockport . '/sha1';
256         my ($r, $w);
257         pipe($r, $w) or die "pipe: $!";
258         my $tout = IO::File->new_tmpfile or die "new_tmpfile: $!";
259         my $pid = fork;
260         defined $pid or die "fork: $!";
261         my @cmd = (qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url);
262         if ($pid == 0) {
263                 dup2(fileno($r), 0) or die "redirect stdin failed: $!\n";
264                 dup2(fileno($tout), 1) or die "redirect stdout failed: $!\n";
265                 exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
266         }
267         $w->autoflush(1);
268         foreach my $c ('a'..'z') {
269                 print $w $c or die "failed to write to curl: $!";
270                 delay();
271         }
272         close $w or die "close write pipe: $!";
273         close $r or die "close read pipe: $!";
274         my $kid = waitpid $pid, 0;
275         is($?, 0, 'curl exited successfully');
276         $tout->sysseek(0, SEEK_SET);
277         $tout->sysread(my $buf, 100);
278         is($buf, sha1_hex($str), 'read expected body');
279 }
280
281 {
282         my $conn = conn_for($sock, '1.1 pipeline together');
283         $conn->write("PUT /sha1 HTTP/1.1\r\nUser-agent: hello\r\n\r\n" .
284                         "PUT /sha1 HTTP/1.1\r\n\r\n");
285         my $buf = '';
286         my @r;
287         until (scalar(@r) >= 2) {
288                 my $r = $conn->sysread(my $tmp, 4096);
289                 die $! unless defined $r;
290                 die "EOF <$buf>" unless $r;
291                 $buf .= $tmp;
292                 @r = ($buf =~ /\r\n\r\n([a-f0-9]{40})/g);
293         }
294         is(2, scalar @r, 'got 2 responses');
295         my $i = 3;
296         foreach my $hex (@r) {
297                 is($hex, sha1_hex(''), "read expected body $i");
298                 $i++;
299         }
300 }
301
302 {
303         my $conn = conn_for($sock, 'no TCP_CORK on empty body');
304         $conn->write("GET /empty HTTP/1.1\r\nHost:example.com\r\n\r\n");
305         my $buf = '';
306         my $t0 = [ gettimeofday ];
307         until ($buf =~ /\r\n\r\n/s) {
308                 $conn->sysread($buf, 4096, length($buf));
309         }
310         my $elapsed = tv_interval($t0, [ gettimeofday ]);
311         ok($elapsed < 0.190, 'no 200ms TCP cork delay on empty body');
312 }
313
314 {
315         my $conn = conn_for($sock, 'graceful termination during slow request');
316         $conn->write("PUT /sha1 HTTP/1.0\r\n");
317         delay();
318         $conn->write("Content-Length: $len\r\n");
319         delay();
320         $conn->write("\r\n");
321         my $kpid = $pid;
322         $pid = undef;
323         is(kill('TERM', $kpid), 1, 'started graceful shutdown');
324         delay();
325         my $n = 0;
326         foreach my $c ('a'..'z') {
327                 $n += $conn->write($c);
328         }
329         is($n, $len, 'wrote alphabet');
330         $check_self->($conn);
331         is(waitpid($kpid, 0), $kpid, 'reaped httpd');
332         is($?, 0, 'no error');
333         $spawn_httpd->('-W0');
334 }
335
336 # various DoS attacks against the chunk parser:
337 {
338         local $SIG{PIPE} = 'IGNORE';
339         my $conn = conn_for($sock, '1.1 chunk header excessive');
340         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
341         my $n = 0;
342         my $w;
343         while ($w = $conn->write('ffffffff')) {
344                 $n += $w;
345         }
346         ok($!, 'got error set in $!');
347         is($w, undef, 'write error happened');
348         ok($n > 0, 'was able to write');
349         my $r = $conn->read(my $buf, 66666);
350         ok($r > 0, 'got non-empty response');
351         like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
352
353         $conn = conn_for($sock, '1.1 chunk trailer excessive');
354         $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
355         is($conn->syswrite("1\r\na"), 4, 'wrote first header + chunk');
356         delay();
357         $n = 0;
358         while ($w = $conn->write("\r")) {
359                 $n += $w;
360         }
361         ok($!, 'got error set in $!');
362         ok($n > 0, 'wrote part of chunk end (\r)');
363         $r = $conn->read($buf, 66666);
364         ok($r > 0, 'got non-empty response');
365         like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
366 }
367
368 {
369         my $conn = conn_for($sock, '1.1 chunked close trickle');
370         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
371         $conn->write("Transfer-encoding: chunked\r\n\r\n");
372         foreach my $x ('a'..'z') {
373                 delay();
374                 $conn->write('1');
375                 delay();
376                 $conn->write("\r");
377                 delay();
378                 $conn->write("\n");
379                 delay();
380                 $conn->write($x);
381                 delay();
382                 $conn->write("\r");
383                 delay();
384                 $conn->write("\n");
385         }
386         $conn->write('0');
387         delay();
388         $conn->write("\r");
389         delay();
390         $conn->write("\n");
391         delay();
392         $conn->write("\r");
393         delay();
394         $conn->write("\n");
395         delay();
396         $check_self->($conn);
397 }
398
399 {
400         my $conn = conn_for($sock, '1.1 chunked close');
401         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
402         my $xlen = sprintf('%x', $len);
403         $conn->write("Transfer-Encoding: chunked\r\n\r\n$xlen\r\n" .
404                 "$str\r\n0\r\n\r\n");
405         $check_self->($conn);
406 }
407
408 {
409         my $conn = conn_for($sock, 'chunked body + pipeline');
410         $conn->write("PUT /sha1 HTTP/1.1\r\n" .
411                         "Transfer-Encoding: chunked\r\n");
412         delay();
413         $conn->write("\r\n1\r\n");
414         delay();
415         $conn->write('a');
416         delay();
417         $conn->write("\r\n0\r\n\r\nPUT /sha1 HTTP/1.1\r\n");
418         delay();
419
420         my $buf = '';
421         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
422                 $conn->sysread(my $tmp, 4096);
423                 $buf .= $tmp;
424         }
425         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
426         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
427         is($body, sha1_hex('a'), 'read expected body');
428
429         $conn->write("Connection: close\r\n");
430         $conn->write("Content-Length: $len\r\n\r\n$str");
431         $check_self->($conn);
432 }
433
434 {
435         my $conn = conn_for($sock, 'trickle header, one-shot body + pipeline');
436         $conn->write("PUT /sha1 HTTP/1.0\r\n" .
437                         "Connection: keep-alive\r\n");
438         delay();
439         $conn->write("Content-Length: $len\r\n\r\n${str}PUT");
440         my $buf = '';
441         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
442                 $conn->sysread(my $tmp, 4096);
443                 $buf .= $tmp;
444         }
445         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
446         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
447         is($body, sha1_hex($str), 'read expected body');
448
449         $conn->write(" /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n$str");
450         $check_self->($conn);
451 }
452
453 {
454         my $conn = conn_for($sock, 'trickle body');
455         $conn->write("PUT /sha1 HTTP/1.0\r\n");
456         $conn->write("Content-Length: $len\r\n\r\n");
457         my $beg = substr($str, 0, 10);
458         my $end = substr($str, 10);
459         is($beg . $end, $str, 'substr setup correct');
460         delay();
461         $conn->write($beg);
462         delay();
463         $conn->write($end);
464         $check_self->($conn);
465 }
466
467 {
468         my $conn = conn_for($sock, 'one-shot write');
469         $conn->write("PUT /sha1 HTTP/1.0\r\n" .
470                         "Content-Length: $len\r\n\r\n$str");
471         $check_self->($conn);
472 }
473
474 {
475         my $conn = conn_for($sock, 'trickle header, one-shot body');
476         $conn->write("PUT /sha1 HTTP/1.0\r\n");
477         delay();
478         $conn->write("Content-Length: $len\r\n\r\n$str");
479         $check_self->($conn);
480 }
481
482 {
483         my $conn = conn_for($sock, '1.1 Connnection: close');
484         $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
485         delay();
486         $conn->write("Content-Length: $len\r\n\r\n$str");
487         $check_self->($conn);
488 }
489
490 {
491         my $conn = conn_for($sock, '1.1 pipeline start');
492         $conn->write("PUT /sha1 HTTP/1.1\r\n\r\nPUT");
493         my $buf = '';
494         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
495                 $conn->sysread(my $tmp, 4096);
496                 $buf .= $tmp;
497         }
498         my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
499         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
500         is($body, sha1_hex(''), 'read expected body');
501
502         # 2nd request
503         $conn->write(" /sha1 HTTP/1.1\r\n\r\n");
504         $buf = '';
505         until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
506                 $conn->sysread(my $tmp, 4096);
507                 $buf .= $tmp;
508         }
509         ($head, $body) = split(/\r\n\r\n/, $buf, 2);
510         like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
511         is($body, sha1_hex(''), 'read expected body #2');
512 }
513
514 done_testing();
515
516 sub capture {
517         my ($f) = @_;
518         open my $fh, '+<', $f or die "failed to open $f: $!\n";
519         local $/ = "\n";
520         my @r = <$fh>;
521         truncate($fh, 0) or die "truncate failed on $f: $!\n";
522         \@r
523 }
524
525 1;