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);
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');
86 my $conn = conn_for($sock, '1.1 pipeline together');
87 $conn->write("PUT /sha1 HTTP/1.1\r\nUser-agent: hello\r\n\r\n" .
88 "PUT /sha1 HTTP/1.1\r\n\r\n");
91 until (scalar(@r) >= 2) {
92 my $r = $conn->sysread(my $tmp, 4096);
93 die $! unless defined $r;
94 die "EOF <$buf>" unless $r;
96 @r = ($buf =~ /\r\n\r\n([a-f0-9]{40})/g);
98 is(2, scalar @r, 'got 2 responses');
100 foreach my $hex (@r) {
101 is($hex, sha1_hex(''), "read expected body $i");
106 # various DoS attacks against the chunk parser:
108 local $SIG{PIPE} = 'IGNORE';
109 my $conn = conn_for($sock, '1.1 chunk header excessive');
110 $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
113 while ($w = $conn->write('ffffffff')) {
116 ok($!, 'got error set in $!');
117 is($w, undef, 'write error happened');
118 ok($n > 0, 'was able to write');
119 my $r = $conn->read(my $buf, 66666);
120 ok($r > 0, 'got non-empty response');
121 like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
123 $conn = conn_for($sock, '1.1 chunk trailer excessive');
124 $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n");
125 is($conn->syswrite("1\r\na"), 4, 'wrote first header + chunk');
128 while ($w = $conn->write("\r")) {
131 ok($!, 'got error set in $!');
132 ok($n > 0, 'wrote part of chunk end (\r)');
133 $r = $conn->read($buf, 66666);
134 ok($r > 0, 'got non-empty response');
135 like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response');
139 my $conn = conn_for($sock, '1.1 chunked close trickle');
140 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
141 $conn->write("Transfer-encoding: chunked\r\n\r\n");
142 foreach my $x ('a'..'z') {
166 $check_self->($conn);
170 my $conn = conn_for($sock, '1.1 chunked close');
171 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
172 my $xlen = sprintf('%x', $len);
173 $conn->write("Transfer-Encoding: chunked\r\n\r\n$xlen\r\n" .
174 "$str\r\n0\r\n\r\n");
175 $check_self->($conn);
179 my $conn = conn_for($sock, 'chunked body + pipeline');
180 $conn->write("PUT /sha1 HTTP/1.1\r\n" .
181 "Transfer-Encoding: chunked\r\n");
183 $conn->write("\r\n1\r\n");
187 $conn->write("\r\n0\r\n\r\nPUT /sha1 HTTP/1.1\r\n");
191 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
192 $conn->sysread(my $tmp, 4096);
195 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
196 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
197 is($body, sha1_hex('a'), 'read expected body');
199 $conn->write("Connection: close\r\n");
200 $conn->write("Content-Length: $len\r\n\r\n$str");
201 $check_self->($conn);
205 my $conn = conn_for($sock, 'trickle header, one-shot body + pipeline');
206 $conn->write("PUT /sha1 HTTP/1.0\r\n" .
207 "Connection: keep-alive\r\n");
209 $conn->write("Content-Length: $len\r\n\r\n${str}PUT");
211 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
212 $conn->sysread(my $tmp, 4096);
215 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
216 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
217 is($body, sha1_hex($str), 'read expected body');
219 $conn->write(" /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n$str");
220 $check_self->($conn);
224 my $conn = conn_for($sock, 'trickle body');
225 $conn->write("PUT /sha1 HTTP/1.0\r\n");
226 $conn->write("Content-Length: $len\r\n\r\n");
227 my $beg = substr($str, 0, 10);
228 my $end = substr($str, 10);
229 is($beg . $end, $str, 'substr setup correct');
234 $check_self->($conn);
238 my $conn = conn_for($sock, 'one-shot write');
239 $conn->write("PUT /sha1 HTTP/1.0\r\n" .
240 "Content-Length: $len\r\n\r\n$str");
241 $check_self->($conn);
245 my $conn = conn_for($sock, 'trickle header, one-shot body');
246 $conn->write("PUT /sha1 HTTP/1.0\r\n");
248 $conn->write("Content-Length: $len\r\n\r\n$str");
249 $check_self->($conn);
253 my $conn = conn_for($sock, '1.1 Connnection: close');
254 $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n");
256 $conn->write("Content-Length: $len\r\n\r\n$str");
257 $check_self->($conn);
261 my $conn = conn_for($sock, '1.1 pipeline start');
262 $conn->write("PUT /sha1 HTTP/1.1\r\n\r\nPUT");
264 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
265 $conn->sysread(my $tmp, 4096);
268 my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
269 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
270 is($body, sha1_hex(''), 'read expected body');
273 $conn->write(" /sha1 HTTP/1.1\r\n\r\n");
275 until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) {
276 $conn->sysread(my $tmp, 4096);
279 ($head, $body) = split(/\r\n\r\n/, $buf, 2);
280 like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
281 is($body, sha1_hex(''), 'read expected body #2');