diff options
Diffstat (limited to 'public-inbox.cgi')
-rwxr-xr-x | public-inbox.cgi | 254 |
1 files changed, 18 insertions, 236 deletions
diff --git a/public-inbox.cgi b/public-inbox.cgi index 1d43b86f..57935c50 100755 --- a/public-inbox.cgi +++ b/public-inbox.cgi @@ -1,246 +1,28 @@ #!/usr/bin/perl -w # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) -# -# We focus on the lowest common denominators here: -# - targeted at text-only console browsers (lynx, w3m, etc..) -# - Only basic HTML, CSS only for line-wrapping <pre> text content for GUIs -# - No JavaScript, graphics or icons allowed. -# - Must not rely on static content -# - UTF-8 is only for user-content, 7-bit US-ASCII for us - -use 5.008; use strict; use warnings; -use PublicInbox::Config; -use URI::Escape qw(uri_escape_utf8 uri_unescape); -our $LISTNAME_RE = qr!\A/([\w\.\-]+)!; -our $NO_SCRIPT_NAME; # for prettier redirects with mod_perl2 -our $pi_config; +require PublicInbox::WWW; +use CGI qw/-nosticky/; +our $NO_SCRIPT_NAME; BEGIN { - $pi_config = PublicInbox::Config->new; - # TODO: detect and reload config as needed $NO_SCRIPT_NAME = 1 if $ENV{NO_SCRIPT_NAME}; - if ($ENV{MOD_PERL}) { - require CGI; - no warnings; - $CGI::NOSTICKY = 1; - CGI->compile; - } -} - -if ($ENV{PI_PLACKUP}) { - psgi_app(); -} else { - # some servers (Ruby webrick) include scheme://host[:port] here, - # which confuses CGI.pm when generating self_url. - # RFC 3875 does not mention REQUEST_URI at all, - # so nuke it since CGI.pm functions without it. - require CGI; - delete $ENV{REQUEST_URI}; - $ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME; - my $req = CGI->new; - my $ret = main($req, $req->request_method); - binmode STDOUT; - if (@ARGV && $ARGV[0] eq 'static') { - print $ret->[2]->[0]; - } else { # CGI - cgi_print($ret); - } -} - -# private functions below - -sub main { - my ($cgi, $method) = @_; - my %ctx; - if ($method !~ /\AGET|HEAD\z/) { - return r(405, 'Method Not Allowed'); - } - my $path_info = $cgi->path_info; - - # top-level indices and feeds - if ($path_info eq '/') { - r404(); - } elsif ($path_info =~ m!$LISTNAME_RE\z!o) { - invalid_list(\%ctx, $1) || redirect_list_index(\%ctx, $cgi); - } elsif ($path_info =~ m!$LISTNAME_RE(?:/|/index\.html)?\z!o) { - invalid_list(\%ctx, $1) || get_index(\%ctx, $cgi, 0); - } elsif ($path_info =~ m!$LISTNAME_RE/atom\.xml\z!o) { - invalid_list(\%ctx, $1) || get_atom(\%ctx, $cgi, 0); - - # single-message pages - } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.txt\z!o) { - invalid_list_mid(\%ctx, $1, $2) || get_mid_txt(\%ctx, $cgi); - } elsif ($path_info =~ m!$LISTNAME_RE/m/(\S+)\.html\z!o) { - invalid_list_mid(\%ctx, $1, $2) || get_mid_html(\%ctx, $cgi); - - # full-message page - } elsif ($path_info =~ m!$LISTNAME_RE/f/(\S+)\.html\z!o) { - invalid_list_mid(\%ctx, $1, $2) || get_full_html(\%ctx, $cgi); - - # convenience redirects, order matters - } elsif ($path_info =~ m!$LISTNAME_RE/(?:m|f)/(\S+)\z!o) { - invalid_list_mid(\%ctx, $1, $2) || redirect_mid(\%ctx, $cgi); - - } else { - r404(); - } -} - -sub r404 { r(404, 'Not Found') } - -# simple response for errors -sub r { [ $_[0], ['Content-Type' => 'text/plain'], [ join(' ', @_, "\n") ] ] } - -# returns undef if valid, array ref response if invalid -sub invalid_list { - my ($ctx, $listname) = @_; - my $git_dir = $pi_config->get($listname, "mainrepo"); - if (defined $git_dir) { - $ctx->{git_dir} = $git_dir; - $ctx->{listname} = $listname; - return; - } - r404(); -} - -# returns undef if valid, array ref response if invalid -sub invalid_list_mid { - my ($ctx, $listname, $mid) = @_; - my $ret = invalid_list($ctx, $listname, $mid); - $ctx->{mid} = uri_unescape($mid) unless $ret; - $ret; -} - -# /$LISTNAME/atom.xml -> Atom feed, includes replies -sub get_atom { - my ($ctx, $cgi, $top) = @_; - require PublicInbox::Feed; - [ 200, [ 'Content-Type' => 'application/xml' ], - [ PublicInbox::Feed->generate({ - git_dir => $ctx->{git_dir}, - listname => $ctx->{listname}, - pi_config => $pi_config, - cgi => $cgi, - top => $top, - }) ] - ]; -} - -# /$LISTNAME/?r=$GIT_COMMIT -> HTML only -sub get_index { - my ($ctx, $cgi, $top) = @_; - require PublicInbox::Feed; - [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ], - [ PublicInbox::Feed->generate_html_index({ - git_dir => $ctx->{git_dir}, - listname => $ctx->{listname}, - pi_config => $pi_config, - cgi => $cgi, - top => $top, - }) ] - ]; -} - -# just returns a string ref for the blob in the current ctx -sub mid2blob { - my ($ctx) = @_; - require Digest::SHA; - my $hex = Digest::SHA::sha1_hex($ctx->{mid}); - $hex =~ /\A([a-f0-9]{2})([a-f0-9]{38})\z/i or - die "BUG: not a SHA-1 hex: $hex"; - - my @cmd = ('git', "--git-dir=$ctx->{git_dir}", - qw(cat-file blob), "HEAD:$1/$2"); - my $cmd = join(' ', @cmd); - my $pid = open my $fh, '-|'; - defined $pid or die "fork failed: $!\n"; - if ($pid == 0) { - open STDERR, '>', '/dev/null'; # ignore errors - exec @cmd or die "exec failed: $!\n"; - } else { - my $blob = eval { local $/; <$fh> }; - close $fh; - $? == 0 ? \$blob : undef; - } -} - -# /$LISTNAME/m/$MESSAGE_ID.txt -> raw original -sub get_mid_txt { - my ($ctx, $cgi) = @_; - my $x = mid2blob($ctx); - $x ? [ 200, [ 'Content-Type' => 'text/plain' ], [ $$x ] ] : r404(); -} - -# /$LISTNAME/m/$MESSAGE_ID.html -> HTML content (short quotes) -sub get_mid_html { - my ($ctx, $cgi) = @_; - my $x = mid2blob($ctx); - return r404() unless $x; - - require PublicInbox::View; - my $mid_href = PublicInbox::Hval::ascii_html( - uri_escape_utf8($ctx->{mid})); - my $pfx = "../f/$mid_href.html"; - require Email::MIME; - [ 200, [ 'Content-Type' => 'text/html; charset=UTF-8' ], - [ PublicInbox::View->as_html(Email::MIME->new($$x), $pfx) ] ]; -} - -# /$LISTNAME/f/$MESSAGE_ID.html -> HTML content (fullquotes) -sub get_full_html { - my ($ctx, $cgi) = @_; - my $x = mid2blob($ctx); - return r404() unless $x; - require PublicInbox::View; - require Email::MIME; - [ 200, [ 'Content-Type' => 'text/html' ], - [ PublicInbox::View->as_html(Email::MIME->new($$x))] ]; -} - -sub self_url { - my ($cgi) = @_; - ref($cgi) eq 'CGI' ? $cgi->self_url : $cgi->uri->as_string; -} - -sub redirect_list_index { - my ($ctx, $cgi) = @_; - do_redirect(self_url($cgi) . "/"); -} - -sub redirect_mid { - my ($ctx, $cgi) = @_; - my $url = self_url($cgi); - $url =~ s!/f/!/m/!; - do_redirect($url . '.html'); -} - -sub do_redirect { - my ($url) = @_; - [ 301, - [ Location => $url, 'Content-Type' => 'text/plain' ], - [ "Redirecting to $url\n" ] - ] -} - -sub psgi_app { - # preload so we are CoW friendly - require PublicInbox::Feed; - require PublicInbox::View; - require Mail::Thread; - require Digest::SHA; - require POSIX; - require XML::Atom::SimpleFeed; - require Plack::Request; - sub { - my $req = Plack::Request->new(@_); - main($req, $req->method); - }; -} - -sub cgi_print { - my ($ret) = @_; + CGI->compile if $ENV{MOD_PERL}; +} + +# some servers (Ruby webrick) include scheme://host[:port] here, +# which confuses CGI.pm when generating self_url. +# RFC 3875 does not mention REQUEST_URI at all, +# so nuke it since CGI.pm functions without it. +delete $ENV{REQUEST_URI}; +$ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME; +my $req = CGI->new; +my $ret = PublicInbox::WWW::run($req, $req->request_method); +binmode STDOUT; +if (@ARGV && $ARGV[0] eq 'static') { + print $ret->[2]->[0]; # only show the body +} else { # CGI my ($status, $headers, $body) = @$ret; my %codes = ( 200 => 'OK', |