version 1.3, 2006/03/03 23:25:47
|
version 1.4, 2006/03/03 23:31:06
|
Line 55 use vars qw($PREFORK $MAX_CLIENTS_PER_CH
|
Line 55 use vars qw($PREFORK $MAX_CLIENTS_PER_CH
|
); |
); |
|
|
sub maximareply { |
sub maximareply { |
my $cmd=shift; |
my ($cmd) = @_; |
my $reply=''; |
my $reply=''; |
my $error=''; |
my $error=''; |
my $exitstatus=''; |
my $exitstatus=''; |
Line 115 sub HUNTSMAN { # si
|
Line 115 sub HUNTSMAN { # si
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
|
|
sub logthis { |
sub logthis { |
my $message=shift; |
my ($message)=@_; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log"); |
my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log"); |
my $now=time; |
my $now=time; |
Line 127 sub logthis {
|
Line 127 sub logthis {
|
# -------------------------------------------------------------- Status setting |
# -------------------------------------------------------------- Status setting |
|
|
sub status { |
sub status { |
my $what=shift; |
my ($what)=@_; |
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
$status=$local.': '.$what; |
$status=$local.': '.$what; |
Line 137 sub status {
|
Line 137 sub status {
|
# -------------------------------------------------------- Escape Special Chars |
# -------------------------------------------------------- Escape Special Chars |
|
|
sub escape { |
sub escape { |
my $str=shift; |
my ($str)=@_; |
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
return $str; |
return $str; |
} |
} |
Line 145 sub escape {
|
Line 145 sub escape {
|
# ----------------------------------------------------- Un-Escape Special Chars |
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
sub unescape { |
sub unescape { |
my $str=shift; |
my ($str)=@_; |
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
return $str; |
return $str; |
} |
} |
Line 240 close(PIDSAVE);
|
Line 240 close(PIDSAVE);
|
|
|
# Fork off our children. |
# Fork off our children. |
for (1 .. $PREFORK) { |
for (1 .. $PREFORK) { |
make_new_child( ); |
&make_new_child(); |
} |
} |
|
|
# Install signal handlers. |
# Install signal handlers. |
Line 253 while (1) {
|
Line 253 while (1) {
|
sleep; # wait for a signal (i.e., child's death) |
sleep; # wait for a signal (i.e., child's death) |
for (my $i = $children; $i < $PREFORK; $i++) { |
for (my $i = $children; $i < $PREFORK; $i++) { |
&status('Parent process, starting child'); |
&status('Parent process, starting child'); |
make_new_child( ); # top up the child pool |
&make_new_child(); # top up the child pool |
} |
} |
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
my $pid; |
|
my $sigset; |
|
|
|
# block signal for fork |
# block signal for fork |
$sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
sigprocmask(SIG_BLOCK, $sigset) |
sigprocmask(SIG_BLOCK, $sigset) |
or die "Can't block SIGINT for fork: $!\n"; |
or die "Can't block SIGINT for fork: $!\n"; |
|
|
die "fork: $!" unless defined ($pid = fork); |
die "fork: $!" unless defined (my $pid = fork); |
|
|
if ($pid) { |
if ($pid) { |
# Parent records the child's birth and returns. |
# Parent records the child's birth and returns. |
Line 282 sub make_new_child {
|
Line 280 sub make_new_child {
|
# unblock signals |
# unblock signals |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
|
|
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
&process_requests(); |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
|
&status('Accepting connections'); |
|
$client = $server->accept( ) or last; |
|
while ($cmd=<$client>) { |
|
&status('Processing command'); |
|
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
|
} |
|
} |
|
|
|
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
|
# this exit is VERY important, otherwise the child will become |
# this exit is VERY important, otherwise the child will become |
Line 301 sub make_new_child {
|
Line 291 sub make_new_child {
|
exit; |
exit; |
} |
} |
} |
} |
|
|
|
sub process_requests { |
|
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
|
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
|
&status('Accepting connections'); |
|
$client = $server->accept( ) or last; |
|
while ($cmd=<$client>) { |
|
&status('Processing command'); |
|
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
|
} |
|
} |
|
} |