]> Sergey Matveev's repositories - public-inbox.git/blob - public-inbox.cgi
4b74a62ae04f59710e32774e611d6e9d3b04cb71
[public-inbox.git] / public-inbox.cgi
1 #!/usr/bin/perl -w
2 # Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
3 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
4 #
5 # Enables using PublicInbox::WWW as a CGI script
6 use strict;
7 use warnings;
8 use IO::Handle;
9 use PublicInbox::WWW;
10 use CGI qw/-nosticky/;
11 our $NO_SCRIPT_NAME;
12 our %HTTP_CODES;
13 BEGIN {
14         $NO_SCRIPT_NAME = 1 if $ENV{NO_SCRIPT_NAME};
15         if ($ENV{MOD_PERL}) {
16                 CGI->compile;
17                 PublicInbox::WWW->preload;
18         }
19
20         %HTTP_CODES = (
21                 200 => 'OK',
22                 300 => 'Multiple Choices',
23                 301 => 'Moved Permanently',
24                 302 => 'Found',
25                 404 => 'Not Found',
26                 405 => 'Method Not Allowed',
27                 501 => 'Not Implemented',
28         );
29 }
30
31 # some servers (Ruby webrick) include scheme://host[:port] here,
32 # which confuses CGI.pm when generating self_url.
33 # RFC 3875 does not mention REQUEST_URI at all,
34 # so nuke it since CGI.pm functions without it.
35 delete $ENV{REQUEST_URI};
36 $ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME;
37 my $req = CGI->new;
38 my $ret = PublicInbox::WWW::run($req, $req->request_method);
39
40 my $out = select;
41 $out->binmode;
42
43 if (ref($ret) eq 'CODE') {
44         $ret->(*dump_header);
45 } else {
46         my ($status, $headers, $body) = @$ret;
47
48         dump_header([$status, $headers])->write($body->[0]);
49 }
50
51 sub dump_header {
52         my ($res) = @_;
53         my $fh = select;
54         my ($status, $headers) = @$res;
55         $fh->write("Status: $status $HTTP_CODES{$status}\r\n");
56         my @tmp = @$headers;
57         while (my ($k, $v) = splice(@tmp, 0, 2)) {
58                 $fh->write("$k: $v\r\n");
59         }
60         $fh->write("\r\n");
61         $fh;
62 }