lib/PublicInbox/WwwListing.pm

   1 # Copyright (C) 2019-2021 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 PublicInbox::Hval qw(prurl fmt_ts);
   9 use PublicInbox::Linkify;
  10 use PublicInbox::GzipFilter qw(gzf_maybe);
  11 use PublicInbox::ConfigIter;
  12 use PublicInbox::WwwStream;
  13 use bytes (); # bytes::length
  14
  15 sub ibx_entry {
  16         my ($ctx, $ibx) = @_;
  17         my $mtime = $ibx->modified;
  18         my $ts = fmt_ts($mtime);
  19         my $url = prurl($ctx->{env}, $ibx->{url});
  20         my $tmp = <<"";
  21 * $ts - $url
  22   ${\$ibx->description}
  23
  24         if (defined(my $info_url = $ibx->{infourl})) {
  25                 $tmp .= '  ' . prurl($ctx->{env}, $info_url) . "\n";
  26         }
  27         push @{$ctx->{-list}}, [ $mtime, $tmp ];
  28 }
  29
  30 sub list_match_i { # ConfigIter callback
  31         my ($cfg, $section, $re, $ctx) = @_;
  32         if (defined($section)) {
  33                 return if $section !~ m!\Apublicinbox\.([^/]+)\z!;
  34                 my $ibx = $cfg->lookup_name($1) or return;
  35                 if (!$ibx->{-hide}->{$ctx->hide_key} &&
  36                                         grep(/$re/, @{$ibx->{url}})) {
  37                         $ctx->ibx_entry($ibx);
  38                 }
  39         } else { # undef == "EOF"
  40                 $ctx->{-wcb}->($ctx->psgi_triple);
  41         }
  42 }
  43
  44 sub url_regexp {
  45         my ($ctx, $key, $default) = @_;
  46         $key //= 'publicInbox.wwwListing';
  47         $default //= '404';
  48         my $v = $ctx->{www}->{pi_cfg}->{lc $key} // $default;
  49 again:
  50         if ($v eq 'match=domain') {
  51                 my $h = $ctx->{env}->{HTTP_HOST} // $ctx->{env}->{SERVER_NAME};
  52                 $h =~ s/:[0-9]+\z//;
  53                 qr!\A(?:https?:)?//\Q$h\E(?::[0-9]+)?/!i;
  54         } elsif ($v eq 'all') {
  55                 qr/./;
  56         } elsif ($v eq '404') {
  57                 undef;
  58         } else {
  59                 warn <<EOF;
  60 `$v' is not a valid value for `$key'
  61 $key be one of `all', `match=domain', or `404'
  62 EOF
  63                 $v = $default; # 'match=domain' or 'all'
  64                 goto again;
  65         }
  66 }
  67
  68 sub hide_key { 'www' }
  69
  70 sub response {
  71         my ($class, $ctx) = @_;
  72         bless $ctx, $class;
  73         if (my $ALL = $ctx->{www}->{pi_cfg}->ALL) {
  74                 $ALL->misc->reopen;
  75         }
  76         my $re = $ctx->url_regexp or return $ctx->psgi_triple;
  77         my $iter = PublicInbox::ConfigIter->new($ctx->{www}->{pi_cfg},
  78                                                 \&list_match_i, $re, $ctx);
  79         sub {
  80                 $ctx->{-wcb} = $_[0]; # HTTP server callback
  81                 $ctx->{env}->{'pi-httpd.async'} ?
  82                                 $iter->event_step : $iter->each_section;
  83         }
  84 }
  85
  86 sub psgi_triple {
  87         my ($ctx) = @_;
  88         my $h = [ 'Content-Type', 'text/html; charset=UTF-8',
  89                         'Content-Length', undef ];
  90         my $gzf = gzf_maybe($h, $ctx->{env});
  91         $gzf->zmore('<html><head><title>' .
  92                                 'public-inbox listing</title>' .
  93                                 '</head><body><pre>');
  94         my $code = 404;
  95         if (my $list = $ctx->{-list}) {
  96                 $code = 200;
  97                 # sort by ->modified
  98                 @$list = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @$list;
  99                 $list = join("\n", @$list);
 100                 my $l = PublicInbox::Linkify->new;
 101                 $gzf->zmore($l->to_html($list));
 102         } else {
 103                 $gzf->zmore('no inboxes, yet');
 104         }
 105         my $out = $gzf->zflush('</pre><hr><pre>'.
 106                         PublicInbox::WwwStream::code_footer($ctx->{env}) .
 107                         '</pre></body></html>');
 108         $h->[3] = bytes::length($out);
 109         [ $code, $h, [ $out ] ];
 110 }
 111
 112 1;