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/mid_compress 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;
  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 $doc_id = eval {
  44                                 my $s = PublicInbox::Search->new($git_dir);
  45                                 $s->find_unique_doc_id('mid', $mid);
  46                         };
  47                         if ($@) {
  48                                 # xapian not configured for this repo
  49                         } else {
  50                                 # maybe we found it!
  51                                 return r302($url, $mid) if (defined $doc_id);
  52
  53                                 # no point in trying the fork fallback if we
  54                                 # know Xapian is up-to-date but missing the
  55                                 # message in the current repo
  56                                 next;
  57                         }
  58                 }
  59
  60                 # queue up for forking after we've tried Xapian on all of them
  61                 push @nox, { git_dir => $git_dir, url => $url };
  62         }
  63
  64         # Xapian not installed or configured for some repos
  65         my $path = "HEAD:" . mid2path($mid);
  66
  67         foreach my $n (@nox) {
  68                 my @cmd = ('git', "--git-dir=$n->{git_dir}", 'cat-file',
  69                            '-t', $path);
  70                 my $pid = open my $fh, '-|';
  71                 defined $pid or die "fork failed: $!\n";
  72
  73                 if ($pid == 0) {
  74                         open STDERR, '>', '/dev/null'; # ignore errors
  75                         exec @cmd or die "exec failed: $!\n";
  76                 } else {
  77                         my $type = eval { local $/; <$fh> };
  78                         close $fh;
  79                         if ($? == 0 && $type eq "blob\n") {
  80                                 return r302($n->{url}, $mid);
  81                         }
  82                 }
  83         }
  84
  85         my $code = 404;
  86         my $h = PublicInbox::Hval->new_msgid($mid, 1);
  87         my $href = $h->as_href;
  88         my $html = $h->as_html;
  89         my $title = "Message-ID &lt;$html&gt; not found";
  90
  91         # Fall back to external repos if configured
  92         my $s = "<html><head><title>$title</title>" .
  93                 "</head><body><pre><b>$title</b>";
  94
  95         if (@EXT_URL) {
  96                 $code = 300;
  97                 $s .= "\n\nPerhaps try an external site:\n\n";
  98                 foreach my $u (@EXT_URL) {
  99                         my $r = sprintf($u, $href);
 100                         my $t = sprintf($u, $html);
 101                         $s .= qq{<a\nhref="$r">$t</a>\n};
 102                 }
 103         }
 104
 105         [300, ['Content-Type'=>'text/html; charset=UTF-8'], [$s]];
 106 }
 107
 108 # Redirect to another public-inbox which is mapped by $pi_config
 109 sub r302 {
 110         my ($url, $mid) = @_;
 111         $url .= '/' . uri_escape_utf8($mid) . '/';
 112         [ 302,
 113           [ 'Location' => $url, 'Content-Type' => 'text/plain' ],
 114           [ "Redirecting to\n$url\n" ] ]
 115 }
 116
 117 1;