support dumping thread as an mbox

Some folks may not want to download and install Perl code like
ssoma, so allow downloading an mbox containing the entire
thread.

diff --git a/lib/PublicInbox/Mbox.pm b/lib/PublicInbox/Mbox.pm
new file mode 100644 (file)
index 0000000..2ec5065
--- /dev/null
+++ b/lib/PublicInbox/Mbox.pm
@@ -0,0 +1,55 @@
+# Copyright (C) 2015, all contributors <meta@public-inbox.org>
+# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# Streaming interface for formatting messages as an mbox
+package PublicInbox::Mbox;
+use strict;
+use warnings;
+use PublicInbox::MID qw/mid_clean mid_compressed mid2path/;
+use Fcntl qw(SEEK_SET);
+
+sub thread_mbox {
+       my ($ctx, $srch) = @_;
+       my $mid = mid_compressed($ctx->{mid});
+       my $res = $srch->get_thread($mid);
+       my $msgs = delete $res->{msgs};
+       require PublicInbox::GitCatFile;
+       require Email::Simple;
+       my $git = PublicInbox::GitCatFile->new($ctx->{git_dir});
+
+       sub {
+               my ($res) = @_; # Plack callback
+               my $w = $res->([200, [ 'Content-Type' => 'text/plain' ] ]);
+               while (defined(my $smsg = shift @$msgs)) {
+                       my $msg = eval {
+                               my $path = 'HEAD:' . mid2path($smsg->mid);
+                               Email::Simple->new($git->cat_file($path));
+                       };
+                       emit($w, $msg) if $msg;
+               }
+       }
+}
+
+sub emit {
+       my ($fh, $simple) = @_; # Email::Simple object
+
+       # drop potentially confusing headers, ssoma already should've dropped
+       # Lines and Content-Length
+       foreach my $d (qw(Lines Content-Length Status)) {
+               $simple->header_set($d);
+       }
+
+       my $buf = $simple->header_obj->as_string;
+       unless ($buf =~ /\AFrom /) {
+               $fh->write("From a\@a Thu Jan  1 00:00:00 1970\n");
+       }
+       $fh->write($buf .= $simple->crlf);
+
+       $buf = $simple->body;
+       $simple->body_set('');
+       $buf =~ s/^(From )/>$1/gm;
+       $buf .= "\n" unless $buf =~ /\n\z/s;
+
+       $fh->write($buf);
+}
+
+1;

