lib/PublicInbox/ExtMsg.pm

   1 # Copyright (C) 2015 all contributors <meta@public-inbox.org>
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 package PublicInbox::ExtMsg;
   4 use strict;
   5 use warnings;
   6 use URI::Escape qw(uri_escape_utf8);
   7 use PublicInbox::Hval;
   8 use PublicInbox::MID qw/mid2path/;
   9
  10 # TODO: user-configurable
  11 our @EXT_URL = (
  12         'http://mid.gmane.org/%s',
  13         'https://lists.debian.org/msgid-search/%s',
  14         'http://mid.mail-archive.com/%s',
  15         'http://marc.info/?i=%s',
  16 );
  17
  18 sub ext_msg {
  19         my ($ctx) = @_;
  20         my $pi_config = $ctx->{pi_config};
  21         my $listname = $ctx->{listname};
  22         my $mid = $ctx->{mid};
  23
  24         eval { require PublicInbox::Search };
  25         my $have_xap = $@ ? 0 : 1;
  26         my (@nox, @pfx);
  27
  28         foreach my $k (keys %$pi_config) {
  29                 $k =~ /\Apublicinbox\.([A-Z0-9a-z-]+)\.url\z/ or next;
  30                 my $list = $1;
  31                 next if $list eq $listname;
  32
  33                 my $git_dir = $pi_config->{"publicinbox.$list.mainrepo"};
  34                 defined $git_dir or next;
  35
  36                 my $url = $pi_config->{"publicinbox.$list.url"};
  37                 defined $url or next;
  38
  39                 $url =~ s!/+\z!!;
  40
  41                 # try to find the URL with Xapian to avoid forking
  42                 if ($have_xap) {
  43                         my $s;
  44                         my $doc_id = eval {
  45                                 $s = PublicInbox::Search->new($git_dir);
  46                                 $s->find_unique_doc_id('mid', $mid);
  47                         };
  48                         if ($@) {
  49                                 # xapian not configured for this repo
  50                         } else {
  51                                 # maybe we found it!
  52                                 return r302($url, $mid) if (defined $doc_id);
  53
  54                                 # no point in trying the fork fallback if we
  55                                 # know Xapian is up-to-date but missing the
  56                                 # message in the current repo
  57                                 push @pfx, { git_dir => $git_dir, url => $url };
  58                                 next;
  59                         }
  60                 }
  61
  62                 # queue up for forking after we've tried Xapian on all of them
  63                 push @nox, { git_dir => $git_dir, url => $url };
  64         }
  65
  66         # Xapian not installed or configured for some repos
  67         my $path = "HEAD:" . mid2path($mid);
  68
  69         foreach my $n (@nox) {
  70                 my @cmd = ('git', "--git-dir=$n->{git_dir}", 'cat-file',
  71                            '-t', $path);
  72                 my $pid = open my $fh, '-|';
  73                 defined $pid or die "fork failed: $!\n";
  74
  75                 if ($pid == 0) {
  76                         open STDERR, '>', '/dev/null'; # ignore errors
  77                         exec @cmd or die "exec failed: $!\n";
  78                 } else {
  79                         my $type = eval { local $/; <$fh> };
  80                         close $fh;
  81                         if ($? == 0 && $type eq "blob\n") {
  82                                 return r302($n->{url}, $mid);
  83                         }
  84                 }
  85         }
  86
  87         # fall back to partial MID matching
  88         my $n_partial = 0;
  89         my @partial;
  90
  91         eval { require PublicInbox::Msgmap };
  92         my $have_mm = $@ ? 0 : 1;
  93         if ($have_mm) {
  94                 my $cgi = $ctx->{cgi};
  95                 my $url = ref($cgi) eq 'CGI' ? $cgi->url(-base) . '/'
  96                                         : $cgi->base->as_string;
  97                 $url .= $listname;
  98                 unshift @pfx, { git_dir => $ctx->{git_dir}, url => $url };
  99                 foreach my $pfx (@pfx) {
 100                         my $git_dir = delete $pfx->{git_dir} or next;
 101                         my $mm = eval { PublicInbox::Msgmap->new($git_dir) };
 102
 103                         $mm or next;
 104                         if (my $res = $mm->mid_prefixes($mid)) {
 105                                 $n_partial += scalar(@$res);
 106                                 $pfx->{res} = $res;
 107                                 push @partial, $pfx;
 108                         }
 109                 }
 110         }
 111         my $code = 404;
 112         my $h = PublicInbox::Hval->new_msgid($mid, 1);
 113         my $href = $h->as_href;
 114         my $html = $h->as_html;
 115         my $title = "Message-ID &lt;$html&gt; not found";
 116         my $s = "<html><head><title>$title</title>" .
 117                 "</head><body><pre><b>$title</b>\n";
 118
 119         if ($n_partial) {
 120                 $code = 300;
 121                 my $es = $n_partial == 1 ? '' : 'es';
 122                 $s.= "\n$n_partial partial match$es found:\n\n";
 123                 foreach my $pfx (@partial) {
 124                         my $u = $pfx->{url};
 125                         foreach my $m (@{$pfx->{res}}) {
 126                                 my $p = PublicInbox::Hval->new($m);
 127                                 my $r = $p->as_href;
 128                                 my $t = $p->as_html;
 129                                 $s .= qq{<a\nhref="$u/$r/">$u/$t/</a>\n};
 130                         }
 131                 }
 132         }
 133
 134         # Fall back to external repos if configured
 135         if (@EXT_URL && index($mid, '@') >= 0) {
 136                 $code = 300;
 137                 $s .= "\nPerhaps try an external site:\n\n";
 138                 foreach my $u (@EXT_URL) {
 139                         my $r = sprintf($u, $href);
 140                         my $t = sprintf($u, $html);
 141                         $s .= qq{<a\nhref="$r">$t</a>\n};
 142                 }
 143         }
 144         $s .= '</pre></body></html>';
 145
 146         [300, ['Content-Type'=>'text/html; charset=UTF-8'], [$s]];
 147 }
 148
 149 # Redirect to another public-inbox which is mapped by $pi_config
 150 sub r302 {
 151         my ($url, $mid) = @_;
 152         $url .= '/' . uri_escape_utf8($mid) . '/';
 153         [ 302,
 154           [ 'Location' => $url, 'Content-Type' => 'text/plain' ],
 155           [ "Redirecting to\n$url\n" ] ]
 156 }
 157
 158 1;