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.
6
2001
/
04
/
18
12
:48:
59
leif
Exp $
+
# $Id: perlhelper,v 1.
7
2003
/
09
/
16
17
:48:
15
mast
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: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:359:
*CORE::GLOBAL::exit = \&_CatchExit; $SIG{ALRM} = \&_CatchAlarm; tie(*STDOUT, 'Roxen::TieStdio'); # Main loop. { my ($cmd, $var, $len, $data) = (); 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;
Roxen.git/server/perl/bin/perlhelper:443:
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.
6
2001
/
04
/
18
12
:48:
59
leif
Exp $'); }
+
{ Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.
7
2003
/
09
/
16
17
:48:
15
mast
Exp $'); }
else { die "perlhelper $$/MLQQ: exiting.\n"; } } } # die "$$ perlhelper: exiting normally.\n"; CORE::exit(0); }