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);
52 'Archived-At', "<$base$mid/>",
53 'List-Archive', "<$base>",
54 'List-Post', "<mailto:$feed_opts->{id_addr}>",
57 my $crlf = $simple->crlf;
58 for (my $i = 0; $i < @append; $i += 2) {
60 my $v = $append[$i + 1];
61 my @v = $header_obj->header($k);
68 $append .= "$k: $v$crlf" if defined $v;
70 my $buf = $header_obj->as_string;
71 unless ($buf =~ /\AFrom /) {
72 $fh->write("From mboxrd\@z Thu Jan 1 00:00:00 1970\n");
75 $fh->write($buf .= $append);
78 $simple->body_set('');
80 # mboxrd quoting style
81 # ref: http://www.qmail.org/man/man5/mbox.html
82 $buf =~ s/^(>*From )/>$1/gm;
84 $fh->write($buf .= "\n");
88 my ($response, $ctx, $srch, $sfx) = @_;
91 eval { require IO::Compress::Gzip };
92 return need_gzip($response) if $@;
96 # http://www.iana.org/assignments/media-types/application/gzip
97 # http://www.iana.org/assignments/media-types/application/mbox
98 my $fh = $response->([200, ['Content-Type' => "application/$type"]]);
99 $fh = PublicInbox::MboxGz->new($fh) if $sfx;
101 require PublicInbox::Git;
102 my $mid = $ctx->{mid};
103 my $git = $ctx->{git} ||= PublicInbox::Git->new($ctx->{git_dir});
104 my %opts = (offset => 0, asc => 1);
107 my $res = $srch->get_thread($mid, \%opts);
108 my $msgs = $res->{msgs};
110 while (defined(my $smsg = shift @$msgs)) {
112 my $p = 'HEAD:'.mid2path($smsg->mid);
113 Email::Simple->new($git->cat_file($p));
115 emit_msg($ctx, $fh, $msg) if $msg;
118 $opts{offset} += $nr;
125 my ($ctx, $range) = @_;
126 sub { _emit_range($_[0], $ctx, $range) };
130 my ($res, $ctx, $range) = @_;
132 eval { require IO::Compress::Gzip };
133 return need_gzip($res) if $@;
135 if ($range eq 'all') { # TODO: YYYY[-MM]
138 $res->([404, [qw(Content-Type text/plain)], []]);
142 # http://www.iana.org/assignments/media-types/application/gzip
143 my $fh = $res->([200, [qw(Content-Type application/gzip)]]);
144 $fh = PublicInbox::MboxGz->new($fh);
145 my $env = $ctx->{cgi}->env;
146 my $srch = $ctx->{srch};
147 my $git = $ctx->{git};
148 my %opts = (offset => 0, asc => 1);
151 my $res = $srch->query($query, \%opts);
152 my $msgs = $res->{msgs};
154 while (defined(my $smsg = shift @$msgs)) {
156 my $p = 'HEAD:'.mid2path($smsg->mid);
157 Email::Simple->new($git->cat_file($p));
159 emit_msg($ctx, $fh, $msg) if $msg;
162 $opts{offset} += $nr;
165 $cb->(); # first part is free
166 return $fh->close if $nr == 0;
168 if ($env->{'pi-httpd.async'}) {
169 my $io = $env->{'psgix.io'} or die "no IO";
180 $io->write($next); # Danga::Socket::write
183 $cb->() while ($nr > 0);
188 my $fh = $_[0]->([501, ['Content-Type' => 'text/html']]);
189 my $title = 'gzipped mbox not available';
191 <html><head><title>$title</title><body><pre>$title
192 The administrator needs to install the IO::Compress::Gzip Perl module
193 to support gzipped mboxes.
194 <a href="../">Return to index</a></pre></body></html>
201 # fh may not be a proper IO, so we wrap the write and close methods
202 # to prevent IO::Compress::Gzip from complaining
203 package PublicInbox::MboxGz;
208 my ($class, $fh) = @_;
212 gz => IO::Compress::Gzip->new(\$buf),
219 if (defined ${$self->{buf}}) {
220 $self->{fh}->write(${$self->{buf}});
221 ${$self->{buf}} = undef;
226 $_[0]->{gz}->write($_[1]);