1 # Copyright (C) 2015 all contributors <meta@public-inbox.org>
2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
4 # Streaming interface for formatting messages as an mboxrd.
5 # Used by the web interface
6 package PublicInbox::Mbox;
9 use PublicInbox::MID qw/mid2path mid_clean/;
10 use URI::Escape qw/uri_escape_utf8/;
11 require Email::Simple;
14 my ($ctx, $srch, $sfx) = @_;
16 my ($response) = @_; # Plack callback
17 emit_mbox($response, $ctx, $srch, $sfx);
22 my $simple = Email::Simple->new(pop);
26 # single message should be easily renderable in browsers
27 my $fh = $response->([200, ['Content-Type'=>'text/plain']]);
28 emit_msg($ctx, $fh, $simple);
34 my ($ctx, $fh, $simple) = @_; # Email::Simple object
35 my $header_obj = $simple->header_obj;
37 # drop potentially confusing headers, ssoma already should've dropped
38 # Lines and Content-Length
39 foreach my $d (qw(Lines Bytes Content-Length Status)) {
40 $header_obj->header_set($d);
42 my $feed_opts = $ctx->{feed_opts};
44 require PublicInbox::Feed; # FIXME: gross
45 $feed_opts = PublicInbox::Feed::get_feedopts($ctx);
46 $ctx->{feed_opts} = $feed_opts;
48 my $base = $feed_opts->{url};
49 my $mid = mid_clean($header_obj->header('Message-ID'));
50 $mid = uri_escape_utf8($mid);
51 my @archived_at = $header_obj->header('Archived-At');
52 push @archived_at, "<$base$mid/>";
53 $header_obj->header_set('Archived-At', @archived_at);
54 $header_obj->header_set('List-Archive', "<$base>");
55 $header_obj->header_set('List-Post', "<mailto:$feed_opts->{id_addr}>");
57 my $buf = $header_obj->as_string;
58 unless ($buf =~ /\AFrom /) {
59 $fh->write("From mboxrd\@z Thu Jan 1 00:00:00 1970\n");
61 $fh->write($buf .= $simple->crlf);
64 $simple->body_set('');
66 # mboxrd quoting style
67 # ref: http://www.qmail.org/man/man5/mbox.html
68 $buf =~ s/^(>*From )/>$1/gm;
70 $buf .= "\n" unless $buf =~ /\n\z/s;
76 my ($response, $ctx, $srch, $sfx) = @_;
79 eval { require IO::Compress::Gzip };
80 return need_gzip($response) if $@;
84 # http://www.iana.org/assignments/media-types/application/gzip
85 # http://www.iana.org/assignments/media-types/application/mbox
86 my $fh = $response->([200, ['Content-Type' => "application/$type"]]);
87 $fh = PublicInbox::MboxGz->new($fh) if $sfx;
89 require PublicInbox::Git;
90 my $mid = $ctx->{mid};
91 my $git = $ctx->{git} ||= PublicInbox::Git->new($ctx->{git_dir});
92 my %opts = (offset => 0);
95 my $res = $srch->get_thread($mid, \%opts);
96 my $msgs = $res->{msgs};
98 while (defined(my $smsg = shift @$msgs)) {
100 my $p = 'HEAD:'.mid2path($smsg->mid);
101 Email::Simple->new($git->cat_file($p));
103 emit_msg($ctx, $fh, $msg) if $msg;
106 $opts{offset} += $nr;
113 my $fh = $_[0]->([501, ['Content-Type' => 'text/html']]);
114 my $title = 'gzipped mbox not available';
116 <html><head><title>$title</title><body><pre>$title
117 The administrator needs to install the IO::Compress::Gzip Perl module
118 to support gzipped mboxes.
119 <a href="../">Return to index</a></pre></body></html>
126 # fh may not be a proper IO, so we wrap the write and close methods
127 # to prevent IO::Compress::Gzip from complaining
128 package PublicInbox::MboxGz;
133 my ($class, $fh) = @_;
137 gz => IO::Compress::Gzip->new(\$buf),
144 if (defined ${$self->{buf}}) {
145 $self->{fh}->write(${$self->{buf}});
146 ${$self->{buf}} = undef;
151 $_[0]->{gz}->write($_[1]);