]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/View.pm
7339467120205679175462e2a716f84588ef37df
[public-inbox.git] / lib / PublicInbox / View.pm
1 # Copyright (C) 2014-2018 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 #
4 # Used for displaying the HTML web interface.
5 # See Documentation/design_www.txt for this.
6 package PublicInbox::View;
7 use strict;
8 use warnings;
9 use PublicInbox::MsgTime qw(msg_datestamp);
10 use PublicInbox::Hval qw/ascii_html obfuscate_addrs/;
11 use PublicInbox::Linkify;
12 use PublicInbox::MID qw/id_compress mid_escape mids references/;
13 use PublicInbox::MsgIter;
14 use PublicInbox::Address;
15 use PublicInbox::WwwStream;
16 use PublicInbox::Reply;
17 require POSIX;
18 use Time::Local qw(timegm);
19
20 use constant COLS => 72;
21 use constant INDENT => '  ';
22 use constant TCHILD => '` ';
23 sub th_pfx ($) { $_[0] == 0 ? '' : TCHILD };
24
25 # public functions: (unstable)
26
27 sub msg_html {
28         my ($ctx, $mime, $more, $smsg) = @_;
29         my $hdr = $mime->header_obj;
30         my $ibx = $ctx->{-inbox};
31         my $obfs_ibx = $ctx->{-obfs_ibx} = $ibx->{obfuscate} ? $ibx : undef;
32         my $tip = _msg_html_prepare($hdr, $ctx, $more, 0);
33         my $end = 2;
34         PublicInbox::WwwStream->response($ctx, 200, sub {
35                 my ($nr, undef) = @_;
36                 if ($nr == 1) {
37                         # $more cannot be true w/o $smsg being defined:
38                         my $upfx = $more ? '../'.mid_escape($smsg->mid).'/' : '';
39                         $tip . multipart_text_as_html($mime, $upfx, $obfs_ibx) .
40                                 '</pre><hr>'
41                 } elsif ($more && @$more) {
42                         ++$end;
43                         msg_html_more($ctx, $more, $nr);
44                 } elsif ($nr == $end) {
45                         # fake an EOF if generating the footer fails;
46                         # we want to at least show the message if something
47                         # here crashes:
48                         eval {
49                                 '<pre>' . html_footer($hdr, 1, $ctx) .
50                                 '</pre>' . msg_reply($ctx, $hdr)
51                         };
52                 } else {
53                         undef
54                 }
55         });
56 }
57
58 sub msg_page {
59         my ($ctx) = @_;
60         my $mid = $ctx->{mid};
61         my $ibx = $ctx->{-inbox};
62         my ($first, $more);
63         my $smsg;
64         if (my $srch = $ibx->search) {
65                 my ($id, $prev);
66                 $smsg = $srch->next_by_mid($mid, \$id, \$prev);
67                 $first = $ibx->msg_by_smsg($smsg) if $smsg;
68                 if ($first) {
69                         my $next = $srch->next_by_mid($mid, \$id, \$prev);
70                         $more = [ $id, $prev, $next ] if $next;
71                 }
72                 return unless $first;
73         } else {
74                 $first = $ibx->msg_by_mid($mid) or return;
75         }
76         msg_html($ctx, PublicInbox::MIME->new($first), $more, $smsg);
77 }
78
79 sub msg_html_more {
80         my ($ctx, $more, $nr) = @_;
81         my $str = eval {
82                 my ($id, $prev, $smsg) = @$more;
83                 my $mid = $ctx->{mid};
84                 $smsg = $ctx->{-inbox}->smsg_mime($smsg);
85                 my $next = $ctx->{srch}->next_by_mid($mid, \$id, \$prev);
86                 @$more = $next ? ($id, $prev, $next) : ();
87                 if ($smsg) {
88                         my $mime = $smsg->{mime};
89                         my $upfx = '../' . mid_escape($smsg->mid) . '/';
90                         _msg_html_prepare($mime->header_obj, $ctx, $more, $nr) .
91                                 multipart_text_as_html($mime, $upfx,
92                                                         $ctx->{-obfs_ibx}) .
93                                 '</pre><hr>'
94                 } else {
95                         '';
96                 }
97         };
98         if ($@) {
99                 warn "Error lookup up additional messages: $@\n";
100                 $str = '<pre>Error looking up additional messages</pre>';
101         }
102         $str;
103 }
104
105 # /$INBOX/$MESSAGE_ID/#R
106 sub msg_reply {
107         my ($ctx, $hdr) = @_;
108         my $se_url =
109          'https://kernel.org/pub/software/scm/git/docs/git-send-email.html';
110         my $p_url =
111          'https://en.wikipedia.org/wiki/Posting_style#Interleaved_style';
112
113         my $info = '';
114         my $ibx = $ctx->{-inbox};
115         if (my $url = $ibx->{infourl}) {
116                 $url = PublicInbox::Hval::prurl($ctx->{env}, $url);
117                 $info = qq(\n  List information: <a\nhref="$url">$url</a>\n);
118         }
119
120         my ($arg, $link, $reply_to_all) =
121                         PublicInbox::Reply::mailto_arg_link($ibx, $hdr);
122
123         # mailto: link only works if address obfuscation is disabled
124         if ($link) {
125                 $link = <<EOF;
126
127 * If your mail client supports setting the <b>In-Reply-To</b> header
128   via mailto: links, try the <a
129 href="$link">mailto: link</a>
130 EOF
131         }
132
133         push @$arg, '/path/to/YOUR_REPLY';
134         $arg = ascii_html(join(" \\\n    ", '', @$arg));
135         <<EOF
136 <hr><pre
137 id=R><b>Reply instructions:</b>
138
139 You may reply publically to <a
140 href=#t>this message</a> via plain-text email
141 using any one of the following methods:
142
143 * Save the following mbox file, import it into your mail client,
144   and $reply_to_all from there: <a
145 href=raw>mbox</a>
146
147   Avoid top-posting and favor interleaved quoting:
148   <a
149 href="$p_url">$p_url</a>
150 $info
151 * Reply using the <b>--to</b>, <b>--cc</b>, and <b>--in-reply-to</b>
152   switches of git-send-email(1):
153
154   git send-email$arg
155
156   <a
157 href="$se_url">$se_url</a>
158 $link</pre>
159 EOF
160 }
161
162 sub in_reply_to {
163         my ($hdr) = @_;
164         my $refs = references($hdr);
165         $refs->[-1];
166 }
167
168 sub fold_addresses ($) {
169         return $_[0] if length($_[0]) <= COLS;
170         # try to fold on commas after non-word chars before $lim chars,
171         # Try to get the "," preceeded by ">" or ")", but avoid folding
172         # on the comma where somebody uses "Lastname, Firstname".
173         # We also try to keep the last and penultimate addresses in
174         # the list on the same line if possible, hence the extra \z
175         # Fall back to folding on spaces at $lim + 1 chars
176         my $lim = COLS - 8; # 8 = "\t" display width
177         my $too_long = $lim + 1;
178         $_[0] =~ s/\s*\z//s; # Email::Simple doesn't strip trailing spaces
179         $_[0] = join("\n\t",
180                 ($_[0] =~ /(.{0,$lim}\W(?:,|\z)|
181                                 .{1,$lim}(?:,|\z)|
182                                 .{1,$lim}|
183                                 .{$too_long,}?)(?:\s|\z)/xgo));
184 }
185
186 sub _hdr_names_html ($$) {
187         my ($hdr, $field) = @_;
188         my $val = $hdr->header($field) or return '';
189         ascii_html(join(', ', PublicInbox::Address::names($val)));
190 }
191
192 sub nr_to_s ($$$) {
193         my ($nr, $singular, $plural) = @_;
194         return "0 $plural" if $nr == 0;
195         $nr == 1 ? "$nr $singular" : "$nr $plural";
196 }
197
198 # this is already inside a <pre>
199 sub index_entry {
200         my ($smsg, $ctx, $more) = @_;
201         my $srch = $ctx->{srch};
202         my $subj = $smsg->subject;
203         my $mid_raw = $smsg->mid;
204         my $id = id_compress($mid_raw, 1);
205         my $id_m = 'm'.$id;
206
207         my $root_anchor = $ctx->{root_anchor} || '';
208         my $irt;
209         my $obfs_ibx = $ctx->{-obfs_ibx};
210
211         my $rv = "<a\nhref=#e$id\nid=m$id>*</a> ";
212         $subj = '<b>'.ascii_html($subj).'</b>';
213         obfuscate_addrs($obfs_ibx, $subj) if $obfs_ibx;
214         $subj = "<u\nid=u>$subj</u>" if $root_anchor eq $id_m;
215         $rv .= $subj . "\n";
216         $rv .= _th_index_lite($mid_raw, \$irt, $id, $ctx);
217         my @tocc;
218         my $mime = $smsg->{mime};
219         my $hdr = $mime->header_obj;
220         my $from = _hdr_names_html($hdr, 'From');
221         obfuscate_addrs($obfs_ibx, $from) if $obfs_ibx;
222         $rv .= "From: $from @ ".fmt_ts($smsg->ds)." UTC";
223         my $upfx = $ctx->{-upfx};
224         my $mhref = $upfx . mid_escape($mid_raw) . '/';
225         $rv .= qq{ (<a\nhref="$mhref">permalink</a> / };
226         $rv .= qq{<a\nhref="${mhref}raw">raw</a>)\n};
227         my $to = fold_addresses(_hdr_names_html($hdr, 'To'));
228         my $cc = fold_addresses(_hdr_names_html($hdr, 'Cc'));
229         my ($tlen, $clen) = (length($to), length($cc));
230         my $to_cc = '';
231         if (($tlen + $clen) > COLS) {
232                 $to_cc .= '  To: '.$to."\n" if $tlen;
233                 $to_cc .= '  Cc: '.$cc."\n" if $clen;
234         } else {
235                 if ($tlen) {
236                         $to_cc .= '  To: '.$to;
237                         $to_cc .= '; <b>+Cc:</b> '.$cc if $clen;
238                 } else {
239                         $to_cc .= '  Cc: '.$cc if $clen;
240                 }
241                 $to_cc .= "\n";
242         }
243         obfuscate_addrs($obfs_ibx, $to_cc) if $obfs_ibx;
244         $rv .= $to_cc;
245
246         my $mapping = $ctx->{mapping};
247         if (!$mapping && (defined($irt) || defined($irt = in_reply_to($hdr)))) {
248                 my $mirt = PublicInbox::Hval->new_msgid($irt);
249                 my $href = $upfx . $mirt->{href}. '/';
250                 my $html = $mirt->as_html;
251                 $rv .= qq(In-Reply-To: &lt;<a\nhref="$href">$html</a>&gt;\n)
252         }
253         $rv .= "\n";
254
255         # scan through all parts, looking for displayable text
256         msg_iter($mime, sub { $rv .= add_text_body($mhref, $obfs_ibx, $_[0]) });
257
258         # add the footer
259         $rv .= "\n<a\nhref=#$id_m\nid=e$id>^</a> ".
260                 "<a\nhref=\"$mhref\">permalink</a>" .
261                 " <a\nhref=\"${mhref}raw\">raw</a>" .
262                 " <a\nhref=\"${mhref}#R\">reply</a>";
263
264         my $hr;
265         if (my $pct = $ctx->{pct}) { # used by SearchView.pm
266                 $rv .= "\t[relevance $pct->{$mid_raw}%]";
267                 $hr = 1;
268         } elsif ($mapping) {
269                 my $nested = 'nested';
270                 my $flat = 'flat';
271                 my $end = '';
272                 if ($ctx->{flat}) {
273                         $hr = 1;
274                         $flat = "<b>$flat</b>";
275                 } else {
276                         $nested = "<b>$nested</b>";
277                 }
278                 $rv .= "\t[<a\nhref=\"${mhref}T/#u\">$flat</a>";
279                 $rv .= "|<a\nhref=\"${mhref}t/#u\">$nested</a>]";
280                 $rv .= " <a\nhref=#r$id>$ctx->{s_nr}</a>";
281         } else {
282                 $hr = $ctx->{-hr};
283         }
284
285         $rv .= $more ? '</pre><hr><pre>' : '</pre>' if $hr;
286         $rv;
287 }
288
289 sub pad_link ($$;$) {
290         my ($mid, $level, $s) = @_;
291         $s ||= '...';
292         my $id = id_compress($mid, 1);
293         (' 'x19).indent_for($level).th_pfx($level)."<a\nhref=#r$id>($s)</a>\n";
294 }
295
296 sub _th_index_lite {
297         my ($mid_raw, $irt, $id, $ctx) = @_;
298         my $rv = '';
299         my $mapping = $ctx->{mapping} or return $rv;
300         my $pad = '  ';
301         my $mid_map = $mapping->{$mid_raw};
302         defined $mid_map or
303                 return 'public-inbox BUG: '.ascii_html($mid_raw).' not mapped';
304         my ($attr, $node, $idx, $level) = @$mid_map;
305         my $children = $node->{children};
306         my $nr_c = scalar @$children;
307         my $nr_s = 0;
308         my $siblings;
309         if (my $smsg = $node->{smsg}) {
310                 ($$irt) = (($smsg->{references} || '') =~ m/<([^>]+)>\z/);
311         }
312         my $irt_map = $mapping->{$$irt} if defined $$irt;
313         if (defined $irt_map) {
314                 $siblings = $irt_map->[1]->{children};
315                 $nr_s = scalar(@$siblings) - 1;
316                 $rv .= $pad . $irt_map->[0];
317                 if ($idx > 0) {
318                         my $prev = $siblings->[$idx - 1];
319                         my $pmid = $prev->{id};
320                         if ($idx > 2) {
321                                 my $s = ($idx - 1). ' preceding siblings ...';
322                                 $rv .= pad_link($pmid, $level, $s);
323                         } elsif ($idx == 2) {
324                                 my $ppmid = $siblings->[0]->{id};
325                                 $rv .= $pad . $mapping->{$ppmid}->[0];
326                         }
327                         $rv .= $pad . $mapping->{$pmid}->[0];
328                 }
329         }
330         my $s_s = nr_to_s($nr_s, 'sibling', 'siblings');
331         my $s_c = nr_to_s($nr_c, 'reply', 'replies');
332         $attr =~ s!\n\z!</b>\n!s;
333         $attr =~ s!<a\nhref.*</a> !!s; # no point in duplicating subject
334         $attr =~ s!<a\nhref=[^>]+>([^<]+)</a>!$1!s; # no point linking to self
335         $rv .= "<b>@ $attr";
336         if ($nr_c) {
337                 my $cmid = $children->[0]->{id};
338                 $rv .= $pad . $mapping->{$cmid}->[0];
339                 if ($nr_c > 2) {
340                         my $s = ($nr_c - 1). ' more replies';
341                         $rv .= pad_link($cmid, $level + 1, $s);
342                 } elsif (my $cn = $children->[1]) {
343                         $rv .= $pad . $mapping->{$cn->{id}}->[0];
344                 }
345         }
346
347         my $next = $siblings->[$idx+1] if $siblings && $idx >= 0;
348         if ($next) {
349                 my $nmid = $next->{id};
350                 $rv .= $pad . $mapping->{$nmid}->[0];
351                 my $nnext = $nr_s - $idx;
352                 if ($nnext > 2) {
353                         my $s = ($nnext - 1).' subsequent siblings';
354                         $rv .= pad_link($nmid, $level, $s);
355                 } elsif (my $nn = $siblings->[$idx + 2]) {
356                         $rv .= $pad . $mapping->{$nn->{id}}->[0];
357                 }
358         }
359         $rv .= $pad ."<a\nhref=#r$id>$s_s, $s_c; $ctx->{s_nr}</a>\n";
360 }
361
362 sub walk_thread {
363         my ($rootset, $ctx, $cb) = @_;
364         my @q = map { (0, $_, -1) } @$rootset;
365         while (@q) {
366                 my ($level, $node, $i) = splice(@q, 0, 3);
367                 defined $node or next;
368                 $cb->($ctx, $level, $node, $i);
369                 ++$level;
370                 $i = 0;
371                 unshift @q, map { ($level, $_, $i++) } @{$node->{children}};
372         }
373 }
374
375 sub pre_thread  {
376         my ($ctx, $level, $node, $idx) = @_;
377         $ctx->{mapping}->{$node->{id}} = [ '', $node, $idx, $level ];
378         skel_dump($ctx, $level, $node);
379 }
380
381 sub thread_index_entry {
382         my ($ctx, $level, $smsg) = @_;
383         my ($beg, $end) = thread_adj_level($ctx, $level);
384         $beg . '<pre>' . index_entry($smsg, $ctx, 0) . '</pre>' . $end;
385 }
386
387 sub stream_thread ($$) {
388         my ($rootset, $ctx) = @_;
389         my $inbox = $ctx->{-inbox};
390         my @q = map { (0, $_) } @$rootset;
391         my $level;
392         my $smsg;
393         while (@q) {
394                 $level = shift @q;
395                 my $node = shift @q or next;
396                 my $cl = $level + 1;
397                 unshift @q, map { ($cl, $_) } @{$node->{children}};
398                 $smsg = $inbox->smsg_mime($node->{smsg}) and last;
399         }
400         return missing_thread($ctx) unless $smsg;
401
402         $ctx->{-obfs_ibx} = $inbox->{obfuscate} ? $inbox : undef;
403         $ctx->{-title_html} = ascii_html($smsg->subject);
404         $ctx->{-html_tip} = thread_index_entry($ctx, $level, $smsg);
405         $smsg = undef;
406         PublicInbox::WwwStream->response($ctx, 200, sub {
407                 return unless $ctx;
408                 while (@q) {
409                         $level = shift @q;
410                         my $node = shift @q or next;
411                         my $cl = $level + 1;
412                         unshift @q, map { ($cl, $_) } @{$node->{children}};
413                         if ($smsg = $inbox->smsg_mime($node->{smsg})) {
414                                 return thread_index_entry($ctx, $level, $smsg);
415                         } else {
416                                 return ghost_index_entry($ctx, $level, $node);
417                         }
418                 }
419                 my $ret = join('', thread_adj_level($ctx, 0));
420                 $ret .= ${$ctx->{dst}}; # skel
421                 $ctx = undef;
422                 $ret;
423         });
424 }
425
426 sub thread_html {
427         my ($ctx) = @_;
428         my $mid = $ctx->{mid};
429         my $srch = $ctx->{srch};
430         my ($nr, $msgs) = $srch->get_thread($mid);
431         return missing_thread($ctx) if $nr == 0;
432         my $skel = '<hr><pre>';
433         $skel .= $nr == 1 ? 'only message in thread' : 'end of thread';
434         $skel .= ", back to <a\nhref=\"../../\">index</a>\n\n";
435         $skel .= "<b\nid=t>Thread overview:</b> ";
436         $skel .= $nr == 1 ? '(only message)' : "$nr+ messages";
437         $skel .= " (download: <a\nhref=\"../t.mbox.gz\">mbox.gz</a>";
438         $skel .= " / follow: <a\nhref=\"../t.atom\">Atom feed</a>)\n";
439         $skel .= "-- links below jump to the message on this page --\n";
440         $ctx->{-upfx} = '../../';
441         $ctx->{cur_level} = 0;
442         $ctx->{dst} = \$skel;
443         $ctx->{prev_attr} = '';
444         $ctx->{prev_level} = 0;
445         $ctx->{root_anchor} = anchor_for($mid);
446         $ctx->{mapping} = {};
447         $ctx->{s_nr} = "$nr+ messages in thread";
448
449         my $rootset = thread_results($ctx, $msgs);
450
451         # reduce hash lookups in pre_thread->skel_dump
452         my $inbox = $ctx->{-inbox};
453         $ctx->{-obfs_ibx} = $inbox->{obfuscate} ? $inbox : undef;
454         walk_thread($rootset, $ctx, *pre_thread);
455
456         $skel .= '</pre>';
457         return stream_thread($rootset, $ctx) unless $ctx->{flat};
458
459         # flat display: lazy load the full message from smsg
460         my $smsg;
461         while (my $m = shift @$msgs) {
462                 $smsg = $inbox->smsg_mime($m) and last;
463         }
464         return missing_thread($ctx) unless $smsg;
465         $ctx->{-title_html} = ascii_html($smsg->subject);
466         $ctx->{-html_tip} = '<pre>'.index_entry($smsg, $ctx, scalar @$msgs);
467         $smsg = undef;
468         PublicInbox::WwwStream->response($ctx, 200, sub {
469                 return unless $msgs;
470                 $smsg = undef;
471                 while (my $m = shift @$msgs) {
472                         $smsg = $inbox->smsg_mime($m) and last;
473                 }
474                 return index_entry($smsg, $ctx, scalar @$msgs) if $smsg;
475                 $msgs = undef;
476                 $skel;
477         });
478 }
479
480 sub multipart_text_as_html {
481         my ($mime, $upfx, $obfs_ibx) = @_;
482         my $rv = "";
483
484         # scan through all parts, looking for displayable text
485         msg_iter($mime, sub { $rv .= add_text_body($upfx, $obfs_ibx, $_[0]) });
486         $rv;
487 }
488
489 sub flush_quote {
490         my ($s, $l, $quot) = @_;
491
492         # show everything in the full version with anchor from
493         # short version (see above)
494         my $rv = $l->linkify_1(join('', @$quot));
495         @$quot = ();
496
497         # we use a <span> here to allow users to specify their own
498         # color for quoted text
499         $rv = $l->linkify_2(ascii_html($rv));
500         $$s .= qq(<span\nclass="q">) . $rv . '</span>'
501 }
502
503 sub attach_link ($$$$;$) {
504         my ($upfx, $ct, $p, $fn, $err) = @_;
505         my ($part, $depth, @idx) = @$p;
506         my $nl = $idx[-1] > 1 ? "\n" : '';
507         my $idx = join('.', @idx);
508         my $size = bytes::length($part->body);
509
510         # hide attributes normally, unless we want to aid users in
511         # spotting MUA problems:
512         $ct =~ s/;.*// unless $err;
513         $ct = ascii_html($ct);
514         my $desc = $part->header('Content-Description');
515         $desc = $fn unless defined $desc;
516         $desc = '' unless defined $desc;
517         my $sfn;
518         if (defined $fn && $fn =~ /\A[[:alnum:]][\w\.-]+[[:alnum:]]\z/) {
519                 $sfn = $fn;
520         } elsif ($ct eq 'text/plain') {
521                 $sfn = 'a.txt';
522         } else {
523                 $sfn = 'a.bin';
524         }
525         my $ret = qq($nl<a\nhref="$upfx$idx-$sfn">);
526         if ($err) {
527                 $ret .=
528 "[-- Warning: decoded text below may be mangled --]\n";
529         }
530         $ret .= "[-- Attachment #$idx: ";
531         my $ts = "Type: $ct, Size: $size bytes";
532         $desc = ascii_html($desc);
533         $ret .= ($desc eq '') ? "$ts --]" : "$desc --]\n[-- $ts --]";
534         $ret .= "</a>\n";
535 }
536
537 sub add_text_body {
538         my ($upfx, $obfs_ibx, $p) = @_;
539         # $p - from msg_iter: [ Email::MIME, depth, @idx ]
540         my ($part, $depth) = @$p; # attachment @idx is unused
541         my $ct = $part->content_type || 'text/plain';
542         my $fn = $part->filename;
543
544         if ($ct =~ m!\btext/x?html\b!i) {
545                 return attach_link($upfx, $ct, $p, $fn);
546         }
547
548         my $s = eval { $part->body_str };
549
550         # badly-encoded message? tell the world about it!
551         my $err = $@;
552         if ($err) {
553                 if ($ct =~ m!\btext/plain\b!i) {
554                         # Try to assume UTF-8 because Alpine seems to
555                         # do wacky things and set charset=X-UNKNOWN
556                         $part->charset_set('UTF-8');
557                         $s = eval { $part->body_str };
558
559                         # If forcing charset=UTF-8 failed,
560                         # attach_link will warn further down...
561                         $s = $part->body if $@;
562                 } else {
563                         return attach_link($upfx, $ct, $p, $fn);
564                 }
565         }
566
567         my @lines = split(/^/m, $s);
568         $s = '';
569         if (defined($fn) || $depth > 0 || $err) {
570                 $s .= attach_link($upfx, $ct, $p, $fn, $err);
571                 $s .= "\n";
572         }
573         my @quot;
574         my $l = PublicInbox::Linkify->new;
575         foreach my $cur (@lines) {
576                 if ($cur !~ /^>/) {
577                         # show the previously buffered quote inline
578                         flush_quote(\$s, $l, \@quot) if @quot;
579
580                         # regular line, OK
581                         $l->linkify_1($cur);
582                         $s .= $l->linkify_2(ascii_html($cur));
583                 } else {
584                         push @quot, $cur;
585                 }
586         }
587
588         if (@quot) { # ugh, top posted
589                 flush_quote(\$s, $l, \@quot);
590                 obfuscate_addrs($obfs_ibx, $s) if $obfs_ibx;
591                 $s;
592         } else {
593                 obfuscate_addrs($obfs_ibx, $s) if $obfs_ibx;
594                 if ($s =~ /\n\z/s) { # common, last line ends with a newline
595                         $s;
596                 } else { # some editors don't do newlines...
597                         $s .= "\n";
598                 }
599         }
600 }
601
602 sub _msg_html_prepare {
603         my ($hdr, $ctx, $more, $nr) = @_;
604         my $srch = $ctx->{srch} if $ctx;
605         my $atom = '';
606         my $obfs_ibx = $ctx->{-obfs_ibx};
607         my $rv = '';
608         my $mids = mids($hdr);
609         my $multiple = scalar(@$mids) > 1; # zero, one, infinity
610         if ($nr == 0) {
611                 if ($more) {
612                         $rv .=
613 "<pre>WARNING: multiple messages refer to this Message-ID\n</pre>";
614                 }
615                 $rv .= "<pre\nid=b>"; # anchor for body start
616         } else {
617                 $rv .= '<pre>';
618         }
619         if ($srch) {
620                 $ctx->{-upfx} = '../';
621         }
622         my @title;
623         my $v;
624         if (defined($v = $hdr->header('From'))) {
625                 $v = PublicInbox::Hval->new($v);
626                 my @n = PublicInbox::Address::names($v->raw);
627                 $title[1] = ascii_html(join(', ', @n));
628                 $v = $v->as_html;
629                 if ($obfs_ibx) {
630                         obfuscate_addrs($obfs_ibx, $v);
631                         obfuscate_addrs($obfs_ibx, $title[1]);
632                 }
633                 $rv .= "From: $v\n" if $v ne '';
634         }
635         foreach my $h (qw(To Cc)) {
636                 defined($v = $hdr->header($h)) or next;
637                 fold_addresses($v);
638                 $v = ascii_html($v);
639                 obfuscate_addrs($obfs_ibx, $v) if $obfs_ibx;
640                 $rv .= "$h: $v\n" if $v ne '';
641         }
642         if (defined($v = $hdr->header('Subject')) && ($v ne '')) {
643                 $v = ascii_html($v);
644                 obfuscate_addrs($obfs_ibx, $v) if $obfs_ibx;
645                 if ($srch) {
646                         $rv .= qq(Subject: <a\nhref="#r"\nid=t>$v</a>\n);
647                 } else {
648                         $rv .= "Subject: $v\n";
649                 }
650                 $title[0] = $v;
651         } else { # dummy anchor for thread skeleton at bottom of page
652                 $rv .= qq(<a\nhref="#r"\nid=t></a>) if $srch;
653                 $title[0] = '(no subject)';
654         }
655         if (defined($v = $hdr->header('Date'))) {
656                 $v = ascii_html($v);
657                 obfuscate_addrs($obfs_ibx, $v) if $obfs_ibx; # possible :P
658                 $rv .= "Date: $v\n";
659         }
660         $ctx->{-title_html} = join(' - ', @title);
661         foreach (@$mids) {
662                 my $mid = PublicInbox::Hval->new_msgid($_) ;
663                 my $mhtml = $mid->as_html;
664                 if ($multiple) {
665                         my $href = $mid->{href};
666                         $rv .= "Message-ID: ";
667                         $rv .= "<a\nhref=\"../$href/\">";
668                         $rv .= "&lt;$mhtml&gt;</a> ";
669                         $rv .= "(<a\nhref=\"../$href/raw\">raw</a>)\n";
670                 } else {
671                         $rv .= "Message-ID: &lt;$mhtml&gt; ";
672                         $rv .= "(<a\nhref=\"raw\">raw</a>)\n";
673                 }
674         }
675         $rv .= _parent_headers($hdr, $srch);
676         $rv .= "\n";
677 }
678
679 sub thread_skel {
680         my ($dst, $ctx, $hdr, $tpfx) = @_;
681         my $srch = $ctx->{srch};
682         my $mid = mids($hdr)->[0];
683         my ($nr, $msgs) = $srch->get_thread($mid);
684         my $expand = qq(expand[<a\nhref="${tpfx}T/#u">flat</a>) .
685                         qq(|<a\nhref="${tpfx}t/#u">nested</a>]  ) .
686                         qq(<a\nhref="${tpfx}t.mbox.gz">mbox.gz</a>  ) .
687                         qq(<a\nhref="${tpfx}t.atom">Atom feed</a>);
688
689         my $parent = in_reply_to($hdr);
690         $$dst .= "\n<b>Thread overview: </b>";
691         if ($nr <= 1) {
692                 if (defined $parent) {
693                         $$dst .= "$expand\n ";
694                         $$dst .= ghost_parent("$tpfx../", $parent) . "\n";
695                 } else {
696                         $$dst .= "[no followups] $expand\n";
697                 }
698                 $ctx->{next_msg} = undef;
699                 $ctx->{parent_msg} = $parent;
700                 return;
701         }
702
703         $$dst .= "$nr+ messages / $expand";
704         $$dst .= qq!  <a\nhref="#b">top</a>\n!;
705
706         my $subj = $hdr->header('Subject');
707         defined $subj or $subj = '';
708         $ctx->{prev_subj} = [ split(/ /, $srch->subject_normalized($subj)) ];
709         $ctx->{cur} = $mid;
710         $ctx->{prev_attr} = '';
711         $ctx->{prev_level} = 0;
712         $ctx->{dst} = $dst;
713
714         # reduce hash lookups in skel_dump
715         my $ibx = $ctx->{-inbox};
716         $ctx->{-obfs_ibx} = $ibx->{obfuscate} ? $ibx : undef;
717         walk_thread(thread_results($ctx, $msgs), $ctx, *skel_dump);
718
719         $ctx->{parent_msg} = $parent;
720 }
721
722 sub _parent_headers {
723         my ($hdr, $srch) = @_;
724         my $rv = '';
725
726         my $irt = in_reply_to($hdr);
727         if (defined $irt) {
728                 my $v = PublicInbox::Hval->new_msgid($irt);
729                 my $html = $v->as_html;
730                 my $href = $v->{href};
731                 $rv .= "In-Reply-To: &lt;";
732                 $rv .= "<a\nhref=\"../$href/\">$html</a>&gt;\n";
733         }
734
735         # do not display References: if search is present,
736         # we show the thread skeleton at the bottom, instead.
737         return $rv if $srch;
738
739         my $refs = $hdr->header_raw('References');
740         if ($refs) {
741                 # avoid redundant URLs wasting bandwidth
742                 my %seen;
743                 $seen{$irt} = 1 if defined $irt;
744                 my @refs;
745                 my @raw_refs = ($refs =~ /<([^>]+)>/g);
746                 foreach my $ref (@raw_refs) {
747                         next if $seen{$ref};
748                         $seen{$ref} = 1;
749                         push @refs, linkify_ref_nosrch($ref);
750                 }
751
752                 if (@refs) {
753                         $rv .= 'References: '. join("\n\t", @refs) . "\n";
754                 }
755         }
756         $rv;
757 }
758
759 sub html_footer {
760         my ($hdr, $standalone, $ctx, $rhref) = @_;
761
762         my $srch = $ctx->{srch} if $ctx;
763         my $upfx = '../';
764         my $tpfx = '';
765         my $idx = $standalone ? " <a\nhref=\"$upfx\">index</a>" : '';
766         my $irt = '';
767         if ($idx && $srch) {
768                 $idx .= "\n";
769                 thread_skel(\$idx, $ctx, $hdr, $tpfx);
770                 my ($next, $prev);
771                 my $parent = '       ';
772                 $next = $prev = '    ';
773
774                 if (my $n = $ctx->{next_msg}) {
775                         $n = PublicInbox::Hval->new_msgid($n)->{href};
776                         $next = "<a\nhref=\"$upfx$n/\"\nrel=next>next</a>";
777                 }
778                 my $u;
779                 my $par = $ctx->{parent_msg};
780                 if ($par) {
781                         $u = PublicInbox::Hval->new_msgid($par)->{href};
782                         $u = "$upfx$u/";
783                 }
784                 if (my $p = $ctx->{prev_msg}) {
785                         $prev = PublicInbox::Hval->new_msgid($p)->{href};
786                         if ($p && $par && $p eq $par) {
787                                 $prev = "<a\nhref=\"$upfx$prev/\"\n" .
788                                         'rel=prev>prev parent</a>';
789                                 $parent = '';
790                         } else {
791                                 $prev = "<a\nhref=\"$upfx$prev/\"\n" .
792                                         'rel=prev>prev</a>';
793                                 $parent = " <a\nhref=\"$u\">parent</a>" if $u;
794                         }
795                 } elsif ($u) { # unlikely
796                         $parent = " <a\nhref=\"$u\"\nrel=prev>parent</a>";
797                 }
798                 $irt = "$next $prev$parent ";
799         } else {
800                 $irt = '';
801         }
802         $rhref ||= '#R';
803         $irt .= qq(<a\nhref="$rhref">reply</a>);
804         $irt .= $idx;
805 }
806
807 sub linkify_ref_nosrch {
808         my $v = PublicInbox::Hval->new_msgid($_[0]);
809         my $html = $v->as_html;
810         my $href = $v->{href};
811         "&lt;<a\nhref=\"../$href/\">$html</a>&gt;";
812 }
813
814 sub anchor_for {
815         my ($msgid) = @_;
816         'm' . id_compress($msgid, 1);
817 }
818
819 sub ghost_parent {
820         my ($upfx, $mid) = @_;
821
822         $mid = PublicInbox::Hval->new_msgid($mid);
823         my $href = $mid->{href};
824         my $html = $mid->as_html;
825         qq{[parent not found: &lt;<a\nhref="$upfx$href/">$html</a>&gt;]};
826 }
827
828 sub indent_for {
829         my ($level) = @_;
830         $level ? INDENT x ($level - 1) : '';
831 }
832
833 sub thread_results {
834         my ($ctx, $msgs) = @_;
835         require PublicInbox::SearchThread;
836         PublicInbox::SearchThread::thread($msgs, *sort_ds, $ctx->{-inbox});
837 }
838
839 sub missing_thread {
840         my ($ctx) = @_;
841         require PublicInbox::ExtMsg;
842         PublicInbox::ExtMsg::ext_msg($ctx);
843 }
844
845 sub _msg_date {
846         my ($hdr) = @_;
847         fmt_ts(msg_datestamp($hdr));
848 }
849
850 sub fmt_ts { POSIX::strftime('%Y-%m-%d %k:%M', gmtime($_[0])) }
851
852 sub dedupe_subject {
853         my ($prev_subj, $subj, $val) = @_;
854
855         my $omit = ''; # '"' denotes identical text omitted
856         my (@prev_pop, @curr_pop);
857         while (@$prev_subj && @$subj && $subj->[-1] eq $prev_subj->[-1]) {
858                 push(@prev_pop, pop(@$prev_subj));
859                 push(@curr_pop, pop(@$subj));
860                 $omit ||= $val;
861         }
862         pop @$subj if @$subj && $subj->[-1] =~ /^re:\s*/i;
863         if (scalar(@curr_pop) == 1) {
864                 $omit = '';
865                 push @$prev_subj, @prev_pop;
866                 push @$subj, @curr_pop;
867         }
868         $omit;
869 }
870
871 sub skel_dump {
872         my ($ctx, $level, $node) = @_;
873         my $smsg = $node->{smsg} or return _skel_ghost($ctx, $level, $node);
874
875         my $dst = $ctx->{dst};
876         my $cur = $ctx->{cur};
877         my $mid = $smsg->{mid};
878
879         my $f = ascii_html($smsg->from_name);
880         my $obfs_ibx = $ctx->{-obfs_ibx};
881         obfuscate_addrs($obfs_ibx, $f) if $obfs_ibx;
882
883         my $d = fmt_ts($smsg->{ds}) . ' ' . indent_for($level) . th_pfx($level);
884         my $attr = $f;
885         $ctx->{first_level} ||= $level;
886
887         if ($attr ne $ctx->{prev_attr} || $ctx->{prev_level} > $level) {
888                 $ctx->{prev_attr} = $attr;
889         }
890         $ctx->{prev_level} = $level;
891
892         if ($cur) {
893                 if ($cur eq $mid) {
894                         delete $ctx->{cur};
895                         $$dst .= "<b>$d<a\nid=r\nhref=\"#t\">".
896                                  "$attr [this message]</a></b>\n";
897                         return;
898                 } else {
899                         $ctx->{prev_msg} = $mid;
900                 }
901         } else {
902                 $ctx->{next_msg} ||= $mid;
903         }
904
905         # Subject is never undef, this mail was loaded from
906         # our Xapian which would've resulted in '' if it were
907         # really missing (and Filter rejects empty subjects)
908         my @subj = split(/ /, $ctx->{srch}->subject_normalized($smsg->subject));
909
910         # remove common suffixes from the subject if it matches the previous,
911         # so we do not show redundant text at the end.
912         my $prev_subj = $ctx->{prev_subj} || [];
913         $ctx->{prev_subj} = [ @subj ];
914         my $omit = dedupe_subject($prev_subj, \@subj, '&#34; ');
915         my $end;
916         if (@subj) {
917                 my $subj = join(' ', @subj);
918                 $subj = ascii_html($subj);
919                 obfuscate_addrs($obfs_ibx, $subj) if $obfs_ibx;
920                 $end = "$subj</a> $omit$f\n"
921         } else {
922                 $end = "$f</a>\n";
923         }
924         my $m;
925         my $id = '';
926         my $mapping = $ctx->{mapping};
927         if ($mapping) {
928                 my $map = $mapping->{$mid};
929                 $id = id_compress($mid, 1);
930                 $m = '#m'.$id;
931                 $map->[0] = "$d<a\nhref=\"$m\">$end";
932                 $id = "\nid=r".$id;
933         } else {
934                 $m = $ctx->{-upfx}.mid_escape($mid).'/';
935         }
936         $$dst .=  $d . "<a\nhref=\"$m\"$id>" . $end;
937 }
938
939 sub _skel_ghost {
940         my ($ctx, $level, $node) = @_;
941
942         my $mid = $node->{id};
943         my $d = $ctx->{pct} ? '    [irrelevant] ' # search result
944                             : '     [not found] ';
945         $d .= indent_for($level) . th_pfx($level);
946         my $upfx = $ctx->{-upfx};
947         my $m = PublicInbox::Hval->new_msgid($mid);
948         my $href = $upfx . $m->{href} . '/';
949         my $html = $m->as_html;
950
951         my $mapping = $ctx->{mapping};
952         my $map = $mapping->{$mid} if $mapping;
953         if ($map) {
954                 my $id = id_compress($mid, 1);
955                 $map->[0] = $d . qq{&lt;<a\nhref=#r$id>$html</a>&gt;\n};
956                 $d .= qq{&lt;<a\nhref="$href"\nid=r$id>$html</a>&gt;\n};
957         } else {
958                 $d .= qq{&lt;<a\nhref="$href">$html</a>&gt;\n};
959         }
960         my $dst = $ctx->{dst};
961         $$dst .= $d;
962 }
963
964 sub sort_ds {
965         [ sort {
966                 (eval { $a->topmost->{smsg}->ds } || 0) <=>
967                 (eval { $b->topmost->{smsg}->ds } || 0)
968         } @{$_[0]} ];
969 }
970
971 # accumulate recent topics if search is supported
972 # returns 200 if done, 404 if not
973 sub acc_topic {
974         my ($ctx, $level, $node) = @_;
975         my $srch = $ctx->{srch};
976         my $mid = $node->{id};
977         my $x = $node->{smsg} || $ctx->{-inbox}->smsg_by_mid($mid);
978         my ($subj, $ds);
979         my $topic;
980         if ($x) {
981                 $subj = $x->subject;
982                 $subj = $srch->subject_normalized($subj);
983                 $ds = $x->ds;
984                 if ($level == 0) {
985                         $topic = [ $ds, 1, { $subj => $mid }, $subj ];
986                         $ctx->{-cur_topic} = $topic;
987                         push @{$ctx->{order}}, $topic;
988                         return;
989                 }
990
991                 $topic = $ctx->{-cur_topic}; # should never be undef
992                 $topic->[0] = $ds if $ds > $topic->[0];
993                 $topic->[1]++;
994                 my $seen = $topic->[2];
995                 if (scalar(@$topic) == 3) { # parent was a ghost
996                         push @$topic, $subj;
997                 } elsif (!$seen->{$subj}) {
998                         push @$topic, $level, $subj;
999                 }
1000                 $seen->{$subj} = $mid; # latest for subject
1001         } else { # ghost message
1002                 return if $level != 0; # ignore child ghosts
1003                 $topic = [ -666, 0, {} ];
1004                 $ctx->{-cur_topic} = $topic;
1005                 push @{$ctx->{order}}, $topic;
1006         }
1007 }
1008
1009 sub dump_topics {
1010         my ($ctx) = @_;
1011         my $order = delete $ctx->{order}; # [ ds, subj1, subj2, subj3, ... ]
1012         if (!@$order) {
1013                 $ctx->{-html_tip} = '<pre>[No topics in range]</pre>';
1014                 return 404;
1015         }
1016
1017         my @out;
1018         my $ibx = $ctx->{-inbox};
1019         my $obfs_ibx = $ibx->{obfuscate} ? $ibx : undef;
1020         my $srch = $ctx->{srch};
1021
1022         # sort by recency, this allows new posts to "bump" old topics...
1023         foreach my $topic (sort { $b->[0] <=> $a->[0] } @$order) {
1024                 my ($ds, $n, $seen, $top, @ex) = @$topic;
1025                 @$topic = ();
1026                 next unless defined $top;  # ghost topic
1027                 my $mid = delete $seen->{$top};
1028                 my $href = mid_escape($mid);
1029                 my $prev_subj = [ split(/ /, $top) ];
1030                 $top = PublicInbox::Hval->new($top)->as_html;
1031                 $ds = fmt_ts($ds);
1032
1033                 # $n isn't the total number of posts on the topic,
1034                 # just the number of posts in the current results window
1035                 my $anchor;
1036                 if ($n == 1) {
1037                         $n = '';
1038                         $anchor = '#u'; # top of only message
1039                 } else {
1040                         $n = " ($n+ messages)";
1041                         $anchor = '#t'; # thread skeleton
1042                 }
1043
1044                 my $mbox = qq(<a\nhref="$href/t.mbox.gz">mbox.gz</a>);
1045                 my $atom = qq(<a\nhref="$href/t.atom">Atom</a>);
1046                 my $s = "<a\nhref=\"$href/T/$anchor\"><b>$top</b></a>\n" .
1047                         " $ds UTC $n - $mbox / $atom\n";
1048                 for (my $i = 0; $i < scalar(@ex); $i += 2) {
1049                         my $level = $ex[$i];
1050                         my $subj = $ex[$i + 1];
1051                         $mid = delete $seen->{$subj};
1052                         my @subj = split(/ /, $srch->subject_normalized($subj));
1053                         my @next_prev = @subj; # full copy
1054                         my $omit = dedupe_subject($prev_subj, \@subj, ' &#34;');
1055                         $prev_subj = \@next_prev;
1056                         $subj = ascii_html(join(' ', @subj));
1057                         obfuscate_addrs($obfs_ibx, $subj) if $obfs_ibx;
1058                         $href = mid_escape($mid);
1059                         $s .= indent_for($level) . TCHILD;
1060                         $s .= "<a\nhref=\"$href/T/#u\">$subj</a>$omit\n";
1061                 }
1062                 push @out, $s;
1063         }
1064         $ctx->{-html_tip} = '<pre>' . join("\n", @out) . '</pre>';
1065         200;
1066 }
1067
1068 sub ts2str ($) {
1069         my ($ts) = @_;
1070         POSIX::strftime('%Y%m%d%H%M%S', gmtime($ts));
1071 }
1072
1073 sub str2ts ($) {
1074         my ($yyyy, $mon, $dd, $hh, $mm, $ss) = unpack('A4A2A2A2A2A2', $_[0]);
1075         timegm($ss, $mm, $hh, $dd, $mon - 1, $yyyy);
1076 }
1077
1078 sub pagination_footer ($$) {
1079         my ($ctx, $latest) = @_;
1080         delete $ctx->{qp} or return;
1081         my $next = $ctx->{next_page} || '';
1082         my $prev = $ctx->{prev_page} || '';
1083         if ($prev) {
1084                 $next = $next ? "$next " : '     ';
1085                 $prev .= qq! <a\nhref='$latest'>latest</a>!;
1086         }
1087         "<hr><pre>page: $next$prev</pre>";
1088 }
1089
1090 sub index_nav { # callback for WwwStream
1091         my (undef, $ctx) = @_;
1092         pagination_footer($ctx, '.')
1093 }
1094
1095 sub paginate_recent ($$) {
1096         my ($ctx, $lim) = @_;
1097         my $t = $ctx->{qp}->{t} || '';
1098         my $opts = { limit => $lim };
1099         my ($after, $before);
1100
1101         # Xapian uses '..' but '-' is perhaps friendier to URL linkifiers
1102         # if only $after exists "YYYYMMDD.." because "." could be skipped
1103         # if interpreted as an end-of-sentence
1104         $t =~ s/\A(\d{8,14})-// and $after = str2ts($1);
1105         $t =~ /\A(\d{8,14})\z/ and $before = str2ts($1);
1106
1107         my $ibx = $ctx->{-inbox};
1108         my $msgs = $ibx->recent($opts, $after, $before);
1109         my $nr = scalar @$msgs;
1110         if ($nr < $lim && defined($after)) {
1111                 $after = $before = undef;
1112                 $msgs = $ibx->recent($opts);
1113                 $nr = scalar @$msgs;
1114         }
1115         my $more = $nr == $lim;
1116         my ($newest, $oldest);
1117         if ($nr) {
1118                 $newest = $msgs->[0]->{ts};
1119                 $oldest = $msgs->[-1]->{ts};
1120                 # if we only had $after, our SQL query in ->recent ordered
1121                 if ($newest < $oldest) {
1122                         ($oldest, $newest) = ($newest, $oldest);
1123                         $more = 0 if defined($after) && $after < $oldest;
1124                 }
1125         }
1126         if (defined($oldest) && $more) {
1127                 my $s = ts2str($oldest);
1128                 $ctx->{next_page} = qq!<a\nhref="?t=$s"\nrel=next>next</a>!;
1129         }
1130         if (defined($newest) && (defined($before) || defined($after))) {
1131                 my $s = ts2str($newest);
1132                 $ctx->{prev_page} = qq!<a\nhref="?t=$s-"\nrel=prev>prev</a>!;
1133         }
1134         $msgs;
1135 }
1136
1137 sub index_topics {
1138         my ($ctx) = @_;
1139         my $msgs = paginate_recent($ctx, 200); # 200 is our window
1140         if (@$msgs) {
1141                 walk_thread(thread_results($ctx, $msgs), $ctx, *acc_topic);
1142         }
1143         PublicInbox::WwwStream->response($ctx, dump_topics($ctx), *index_nav);
1144 }
1145
1146 sub thread_adj_level {
1147         my ($ctx, $level) = @_;
1148
1149         my $max = $ctx->{cur_level};
1150         if ($level <= 0) {
1151                 return ('', '') if $max == 0; # flat output
1152
1153                 # reset existing lists
1154                 my $beg = $max > 1 ? ('</ul></li>' x ($max - 1)) : '';
1155                 $ctx->{cur_level} = 0;
1156                 ("$beg</ul>", '');
1157         } elsif ($level == $max) { # continue existing list
1158                 qw(<li> </li>);
1159         } elsif ($level < $max) {
1160                 my $beg = $max > 1 ? ('</ul></li>' x ($max - $level)) : '';
1161                 $ctx->{cur_level} = $level;
1162                 ("$beg<li>", '</li>');
1163         } else { # ($level > $max) # start a new level
1164                 $ctx->{cur_level} = $level;
1165                 my $beg = ($max ? '<li>' : '') . '<ul><li>';
1166                 ($beg, '</li>');
1167         }
1168 }
1169
1170 sub ghost_index_entry {
1171         my ($ctx, $level, $node) = @_;
1172         my ($beg, $end) = thread_adj_level($ctx,  $level);
1173         $beg . '<pre>'. ghost_parent($ctx->{-upfx}, $node->{id})
1174                 . '</pre>' . $end;
1175 }
1176
1177 1;