From dbaf64b646943bd92e1aa8d581e23a5adb4a3e57 Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Tue, 23 Feb 2016 02:52:18 +0000 Subject: initial public-inbox-httpd implemenation This is meant to provide an easy starting point for server admins. It provides a basic HTTP server for admins unfamiliar with configuring PSGI applications as well as being an identical interface for management as our nntpd implementation. This HTTP server may also be a generic Plack/PSGI server for existing Plack/PSGI applications. --- t/httpd-corner.psgi | 37 +++++++ t/httpd-corner.t | 286 ++++++++++++++++++++++++++++++++++++++++++++++++++++ t/httpd.t | 119 ++++++++++++++++++++++ 3 files changed, 442 insertions(+) create mode 100644 t/httpd-corner.psgi create mode 100644 t/httpd-corner.t create mode 100644 t/httpd.t (limited to 't') diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi new file mode 100644 index 00000000..1947f376 --- /dev/null +++ b/t/httpd-corner.psgi @@ -0,0 +1,37 @@ +# Copyright (C) 2016 all contributors +# License: AGPL-3.0+ +# corner case tests for the generic PSGI server +# Usage: plackup [OPTIONS] /path/to/this/file +use strict; +use warnings; +use Plack::Request; +use Plack::Builder; +require Digest::SHA; +my $app = sub { + my ($env) = @_; + my $path = $env->{PATH_INFO}; + my $in = $env->{'psgi.input'}; + my $actual = -s $in; + my $code = 500; + my $h = [ 'Content-Type' => 'text/plain' ]; + my $body = []; + if ($path eq '/sha1') { + my $sha1 = Digest::SHA->new('SHA-1'); + my $buf; + while (1) { + my $r = $in->read($buf, 4096); + die "read err: $!" unless defined $r; + last if $r == 0; + $sha1->add($buf); + } + $code = 200; + push @$body, $sha1->hexdigest; + } + [ $code, $h, $body ] +}; + +builder { + enable 'ContentLength'; + enable 'Head'; + $app; +} diff --git a/t/httpd-corner.t b/t/httpd-corner.t new file mode 100644 index 00000000..5834c1bd --- /dev/null +++ b/t/httpd-corner.t @@ -0,0 +1,286 @@ +# Copyright (C) 2016 all contributors +# License: AGPL-3.0+ +# note: our HTTP server should be standalone and capable of running +# generic Rack apps. +use strict; +use warnings; +use Test::More; + +foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket + HTTP::Parser::XS HTTP::Date HTTP::Status)) { + eval "require $mod"; + plan skip_all => "$mod missing for httpd-corner.t" if $@; +} + +use Digest::SHA qw(sha1_hex); +use File::Temp qw/tempdir/; +use Cwd qw/getcwd/; +use IO::Socket; +use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD); +use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); +my $tmpdir = tempdir(CLEANUP => 1); +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $httpd = 'blib/script/public-inbox-httpd'; +my $psgi = getcwd()."/t/httpd-corner.psgi"; +my %opts = ( + LocalAddr => '127.0.0.1', + ReuseAddr => 1, + Proto => 'tcp', + Type => SOCK_STREAM, + Listen => 1024, +); +my $sock = IO::Socket::INET->new(%opts); +my $pid; +END { kill 'TERM', $pid if defined $pid }; +{ + ok($sock, 'sock created'); + $! = 0; + my $fl = fcntl($sock, F_GETFD, 0); + ok(! $!, 'no error from fcntl(F_GETFD)'); + is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)'); + $pid = fork; + if ($pid == 0) { + use POSIX qw(dup2); + # pretend to be systemd + fcntl($sock, F_SETFD, $fl &= ~FD_CLOEXEC); + dup2(fileno($sock), 3) or die "dup2 failed: $!\n"; + $ENV{LISTEN_PID} = $$; + $ENV{LISTEN_FDS} = 1; + exec $httpd, '-W0', "--stdout=$out", "--stderr=$err", $psgi; + die "FAIL: $!\n"; + } + ok(defined $pid, 'forked httpd process successfully'); + $! = 0; + fcntl($sock, F_SETFD, $fl |= FD_CLOEXEC); + ok(! $!, 'no error from fcntl(F_SETFD)'); +} + +sub conn_for { + my ($sock, $msg) = @_; + my $conn = IO::Socket::INET->new( + PeerAddr => $sock->sockhost, + PeerPort => $sock->sockport, + Proto => 'tcp', + Type => SOCK_STREAM); + ok($conn, "connected for $msg"); + $conn->autoflush(1); + setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1); + return $conn; +} + +sub delay { select(undef, undef, undef, shift || rand(0.02)) } + +my $str = 'abcdefghijklmnopqrstuvwxyz'; +my $len = length $str; +is($len, 26, 'got the alphabet'); +my $check_self = sub { + my ($conn) = @_; + $conn->read(my $buf, 4096); + my ($head, $body) = split(/\r\n\r\n/, $buf, 2); + like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length'); + is($body, sha1_hex($str), 'read expected body'); +}; + +{ + my $conn = conn_for($sock, '1.1 pipeline together'); + $conn->write("PUT /sha1 HTTP/1.1\r\nUser-agent: hello\r\n\r\n" . + "PUT /sha1 HTTP/1.1\r\n\r\n"); + my $buf = ''; + my @r; + until (scalar(@r) >= 2) { + my $r = $conn->sysread(my $tmp, 4096); + die $! unless defined $r; + die "EOF <$buf>" unless $r; + $buf .= $tmp; + @r = ($buf =~ /\r\n\r\n([a-f0-9]{40})/g); + } + is(2, scalar @r, 'got 2 responses'); + my $i = 3; + foreach my $hex (@r) { + is($hex, sha1_hex(''), "read expected body $i"); + $i++; + } +} + +# various DoS attacks against the chunk parser: +{ + local $SIG{PIPE} = 'IGNORE'; + my $conn = conn_for($sock, '1.1 chunk header excessive'); + $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n"); + my $n = 0; + my $w; + while ($w = $conn->write('ffffffff')) { + $n += $w; + } + ok($!, 'got error set in $!'); + is($w, undef, 'write error happened'); + ok($n > 0, 'was able to write'); + my $r = $conn->read(my $buf, 66666); + ok($r > 0, 'got non-empty response'); + like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response'); + + $conn = conn_for($sock, '1.1 chunk trailer excessive'); + $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding:chunked\r\n\r\n"); + is($conn->syswrite("1\r\na"), 4, 'wrote first header + chunk'); + delay(); + $n = 0; + while ($w = $conn->write("\r")) { + $n += $w; + } + ok($!, 'got error set in $!'); + ok($n > 0, 'wrote part of chunk end (\r)'); + $r = $conn->read($buf, 66666); + ok($r > 0, 'got non-empty response'); + like($buf, qr!HTTP/1\.\d 400 !, 'got 400 response'); +} + +{ + my $conn = conn_for($sock, '1.1 chunked close trickle'); + $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n"); + $conn->write("Transfer-encoding: chunked\r\n\r\n"); + foreach my $x ('a'..'z') { + delay(); + $conn->write('1'); + delay(); + $conn->write("\r"); + delay(); + $conn->write("\n"); + delay(); + $conn->write($x); + delay(); + $conn->write("\r"); + delay(); + $conn->write("\n"); + } + $conn->write('0'); + delay(); + $conn->write("\r"); + delay(); + $conn->write("\n"); + delay(); + $conn->write("\r"); + delay(); + $conn->write("\n"); + delay(); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, '1.1 chunked close'); + $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n"); + my $xlen = sprintf('%x', $len); + $conn->write("Transfer-Encoding: chunked\r\n\r\n$xlen\r\n" . + "$str\r\n0\r\n\r\n"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, 'chunked body + pipeline'); + $conn->write("PUT /sha1 HTTP/1.1\r\n" . + "Transfer-Encoding: chunked\r\n"); + delay(); + $conn->write("\r\n1\r\n"); + delay(); + $conn->write('a'); + delay(); + $conn->write("\r\n0\r\n\r\nPUT /sha1 HTTP/1.1\r\n"); + delay(); + + my $buf = ''; + until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) { + $conn->sysread(my $tmp, 4096); + $buf .= $tmp; + } + my ($head, $body) = split(/\r\n\r\n/, $buf, 2); + like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length'); + is($body, sha1_hex('a'), 'read expected body'); + + $conn->write("Connection: close\r\n"); + $conn->write("Content-Length: $len\r\n\r\n$str"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, 'trickle header, one-shot body + pipeline'); + $conn->write("PUT /sha1 HTTP/1.0\r\n" . + "Connection: keep-alive\r\n"); + delay(); + $conn->write("Content-Length: $len\r\n\r\n${str}PUT"); + my $buf = ''; + until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) { + $conn->sysread(my $tmp, 4096); + $buf .= $tmp; + } + my ($head, $body) = split(/\r\n\r\n/, $buf, 2); + like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length'); + is($body, sha1_hex($str), 'read expected body'); + + $conn->write(" /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n$str"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, 'trickle body'); + $conn->write("PUT /sha1 HTTP/1.0\r\n"); + $conn->write("Content-Length: $len\r\n\r\n"); + my $beg = substr($str, 0, 10); + my $end = substr($str, 10); + is($beg . $end, $str, 'substr setup correct'); + delay(); + $conn->write($beg); + delay(); + $conn->write($end); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, 'one-shot write'); + $conn->write("PUT /sha1 HTTP/1.0\r\n" . + "Content-Length: $len\r\n\r\n$str"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, 'trickle header, one-shot body'); + $conn->write("PUT /sha1 HTTP/1.0\r\n"); + delay(); + $conn->write("Content-Length: $len\r\n\r\n$str"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, '1.1 Connnection: close'); + $conn->write("PUT /sha1 HTTP/1.1\r\nConnection:close\r\n"); + delay(); + $conn->write("Content-Length: $len\r\n\r\n$str"); + $check_self->($conn); +} + +{ + my $conn = conn_for($sock, '1.1 pipeline start'); + $conn->write("PUT /sha1 HTTP/1.1\r\n\r\nPUT"); + my $buf = ''; + until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) { + $conn->sysread(my $tmp, 4096); + $buf .= $tmp; + } + my ($head, $body) = split(/\r\n\r\n/, $buf, 2); + like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length'); + is($body, sha1_hex(''), 'read expected body'); + + # 2nd request + $conn->write(" /sha1 HTTP/1.1\r\n\r\n"); + $buf = ''; + until ($buf =~ /\r\n\r\n[a-f0-9]{40}\z/) { + $conn->sysread(my $tmp, 4096); + $buf .= $tmp; + } + ($head, $body) = split(/\r\n\r\n/, $buf, 2); + like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length'); + is($body, sha1_hex(''), 'read expected body #2'); +} + +done_testing(); + +1; diff --git a/t/httpd.t b/t/httpd.t new file mode 100644 index 00000000..ad636fc1 --- /dev/null +++ b/t/httpd.t @@ -0,0 +1,119 @@ +# Copyright (C) 2016 all contributors +# License: AGPL-3.0+ +use strict; +use warnings; +use Test::More; + +foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket + HTTP::Parser::XS HTTP::Date HTTP::Status)) { + eval "require $mod"; + plan skip_all => "$mod missing for httpd.t" if $@; +} +use File::Temp qw/tempdir/; +use Cwd qw/getcwd/; +use IO::Socket; +use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD); +use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); +use IPC::Run; + +# FIXME: too much setup +my $tmpdir = tempdir(CLEANUP => 1); +my $home = "$tmpdir/pi-home"; +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $pi_home = "$home/.public-inbox"; +my $pi_config = "$pi_home/config"; +my $maindir = "$tmpdir/main.git"; +my $main_bin = getcwd()."/t/main-bin"; +my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock +my $group = 'test-httpd'; +my $addr = $group . '@example.com'; +my $cfgpfx = "publicinbox.$group"; +my $failbox = "$home/fail.mbox"; +local $ENV{PI_EMERGENCY} = $failbox; +my $mda = 'blib/script/public-inbox-mda'; +my $httpd = 'blib/script/public-inbox-httpd'; +my $init = 'blib/script/public-inbox-init'; + +my %opts = ( + LocalAddr => '127.0.0.1', + ReuseAddr => 1, + Proto => 'tcp', + Type => SOCK_STREAM, + Listen => 1024, +); +my $sock = IO::Socket::INET->new(%opts); +my $pid; +END { kill 'TERM', $pid if defined $pid }; +{ + local $ENV{HOME} = $home; + ok(!system($init, $group, $maindir, 'http://example.com/', $addr), + 'init ran properly'); + + # ensure successful message delivery + { + local $ENV{ORIGINAL_RECIPIENT} = $addr; + my $in = < +To: You +Cc: $addr +Message-Id: +Subject: hihi +Date: Thu, 01 Jan 1970 06:06:06 +0000 + +nntp +EOF + local $ENV{PATH} = $main_path; + IPC::Run::run([$mda], \$in); + is(0, $?, 'ran MDA correctly'); + } + ok($sock, 'sock created'); + $! = 0; + my $fl = fcntl($sock, F_GETFD, 0); + ok(! $!, 'no error from fcntl(F_GETFD)'); + is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)'); + $pid = fork; + if ($pid == 0) { + use POSIX qw(dup2); + # pretend to be systemd + fcntl($sock, F_SETFD, $fl &= ~FD_CLOEXEC); + dup2(fileno($sock), 3) or die "dup2 failed: $!\n"; + $ENV{LISTEN_PID} = $$; + $ENV{LISTEN_FDS} = 1; + exec $httpd, "--stdout=$out", "--stderr=$err"; + die "FAIL: $!\n"; + } + ok(defined $pid, 'forked httpd process successfully'); + $! = 0; + fcntl($sock, F_SETFD, $fl |= FD_CLOEXEC); + ok(! $!, 'no error from fcntl(F_SETFD)'); + my $host = $sock->sockhost; + my $port = $sock->sockport; + my $conn = IO::Socket::INET->new(PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Type => SOCK_STREAM); + ok($conn, 'connected'); + ok($conn->write("GET / HTTP/1.0\r\n\r\n"), 'wrote data to socket'); + { + my $buf; + ok($conn->read($buf, 4096), 'read some bytes'); + like($buf, qr!\AHTTP/1\.[01] 404\b!, 'got 404 response'); + is($conn->read($buf, 1), 0, "EOF"); + } + + is(system(qw(git clone -q --mirror), + "http://$host:$port/$group", "$tmpdir/clone.git"), + 0, 'clone successful'); + ok(kill('TERM', $pid), 'killed httpd'); + $pid = undef; + waitpid(-1, 0); + + is(system('git', "--git-dir=$tmpdir/clone.git", + qw(fsck --no-verbose)), 0, + 'fsck on cloned directory successful'); +} + +done_testing(); + +1; -- cgit v1.2.3-24-ge0c7