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 use strict;
   5 use warnings;
   6 use IO::Handle;
   7 require PublicInbox::WWW;
   8 use CGI qw/-nosticky/;
   9 our $NO_SCRIPT_NAME;
  10 our %HTTP_CODES;
  11 BEGIN {
  12         $NO_SCRIPT_NAME = 1 if $ENV{NO_SCRIPT_NAME};
  13         CGI->compile if $ENV{MOD_PERL};
  14
  15         %HTTP_CODES = (
  16                 200 => 'OK',
  17                 301 => 'Moved Permanently',
  18                 404 => 'Not Found',
  19                 405 => 'Method Not Allowed',
  20                 501 => 'Not Implemented',
  21         );
  22 }
  23
  24 # some servers (Ruby webrick) include scheme://host[:port] here,
  25 # which confuses CGI.pm when generating self_url.
  26 # RFC 3875 does not mention REQUEST_URI at all,
  27 # so nuke it since CGI.pm functions without it.
  28 delete $ENV{REQUEST_URI};
  29 $ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME;
  30 my $req = CGI->new;
  31 my $ret = PublicInbox::WWW::run($req, $req->request_method);
  32
  33 my $out = select;
  34 $out->binmode;
  35
  36 if (ref($ret) eq 'CODE') {
  37         $ret->(*dump_header);
  38 } else {
  39         my ($status, $headers, $body) = @$ret;
  40
  41         dump_header([$status, $headers])->write($body->[0]);
  42 }
  43
  44 sub dump_header {
  45         my ($res) = @_;
  46         my $fh = select;
  47         my ($status, $headers) = @$res;
  48         $fh->write("Status: $status $HTTP_CODES{$status}\r\n");
  49         my @tmp = @$headers;
  50         while (my ($k, $v) = splice(@tmp, 0, 2)) {
  51                 $fh->write("$k: $v\r\n");
  52         }
  53         $fh->write("\r\n");
  54         $fh;
  55 }