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.4 2001/03/13 14:18:10 leif Exp $
+
#
$Id$
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:264:
sub remote_addr { die "Perl: Arrgh! \$r->connection->remote_addr\n";} sub user { return $Roxen::Request::req_info{'auth_user'};} # Note: this one exists in both Request and Connection: sub auth_type { return $Roxen::Request::req_info{'auth_type'};} package Roxen::_helper; use IO::Handle;
-
my ($infd, $outfd) = (-1, -1);
+
my ($cmdin ) = (new IO::Handle); my ($cmdout) = (new IO::Handle);
-
for(; $ARGV[0] =~ /^-/; shift @ARGV)
-
{ if ($ARGV[0] =~ /^--cmdsocket=(\d+)$/)
-
{ $infd = $1; $outfd = $1;}
-
else
-
{ die "Invalid option: $ARGV[0]\n";}
-
}
+
#
for(; $ARGV[0] =~ /^-/; shift @ARGV)
+
#
{ if ($ARGV[0] =~ /^--cmdsocket=(\d+)$/)
+
#
{ $infd = $1; $outfd = $1;}
+
#
else
+
#
{ die "Invalid option: $ARGV[0]\n";}
+
#
}
sub diag { # print STDERR join('', @_); } sub Getdata($) { my ($bytes, $len, $tmp, @lens) = (shift); $cmdin->sysread($tmp, $bytes) == $bytes or die "$$/Getdata: exiting.\n";
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";
+
$cmdin->fdopen(
0
, "r") or die "Unable to open command input.\n";
+
$cmdout->fdopen(
1
, "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.4 2001/03/13 14:18:10 leif Exp $
'); }
+
{ Sendreply('Roxen Perl Helper:
$Id$
'); }
else { die "perlhelper $$/MLQQ: exiting.\n"; } } } # die "$$ perlhelper: exiting normally.\n"; CORE::exit(0); }