]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/Mbox.pm
imap+nntp: share COMPRESS implementation
[public-inbox.git] / lib / PublicInbox / Mbox.pm
index 9995140cd8228db8b26313927d04e432a3007cf2..b977308d05417d36e6e092dbe00b6d80775fcbc3 100644 (file)
@@ -1,82 +1,63 @@
-# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 
-# Streaming (via getline) interface for formatting messages as an mboxrd.
-# Used by the PSGI web interface.
-#
-# public-inbox-httpd favors "getline" response bodies to take a
-# "pull"-based approach to feeding slow clients (as opposed to a
-# more common "push" model)
+# Streaming interface for mboxrd HTTP responses
+# See PublicInbox::GzipFilter for details.
 package PublicInbox::Mbox;
 use strict;
-use warnings;
+use parent 'PublicInbox::GzipFilter';
 use PublicInbox::MID qw/mid_escape/;
 use PublicInbox::Hval qw/to_filename/;
 use PublicInbox::Smsg;
-use PublicInbox::WwwStream qw(html_oneshot);
-use Email::Simple;
-use Email::MIME::Encode;
-
-sub subject_fn ($) {
-       my ($hdr) = @_;
-       my $fn = $hdr->header('Subject');
-       return 'no-subject' if (!defined($fn) || $fn eq '');
-
-       # no need for full Email::MIME, here
-       if ($fn =~ /=\?/) {
-               eval { $fn = Encode::decode('MIME-Header', $fn) };
-               return 'no-subject' if $@;
-       }
-       $fn =~ s/^re:\s+//i;
-       $fn eq '' ? 'no-subject' : to_filename($fn);
-}
-
-sub mb_stream {
-       my ($more) = @_;
-       bless $more, 'PublicInbox::Mbox';
-}
+use PublicInbox::Eml;
 
 # called by PSGI server as body response
 # this gets called twice for every message, once to return the header,
 # once to retrieve the body
 sub getline {
-       my ($more) = @_; # self
-       my ($ctx, $id, $prev, $next, $mref, $hdr) = @$more;
-       if ($hdr) { # first message hits this, only
-               pop @$more; # $hdr
-               pop @$more; # $mref
-               return msg_hdr($ctx, $hdr) . msg_body($$mref);
+       my ($ctx) = @_; # ctx
+       my $smsg = $ctx->{smsg} or return;
+       my $ibx = $ctx->{ibx};
+       my $eml = delete($ctx->{eml}) // $ibx->smsg_eml($smsg) // return;
+       my $n = $ctx->{smsg} = $ibx->over->next_by_mid(@{$ctx->{next_arg}});
+       $ctx->zmore(msg_hdr($ctx, $eml));
+       if ($n) {
+               $ctx->translate(msg_body($eml));
+       } else { # last message
+               $ctx->zmore(msg_body($eml));
+               $ctx->zflush;
        }
-       my $cur = $next or return;
-       my $ibx = $ctx->{-inbox};
-       $next = $ibx->over->next_by_mid($ctx->{mid}, \$id, \$prev);
-       $mref = $ibx->msg_by_smsg($cur) or return;
-       $hdr = Email::Simple->new($mref)->header_obj;
-       @$more = ($ctx, $id, $prev, $next); # $next may be undef, here
-       msg_hdr($ctx, $hdr) . msg_body($$mref);
 }
 
-sub close {} # noop
+# called by PublicInbox::DS::write after http->next_step
+sub async_next {
+       my ($http) = @_; # PublicInbox::HTTP
+       my $ctx = $http->{forward} or return; # client aborted
+       eval {
+               my $smsg = $ctx->{smsg} or return $ctx->close;
+               $ctx->smsg_blob($smsg);
+       };
+       warn "E: $@" if $@;
+}
+
+sub async_eml { # for async_blob_cb
+       my ($ctx, $eml) = @_;
+       my $smsg = delete $ctx->{smsg};
+       # next message
+       $ctx->{smsg} = $ctx->{ibx}->over->next_by_mid(@{$ctx->{next_arg}});
+       local $ctx->{eml} = $eml; # for mbox_hdr
+       $ctx->zmore(msg_hdr($ctx, $eml));
+       $ctx->write(msg_body($eml));
+}
 
-# /$INBOX/$MESSAGE_ID/raw
-sub emit_raw {
+sub mbox_hdr ($) {
        my ($ctx) = @_;
-       my $mid = $ctx->{mid};
-       my $ibx = $ctx->{-inbox};
-       $ctx->{base_url} = $ibx->base_url($ctx->{env});
-       my ($mref, $more, $id, $prev, $next);
-       if (my $over = $ibx->over) {
-               my $smsg = $over->next_by_mid($mid, \$id, \$prev) or return;
-               $mref = $ibx->msg_by_smsg($smsg) or return;
-               $next = $over->next_by_mid($mid, \$id, \$prev);
-       } else {
-               $mref = $ibx->msg_by_mid($mid) or return;
-       }
-       my $hdr = Email::Simple->new($mref)->header_obj;
-       $more = [ $ctx, $id, $prev, $next, $mref, $hdr ]; # for ->getline
-       my $fn = subject_fn($hdr);
+       my $eml = $ctx->{eml} //= $ctx->{ibx}->smsg_eml($ctx->{smsg});
+       my $fn = $eml->header_str('Subject') // '';
+       $fn =~ s/^re:\s+//i;
+       $fn = to_filename($fn) // 'no-subject';
        my @hdr = ('Content-Type');
-       if ($ibx->{obfuscate}) {
+       if ($ctx->{ibx}->{obfuscate}) {
                # obfuscation is stupid, but maybe scrapers are, too...
                push @hdr, 'application/mbox';
                $fn .= '.mbox';
@@ -84,55 +65,57 @@ sub emit_raw {
                push @hdr, 'text/plain';
                $fn .= '.txt';
        }
+       my $cs = $ctx->{eml}->ct->{attributes}->{charset} // 'UTF-8';
+       $cs = 'UTF-8' if $cs =~ /[^a-zA-Z0-9\-\_]/; # avoid header injection
+       $hdr[-1] .= "; charset=$cs";
        push @hdr, 'Content-Disposition', "inline; filename=$fn";
-       [ 200, \@hdr, mb_stream($more) ];
+       [ 200, \@hdr ];
+}
+
+# for rare cases where v1 inboxes aren't indexed w/ ->over at all
+sub no_over_raw ($) {
+       my ($ctx) = @_;
+       my $mref = $ctx->{ibx}->msg_by_mid($ctx->{mid}) or return;
+       my $eml = $ctx->{eml} = PublicInbox::Eml->new($mref);
+       [ @{mbox_hdr($ctx)}, [ msg_hdr($ctx, $eml) . msg_body($eml) ] ]
+}
+
+# /$INBOX/$MESSAGE_ID/raw
+sub emit_raw {
+       my ($ctx) = @_;
+       $ctx->{base_url} = $ctx->{ibx}->base_url($ctx->{env});
+       my $over = $ctx->{ibx}->over or return no_over_raw($ctx);
+       my ($id, $prev);
+       my $mip = $ctx->{next_arg} = [ $ctx->{mid}, \$id, \$prev ];
+       my $smsg = $ctx->{smsg} = $over->next_by_mid(@$mip) or return;
+       bless $ctx, __PACKAGE__;
+       $ctx->psgi_response(\&mbox_hdr);
 }
 
-sub msg_hdr ($$;$) {
-       my ($ctx, $header_obj, $mid) = @_;
+sub msg_hdr ($$) {
+       my ($ctx, $eml) = @_;
+       my $header_obj = $eml->header_obj;
 
        # drop potentially confusing headers, ssoma already should've dropped
        # Lines and Content-Length
        foreach my $d (qw(Lines Bytes Content-Length Status)) {
                $header_obj->header_set($d);
        }
-       my $ibx = $ctx->{-inbox};
-       my $base = $ctx->{base_url};
-       $mid = $ctx->{mid} unless defined $mid;
-       $mid = mid_escape($mid);
-       my @append = (
-               'Archived-At', "<$base$mid/>",
-               'List-Archive', "<$base>",
-               'List-Post', "<mailto:$ibx->{-primary_address}>",
-       );
        my $crlf = $header_obj->crlf;
        my $buf = $header_obj->as_string;
        # fixup old bug from import (pre-a0c07cba0e5d8b6a)
        $buf =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
-       $buf = "From mboxrd\@z Thu Jan  1 00:00:00 1970" . $crlf . $buf;
-
-       for (my $i = 0; $i < @append; $i += 2) {
-               my $k = $append[$i];
-               my $v = $append[$i + 1];
-               my @v = $header_obj->header($k);
-               foreach (@v) {
-                       if ($v eq $_) {
-                               $v = undef;
-                               last;
-                       }
-               }
-               $buf .= "$k: $v$crlf" if defined $v;
-       }
-       $buf .= $crlf;
+       "From mboxrd\@z Thu Jan  1 00:00:00 1970" . $crlf . $buf . $crlf;
 }
 
 sub msg_body ($) {
+       my $bdy = $_[0]->{bdy} // return "\n";
        # mboxrd quoting style
        # https://en.wikipedia.org/wiki/Mbox#Modified_mbox
        # https://www.loc.gov/preservation/digital/formats/fdd/fdd000385.shtml
        # https://web.archive.org/http://www.qmail.org/man/man5/mbox.html
-       $_[0] =~ s/^(>*From )/>$1/gm;
-       $_[0] .= "\n";
+       $$bdy =~ s/^(>*From )/>$1/gm;
+       $$bdy .= "\n";
 }
 
 sub thread_cb {
@@ -143,8 +126,9 @@ sub thread_cb {
                        return $smsg;
                }
                # refill result set
-               $ctx->{msgs} = $msgs = $ctx->{over}->get_thread($ctx->{mid},
-                                                               $ctx->{prev});
+               my $over = $ctx->{ibx}->over or return $ctx->gone('over');
+               $ctx->{msgs} = $msgs = $over->get_thread($ctx->{mid},
+                                                       $ctx->{prev});
                return unless @$msgs;
                $ctx->{prev} = $msgs->[-1];
        }
@@ -152,99 +136,121 @@ sub thread_cb {
 
 sub thread_mbox {
        my ($ctx, $over, $sfx) = @_;
-       eval { require PublicInbox::MboxGz };
-       return need_gzip($ctx) if $@;
        my $msgs = $ctx->{msgs} = $over->get_thread($ctx->{mid}, {});
        return [404, [qw(Content-Type text/plain)], []] if !@$msgs;
        $ctx->{prev} = $msgs->[-1];
-       $ctx->{over} = $over; # bump refcnt
-       PublicInbox::MboxGz->response($ctx, \&thread_cb, $msgs->[0]->subject);
+       require PublicInbox::MboxGz;
+       PublicInbox::MboxGz::mbox_gz($ctx, \&thread_cb, $msgs->[0]->{subject});
 }
 
 sub emit_range {
        my ($ctx, $range) = @_;
 
-       my $query;
+       my $q;
        if ($range eq 'all') { # TODO: YYYY[-MM]
-               $query = '';
+               $q = '';
        } else {
                return [404, [qw(Content-Type text/plain)], []];
        }
-       mbox_all($ctx, $query);
+       mbox_all($ctx, { q => $q });
 }
 
 sub all_ids_cb {
        my ($ctx) = @_;
+       my $over = $ctx->{ibx}->over or return $ctx->gone('over');
        my $ids = $ctx->{ids};
        do {
                while ((my $num = shift @$ids)) {
-                       my $smsg = $ctx->{over}->get_art($num) or next;
+                       my $smsg = $over->get_art($num) or next;
                        return $smsg;
                }
-               $ctx->{ids} = $ids = $ctx->{mm}->ids_after(\($ctx->{prev}));
+               $ctx->{ids} = $ids = $over->ids_after(\($ctx->{prev}));
        } while (@$ids);
 }
 
 sub mbox_all_ids {
        my ($ctx) = @_;
-       my $ibx = $ctx->{-inbox};
        my $prev = 0;
-       my $mm = $ctx->{mm} = $ibx->mm;
-       my $ids = $mm->ids_after(\$prev) or return
-               [404, [qw(Content-Type text/plain)], ["No results found\n"]];
-       $ctx->{over} = $ibx->over or
+       my $over = $ctx->{ibx}->over or
                return PublicInbox::WWW::need($ctx, 'Overview');
+       my $ids = $over->ids_after(\$prev) or return
+               [404, [qw(Content-Type text/plain)], ["No results found\n"]];
        $ctx->{ids} = $ids;
        $ctx->{prev} = $prev;
-       return PublicInbox::MboxGz->response($ctx, \&all_ids_cb, 'all');
+       $ctx->{-low_prio} = 1;
+       require PublicInbox::MboxGz;
+       PublicInbox::MboxGz::mbox_gz($ctx, \&all_ids_cb, 'all');
 }
 
 sub results_cb {
        my ($ctx) = @_;
-       my $mset = $ctx->{mset};
-       my $srch = $ctx->{srch};
+       my $over = $ctx->{ibx}->over or return $ctx->gone('over');
        while (1) {
-               while (my $mi = (($mset->items)[$ctx->{iter}++])) {
-                       my $smsg = PublicInbox::Smsg::from_mitem($mi,
-                                                               $srch) or next;
+               while (defined(my $num = shift(@{$ctx->{ids}}))) {
+                       my $smsg = $over->get_art($num) or next;
                        return $smsg;
                }
-               # refill result set
-               $mset = $ctx->{mset} = $srch->query($ctx->{query},
-                                                       $ctx->{qopts});
+               # refill result set, deprioritize since there's many results
+               my $srch = $ctx->{ibx}->isrch or return $ctx->gone('search');
+               my $mset = $srch->mset($ctx->{query}, $ctx->{qopts});
                my $size = $mset->size or return;
                $ctx->{qopts}->{offset} += $size;
-               $ctx->{iter} = 0;
+               $ctx->{ids} = $srch->mset_to_artnums($mset, $ctx->{qopts});
+               $ctx->{-low_prio} = 1;
        }
 }
 
+sub results_thread_cb {
+       my ($ctx) = @_;
+
+       my $over = $ctx->{ibx}->over or return $ctx->gone('over');
+       while (1) {
+               while (defined(my $num = shift(@{$ctx->{xids}}))) {
+                       my $smsg = $over->get_art($num) or next;
+                       return $smsg;
+               }
+
+               # refills ctx->{xids}
+               next if $over->expand_thread($ctx);
+
+               # refill result set, deprioritize since there's many results
+               my $srch = $ctx->{ibx}->isrch or return $ctx->gone('search');
+               my $mset = $srch->mset($ctx->{query}, $ctx->{qopts});
+               my $size = $mset->size or return;
+               $ctx->{qopts}->{offset} += $size;
+               $ctx->{ids} = $srch->mset_to_artnums($mset, $ctx->{qopts});
+               $ctx->{-low_prio} = 1;
+       }
+
+}
+
 sub mbox_all {
-       my ($ctx, $query) = @_;
-
-       eval { require PublicInbox::MboxGz };
-       return need_gzip($ctx) if $@;
-       return mbox_all_ids($ctx) if $query eq '';
-       my $qopts = $ctx->{qopts} = { mset => 2 };
-       my $srch = $ctx->{srch} = $ctx->{-inbox}->search or
-               return PublicInbox::WWW::need($ctx, 'Search');;
-       my $mset = $ctx->{mset} = $srch->query($query, $qopts);
+       my ($ctx, $q) = @_;
+       my $q_string = $q->{'q'};
+       return mbox_all_ids($ctx) if $q_string !~ /\S/;
+       my $srch = $ctx->{ibx}->isrch or
+               return PublicInbox::WWW::need($ctx, 'Search');
+       my $over = $ctx->{ibx}->over or
+               return PublicInbox::WWW::need($ctx, 'Overview');
+
+       my $qopts = $ctx->{qopts} = { relevance => -2 }; # ORDER BY docid DESC
+       $qopts->{threads} = 1 if $q->{t};
+       $srch->query_approxidate($ctx->{ibx}->git, $q_string);
+       my $mset = $srch->mset($q_string, $qopts);
        $qopts->{offset} = $mset->size or
                        return [404, [qw(Content-Type text/plain)],
                                ["No results found\n"]];
-       $ctx->{iter} = 0;
-       $ctx->{query} = $query;
-       PublicInbox::MboxGz->response($ctx, \&results_cb, 'results-'.$query);
-}
-
-sub need_gzip {
-       html_oneshot($_[0], 501, \<<EOF);
-<pre>gzipped mbox not available
-
-The administrator needs to install the Compress::Raw::Zlib Perl module
-to support gzipped mboxes.
-
-<a href="../">Return to index</a></pre>
-EOF
+       $ctx->{query} = $q_string;
+       $ctx->{ids} = $srch->mset_to_artnums($mset, $qopts);
+       require PublicInbox::MboxGz;
+       my $fn;
+       if ($q->{t} && $srch->has_threadid) {
+               $fn = 'results-thread-'.$q_string;
+               PublicInbox::MboxGz::mbox_gz($ctx, \&results_thread_cb, $fn);
+       } else {
+               $fn = 'results-'.$q_string;
+               PublicInbox::MboxGz::mbox_gz($ctx, \&results_cb, $fn);
+       }
 }
 
 1;