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";
}
|