Branch: Tag:

2001-04-18

2001-04-18 12:48:59 by Leif Stensson <leif@lysator.liu.se>

Added some support for configurable timeouts.

Rev: server/perl/bin/perlhelper:1.6

2:      # 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;   
364:      # 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";
372:       $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.
397:    { $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;    }
412:    $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")
432:    { 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();    }
442:    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"; }    }