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