cgi: preliminary Plack compatibility

This needs further testing and refactoring, but seems to work
reasonably well.

diff --git a/public-inbox.cgi b/public-inbox.cgi
index 34c63a567cbb46c95dd75c049d5fbe7759e9c5e6..26b0fc618798d3e86f2038811bf6a727b20f7063 100755 (executable)
--- a/public-inbox.cgi
+++ b/public-inbox.cgi
@@ -16,7 +16,7 @@ use CGI qw(:cgi -nosticky); # PSGI/FastCGI/mod_perl compat
 use Encode qw(find_encoding);
 use PublicInbox::Config;
 use URI::Escape qw(uri_escape uri_unescape);
-my $enc_utf8 = find_encoding('UTF-8');
+our $enc_utf8 = find_encoding('UTF-8');
 our $LISTNAME_RE = qr!\A/([\w\.\-]+)!;
 our $pi_config;
 BEGIN {
@@ -27,22 +27,18 @@ BEGIN {
        }
 }
 
-my $ret = main();
-
-my ($status, $headers, $body) = @$ret;
-set_binmode($headers);
-if (@ARGV && $ARGV[0] eq 'static') {
-       print $body;
-} else { # CGI
-       print "Status: $status\r\n";
-       while (my ($k, $v) = each %$headers) {
-               print "$k: $v\r\n";
+if ($ENV{PI_PLACKUP}) {
+       psgi_app();
+} else {
+       my $ret = main();
+       binmode STDOUT;
+       if (@ARGV && $ARGV[0] eq 'static') {
+               print $ret->[2]->[0];
+       } else { # CGI
+               cgi_print($ret);
        }
-       print "\r\n", $body;
 }
 
-# TODO: plack support
-
 # private functions below
 
 sub main {
@@ -55,7 +51,7 @@ sub main {
        my $cgi = CGI->new;
        my %ctx;
        if ($cgi->request_method !~ /\AGET|HEAD\z/) {
-               return r("405 Method Not Allowed");
+               return r(405, 'Method Not Allowed');
        }
        my $path_info = $enc_utf8->decode($cgi->path_info);
 
@@ -88,10 +84,10 @@ sub main {
        }
 }
 
-sub r404 { r("404 Not Found") }
+sub r404 { r(404, 'Not Found') }
 
 # simple response for errors
-sub r { [ $_[0], { 'Content-Type' => 'text/plain' }, $_[0]."\n" ] }
+sub r { [ $_[0], ['Content-Type' => 'text/plain'], [ join(' ', @_, "\n") ] ] }
 
 # returns undef if valid, array ref response if invalid
 sub invalid_list {
@@ -108,23 +104,23 @@ sub invalid_list {
 # returns undef if valid, array ref response if invalid
 sub invalid_list_mid {
        my ($ctx, $listname, $mid) = @_;
-       my $ret = invalid_list($ctx, $listname, $mid) and return $ret;
-       $ctx->{mid} = uri_unescape($mid);
-       undef;
+       my $ret = invalid_list($ctx, $listname, $mid);
+       $ctx->{mid} = uri_unescape($mid) unless $ret;
+       $ret;
 }
 
 # /$LISTNAME/atom.xml                       -> Atom feed, includes replies
 sub get_atom {
        my ($ctx, $cgi, $top) = @_;
        require PublicInbox::Feed;
-       [ '200 OK', { 'Content-Type' => 'application/xml' },
-         PublicInbox::Feed->generate({
+       [ 200, [ 'Content-Type' => 'application/xml' ],
+         [ PublicInbox::Feed->generate({
                        git_dir => $ctx->{git_dir},
                        listname => $ctx->{listname},
                        pi_config => $pi_config,
                        cgi => $cgi,
                        top => $top,
-               })
+               }) ]
        ];
 }
 
@@ -132,14 +128,14 @@ sub get_atom {
 sub get_index {
        my ($ctx, $cgi, $top) = @_;
        require PublicInbox::Feed;
-       [ '200 OK', { 'Content-Type' => 'text/html' },
-         PublicInbox::Feed->generate_html_index({
+       [ 200, [ 'Content-Type' => 'text/html' ],
+         [ PublicInbox::Feed->generate_html_index({
                        git_dir => $ctx->{git_dir},
                        listname => $ctx->{listname},
                        pi_config => $pi_config,
                        cgi => $cgi,
                        top => $top,
-               })
+               }) ]
        ];
 }
 
@@ -159,7 +155,7 @@ sub mid2blob {
 sub get_mid_txt {
        my ($ctx, $cgi) = @_;
        my $x = mid2blob($ctx);
-       $x ? [ "200 OK", {'Content-Type' => 'text/plain'}, $$x ] : r404();
+       $x ? [ 200, [ 'Content-Type' => 'text/plain' ], [ $$x ] ] : r404();
 }
 
 # /$LISTNAME/m/$MESSAGE_ID.html                   -> HTML content (short quotes)
@@ -172,8 +168,8 @@ sub get_mid_html {
        my $mid_href = PublicInbox::Hval::ascii_html(uri_escape($ctx->{mid}));
        my $pfx = "../f/$mid_href.html";
        require Email::MIME;
-       [ "200 OK", {'Content-Type' => 'text/html'},
-               PublicInbox::View->as_html(Email::MIME->new($$x), $pfx)];
+       [ 200, [ 'Content-Type' => 'text/html' ],
+               [ PublicInbox::View->as_html(Email::MIME->new($$x), $pfx) ] ];
 }
 
 # /$LISTNAME/f/$MESSAGE_ID.html                   -> HTML content (fullquotes)
@@ -183,8 +179,8 @@ sub get_full_html {
        return r404() unless $x;
        require PublicInbox::View;
        require Email::MIME;
-       [ "200 OK", {'Content-Type' => 'text/html'},
-               PublicInbox::View->as_html(Email::MIME->new($$x))];
+       [ 200, [ 'Content-Type' => 'text/html' ],
+               [ PublicInbox::View->as_html(Email::MIME->new($$x))] ];
 }
 
 sub redirect_list_index {
@@ -201,19 +197,44 @@ sub redirect_mid {
 
 sub do_redirect {
        my ($url) = @_;
-       [ '301 Moved Permanently',
-         { Location => $url, 'Content-Type' => 'text/plain' },
-         "Redirecting to $url\n"
+       [ 301,
+         [ Location => $url, 'Content-Type' => 'text/plain' ],
+         [ "Redirecting to $url\n" ]
        ]
 }
 
-# only used for CGI and static file generation modes
-sub set_binmode {
-       my ($headers) = @_;
-       if ($headers->{'Content-Type'} eq 'text/plain') {
-               # no way to validate raw messages, mixed encoding is possible.
-               binmode STDOUT;
-       } else { # strict encoding for HTML and XML
-               binmode STDOUT, ':encoding(us-ascii)';
+sub psgi_app {
+       require CGI::Emulate::PSGI;
+
+       # preload so we are CoW friendly
+       require PublicInbox::Feed;
+       require PublicInbox::View;
+       require Mail::Thread;
+       require Digest::SHA;
+       require POSIX;
+       require XML::Atom::SimpleFeed;
+       eval { require Git };
+       sub {
+               my ($e) = @_;
+               local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($e));
+               main();
+       }
+}
+
+sub cgi_print {
+       my ($ret) = @_;
+       my ($status, $headers, $body) = @$ret;
+       my %codes = (
+               200 => 'OK',
+               301 => 'Moved Permanently',
+               404 => 'Not Found',
+               405 => 'Method Not Allowed',
+       );
+
+       print "Status: $status $codes{$status}\r\n";
+       my @tmp = @$headers;
+       while (my ($k, $v) = splice(@tmp, 0, 2)) {
+               print "$k: $v\r\n";
        }
+       print "\r\n", $body->[0];
 }