lib/PublicInbox/View.pm

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 package PublicInbox::View;
   4 use strict;
   5 use warnings;
   6 use PublicInbox::Hval;
   7 use URI::Escape qw/uri_escape_utf8/;
   8 use Encode qw/find_encoding/;
   9 use Encode::MIME::Header;
  10 use Email::MIME::ContentType qw/parse_content_type/;
  11 require POSIX;
  12
  13 # TODO: make these constants tunable
  14 use constant MAX_INLINE_QUOTED => 5;
  15 use constant MAX_TRUNC_LEN => 72;
  16 use constant PRE_WRAP => '<pre style="white-space:pre-wrap">';
  17
  18 *ascii_html = *PublicInbox::Hval::ascii_html;
  19
  20 my $enc_utf8 = find_encoding('UTF-8');
  21 my $enc_mime = find_encoding('MIME-Header');
  22
  23 # public functions:
  24 sub msg_html {
  25         my ($class, $mime, $full_pfx, $footer) = @_;
  26         if (defined $footer) {
  27                 $footer = "\n" . $footer;
  28         } else {
  29                 $footer = '';
  30         }
  31         headers_to_html_header($mime, $full_pfx) .
  32                 multipart_text_as_html($mime, $full_pfx) .
  33                 '</pre><hr />' . PRE_WRAP .
  34                 html_footer($mime, 1) . $footer .
  35                 '</pre></body></html>';
  36 }
  37
  38 sub feed_entry {
  39         my ($class, $mime, $full_pfx) = @_;
  40
  41         PRE_WRAP . multipart_text_as_html($mime, $full_pfx) . '</pre>';
  42 }
  43
  44 # this is already inside a <pre>
  45 sub index_entry {
  46         my ($class, $mime, $now, $level, $seen) = @_;
  47         my $rv = "";
  48         my $part_nr = 0;
  49         my $enc_msg = enc_for($mime->header("Content-Type"));
  50         my $subj = $mime->header('Subject');
  51         my $header_obj = $mime->header_obj;
  52
  53         my $mid_raw = $header_obj->header_raw('Message-ID');
  54         my $name = anchor_for($mid_raw);
  55         $seen->{$name} = "#$name"; # save the anchor for later
  56
  57         my $mid = PublicInbox::Hval->new_msgid($mid_raw);
  58         my $from = PublicInbox::Hval->new_oneline($mime->header('From'))->raw;
  59         my @from = Email::Address->parse($from);
  60         $from = $from[0]->name;
  61         (defined($from) && length($from)) or $from = $from[0]->address;
  62
  63         $from = PublicInbox::Hval->new_oneline($from)->as_html;
  64         $subj = PublicInbox::Hval->new_oneline($subj)->as_html;
  65         my $pfx = ('  ' x $level);
  66
  67         my $ts = $mime->header('X-PI-Date');
  68         my $fmt = '%H:%M';
  69         if ($now > ($ts + (365 * 24 * 60 * 60))) {
  70                 # doesn't have to be exactly 1 year
  71                 $fmt = '%Y/%m/%d';
  72         } elsif ($now > ($ts + (24 * 60 * 60))) {
  73                 $fmt = '%m/%d';
  74         }
  75         $ts = POSIX::strftime($fmt, gmtime($ts));
  76
  77         $rv .= "$pfx<a name=\"$name\"><b>$subj</b> $from - $ts</a>\n\n";
  78
  79         # scan through all parts, looking for displayable text
  80         $mime->walk_parts(sub {
  81                 my ($part) = @_;
  82                 return if $part->subparts; # walk_parts already recurses
  83                 my $enc = enc_for($part->content_type) || $enc_msg || $enc_utf8;
  84
  85                 if ($part_nr > 0) {
  86                         my $fn = $part->filename;
  87                         defined($fn) or $fn = "part #" . ($part_nr + 1);
  88                         $rv .= $pfx . add_filename_line($enc->decode($fn));
  89                 }
  90
  91                 my $s = ascii_html($enc->decode($part->body));
  92
  93                 # drop quotes, including the "so-and-so wrote:" line
  94                 $s =~ s/(?:^[^\n]*:\s*\n)?(?:^&gt;[^\n]*\n)+(?:^\s*\n)?//mg;
  95
  96                 # Drop signatures
  97                 $s =~ s/\n*-- \n.*\z//s;
  98
  99                 # kill any trailing whitespace
 100                 $s =~ s/\s+\z//s;
 101
 102                 # add prefix:
 103                 $s =~ s/^/$pfx/sgm;
 104
 105                 $rv .= $s . "\n";
 106                 ++$part_nr;
 107         });
 108
 109         my $href = 'm/' . $mid->as_href . '.html';
 110         $rv .= "$pfx<a\nhref=\"$href\">more</a> ";
 111         my $txt = 'm/' . $mid->as_href . '.txt';
 112         $rv .= "<a\nhref=\"$txt\">raw</a> ";
 113         $rv .= html_footer($mime, 0);
 114
 115         my $irp = $header_obj->header_raw('In-Reply-To');
 116         if (defined $irp) {
 117                 my $anchor_idx = anchor_for($irp);
 118                 my $anchor = $seen->{$anchor_idx};
 119                 unless (defined $anchor) {
 120                         my $v = PublicInbox::Hval->new_msgid($irp);
 121                         my $html = $v->as_html;
 122                         $anchor = 'm/' . $v->as_href . '.html';
 123                         $seen->{$anchor_idx} = $anchor;
 124                 }
 125                 $rv .= " <a\nhref=\"$anchor\">parent</a>";
 126         }
 127
 128         $rv . "\n\n";
 129 }
 130
 131 # only private functions below.
 132
 133 sub enc_for {
 134         my ($ct) = @_;
 135         defined $ct or return $enc_utf8;
 136         my $ct_parsed = parse_content_type($ct);
 137         if ($ct_parsed) {
 138                 if (my $charset = $ct_parsed->{attributes}->{charset}) {
 139                         my $enc = find_encoding($charset);
 140                         return $enc if $enc;
 141                 }
 142         }
 143         $enc_utf8;
 144 }
 145
 146 sub multipart_text_as_html {
 147         my ($mime, $full_pfx) = @_;
 148         my $rv = "";
 149         my $part_nr = 0;
 150         my $enc_msg = enc_for($mime->header("Content-Type"));
 151
 152         # scan through all parts, looking for displayable text
 153         $mime->walk_parts(sub {
 154                 my ($part) = @_;
 155                 return if $part->subparts; # walk_parts already recurses
 156                 my $enc = enc_for($part->content_type) || $enc_msg || $enc_utf8;
 157
 158                 if ($part_nr > 0) {
 159                         my $fn = $part->filename;
 160                         defined($fn) or $fn = "part #" . ($part_nr + 1);
 161                         $rv .= add_filename_line($enc->decode($fn));
 162                 }
 163
 164                 if (defined $full_pfx) {
 165                         $rv .= add_text_body_short($enc, $part, $part_nr,
 166                                                 $full_pfx);
 167                 } else {
 168                         $rv .= add_text_body_full($enc, $part, $part_nr);
 169                 }
 170                 $rv .= "\n" unless $rv =~ /\n\z/s;
 171                 ++$part_nr;
 172         });
 173         $rv;
 174 }
 175
 176 sub add_filename_line {
 177         my ($fn) = @_;
 178         my $len = 72;
 179         my $pad = "-";
 180
 181         $len -= length($fn);
 182         $pad x= ($len/2) if ($len > 0);
 183         "$pad " . ascii_html($fn) . " $pad\n";
 184 }
 185
 186 sub add_text_body_short {
 187         my ($enc, $part, $part_nr, $full_pfx) = @_;
 188         my $n = 0;
 189         my $s = ascii_html($enc->decode($part->body));
 190         # TODO: fold the "so-and-so wrote:" attribute line here, too:
 191         $s =~ s!^((?:(?:&gt;[^\n]*)\n)+)!
 192                 my $cur = $1;
 193                 my @lines = split(/\n/, $cur);
 194                 if (@lines > MAX_INLINE_QUOTED) {
 195                         # show a short snippet of quoted text
 196                         $cur = join(' ', @lines);
 197                         $cur =~ s/^&gt;\s*//;
 198
 199                         my @sum = split(/\s+/, $cur);
 200                         $cur = '';
 201                         do {
 202                                 my $tmp = shift(@sum);
 203                                 my $len = length($tmp) + length($cur);
 204                                 if ($len > MAX_TRUNC_LEN) {
 205                                         @sum = ();
 206                                 } else {
 207                                         $cur .= $tmp . ' ';
 208                                 }
 209                         } while (@sum && length($cur) < MAX_TRUNC_LEN);
 210                         $cur =~ s/ \z/ .../;
 211                         "&gt; &lt;<a href=\"${full_pfx}#q${part_nr}_" . $n++ .
 212                                 "\">$cur<\/a>&gt;\n";
 213                 } else {
 214                         $cur;
 215                 }
 216         !emg;
 217         $s;
 218 }
 219
 220 sub add_text_body_full {
 221         my ($enc, $part, $part_nr) = @_;
 222         my $n = 0;
 223         my $s = ascii_html($enc->decode($part->body));
 224         $s =~ s!^((?:(?:&gt;[^\n]*)\n)+)!
 225                 my $cur = $1;
 226                 my @lines = split(/\n/, $cur);
 227                 if (@lines > MAX_INLINE_QUOTED) {
 228                         "<a name=q${part_nr}_" . $n++ . ">$cur</a>";
 229                 } else {
 230                         $cur;
 231                 }
 232         !emg;
 233         $s;
 234 }
 235
 236 sub headers_to_html_header {
 237         my ($mime, $full_pfx) = @_;
 238
 239         my $rv = "";
 240         my @title;
 241         foreach my $h (qw(From To Cc Subject Date)) {
 242                 my $v = $mime->header($h);
 243                 defined($v) && length($v) or next;
 244                 $v = PublicInbox::Hval->new_oneline($v);
 245                 $rv .= "$h: " . $v->as_html . "\n";
 246
 247                 if ($h eq 'From') {
 248                         my @from = Email::Address->parse($v->raw);
 249                         $v = $from[0]->name;
 250                         unless (defined($v) && length($v)) {
 251                                 $v = '<' . $from[0]->address . '>';
 252                         }
 253                         $title[1] = ascii_html($v);
 254                 } elsif ($h eq 'Subject') {
 255                         $title[0] = $v->as_html;
 256                 }
 257         }
 258
 259         my $header_obj = $mime->header_obj;
 260         my $mid = $header_obj->header_raw('Message-ID');
 261         if (defined $mid) {
 262                 $mid = PublicInbox::Hval->new_msgid($mid);
 263                 $rv .= 'Message-ID: &lt;' . $mid->as_html . '&gt; ';
 264                 my $href = $mid->as_href;
 265                 $href = "../m/$href" unless $full_pfx;
 266                 $rv .= "(<a href=\"$href.txt\">original</a>)\n";
 267         }
 268
 269         my $irp = $header_obj->header_raw('In-Reply-To');
 270         if (defined $irp) {
 271                 my $v = PublicInbox::Hval->new_msgid(my $tmp = $irp);
 272                 my $html = $v->as_html;
 273                 my $href = $v->as_href;
 274                 $rv .= "In-Reply-To: &lt;";
 275                 $rv .= "<a href=\"$href.html\">$html</a>&gt;\n";
 276         }
 277
 278         my $refs = $header_obj->header_raw('References');
 279         if ($refs) {
 280                 $refs =~ s/\s*\Q$irp\E\s*// if (defined $irp);
 281                 my @refs = ($refs =~ /<([^>]+)>/g);
 282                 if (@refs) {
 283                         $rv .= 'References: '. linkify_refs(@refs) . "\n";
 284                 }
 285         }
 286
 287         $rv .= "\n";
 288
 289         ("<html><head><title>".  join(' - ', @title) .
 290          '</title></head><body>' . PRE_WRAP . $rv);
 291 }
 292
 293 sub html_footer {
 294         my ($mime, $purge) = @_;
 295         my %cc; # everyone else
 296         my $to; # this is the From address
 297
 298         foreach my $h (qw(From To Cc)) {
 299                 my $v = $mime->header($h);
 300                 defined($v) && length($v) or next;
 301                 my @addrs = Email::Address->parse($v);
 302                 foreach my $recip (@addrs) {
 303                         my $address = $recip->address;
 304                         my $dst = lc($address);
 305                         $cc{$dst} ||= $address;
 306                         $to ||= $dst;
 307                 }
 308         }
 309         Email::Address->purge_cache if $purge;
 310
 311         my $subj = $mime->header('Subject') || '';
 312         $subj = "Re: $subj" unless $subj =~ /\bRe:/;
 313         my $irp = uri_escape_utf8(
 314                         $mime->header_obj->header_raw('Message-ID') || '');
 315         delete $cc{$to};
 316         $to = uri_escape_utf8($to);
 317         $subj = uri_escape_utf8($subj);
 318
 319         my $cc = uri_escape_utf8(join(',', values %cc));
 320         my $href = "mailto:$to?In-Reply-To=$irp&Cc=${cc}&Subject=$subj";
 321
 322         "<a\nhref=\"" . ascii_html($href) . '">reply</a>';
 323 }
 324
 325 sub linkify_refs {
 326         join(' ', map {
 327                 my $v = PublicInbox::Hval->new_msgid($_);
 328                 my $html = $v->as_html;
 329                 my $href = $v->as_href;
 330                 "&lt;<a href=\"$href.html\">$html</a>&gt;";
 331         } @_);
 332 }
 333
 334 require Digest::SHA;
 335 sub anchor_for {
 336         my ($msgid) = @_;
 337         $msgid =~ s/\A\s*<?//;
 338         $msgid =~ s/>?\s*\z//;
 339         Digest::SHA::sha1_hex($msgid);
 340 }
 341
 342 1;