lib/PublicInbox/WwwListing.pm

   1 # Copyright (C) 2019 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # Provide an HTTP-accessible listing of inboxes.
   5 # Used by PublicInbox::WWW
   6 package PublicInbox::WwwListing;
   7 use strict;
   8 use warnings;
   9 use PublicInbox::Hval qw(ascii_html);
  10 use PublicInbox::Linkify;
  11 use PublicInbox::View;
  12
  13 sub list_all ($$$) {
  14         my ($self, $env, $hide_key) = @_;
  15         my @list;
  16         $self->{pi_config}->each_inbox(sub {
  17                 my ($ibx) = @_;
  18                 push @list, $ibx unless $ibx->{-hide}->{$hide_key};
  19         });
  20         \@list;
  21 }
  22
  23 sub list_match_domain ($$$) {
  24         my ($self, $env, $hide_key) = @_;
  25         my @list;
  26         my $host = $env->{HTTP_HOST} // $env->{SERVER_NAME};
  27         $host =~ s/:[0-9]+\z//;
  28         my $re = qr!\A(?:https?:)?//\Q$host\E(?::[0-9]+)?/!i;
  29         $self->{pi_config}->each_inbox(sub {
  30                 my ($ibx) = @_;
  31                 if (!$ibx->{-hide}->{$hide_key} && $ibx->{url} =~ $re) {
  32                         push @list, $ibx;
  33                 }
  34         });
  35         \@list;
  36 }
  37
  38 sub list_404 ($$) { [] }
  39
  40 # TODO: +cgit
  41 my %VALID = (
  42         all => *list_all,
  43         'match=domain' => *list_match_domain,
  44         404 => *list_404,
  45 );
  46
  47 sub new {
  48         my ($class, $www) = @_;
  49         my $k = 'publicinbox.wwwListing';
  50         my $pi_config = $www->{pi_config};
  51         my $v = $pi_config->{lc($k)} // 404;
  52         bless {
  53                 pi_config => $pi_config,
  54                 style => $www->style("\0"),
  55                 list_cb => $VALID{$v} || do {
  56                         warn <<"";
  57 `$v' is not a valid value for `$k'
  58 $k be one of `all', `match=domain', or `404'
  59
  60                         *list_404;
  61                 },
  62         }, $class;
  63 }
  64
  65 sub ibx_entry {
  66         my ($mtime, $ibx, $env) = @_;
  67         my $ts = PublicInbox::View::fmt_ts($mtime);
  68         my $url = PublicInbox::Hval::prurl($env, $ibx->{url});
  69         my $tmp = <<"";
  70 * $ts - $url
  71   ${\$ibx->description}
  72
  73         if (defined(my $info_url = $ibx->{info_url})) {
  74                 $tmp .= "\n$info_url";
  75         }
  76         $tmp;
  77 }
  78
  79 # not really a stand-alone PSGI app, but maybe it could be...
  80 sub call {
  81         my ($self, $env) = @_;
  82         my $h = [ 'Content-Type', 'text/html; charset=UTF-8' ];
  83         my $hide_key = 'www';
  84         if ($env->{PATH_INFO} =~ m!/manifest\.js(?:\.gz)\z/!) {
  85                 $hide_key = 'manifest';
  86         }
  87         my $list = $self->{list_cb}->($self, $env, $hide_key);
  88         my $code = 404;
  89         my $title = 'public-inbox';
  90         my $out = '';
  91         if (@$list) {
  92                 # Swartzian transform since ->modified is expensive
  93                 @$list = sort {
  94                         $b->[0] <=> $a->[0]
  95                 } map { [ $_->modified, $_ ] } @$list;
  96
  97                 $code = 200;
  98                 $title .= ' - listing';
  99                 my $tmp = join("\n", map { ibx_entry(@$_, $env) } @$list);
 100                 my $l = PublicInbox::Linkify->new;
 101                 $l->linkify_1($tmp);
 102                 $out = '<pre>'.$l->linkify_2(ascii_html($tmp)).'</pre><hr>';
 103         }
 104         $out = "<html><head><title>$title</title></head><body>" . $out;
 105         $out .= '<pre>'. PublicInbox::WwwStream::code_footer($env) .
 106                 '</pre></body></html>';
 107         [ $code, $h, [ $out ] ]
 108 }
 109
 110 1;