]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/ExtMsg.pm
c71510f548191b966cfb4835256764f4ceeae7f3
[public-inbox.git] / 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         'http://mid.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 ext_msg {
30         my ($ctx) = @_;
31         my $cur = $ctx->{-inbox};
32         my $mid = $ctx->{mid};
33
34         eval { require PublicInbox::Search };
35         my $have_xap = $@ ? 0 : 1;
36         my (@nox, @ibx, @found);
37
38         $ctx->{www}->{pi_config}->each_inbox(sub {
39                 my ($other) = @_;
40                 return if $other->{name} eq $cur->{name} || !$other->base_url;
41
42                 my $s = $other->search;
43                 if (!$s) {
44                         push @nox, $other;
45                         return;
46                 }
47
48                 # try to find the URL with Xapian to avoid forking
49                 my $doc_id = eval { $s->find_first_doc_id('Q' . $mid) };
50                 if ($@) {
51                         # xapian not configured properly for this repo
52                         push @nox, $other;
53                         return;
54                 }
55
56                 # maybe we found it!
57                 if (defined $doc_id) {
58                         push @found, $other;
59                 } else {
60                         # no point in trying the fork fallback if we
61                         # know Xapian is up-to-date but missing the
62                         # message in the current repo
63                         push @ibx, $other;
64                 }
65         });
66
67         return exact($ctx, \@found, $mid) if @found;
68
69         # Xapian not installed or configured for some repos,
70         # do a full MID check (this is expensive...):
71         if (@nox) {
72                 my $path = mid2path($mid);
73                 foreach my $other (@nox) {
74                         my (undef, $type, undef) = $other->path_check($path);
75
76                         if ($type && $type eq 'blob') {
77                                 push @found, $other;
78                         }
79                 }
80         }
81         return exact($ctx, \@found, $mid) if @found;
82
83         # fall back to partial MID matching
84         my $n_partial = 0;
85         my @partial;
86
87         if (my $mm = $cur->mm) {
88                 my $tmp_mid = $mid;
89                 my $res = $mm->mid_prefixes($tmp_mid, 100);
90                 if ($res && scalar(@$res)) {
91                         $n_partial += scalar(@$res);
92                         push @partial, [ $cur, $res ];
93                 # fixup common errors:
94                 } elsif ($tmp_mid =~ s,/[tTf],,) {
95                         $res = $mm->mid_prefixes($tmp_mid, 100);
96                         if ($res && scalar(@$res)) {
97                                 $n_partial += scalar(@$res);
98                                 push @partial, [ $cur, $res ];
99                         }
100                 }
101         }
102
103         # can't find a partial match in current inbox, try the others:
104         if (!$n_partial && length($mid) >= 16) {
105                 my $tmp_mid = $mid;
106 again:
107                 foreach my $ibx (@ibx) {
108                         my $mm = $ibx->mm or next;
109                         my $res = $mm->mid_prefixes($tmp_mid, 100);
110                         if ($res && scalar(@$res)) {
111                                 $n_partial += scalar(@$res);
112                                 push @partial, [ $ibx, $res ];
113                                 last if $n_partial >= 100;
114                         }
115                 }
116                 # fixup common errors:
117                 if (!$n_partial && $tmp_mid =~ s,/[tTf],,) {
118                         goto again;
119                 }
120         }
121
122         my $code = 404;
123         my $h = PublicInbox::Hval->new_msgid($mid);
124         my $href = $h->{href};
125         my $html = $h->as_html;
126         my $title = "&lt;$html&gt; not found";
127         my $s = "<pre>Message-ID &lt;$html&gt;\nnot found\n";
128         if ($n_partial) {
129                 $code = 300;
130                 my $es = $n_partial == 1 ? '' : 'es';
131                 $s .= "\n$n_partial partial match$es found:\n\n";
132                 my $cur_name = $cur->{name};
133                 foreach my $pair (@partial) {
134                         my ($ibx, $res) = @$pair;
135                         my $env = $ctx->{env} if $ibx->{name} eq $cur_name;
136                         my $u = $ibx->base_url($env) or next;
137                         foreach my $m (@$res) {
138                                 my $p = PublicInbox::Hval->new_msgid($m);
139                                 my $r = $p->{href};
140                                 my $t = $p->as_html;
141                                 $s .= qq{<a\nhref="$u$r/">$u$t/</a>\n};
142                         }
143                 }
144         }
145         my $ext = ext_urls($ctx, $mid, $href, $html);
146         if ($ext ne '') {
147                 $s .= $ext;
148                 $code = 300;
149         }
150         $ctx->{-html_tip} = $s .= '</pre>';
151         $ctx->{-title_html} = $title;
152         $ctx->{-upfx} = '../';
153         PublicInbox::WwwStream->response($ctx, $code);
154 }
155
156 sub ext_urls {
157         my ($ctx, $mid, $href, $html) = @_;
158
159         # Fall back to external repos if configured
160         if (@EXT_URL && index($mid, '@') >= 0) {
161                 my $env = $ctx->{env};
162                 my $e = "\nPerhaps try an external site:\n\n";
163                 foreach my $url (@EXT_URL) {
164                         my $u = PublicInbox::Hval::prurl($env, $url);
165                         my $r = sprintf($u, $href);
166                         my $t = sprintf($u, $html);
167                         $e .= qq{<a\nhref="$r">$t</a>\n};
168                 }
169                 return $e;
170         }
171         ''
172 }
173
174 sub exact {
175         my ($ctx, $found, $mid) = @_;
176         my $h = PublicInbox::Hval->new_msgid($mid);
177         my $href = $h->{href};
178         my $html = $h->as_html;
179         my $title = "&lt;$html&gt; found in ";
180         my $end = @$found == 1 ? 'another inbox' : 'other inboxes';
181         $ctx->{-title_html} = $title . $end;
182         $ctx->{-upfx} = '../';
183         my $ext_urls = ext_urls($ctx, $mid, $href, $html);
184         my $code = (@$found == 1 && $ext_urls eq '') ? 200 : 300;
185         $ctx->{-html_tip} = join('',
186                         "<pre>Message-ID: &lt;$html&gt;\nfound in $end:\n\n",
187                                 (map {
188                                         my $u = $_->base_url;
189                                         qq(<a\nhref="$u$href/">$u$html/</a>\n)
190                                 } @$found),
191                         $ext_urls, '</pre>');
192         PublicInbox::WwwStream->response($ctx, $code);
193 }
194
195 1;