diff --git a/lib/PublicInbox/WWW.pm b/lib/PublicInbox/WWW.pm
index b0c1348659b154127d8ea6efc0189f27ffed8ec2..cd8a57055cc2410835c52e87d74ca7b0a1fd9607 100644 (file)
--- a/lib/PublicInbox/WWW.pm
+++ b/lib/PublicInbox/WWW.pm
@@ -53,6 +53,9 @@ sub run {
        } elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.html\z!o) {
                invalid_list_mid(\%ctx, $1, $2) || get_thread(\%ctx, $cgi);
 
+       } elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.mbox\z!o) {
+               invalid_list_mid(\%ctx, $1, $2) || get_thread_mbox(\%ctx, $cgi);
+
        } elsif ($path_info =~ m!$LISTNAME_RE/f/\S+\.txt\z!o) {
                invalid_list_mid(\%ctx, $1, $2) ||
                        redirect_mid_txt(\%ctx, $cgi);
@@ -326,4 +329,12 @@ sub msg_pfx {
        "../f/$href.html";
 }
 
+# /$LISTNAME/t/$MESSAGE_ID.mbox                    -> search results as mbox
+sub get_thread_mbox {
+       my ($ctx, $cgi) = @_;
+       my $srch = searcher($ctx) or return need_search($ctx);
+       require PublicInbox::Mbox;
+       PublicInbox::Mbox::thread_mbox($ctx, $srch);
+}
+
 1;

diff --git a/public-inbox.cgi b/public-inbox.cgi
index ed0f12c885bbb8c58fdcbf6e5ffe12b242a0c2b9..5c6dfe8a3c5a298ba3b7f4591c4dce0223b041b8 100755 (executable)
--- a/public-inbox.cgi
+++ b/public-inbox.cgi
@@ -3,12 +3,22 @@
 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
 use strict;
 use warnings;
+use IO::Handle;
 require PublicInbox::WWW;
 use CGI qw/-nosticky/;
 our $NO_SCRIPT_NAME;
+our %HTTP_CODES;
 BEGIN {
        $NO_SCRIPT_NAME = 1 if $ENV{NO_SCRIPT_NAME};
        CGI->compile if $ENV{MOD_PERL};
+
+       %HTTP_CODES = (
+               200 => 'OK',
+               301 => 'Moved Permanently',
+               404 => 'Not Found',
+               405 => 'Method Not Allowed',
+               501 => 'Not Implemented',
+       );
 }
 
 # some servers (Ruby webrick) include scheme://host[:port] here,
@@ -19,23 +29,30 @@ delete $ENV{REQUEST_URI};
 $ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME;
 my $req = CGI->new;
 my $ret = PublicInbox::WWW::run($req, $req->request_method);
-binmode STDOUT;
+
+my $out = select;
+$out->binmode;
 if (@ARGV && $ARGV[0] eq 'static') {
-       print $ret->[2]->[0]; # only show the body
+       $out->write($ret->[2]->[0]); # only show the body
 } else { # CGI
-       my ($status, $headers, $body) = @$ret;
-       my %codes = (
-               200 => 'OK',
-               301 => 'Moved Permanently',
-               404 => 'Not Found',
-               405 => 'Method Not Allowed',
-               501 => 'Not Implemented',
-       );
+       if (ref($ret) eq 'CODE') {
+               $ret->(*dump_header);
+       } else {
+               my ($status, $headers, $body) = @$ret;
+
+               dump_header([$status, $headers])->write($body->[0]);
+       }
+}
 
-       print "Status: $status $codes{$status}\r\n";
+sub dump_header {
+       my ($res) = @_;
+       my $fh = select;
+       my ($status, $headers) = @$res;
+       $fh->write("Status: $status $HTTP_CODES{$status}\r\n");
        my @tmp = @$headers;
        while (my ($k, $v) = splice(@tmp, 0, 2)) {
-               print "$k: $v\r\n";
+               $fh->write("$k: $v\r\n");
        }
-       print "\r\n", $body->[0];
+       $fh->write("\r\n");
+       $fh;
 }

diff --git a/t/cgi.t b/t/cgi.t
index a16ebd8daa5485f57eb3b3647655f23794fd2506..2747a1598bdc06d01ab923c31621b99fe165a661 100644 (file)
--- a/t/cgi.t
+++ b/t/cgi.t
@@ -10,6 +10,7 @@ use IPC::Run qw/run/;
 
 use constant CGI => "blib/script/public-inbox.cgi";
 my $mda = "blib/script/public-inbox-mda";
+my $index = "blib/script/public-inbox-index";
 my $tmpdir = tempdir(CLEANUP => 1);
 my $home = "$tmpdir/pi-home";
 my $pi_home = "$home/.public-inbox";
@@ -178,6 +179,24 @@ EOF
                "slashy URL generated correctly");
 }
 
+# retrieve thread as an mbox
+{
+       local $ENV{HOME} = $home;
+       local $ENV{PATH} = $main_path;
+       my $path = "/test/t/blahblah%40example.com.mbox";
+       my $res = cgi_run($path);
+       like($res->{head}, qr/^Status: 501 /, "search not-yet-enabled");
+       my $indexed = system($index, $maindir) == 0;
+       if ($indexed) {
+               $res = cgi_run($path);
+               # use Data::Dumper; print STDERR Dumper($res);
+               like($res->{head}, qr/^Status: 200 /, "search returned mbox");
+               like($res->{body}, qr/^From /m, "From lines in mbox");
+       } else {
+               like($res->{head}, qr/^Status: 501 /, "search not available");
+       }
+}
+
 # redirect list-name-only URLs
 {
        local $ENV{HOME} = $home;