* [PATCH] initial public-inbox-httpd implemenation
@ 2016-02-20 11:52 e
2016-02-20 11:52 ` [PATCH] view: capture header object early e
0 siblings, 1 reply; 2+ messages in thread
From: e @ 2016-02-20 11:52 UTC (permalink / raw)
To: spew, e
From: ew@dcvr.yhbt.net
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.
---
lib/PublicInbox/HTTP.pm | 318 ++++++++++++++++++++++++++++++++++++++++++++
lib/PublicInbox/Listener.pm | 5 +-
public-inbox-httpd | 100 ++++++++++++++
public-inbox-nntpd | 2 +-
t/httpd-corner.psgi | 37 ++++++
t/httpd-corner.t | 201 ++++++++++++++++++++++++++++
t/httpd.t | 116 ++++++++++++++++
7 files changed, 776 insertions(+), 3 deletions(-)
create mode 100644 lib/PublicInbox/HTTP.pm
create mode 100644 public-inbox-httpd
create mode 100644 t/httpd-corner.psgi
create mode 100644 t/httpd-corner.t
create mode 100644 t/httpd.t
diff --git a/lib/PublicInbox/HTTP.pm b/lib/PublicInbox/HTTP.pm
new file mode 100644
index 0000000..aafff83
--- /dev/null
+++ b/lib/PublicInbox/HTTP.pm
@@ -0,0 +1,318 @@
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Generic PSGI server for convenience. It aims to provide
+# a consistent experience for public-inbox admins so they don't have
+# to learn different ways to admin both NNTP and HTTP components.
+# There's nothing public-inbox-specific, here.
+# Each instance of this class represents a HTTP client socket
+
+package PublicInbox::HTTP;
+use strict;
+use warnings;
+use base qw(Danga::Socket);
+use fields qw(httpd env rbuf input_left);
+use Fcntl qw(:seek);
+use HTTP::Parser::XS qw(parse_http_request); # supports pure Perl fallback
+use HTTP::Status qw(status_message);
+use HTTP::Date qw(time2str);
+use IO::File;
+my $null_io = IO::File->new('/dev/null', '<');
+my %CHUNK = (
+ START => -1, # [a-f0-9]+\r\n
+ END => -2, # \r\n
+ Z_START => -3, # 0\r\n
+ Z_END => -4, # \r\n
+);
+
+use constant CHUNK_MAX_HDR => 256;
+
+sub new ($$$) {
+ my ($class, $sock, $addr, $httpd) = @_;
+ my $self = fields::new($class);
+ $self->SUPER::new($sock);
+ $self->{httpd} = $httpd;
+ $self->watch_read(1);
+ $self;
+}
+
+sub event_read { # called by Danga::Socket
+ my ($self) = @_;
+
+ return event_read_input($self) if defined $self->{env};
+
+ my %env = %{$self->{httpd}->{env}}; # full hash copy
+ my $off = defined($self->{rbuf}) ? length($self->{rbuf}) : 0;
+ my $r = sysread($self->{sock}, $self->{rbuf}, 8192, $off);
+ unless (defined $r) {
+ return if $!{EAGAIN};
+ return $self->close;
+ }
+ return $self->close if $r == 0;
+
+ $r = parse_http_request($self->{rbuf}, \%env);
+
+ # We do not support Trailers in chunked requests, for now
+ # (they are rarely-used)
+ return $self->quit(400) if $r == -1 || $env{HTTP_TRAILER};
+ return if $r < 0; # incomplete
+ $self->{rbuf} = substr($self->{rbuf}, $r);
+ my $len = input_prepare($self, \%env);
+ $len ? event_read_input($self) : app_dispatch($self);
+}
+
+sub event_read_input ($) {
+ my ($self) = @_;
+ my $env = $self->{env};
+ return event_read_input_chunked($self) if env_chunked($env);
+
+ # env->{CONTENT_LENGTH} (identity)
+ my $sock = $self->{sock};
+ my $len = $self->{input_left};
+ $self->{input_left} = undef;
+ my $rbuf = \($self->{rbuf});
+ my $input = $env->{'psgi.input'};
+
+ while ($len > 0) {
+ if ($$rbuf ne '') {
+ my $w = write_in_full($input, $rbuf, $len);
+ return $self->write_err unless $w;
+ $len -= $w;
+ die "BUG: $len < 0 (w=$w)" if $len < 0;
+ if ($len == 0) { # next request may be pipelined
+ $$rbuf = substr($$rbuf, $w);
+ last;
+ }
+ $$rbuf = '';
+ }
+ my $r = sysread($sock, $$rbuf, 8192);
+ return $self->recv_err($r, $len) unless $r;
+ # continue looping if $r > 0;
+ }
+ app_dispatch($self);
+}
+
+sub app_dispatch ($) {
+ my ($self) = @_;
+ $self->watch_read(0);
+ my $env = $self->{env};
+ $self->{env} = undef;
+ $env->{REMOTE_ADDR} = $self->peer_ip_string; # Danga::Socket
+ $env->{REMOTE_PORT} = $self->{peer_port}; # set by peer_ip_string
+ if (my $host = $env->{HTTP_HOST}) {
+ $host =~ s/:(\d+)\z// and $env->{SERVER_PORT} = $1;
+ $env->{SERVER_NAME} = $host;
+ }
+ $env->{'psgi.input'}->seek(0, SEEK_SET);
+ my $res = Plack::Util::run_app($self->{httpd}->{app}, $env);
+ eval {
+ if (ref($res) eq 'CODE') {
+ $res->(sub { response_write($self, $env, $_[0]) });
+ } else {
+ response_write($self, $env, $res);
+ }
+ };
+ $self->close if $@;
+}
+
+sub response_header_write {
+ my ($self, $env, $res) = @_;
+ my $proto = $env->{SERVER_PROTOCOL} or return; # HTTP/0.9 :P
+ my $status = $res->[0];
+ my $h = "$proto $status " . status_message($status) . "\r\n";
+ my ($len, $chunked);
+ my $headers = $res->[1];
+
+ for (my $i = 0; $i < @$headers; $i += 2) {
+ my $k = $headers->[$i];
+ my $v = $headers->[$i + 1];
+ next if $k =~ /\A(?:Connection|Date)\z/i;
+
+ $len = $v if $k =~ /\AContent-Length\z/i;
+ if ($k =~ /\ATransfer-Encoding\z/i && $v =~ /\bchunked\b/i) {
+ $chunked = 1;
+ }
+
+ $h .= "$k: $v\r\n";
+ }
+
+ my $conn = $env->{HTTP_CONNECTION} || '';
+ my $alive = (defined($len) || $chunked) &&
+ ($proto eq 'HTTP/1.1' && $conn !~ /\bclose\b/i) ||
+ ($conn =~ /\bkeep-alive\b/i);
+
+ $h .= 'Connection: ' . ($alive ? 'keep-alive' : 'close');
+ $h .= "\r\nDate: " . time2str(time) . "\r\n\r\n";
+
+ if (($len || $chunked) && $env->{REQUEST_METHOD} ne 'HEAD') {
+ more($self, $h);
+ } else {
+ $self->write($h);
+ }
+ ($alive, $chunked);
+}
+
+sub response_write {
+ my ($self, $env, $res) = @_;
+ my ($alive, $chunked) = response_header_write($self, $env, $res);
+ my $write = sub { $self->write($_[0]) };
+ my $close = sub {
+ if ($alive) {
+ $self->event_write; # watch for readability if done
+ } else {
+ $self->write(sub { $self->close });
+ }
+ };
+
+ if (defined $res->[2]) {
+ Plack::Util::foreach($res->[2], $write);
+ $close->();
+ } else {
+ # this is returned to the calling application:
+ Plack::Util::inline_object(write => $write, close => $close);
+ }
+}
+
+use constant MSG_MORE => ($^O eq 'linux') ? 0x8000 : 0;
+sub more ($$) {
+ my $self = $_[0];
+ if (MSG_MORE && !$self->{write_buf_size}) {
+ my $n = send($self->{sock}, $_[1], MSG_MORE);
+ if (defined $n) {
+ my $dlen = length($_[1]);
+ return 1 if $n == $dlen; # all done!
+ $_[1] = substr($_[1], $n, $dlen - $n);
+ # fall through to normal write:
+ }
+ }
+ $self->write($_[1]);
+}
+
+# overrides existing Danga::Socket method
+sub event_write {
+ my ($self) = @_;
+ # only continue watching for readability when we are done writing:
+ $self->watch_read(1) if $self->write(undef) == 1
+}
+
+sub input_prepare {
+ my ($self, $env) = @_;
+ my $input = $null_io;
+ my $len = $env->{CONTENT_LENGTH};
+ if ($len) {
+ $input = IO::File->new_tmpfile;
+ } elsif (env_chunked($env)) {
+ $input = IO::File->new_tmpfile;
+ $len = $CHUNK{START};
+ }
+ binmode $input;
+ $env->{'psgi.input'} = $input;
+ $self->{env} = $env;
+ $self->{input_left} = $len;
+}
+
+sub env_chunked { ($_[0]->{HTTP_TRANSFER_ENCODING} || '') =~ /\bchunked\b/i }
+
+sub write_err {
+ my ($self) = @_;
+ my $err = $self->{env}->{'psgi.errors'};
+ my $msg = $! || '(zero write)';
+ $err->print("error buffering to input: $msg\n");
+ $self->quit(500);
+}
+
+sub recv_err {
+ my ($self, $r, $len) = @_;
+ return $self->close if (defined $r && $r == 0);
+ if ($!{EAGAIN}) {
+ $self->{input_left} = $len;
+ return;
+ }
+ my $err = $self->{env}->{'psgi.errors'};
+ $err->print("error reading for input: $! ($len bytes remaining)\n");
+ $self->quit(500);
+}
+
+sub write_in_full {
+ my ($fh, $rbuf, $len) = @_;
+ my $rv = 0;
+ my $off = 0;
+ while ($len > 0) {
+ my $w = syswrite($fh, $$rbuf, $len, $off);
+ return ($rv ? $rv : $w) unless $w; # undef or 0
+ $rv += $w;
+ $off += $w;
+ $len -= $w;
+ }
+ $rv
+}
+
+sub event_read_input_chunked { # unlikely...
+ my ($self) = @_;
+ my $input = $self->{env}->{'psgi.input'};
+ my $sock = $self->{sock};
+ my $len = $self->{input_left};
+ $self->{input_left} = undef;
+ my $rbuf = \($self->{rbuf});
+
+chunk_start:
+ while ($len < 0) { # chunk start
+ if ($len == $CHUNK{Z_END}) {
+ return app_dispatch($self) if $$rbuf =~ s/\r\n//;
+ return $self->quit(400) if length($$rbuf) > 2;
+ }
+ if ($len == $CHUNK{END}) {
+ if ($$rbuf =~ s/\r\n//) {
+ $len = $CHUNK{START};
+ } elsif (length($$rbuf) > 2) {
+ return $self->quit(400);
+ }
+ }
+ if ($len == $CHUNK{START}) {
+ if ($$rbuf =~ s/\A([a-f0-9]+).*?\r\n//i) {
+ $len = hex $1;
+ } elsif (length($$rbuf) > CHUNK_MAX_HDR) {
+ return $self->quit(400);
+ }
+ # will break from loop since $len >= 0
+ }
+
+ if ($len < 0) { # chunk header is trickled, read more
+ my $off = length($$rbuf);
+ my $r = sysread($sock, $$rbuf, 8192, $off);
+ return $self->recv_err($r, $len) unless $r;
+ # (implicit) goto chunk_start if $r > 0;
+ }
+ }
+ # drain the current chunk
+ until ($len == 0) {
+ if ($$rbuf ne '') {
+ my $w = write_in_full($input, $rbuf, $len);
+ return $self->write_err unless $w;
+ $len -= $w;
+ if ($len == 0) {
+ # we may have leftover data to parse in chunk
+ $$rbuf = substr($$rbuf, $w);
+ $len = $CHUNK{END};
+ goto chunk_start;
+ }
+ $$rbuf = '';
+ }
+
+ # read more of current chunk
+ my $r = sysread($sock, $$rbuf, 8192);
+ return $self->recv_err($r, $len) unless $r;
+ }
+ # final chunk starts with "0\r\n"
+ $len = $CHUNK{Z_END};
+ goto chunk_start;
+}
+
+sub quit {
+ my ($self, $status) = @_;
+ my $h = "HTTP/1.1 $status " . status_message($status) . "\r\n\r\n";
+ $self->write($h);
+ $self->close;
+}
+
+1;
diff --git a/lib/PublicInbox/Listener.pm b/lib/PublicInbox/Listener.pm
index 8e0554f..5f351a7 100644
--- a/lib/PublicInbox/Listener.pm
+++ b/lib/PublicInbox/Listener.pm
@@ -25,11 +25,12 @@ sub new ($$$) {
sub event_read {
my ($self) = @_;
+ my $sock = $self->{sock};
# no loop here, we want to fairly distribute clients
# between multiple processes sharing the same socket
- if (my $addr = accept(my $c, $self->{sock})) {
+ if (my $addr = accept(my $c, $sock)) {
IO::Handle::blocking($c, 0); # no accept4 :<
- $self->{post_accept}->($c, $addr);
+ $self->{post_accept}->($c, $addr, $sock);
}
}
diff --git a/public-inbox-httpd b/public-inbox-httpd
new file mode 100644
index 0000000..6436bd7
--- /dev/null
+++ b/public-inbox-httpd
@@ -0,0 +1,100 @@
+#!/usr/bin/perl -w
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# Standalone HTTP server for public-inbox.
+use strict;
+use warnings;
+use Plack::Util;
+use PublicInbox::Daemon;
+use PublicInbox::HTTP;
+use PublicInbox::WWW;
+use Plack::Request;
+use Plack::Builder;
+PublicInbox::WWW->preload;
+my $have_deflater = eval { require Plack::Middleware::Deflater; 1 };
+my %httpds;
+my $config;
+my $app;
+my $refresh = sub {
+ if (@ARGV) {
+ eval { $app = Plack::Util::load_psgi(@ARGV) };
+ if ($@) {
+ die $@,
+"$0 runs in /, command-line paths must be absolute\n";
+ }
+ } else {
+ $app = eval {
+ my $deflate_types = eval {
+ require Plack::Middleware::Deflater;
+ [ 'text/html', 'text/plain',
+ 'application/atom+xml' ]
+ };
+ builder {
+ enable 'Chunked';
+ if ($deflate_types) {
+ enable 'Deflater',
+ content_type => $deflate_types
+ }
+ enable 'Head';
+ sub {
+ my $req = Plack::Request->new(@_);
+ PublicInbox::WWW::run($req,
+ $req->method);
+ };
+ };
+ };
+ }
+};
+
+daemon_run('0.0.0.0:8080', $refresh,
+ sub ($$$) { # post_accept
+ my ($client, $addr, $srv) = @_;
+ my $fd = fileno($srv);
+ my $h = $httpds{$fd} ||= PublicInbox::HTTPD->new($srv, $app);
+ PublicInbox::HTTP->new($client, $addr, $h),
+ });
+
+1;
+package PublicInbox::HTTPD;
+use strict;
+use warnings;
+use Plack::Util;
+
+sub new {
+ my ($class, $sock, $app) = @_;
+ my $n = getsockname($sock) or die "not a socket: $sock $!\n";
+ my ($port, $addr);
+ if (length($n) >= 28) {
+ require Socket6;
+ ($port, $addr) = Socket6::unpack_sockaddr_in6($n);
+ } else {
+ ($port, $addr) = Socket::unpack_sockaddr_in($n);
+ }
+
+ my %env = (
+ REMOTE_HOST => '',
+ REMOTE_PORT => 0,
+ SERVER_NAME => $addr,
+ SERVER_PORT => $port,
+ SCRIPT_NAME => '',
+ 'psgi.version' => [ 1, 1 ],
+ 'psgi.errors' => \*STDERR,
+ 'psgi.url_scheme' => 'http',
+ 'psgi.nonblocking' => Plack::Util::TRUE,
+ 'psgi.streaming' => Plack::Util::TRUE,
+ 'psgi.run_once' => Plack::Util::FALSE,
+ 'psgi.multithread' => Plack::Util::FALSE,
+ 'psgi.multiprocess' => Plack::Util::TRUE,
+ 'psgix.harakiri'=> Plack::Util::FALSE,
+ 'psgix.input.buffered' => Plack::Util::TRUE,
+ );
+ bless {
+ err => \*STDERR,
+ out => \*STDOUT,
+ app => $app,
+ env => \%env,
+ }, $class;
+}
+
+1;
diff --git a/public-inbox-nntpd b/public-inbox-nntpd
index 706cbee..23d269d 100755
--- a/public-inbox-nntpd
+++ b/public-inbox-nntpd
@@ -12,7 +12,7 @@ require PublicInbox::Config;
my $nntpd = PublicInbox::NNTPD->new;
daemon_run('0.0.0.0:119',
sub { $nntpd->refresh_groups }, # refresh
- sub ($$) { PublicInbox::NNTP->new($_[0], $nntpd) }); # post_accept
+ sub ($$$) { PublicInbox::NNTP->new($_[0], $nntpd) }); # post_accept
1;
package PublicInbox::NNTPD;
diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi
new file mode 100644
index 0000000..1947f37
--- /dev/null
+++ b/t/httpd-corner.psgi
@@ -0,0 +1,37 @@
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+# 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 0000000..6524ee2
--- /dev/null
+++ b/t/httpd-corner.t
@@ -0,0 +1,201 @@
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+# 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', $psgi;
+ exec $httpd, '-W0', "--stdout=$out", "--stderr=$err", $psgi;
+ die "FAIL: $!\n";
+ }
+ # system("strace -f -p $pid -o /tmp/z -s 999999 -v &");
+ 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");
+ setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1);
+ return $conn;
+}
+
+sub delay { select(undef, undef, undef, shift || rand(0.01)) }
+
+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');
+};
+
+{
+ local $SIG{PIPE} = 'IGNORE';
+ my $conn = conn_for($sock, '1.1 chunked 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');
+}
+
+{
+ 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, '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);
+}
+
+done_testing();
+
+1;
diff --git a/t/httpd.t b/t/httpd.t
new file mode 100644
index 0000000..034f1ae
--- /dev/null
+++ b/t/httpd.t
@@ -0,0 +1,116 @@
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+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 = <<EOF;
+From: Me <me\@example.com>
+To: You <you\@example.com>
+Cc: $addr
+Message-Id: <nntp\@example.com>
+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);
+}
+
+done_testing();
+
+1;
--
EW
^ permalink raw reply related [flat|nested] 2+ messages in thread
* [PATCH] view: capture header object early
2016-02-20 11:52 [PATCH] initial public-inbox-httpd implemenation e
@ 2016-02-20 11:52 ` e
0 siblings, 0 replies; 2+ messages in thread
From: e @ 2016-02-20 11:52 UTC (permalink / raw)
To: spew
From: Eric Wong <e@80x24.org>
For future changes, this will allow us to more quickly notice
if we keep the heavy Email::MIME object around too long.
It has the side effect of avoiding extra method calls with
Email::MIME which forwards header calls to the header_obj.
---
lib/PublicInbox/View.pm | 83 +++++++++++++++++++++++++------------------------
1 file changed, 42 insertions(+), 41 deletions(-)
diff --git a/lib/PublicInbox/View.pm b/lib/PublicInbox/View.pm
index 70b92a7..7bbc224 100644
--- a/lib/PublicInbox/View.pm
+++ b/lib/PublicInbox/View.pm
@@ -35,10 +35,11 @@ sub msg_html {
} else {
$footer = '';
}
- headers_to_html_header($mime, $full_pfx, $ctx) .
+ my $hdr = $mime->header_obj;
+ headers_to_html_header($hdr, $full_pfx, $ctx) .
multipart_text_as_html($mime, $full_pfx) .
'</pre><hr /><pre>' .
- html_footer($mime, 1, $full_pfx, $ctx) .
+ html_footer($hdr, 1, $full_pfx, $ctx) .
$footer .
'</pre></body></html>';
}
@@ -52,12 +53,12 @@ sub feed_entry {
}
sub in_reply_to {
- my ($header_obj) = @_;
- my $irt = $header_obj->header('In-Reply-To');
+ my ($hdr) = @_;
+ my $irt = $hdr->header('In-Reply-To');
return mid_clean($irt) if (defined $irt);
- my $refs = $header_obj->header('References');
+ my $refs = $hdr->header('References');
if ($refs && $refs =~ /<([^>]+)>\s*\z/s) {
return $1;
}
@@ -72,17 +73,17 @@ sub index_entry {
my $srch = $ctx->{srch};
my ($prev, $next) = ($midx - 1, $midx + 1);
my $part_nr = 0;
- my $enc = enc_for($mime->header("Content-Type"));
- my $subj = $mime->header('Subject');
- my $header_obj = $mime->header_obj;
+ my $hdr = $mime->header_obj;
+ my $enc = enc_for($hdr->header("Content-Type"));
+ my $subj = $hdr->header('Subject');
- my $mid_raw = mid_clean($header_obj->header('Message-ID'));
+ my $mid_raw = mid_clean($hdr->header('Message-ID'));
my $id = anchor_for($mid_raw);
my $seen = $state->{seen};
$seen->{$id} = "#$id"; # save the anchor for children, later
my $mid = PublicInbox::Hval->new_msgid($mid_raw);
- my $from = PublicInbox::Hval->new_oneline($mime->header('From'))->raw;
+ my $from = PublicInbox::Hval->new_oneline($hdr->header('From'))->raw;
my @from = Email::Address->parse($from);
$from = $from[0]->name;
@@ -91,7 +92,7 @@ sub index_entry {
my $root_anchor = $state->{root_anchor} || '';
my $path = $root_anchor ? '../../' : '';
my $href = $mid->as_href;
- my $irt = in_reply_to($header_obj);
+ my $irt = in_reply_to($hdr);
my $parent_anchor = $seen->{anchor_for($irt)} if defined $irt;
if ($srch) {
@@ -102,7 +103,7 @@ sub index_entry {
$subj = "<u\nid=u>$subj</u>";
}
- my $ts = _msg_date($mime);
+ my $ts = _msg_date($hdr);
my $rv = "<pre\nid=s$midx>";
$rv .= "<b\nid=$id>$subj</b>\n";
$rv .= "- $from @ $ts UTC - ";
@@ -130,7 +131,7 @@ sub index_entry {
my $txt = "${path}$href/raw";
$rv = "\n<a\nhref=\"$mhref\">$more</a> <a\nhref=\"$txt\">raw</a> ";
- $rv .= html_footer($mime, 0, undef, $ctx);
+ $rv .= html_footer($hdr, 0, undef, $ctx);
if (defined $irt) {
unless (defined $parent_anchor) {
@@ -412,15 +413,14 @@ sub add_text_body {
}
sub headers_to_html_header {
- my ($mime, $full_pfx, $ctx) = @_;
+ my ($hdr, $full_pfx, $ctx) = @_;
my $srch = $ctx->{srch} if $ctx;
my $rv = "";
my @title;
- my $header_obj = $mime->header_obj;
- my $mid = $header_obj->header('Message-ID');
+ my $mid = $hdr->header('Message-ID');
$mid = PublicInbox::Hval->new_msgid($mid);
foreach my $h (qw(From To Cc Subject Date)) {
- my $v = $header_obj->header($h);
+ my $v = $hdr->header($h);
defined($v) && ($v ne '') or next;
$v = PublicInbox::Hval->new_oneline($v);
@@ -443,12 +443,12 @@ sub headers_to_html_header {
$rv .= "(<a\nhref=\"${upfx}raw\">raw</a>)\n";
my $atom;
if ($srch) {
- thread_inline(\$rv, $ctx, $mime, $upfx);
+ thread_inline(\$rv, $ctx, $hdr, $upfx);
$atom = qq{<link\nrel=alternate\ntitle="Atom feed"\n} .
qq!href="${upfx}t.atom"\ntype="application/atom+xml"/>!;
} else {
- $rv .= _parent_headers_nosrch($header_obj);
+ $rv .= _parent_headers_nosrch($hdr);
$atom = '';
}
$rv .= "\n";
@@ -458,16 +458,16 @@ sub headers_to_html_header {
}
sub thread_inline {
- my ($dst, $ctx, $cur, $upfx) = @_;
+ my ($dst, $ctx, $hdr, $upfx) = @_;
my $srch = $ctx->{srch};
- my $mid = mid_clean($cur->header('Message-ID'));
+ my $mid = mid_clean($hdr->header('Message-ID'));
my $res = $srch->get_thread($mid);
my $nr = $res->{total};
my $expand = "<a\nhref=\"${upfx}t/#u\">expand</a> " .
"/ <a\nhref=\"${upfx}t.mbox.gz\">mbox.gz</a>";
$$dst .= 'Thread: ';
- my $parent = in_reply_to($cur);
+ my $parent = in_reply_to($hdr);
if ($nr <= 1) {
if (defined $parent) {
$$dst .= "($expand)\n ";
@@ -486,7 +486,7 @@ sub thread_inline {
}
$$dst .= ")\n";
- my $subj = $srch->subject_path($cur->header('Subject'));
+ my $subj = $srch->subject_path($hdr->header('Subject'));
my $state = {
seen => { $subj => 1 },
srch => $srch,
@@ -505,10 +505,10 @@ sub thread_inline {
}
sub _parent_headers_nosrch {
- my ($header_obj) = @_;
+ my ($hdr) = @_;
my $rv = '';
- my $irt = in_reply_to($header_obj);
+ my $irt = in_reply_to($hdr);
if (defined $irt) {
my $v = PublicInbox::Hval->new_msgid($irt, 1);
my $html = $v->as_html;
@@ -517,7 +517,7 @@ sub _parent_headers_nosrch {
$rv .= "<a\nhref=\"../$href/\">$html</a>>\n";
}
- my $refs = $header_obj->header('References');
+ my $refs = $hdr->header('References');
if ($refs) {
# avoid redundant URLs wasting bandwidth
my %seen;
@@ -538,12 +538,12 @@ sub _parent_headers_nosrch {
}
sub html_footer {
- my ($mime, $standalone, $full_pfx, $ctx) = @_;
+ my ($hdr, $standalone, $full_pfx, $ctx) = @_;
my %cc; # everyone else
my $to; # this is the From address
foreach my $h (qw(From To Cc)) {
- my $v = $mime->header($h);
+ my $v = $hdr->header($h);
defined($v) && ($v ne '') or next;
my @addrs = Email::Address->parse($v);
foreach my $recip (@addrs) {
@@ -555,9 +555,9 @@ sub html_footer {
}
Email::Address->purge_cache if $standalone;
- my $subj = $mime->header('Subject') || '';
+ my $subj = $hdr->header('Subject') || '';
$subj = "Re: $subj" unless $subj =~ /\bRe:/i;
- my $mid = $mime->header('Message-ID');
+ my $mid = $hdr->header('Message-ID');
my $irt = uri_escape_utf8($mid);
delete $cc{$to};
$to = uri_escape_utf8($to);
@@ -740,8 +740,8 @@ sub load_results {
}
sub msg_timestamp {
- my ($mime) = @_;
- my $ts = eval { str2time($mime->header('Date')) };
+ my ($hdr) = @_;
+ my $ts = eval { str2time($hdr->header('Date')) };
defined($ts) ? $ts : 0;
}
@@ -764,21 +764,21 @@ sub missing_thread {
}
sub _msg_date {
- my ($mime) = @_;
- my $ts = $mime->header('X-PI-TS') || msg_timestamp($mime);
+ my ($hdr) = @_;
+ my $ts = $hdr->header('X-PI-TS') || msg_timestamp($hdr);
fmt_ts($ts);
}
sub fmt_ts { POSIX::strftime('%Y-%m-%d %k:%M', gmtime($_[0])) }
sub _inline_header {
- my ($dst, $state, $upfx, $mime, $level) = @_;
+ my ($dst, $state, $upfx, $hdr, $level) = @_;
my $dot = $level == 0 ? '' : '` ';
my $cur = $state->{cur};
- my $mid = mid_clean($mime->header('Message-ID'));
- my $f = $mime->header('X-PI-From');
- my $d = _msg_date($mime);
+ my $mid = mid_clean($hdr->header('Message-ID'));
+ my $f = $hdr->header('X-PI-From');
+ my $d = _msg_date($hdr);
$f = PublicInbox::Hval->new_oneline($f)->as_html;
my $pfx = ' ' . $d . ' ' . indent_for($level);
my $attr = $f;
@@ -806,7 +806,7 @@ sub _inline_header {
# Subject is never undef, this mail was loaded from
# our Xapian which would've resulted in '' if it were
# really missing (and Filter rejects empty subjects)
- my $s = $mime->header('Subject');
+ my $s = $hdr->header('Subject');
my $h = $state->{srch}->subject_path($s);
if ($state->{seen}->{$h}) {
$s = undef;
@@ -828,11 +828,12 @@ sub inline_dump {
my ($dst, $state, $upfx, $node, $level) = @_;
return unless $node;
if (my $mime = $node->message) {
- my $mid = mid_clean($mime->header('Message-ID'));
+ my $hdr = $mime->header_obj;
+ my $mid = mid_clean($hdr->header('Message-ID'));
if ($mid eq $state->{parent_cmp}) {
$state->{parent} = $mid;
}
- _inline_header($dst, $state, $upfx, $mime, $level);
+ _inline_header($dst, $state, $upfx, $hdr, $level);
} else {
my $dot = $level == 0 ? '' : '` ';
my $pfx = (' ' x length(' 1970-01-01 13:37 ')).
--
EW
^ permalink raw reply related [flat|nested] 2+ messages in thread
end of thread, other threads:[~2016-02-20 11:52 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-02-20 11:52 [PATCH] initial public-inbox-httpd implemenation e
2016-02-20 11:52 ` [PATCH] view: capture header object early e
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).