]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/NewsWWW.pm
treewide: run update-copyrights from gnulib for 2019
[public-inbox.git] / lib / PublicInbox / NewsWWW.pm
1 # Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3 #
4 # Plack app redirector for mapping /$NEWSGROUP requests to
5 # the appropriate /$INBOX in PublicInbox::WWW because some
6 # auto-linkifiers cannot handle nntp:// redirects properly.
7 # This is also used directly by PublicInbox::WWW
8 package PublicInbox::NewsWWW;
9 use strict;
10 use warnings;
11 use PublicInbox::Config;
12 use PublicInbox::MID qw(mid_escape);
13 use PublicInbox::Hval qw(prurl);
14
15 sub new {
16         my ($class, $pi_config) = @_;
17         $pi_config ||= PublicInbox::Config->new;
18         bless { pi_config => $pi_config }, $class;
19 }
20
21 sub redirect ($$) {
22         my ($code, $url) = @_;
23         [ $code,
24           [ Location => $url, 'Content-Type' => 'text/plain' ],
25           [ "Redirecting to $url\n" ] ]
26 }
27
28 sub try_inbox {
29         my ($ibx, $arg) = @_;
30         return if scalar(@$arg) > 1;
31
32         # do not pass $env since HTTP_HOST may differ
33         my $url = $ibx->base_url or return;
34
35         my ($mid) = @$arg;
36         eval { $ibx->mm->num_for($mid) } or return;
37
38         # 302 since the same message may show up on
39         # multiple inboxes and inboxes can be added/reordered
40         $arg->[1] = redirect(302, $url .= mid_escape($mid) . '/');
41 }
42
43 sub call {
44         my ($self, $env) = @_;
45
46         # some links may have the article number in them:
47         # /inbox.foo.bar/123456
48         my (undef, @parts) = split(m!/!, $env->{PATH_INFO});
49         my ($ng, $article) = @parts;
50         my $pi_config = $self->{pi_config};
51         if (my $ibx = $pi_config->lookup_newsgroup($ng)) {
52                 my $url = prurl($env, $ibx->{url});
53                 my $code = 301;
54                 if (defined $article && $article =~ /\A[0-9]+\z/) {
55                         my $mid = eval { $ibx->mm->mid_for($article) };
56                         if (defined $mid) {
57                                 # article IDs are not stable across clones,
58                                 # do not encourage caching/bookmarking them
59                                 $code = 302;
60                                 $url .= mid_escape($mid) . '/';
61                         }
62                 }
63                 return redirect($code, $url);
64         }
65
66         my $res;
67         my @try = (join('/', @parts));
68
69         # trailing slash is in the rest of our WWW, so maybe some users
70         # will assume it:
71         if ($parts[-1] eq '') {
72                 pop @parts;
73                 push @try, join('/', @parts);
74         }
75
76         foreach my $mid (@try) {
77                 my $arg = [ $mid ];
78                 $pi_config->each_inbox(\&try_inbox, $arg);
79                 defined($res = $arg->[1]) and last;
80         }
81         $res || [ 404, [qw(Content-Type text/plain)], ["404 Not Found\n"] ];
82 }
83
84 1;