summaryrefslogtreecommitdiff
path: root/util/fcgi.pl
blob: 60f3c324d1da780b144927eb5dd7075734e5755a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
#!/usr/bin/perl

package FCGI::Handler;

use strict;
use warnings;
use lib '/www/vndb/lib';

use strict;
use warnings;
use FCGI;
use CGI::Minimal ();
use Cookie::XS;
use Time::HiRes;
use VNDB;

my $elog = "/www/err.log";

our $req = FCGI::Request();
our $c;
our $outputted = 0;

my $VNDB = VNDB->new(%VNDB::VNDBopts);

our @WRN;
$SIG{__WARN__} = sub { push @FCGI::Handler::WRN, @_; };

while($req->Accept() >= 0) {
 # lighty doesn't always split the query string from REQUEST_URI
  ($ENV{REQUEST_URI}, $ENV{QUERY_STRING}) = split /\?/, $ENV{REQUEST_URI}
    if ($ENV{REQUEST_URI}||'') =~ /\?/;

 # re-init CGI::Minimal (can die())
  eval {
    CGI::Minimal::reset_globals;
    CGI::Minimal::allow_hybrid_post_get(1);
    $c = CGI::Minimal->new();
  };
  if($@) {
    send500();
    $req->Finish();
    next;
  }

 # figure out some required variables
  my $o = $VNDB;
  my $start = [ Time::HiRes::gettimeofday ] if $o->{debug};

 # call appropriate functions in VNDB.pm
  my $e = eval {
    if($c->truncated) {
      send500();
      warn "Truncated post request!\n";
    } else {
      $o->DBCheck;
      $o->get_page; # automatically calls DBCommit on success
    }
    1;
  };

 # Error handling 
  if(@WRN && $e && !$@ && open(my $F, '>>', $elog)) {
    for (@WRN) {
      chomp;
      printf $F "[%s] %s: %s\n", scalar localtime(), $ENV{HTTP_HOST}.$ENV{REQUEST_URI}.'?'.$ENV{QUERY_STRING}, $_;
    }
    close $F;
  }
  if(!defined $e && $@ && open(my $F, '>>', $elog)) {
    printf $F "[%s] %s: FATAL ERROR!\n", scalar localtime(), $ENV{HTTP_HOST}.$ENV{REQUEST_URI}.'?'.$ENV{QUERY_STRING};
    print  $F " ENV-dump:\n";
    printf $F "  %s: %s\n", $_, $ENV{$_} for (sort keys %ENV);
    print  $F " PARAM-dump:\n";
    printf $F "  %s: %s\n", $_, $c->param($_) for (sort $c->param());
    my $err = $@; chomp($err);
    printf $F " ERROR:\n  %s\n", $err;
    if(@WRN) {
      print  $F " WARNINGS:\n";
      for (@WRN) {
        chomp;
        printf $F "  %s\n", $_;
      }
    }
    print $F "\n";
    close $F;
    eval { $o->DBRollBack; };
    send500() if !$outputted;
  }

 # Debug info
  if($o->{debug} && open(my $F, '>>', $elog)) {
    my($sqlt, $sqlc) = (0, 0);
    for (@{$o->{_DB}->{Queries}}) {
      if($_->[0]) {
        $sqlc++;
        $sqlt += $_->[1];
      }
    }
    my $time = Time::HiRes::tv_interval($start);
    my $tpl = $o->{_Res}->{_tpltime} ? $o->{_Res}->{_tpltime}/$time*100 : 0;
    my $gzip = 0;
    $gzip = 100 - $o->{_Res}->{_gzip}->[1]/$o->{_Res}->{_gzip}->[0]*100
      if($o->{_Res}->{_gzip} && ref($o->{_Res}->{_gzip}) eq 'ARRAY' && $o->{_Res}->{_gzip}->[0] > 0);
    printf $F "Took %3dms (SQL/TPL/perl: %4.1f%% %4.1f%% %4.1f%%) (GZIP: %4.1f%%) to parse %s\n",
      $time*1000, $sqlt/$time*100, $tpl, 100-($sqlt/$time*100)-$tpl, $gzip, $ENV{REQUEST_URI};   
    close $F;
  }
 
 # reset vars
  @WRN = ();
  $outputted = 0;
  undef $o->{_Res};
  undef $o->{_Req};

  $req->Finish();
}

sub send500 {
  print "HTTP/1.0 500 Internal Server Error\n";
  print "Content-Type: text/html\n";
  print "X-Sendfile: /www/vndb/www/files/err.html\n\n";
}