public-inbox-cgi

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   3 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   4 #
   5 # We focus on the lowest common denominators here:
   6 # - targeted at text-only console browsers (lynx, w3m, etc..)
   7 # - Only basic HTML, CSS only for line-wrapping <pre> text content for GUIs
   8 # - No JavaScript, graphics or icons allowed.
   9 # - Must not rely on static content
  10 # - UTF-8 is only for user-content, 7-bit US-ASCII for us
  11
  12 use 5.008;
  13 use strict;
  14 use warnings;
  15 use CGI qw(:cgi :escapeHTML -nosticky); # PSGI/FastCGI/mod_perl compat
  16 use Encode qw(decode_utf8);
  17 use PublicInbox::Config;
  18 use Digest::SHA qw(sha1_hex);
  19 our $LISTNAME_RE = qr!\A/([\w\.\-]+)!;
  20 our $pi_config;
  21 BEGIN {
  22         $pi_config = PublicInbox::Config->new;
  23         # TODO: detect and reload config as needed
  24         if ($ENV{MOD_PERL}) {
  25                 CGI->compile;
  26         }
  27 }
  28
  29 binmode STDOUT, ':utf8';
  30
  31 my $ret = main();
  32
  33 my ($status, $headers, $body) = @$ret;
  34 if (@ARGV && $ARGV[0] eq 'static') {
  35         print $body;
  36 } else { # CGI
  37         print "Status: $status\r\n";
  38         while (my ($k, $v) = each %$headers) {
  39                 print "$k: $v\r\n";
  40         }
  41         print "\r\n", $body;
  42 }
  43
  44 # TODO: plack support
  45
  46 # private functions below
  47
  48 sub main {
  49         my $cgi = CGI->new;
  50         my %ctx;
  51         if ($cgi->request_method !~ /\AGET|HEAD\z/) {
  52                 return r("405 Method Not Allowed");
  53         }
  54         my $path_info = decode_utf8($ENV{PATH_INFO});
  55
  56         # top-level indices and feeds
  57         if ($path_info eq "/") {
  58                 r404();
  59         } elsif ($path_info =~ m!$LISTNAME_RE/?\z!o) {
  60                 invalid_list(\%ctx, $1) || get_index(\%ctx, $cgi, 1);
  61         } elsif ($path_info =~ m!$LISTNAME_RE/index\.atom\.xml\z!o) {
  62                 invalid_list(\%ctx, $1) || get_atom(\%ctx, $cgi, 1);
  63         } elsif ($path_info =~ m!$LISTNAME_RE/all\.atom\.xml\z!o) {
  64                 invalid_list(\%ctx, $1) || get_atom(\%ctx, $cgi, 0);
  65
  66         # single-message pages
  67         } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.txt\z!o) {
  68                 invalid_list_mid(\%ctx, $1, $2) || get_mid_txt(\%ctx, $cgi);
  69         } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.html\z!o) {
  70                 invalid_list_mid(\%ctx, $1, $2) || get_mid_html(\%ctx, $cgi);
  71         } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\z!o) {
  72                 redirect_mid_html($cgi, $1, $2);
  73         } else {
  74                 r404();
  75         }
  76 }
  77
  78 sub r404 { r("404 Not Found") }
  79
  80 # simple response for errors
  81 sub r { [ $_[0], { 'Content-Type' => 'text/plain' }, '' ] }
  82
  83 # returns undef if valid, array ref response if invalid
  84 sub invalid_list {
  85         my ($ctx, $listname) = @_;
  86         my $git_dir = $pi_config->get($listname, "mainrepo");
  87         if (defined $git_dir) {
  88                 $ctx->{git_dir} = $git_dir;
  89                 $ctx->{listname} = $listname;
  90                 return undef;
  91         }
  92         r404();
  93 }
  94
  95 # returns undef if valid, array ref response if invalid
  96 sub invalid_list_mid {
  97         my ($ctx, $listname, $mid) = @_;
  98         my $ret = invalid_list($ctx, $listname, $mid) and return $ret;
  99         $ctx->{mid} = $mid;
 100         undef;
 101 }
 102
 103 sub get_atom {
 104         my ($ctx, $cgi, $top) = @_;
 105         require PublicInbox::Feed;
 106         [ '200 OK', { 'Content-Type' => 'application/xml' },
 107           PublicInbox::Feed->generate({
 108                         git_dir => $ctx->{git_dir},
 109                         listname => $ctx->{listname},
 110                         pi_config => $pi_config,
 111                         cgi => $cgi,
 112                         top => $top,
 113                 })
 114         ];
 115 }
 116
 117 sub get_index {
 118         my ($ctx, $cgi, $top) = @_;
 119         require PublicInbox::Feed;
 120         [ '200 OK', { 'Content-Type' => 'text/html' },
 121           PublicInbox::Feed->generate_html_index({
 122                         git_dir => $ctx->{git_dir},
 123                         listname => $ctx->{listname},
 124                         pi_config => $pi_config,
 125                         cgi => $cgi,
 126                         top => $top,
 127                 })
 128         ];
 129 }
 130
 131 sub mid2blob {
 132         my ($ctx) = @_;
 133         local $ENV{GIT_DIR} = $ctx->{git_dir};
 134         my $hex = sha1_hex($ctx->{mid});
 135         $hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or
 136                         die "BUG: not a SHA-1 hex: $hex";
 137         my $blob = `git cat-file blob HEAD:$1/$2 2>/dev/null`;
 138         $? == 0 ? \$blob : undef;
 139 }
 140
 141 sub get_mid_txt {
 142         my ($ctx, $cgi) = @_;
 143         my $x = mid2blob($ctx);
 144         $x ? [ "200 OK", {'Content-Type' => 'text/plain'}, $$x ] : r404();
 145 }