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
9 foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket
10 HTTP::Parser::XS HTTP::Date HTTP::Status)) {
12 plan skip_all => "$mod missing for httpd-corner.t" if $@;
15 use Digest::SHA qw(sha1_hex);
16 use File::Temp qw/tempdir/;
19 use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD :seek);
20 use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY);
21 my $tmpdir = tempdir(CLEANUP => 1);
22 my $err = "$tmpdir/stderr.log";
23 my $out = "$tmpdir/stdout.log";
24 my $httpd = 'blib/script/public-inbox-httpd';
25 my $psgi = getcwd()."/t/httpd-corner.psgi";
27 LocalAddr => '127.0.0.1',
33 my $sock = IO::Socket::INET->new(%opts);
35 END { kill 'TERM', $pid if defined $pid };
37 ok($sock, 'sock created');
39 my $fl = fcntl($sock, F_GETFD, 0);
40 ok(! $!, 'no error from fcntl(F_GETFD)');
41 is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)');
45 # pretend to be systemd
46 fcntl($sock, F_SETFD, $fl &= ~FD_CLOEXEC);
47 dup2(fileno($sock), 3) or die "dup2 failed: $!\n";
48 $ENV{LISTEN_PID} = $$;
50 exec $httpd, '-W0', "--stdout=$out", "--stderr=$err", $psgi;
53 ok(defined $pid, 'forked httpd process successfully');
55 fcntl($sock, F_SETFD, $fl |= FD_CLOEXEC);
56 ok(! $!, 'no error from fcntl(F_SETFD)');
60 my ($sock, $msg) = @_;
61 my $conn = IO::Socket::INET->new(
62 PeerAddr => $sock->sockhost,
63 PeerPort => $sock->sockport,
66 ok($conn, "connected for $msg");
68 setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1);
72 sub delay { select(undef, undef, undef, shift || rand(0.02)) }
74 my $str = 'abcdefghijklmnopqrstuvwxyz';
75 my $len = length $str;
76 is($len, 26, 'got the alphabet');
77 my $check_self = sub {
79 $conn->read(my $buf, 4096);
80 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
81 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
82 is($body, sha1_hex($str), 'read expected body');
89 foreach my $p (split(':', $ENV{PATH})) {
95 $have_curl or skip('curl(1) missing', $ntest);
96 my $url = 'http://' . $sock->sockhost . ':' . $sock->sockport . '/sha1';
98 pipe($r, $w) or die "pipe: $!";
99 my $tout = IO::File->new_tmpfile or die "new_tmpfile: $!";
101 defined $pid or die "fork: $!";
102 my @cmd = (qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url);
104 dup2(fileno($r), 0) or die "redirect stdin failed: $!\n";
105 dup2(fileno($tout), 1) or die "redirect stdout failed: $!\n";
106 exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
109 foreach my $c ('a'..'z') {
110 print $w $c or die "failed to write to curl: $!";
113 close $w or die "close write pipe: $!";
114 close $r or die "close read pipe: $!";
115 my $kid = waitpid $pid, 0;
116 is($?, 0, 'curl exited successfully');
117 $tout->sysseek(0, SEEK_SET);
118 $tout->sysread(my $buf, 100);
119 is($buf, sha1_hex($str), 'read expected body');
123 my $conn = conn_for($sock, '1.1 pipeline together');
124 $conn->write("PUT /sha1 HTTP/1.1\r\nUser-agent: hello\r\n\r\n" .
125 "PUT /sha1 HTTP/1.1\r\n\r\n");
128 until (scalar(@r) >= 2) {
129 my $r = $conn->sysread(my $tmp, 4096);
130 die $! unless defined $r;
131 die "EOF <$buf>" unless $r;
133 @r = ($buf =~ /\r\n\r\n([a-f0-9]{40})/g);
135 is(2, scalar @r, 'got 2 responses');
137 foreach my $hex (@r) {
138 is($hex, sha1_hex(''), "read expected body $i");
143 # various DoS attacks against the chunk parser:
145 local $SIG{PIPE} = 'IGNORE';
146 my $conn = conn_for($sock, '1.1 chunk header excessive');
147 $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
150 while ($w = $conn->write('ffffffff')) {
153 ok($!, 'got error set in $!');
154 is($w, undef, 'write error happened');
155 ok($n > 0, 'was able to write');
156 my $r = $conn->read(my $buf, 66666);
157 ok($r > 0, 'got non-empty response');
158 like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
160 $conn = conn_for($sock, '1.1 chunk trailer excessive');
161 $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
162 is($conn->syswrite("1\r\na"), 4, 'wrote first header + chunk');
165 while ($w = $conn->write("\r")) {
168 ok($!, 'got error set in $!');
169 ok($n > 0, 'wrote part of chunk end (\r)');
170 $r = $conn->read($buf, 66666);
171 ok($r > 0, 'got non-empty response');
172 like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
176 my $conn = conn_for($sock, '1.1 chunked close trickle');
177 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
178 $conn->write("Transfer-encoding: chunked\r\n\r\n");
179 foreach my $x ('a'..'z') {
203 $check_self->($conn);
207 my $conn = conn_for($sock, '1.1 chunked close');
208 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
209 my $xlen = sprintf('%x', $len);
210 $conn->write("Transfer-Encoding: chunked\r\n\r\n$xlen\r\n" .
211 "$str\r\n0\r\n\r\n");
212 $check_self->($conn);
216 my $conn = conn_for($sock, 'chunked body + pipeline');
217 $conn->write("PUT /sha1 HTTP/1.1\r\n" .
218 "Transfer-Encoding: chunked\r\n");
220 $conn->write("\r\n1\r\n");
224 $conn->write("\r\n0\r\n\r\nPUT /sha1 HTTP/1.1\r\n");
228 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
229 $conn->sysread(my $tmp, 4096);
232 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
233 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
234 is($body, sha1_hex('a'), 'read expected body');
236 $conn->write("Connection: close\r\n");
237 $conn->write("Content-Length: $len\r\n\r\n$str");
238 $check_self->($conn);
242 my $conn = conn_for($sock, 'trickle header, one-shot body + pipeline');
243 $conn->write("PUT /sha1 HTTP/1.0\r\n" .
244 "Connection: keep-alive\r\n");
246 $conn->write("Content-Length: $len\r\n\r\n${str}PUT");
248 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
249 $conn->sysread(my $tmp, 4096);
252 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
253 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
254 is($body, sha1_hex($str), 'read expected body');
256 $conn->write(" /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n$str");
257 $check_self->($conn);
261 my $conn = conn_for($sock, 'trickle body');
262 $conn->write("PUT /sha1 HTTP/1.0\r\n");
263 $conn->write("Content-Length: $len\r\n\r\n");
264 my $beg = substr($str, 0, 10);
265 my $end = substr($str, 10);
266 is($beg . $end, $str, 'substr setup correct');
271 $check_self->($conn);
275 my $conn = conn_for($sock, 'one-shot write');
276 $conn->write("PUT /sha1 HTTP/1.0\r\n" .
277 "Content-Length: $len\r\n\r\n$str");
278 $check_self->($conn);
282 my $conn = conn_for($sock, 'trickle header, one-shot body');
283 $conn->write("PUT /sha1 HTTP/1.0\r\n");
285 $conn->write("Content-Length: $len\r\n\r\n$str");
286 $check_self->($conn);
290 my $conn = conn_for($sock, '1.1 Connnection: close');
291 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
293 $conn->write("Content-Length: $len\r\n\r\n$str");
294 $check_self->($conn);
298 my $conn = conn_for($sock, '1.1 pipeline start');
299 $conn->write("PUT /sha1 HTTP/1.1\r\n\r\nPUT");
301 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
302 $conn->sysread(my $tmp, 4096);
305 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
306 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
307 is($body, sha1_hex(''), 'read expected body');
310 $conn->write(" /sha1 HTTP/1.1\r\n\r\n");
312 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
313 $conn->sysread(my $tmp, 4096);
316 ($head, $body) = split(/\r\n\r\n/, $buf, 2);
317 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
318 is($body, sha1_hex(''), 'read expected body #2');