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