Roxen.git
/
server
/
perl
/
bin
/
perlhelper
version
»
Context lines:
10
20
40
80
file
none
3
Roxen.git/server/perl/bin/perlhelper:1:
#! /usr/local/bin/perl # Perl helper script for Roxen Webserver. By Leif Stensson. #
-
# $Id: perlhelper,v 1.
5
2001/04/18 12:
16
:
42
leif Exp $
+
# $Id: perlhelper,v 1.
6
2001/04/18 12:
48
:
59
leif Exp $
package Roxen::Internal; use strict; use vars '%Cache'; sub packagename { my($string) = @_; $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
Roxen.git/server/perl/bin/perlhelper:357:
} *CORE::GLOBAL::exit = \&_CatchExit; $SIG{ALRM} = \&_CatchAlarm; tie(*STDOUT, 'Roxen::TieStdio'); # Main loop. { my ($cmd, $var, $len, $data) = ();
-
my ($starttime, $runcount) = (time, 0);
+
my ($starttime, $runcount)
= (time, 0);
$cmdin->fdopen($infd, "r") or die "Unable to open command input.\n"; $cmdout->fdopen($outfd, "w") or die "Unable to open command output.\n"; $cmdout->autoflush(1); $Roxen::Request::req_req = Roxen::Request->new();
-
+
%Roxen::Request::req_config = ( "timeout" => 180,
+
"lifelength" => 300
+
);
+
while (1) { $Roxen::Request::req_state = 0; alarm 60; # One minute. $cmdin->sysread($cmd, 1) == 1 or die "perhelper $$/MLR: exiting.\n"; diag "[$cmd]"; if ($cmd eq "E") { $var = Getdata(1); $data = Getdata(3); $ENV{$var} = $data; } elsif ($cmd eq "I")
Roxen.git/server/perl/bin/perlhelper:390:
$Roxen::Request::req_vars{$var} = $data; } elsif ($cmd eq "H") { $var = Getdata(1); $data = Getdata(3); $Roxen::Request::req_headers{$var} = $data; } elsif ($cmd eq "L") { $var = Getdata(1); $data = Getdata(3); if ($var eq "libdir" and $Roxen::Request::req_config{$var} ne $data) { push @INC, $data;}
-
if
($var eq "cd")
+
elsif
($var eq "cd")
{ chdir $data;} $Roxen::Request::req_config{$var} = $data; } elsif ($cmd eq "R") { %ENV = (); %Roxen::Request::req_info = (); %Roxen::Request::req_vars = (); %Roxen::Request::req_headers = (); } elsif ($cmd eq "S" or $cmd eq "C") { $Roxen::Request::req_outbuf = ""; $Roxen::Request::req_returncode = 200; $data = Getdata(3); alarm 180; # 3 minutes.
-
+
if ($Roxen::Request::req_config{timeout} >= 30 and
+
$Roxen::Request::req_config{timeout} <= 900)
+
{ alarm 0+$Roxen::Request::req_config{timeout};}
$Roxen::Request::req_state = 5423522; # Magic number. $ENV{GATEWAY_INTERFACE} = "CGI-PerlEx"; # Makes CGI.pm happier. if ($cmd eq "C") { my ($cmdin, $cmdout, $cmd); eval $data; if ($@) { Senderror("PERL EVAL ERROR: $@"); die "Perl: $@"; } } else { diag "{S:$data}\n"; Roxen::Internal::runscript($data); } $Roxen::Request::req_state = 0; alarm 60; # One minute. if ($Roxen::Request::req_returncode != 200) { Sendreply(sprintf "RETURNCODE=%d", $Roxen::Request::req_returncode);} Senddata($Roxen::Request::req_outbuf);
-
last if
$starttime+300
< time; #
Timeout
after
5
minutes.
+
last if
$starttime+$Roxen::Request::req_config{lifelength}
< time;
+
last if $starttime+1800 < time;
#
Final
timeout
after
30
minutes.
$Roxen::Request::req_req = Roxen::Request->new(); } elsif ($cmd eq "Q") { $cmdin->sysread($cmd, 1) == 1 or die "perlhelper $$/MLQ: exiting.\n"; diag "{Q$cmd}"; if ($cmd eq "P") { Sendreply(""); } elsif ($cmd eq "V")
-
{ Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.
5
2001/04/18 12:
16
:
42
leif Exp $'); }
+
{ Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.
6
2001/04/18 12:
48
:
59
leif Exp $'); }
else { die "perlhelper $$/MLQQ: exiting.\n"; } } } # die "$$ perlhelper: exiting normally.\n"; CORE::exit(0); }