lib/PublicInbox/ExtMsg.pm

   1 # Copyright (C) 2015-2018 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 #
   4 # Used by the web interface to link to messages outside of the our
   5 # public-inboxes.  Mail threads may cross projects/threads; so
   6 # we should ensure users can find more easily find them on other
   7 # sites.
   8 package PublicInbox::ExtMsg;
   9 use strict;
  10 use warnings;
  11 use PublicInbox::Hval;
  12 use PublicInbox::MID qw/mid2path/;
  13 use PublicInbox::WwwStream;
  14
  15 # TODO: user-configurable
  16 our @EXT_URL = (
  17         # leading "//" denotes protocol-relative (http:// or https://)
  18         '//marc.info/?i=%s',
  19         '//www.mail-archive.com/search?l=mid&q=%s',
  20         'nntp://news.gmane.org/%s',
  21         'https://lists.debian.org/msgid-search/%s',
  22         '//docs.FreeBSD.org/cgi/mid.cgi?db=mid&id=%s',
  23         'https://www.w3.org/mid/%s',
  24         'http://www.postgresql.org/message-id/%s',
  25         'https://lists.debconf.org/cgi-lurker/keyword.cgi?'.
  26                 'doc-url=/lurker&format=en.html&query=id:%s'
  27 );
  28
  29 sub PARTIAL_MAX () { 100 }
  30
  31 sub search_partial ($$) {
  32         my ($srch, $mid) = @_;
  33         my $opt = { limit => PARTIAL_MAX, mset => 2 };
  34         my @try = ("m:$mid*");
  35         my $chop = $mid;
  36         if ($chop =~ s/(\W+)(\w*)\z//) {
  37                 my ($delim, $word) = ($1, $2);
  38                 if (length($word)) {
  39                         push @try, "m:$chop$delim";
  40                         push @try, "m:$chop$delim*";
  41                 }
  42                 push @try, "m:$chop";
  43                 push @try, "m:$chop*";
  44         }
  45
  46         # break out long words individually to search for, because
  47         # too many messages begin with "Pine.LNX." (or "alpine" or "nycvar")
  48         if ($mid =~ /\w{9,}/) {
  49                 my @long = ($mid =~ m!(\w{3,})!g);
  50                 push(@try, join(' ', map { "m:$_" } @long));
  51
  52                 # is the last element long enough to not trigger excessive
  53                 # wildcard matches?
  54                 if (length($long[-1]) > 8) {
  55                         $long[-1] .= '*';
  56                         push(@try, join(' ', map { "m:$_" } @long));
  57                 }
  58         }
  59
  60         foreach my $m (@try) {
  61                 my $mset = eval { $srch->query($m, $opt) };
  62                 if (ref($@) eq 'Search::Xapian::QueryParserError') {
  63                         # If Xapian can't handle the wildcard since it
  64                         # has too many results.
  65                         next;
  66                 }
  67                 my @mids = map {
  68                         my $doc = $_->get_document;
  69                         PublicInbox::SearchMsg->load_doc($doc)->mid;
  70                 } $mset->items;
  71                 return \@mids if scalar(@mids);
  72         }
  73 }
  74
  75 sub ext_msg {
  76         my ($ctx) = @_;
  77         my $cur = $ctx->{-inbox};
  78         my $mid = $ctx->{mid};
  79
  80         eval { require PublicInbox::Msgmap };
  81         my $have_mm = $@ ? 0 : 1;
  82         my (@ibx, @found);
  83
  84         $ctx->{www}->{pi_config}->each_inbox(sub {
  85                 my ($other) = @_;
  86                 return if $other->{name} eq $cur->{name} || !$other->base_url;
  87
  88                 my $mm = $other->mm or return;
  89
  90                 # try to find the URL with Msgmap to avoid forking
  91                 my $num = $mm->num_for($mid);
  92                 if (defined $num) {
  93                         push @found, $other;
  94                 } else {
  95                         # no point in trying the fork fallback if we
  96                         # know Xapian is up-to-date but missing the
  97                         # message in the current repo
  98                         push @ibx, $other;
  99                 }
 100         });
 101
 102         return exact($ctx, \@found, $mid) if @found;
 103
 104         # fall back to partial MID matching
 105         my @partial;
 106         my $n_partial = 0;
 107         my $srch = $cur->search;
 108         my $mids = search_partial($srch, $mid) if $srch;
 109         if ($mids) {
 110                 $n_partial = scalar(@$mids);
 111                 push @partial, [ $cur, $mids ];
 112         }
 113
 114         # can't find a partial match in current inbox, try the others:
 115         if (!$n_partial && length($mid) >= 16) {
 116                 foreach my $ibx (@ibx) {
 117                         $srch = $ibx->search or next;
 118                         $mids = search_partial($srch, $mid) or next;
 119                         $n_partial += scalar(@$mids);
 120                         push @partial, [ $ibx, $mids];
 121                         last if $n_partial >= PARTIAL_MAX;
 122                 }
 123         }
 124
 125         my $code = 404;
 126         my $h = PublicInbox::Hval->new_msgid($mid);
 127         my $href = $h->{href};
 128         my $html = $h->as_html;
 129         my $title = "&lt;$html&gt; not found";
 130         my $s = "<pre>Message-ID &lt;$html&gt;\nnot found\n";
 131         if ($n_partial) {
 132                 $code = 300;
 133                 my $es = $n_partial == 1 ? '' : 'es';
 134                 $n_partial .= '+' if ($n_partial == PARTIAL_MAX);
 135                 $s .= "\n$n_partial partial match$es found:\n\n";
 136                 my $cur_name = $cur->{name};
 137                 foreach my $pair (@partial) {
 138                         my ($ibx, $res) = @$pair;
 139                         my $env = $ctx->{env} if $ibx->{name} eq $cur_name;
 140                         my $u = $ibx->base_url($env) or next;
 141                         foreach my $m (@$res) {
 142                                 my $p = PublicInbox::Hval->new_msgid($m);
 143                                 my $r = $p->{href};
 144                                 my $t = $p->as_html;
 145                                 $s .= qq{<a\nhref="$u$r/">$u$t/</a>\n};
 146                         }
 147                 }
 148         }
 149         my $ext = ext_urls($ctx, $mid, $href, $html);
 150         if ($ext ne '') {
 151                 $s .= $ext;
 152                 $code = 300;
 153         }
 154         $ctx->{-html_tip} = $s .= '</pre>';
 155         $ctx->{-title_html} = $title;
 156         $ctx->{-upfx} = '../';
 157         PublicInbox::WwwStream->response($ctx, $code);
 158 }
 159
 160 sub ext_urls {
 161         my ($ctx, $mid, $href, $html) = @_;
 162
 163         # Fall back to external repos if configured
 164         if (@EXT_URL && index($mid, '@') >= 0) {
 165                 my $env = $ctx->{env};
 166                 my $e = "\nPerhaps try an external site:\n\n";
 167                 foreach my $url (@EXT_URL) {
 168                         my $u = PublicInbox::Hval::prurl($env, $url);
 169                         my $r = sprintf($u, $href);
 170                         my $t = sprintf($u, $html);
 171                         $e .= qq{<a\nhref="$r">$t</a>\n};
 172                 }
 173                 return $e;
 174         }
 175         ''
 176 }
 177
 178 sub exact {
 179         my ($ctx, $found, $mid) = @_;
 180         my $h = PublicInbox::Hval->new_msgid($mid);
 181         my $href = $h->{href};
 182         my $html = $h->as_html;
 183         my $title = "&lt;$html&gt; found in ";
 184         my $end = @$found == 1 ? 'another inbox' : 'other inboxes';
 185         $ctx->{-title_html} = $title . $end;
 186         $ctx->{-upfx} = '../';
 187         my $ext_urls = ext_urls($ctx, $mid, $href, $html);
 188         my $code = (@$found == 1 && $ext_urls eq '') ? 200 : 300;
 189         $ctx->{-html_tip} = join('',
 190                         "<pre>Message-ID: &lt;$html&gt;\nfound in $end:\n\n",
 191                                 (map {
 192                                         my $u = $_->base_url;
 193                                         qq(<a\nhref="$u$href/">$u$html/</a>\n)
 194                                 } @$found),
 195                         $ext_urls, '</pre>');
 196         PublicInbox::WwwStream->response($ctx, $code);
 197 }
 198
 199 1;