version 1.4, 2006/03/03 23:31:06
|
version 1.5, 2006/03/03 23:41:38
|
Line 48 my $MAX_CLIENTS_PER_CHILD = 5; #
|
Line 48 my $MAX_CLIENTS_PER_CHILD = 5; #
|
my %children = (); # keys are current child process IDs |
my %children = (); # keys are current child process IDs |
my $children = 0; # current number of children |
my $children = 0; # current number of children |
my $status; # string for current status |
my $status; # string for current status |
|
my $pidfile; # file containg parent process pid |
|
my $port; # path to UNIX socket file |
|
my %perlvar; # configuration file info |
|
my $lastlog; # last string that was logged |
|
|
use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status |
use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status |
$cmd_in $cmd_out $cmd_err $pidfile $port %perlvar $lastlog |
$pidfile $port %perlvar $lastlog); |
$currenthostid $client $server $cmd |
|
); |
|
|
|
sub maximareply { |
sub maximareply { |
my ($cmd) = @_; |
my ($cmd) = @_; |
Line 61 sub maximareply {
|
Line 63 sub maximareply {
|
my $exitstatus=''; |
my $exitstatus=''; |
|
|
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } |
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } |
|
|
|
my ($cmd_in, $cmd_out, $cmd_err); |
my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); |
my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); |
$children{$pid} = 1; |
$children{$pid} = 1; |
|
|
print $cmd_in $cmd; |
print $cmd_in $cmd; |
close $cmd_in; |
close($cmd_in); |
|
|
&status("Command sent"); |
&status("Command sent"); |
|
|
Line 79 sub maximareply {
|
Line 83 sub maximareply {
|
} else { |
} else { |
my $line = scalar <$cmd_out>; |
my $line = scalar <$cmd_out>; |
if ($line=~/^(\(\%o|\s)/) { |
if ($line=~/^(\(\%o|\s)/) { |
$line=~s/^\(.*\)/ /; |
$line=~s/^\(.*\)/ /; |
$reply.=$line; |
$reply.=$line; |
} |
} |
} |
} |
$selector->remove($fh) if eof($fh); |
$selector->remove($fh) if eof($fh); |
} |
} |
} |
} |
close $cmd_out; |
close($cmd_out); |
close $cmd_err; |
close($cmd_err); |
&status("Command processed"); |
&status("Command processed"); |
return ($reply,$error,$exitstatus); |
return ($reply,$error,$exitstatus); |
} |
} |
Line 156 sub catchexception {
|
Line 160 sub catchexception {
|
$SIG{QUIT}='DEFAULT'; |
$SIG{QUIT}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
chomp($signal); |
chomp($signal); |
&logthis("<font color=red>CRITICAL: " |
&logthis("<font color=\"red\">CRITICAL: " |
."ABNORMAL EXIT. Child $$ died through " |
."ABNORMAL EXIT. Child $$ died through " |
."\"$signal\"</font>"); |
."\"$signal\"</font>"); |
die("Signal abend"); |
die("Signal abend"); |
} |
} |
|
|
|
|
|
|
# ---------------------------------------------------------------- Main program |
# ---------------------------------------------------------------- Main program |
Line 178 $SIG{__DIE__}=\&catchexception;
|
Line 182 $SIG{__DIE__}=\&catchexception;
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $subj="LON: $currenthostid User ID mismatch"; |
my $subj="LON: User ID mismatch"; |
system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\ |
system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\ |
mailto $emailto -s '$subj' > /dev/null"); |
mailto $emailto -s '$subj' > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
|
|
# --------------------------------------------- Check if other instance running |
# --------------------------------------------- Check if other instance running |
Line 190 if ($wwwid!=$<) {
|
Line 194 if ($wwwid!=$<) {
|
$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid"; |
$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid"; |
|
|
if (-e $pidfile) { |
if (-e $pidfile) { |
my $lfh=IO::File->new("$pidfile"); |
my $lfh=IO::File->new("$pidfile"); |
my $pide=<$lfh>; |
my $pide=<$lfh>; |
chomp($pide); |
chomp($pide); |
if (kill 0 => $pide) { die "already running"; } |
if (kill 0 => $pide) { die "already running"; } |
} |
} |
|
|
# ------------------------------------------------------- Listen to UNIX socket |
# ------------------------------------------------------- Listen to UNIX socket |
&status("Opening socket"); |
&status("Opening socket"); |
|
|
Line 203 $port = "$perlvar{'lonSockDir'}/maximaso
|
Line 208 $port = "$perlvar{'lonSockDir'}/maximaso
|
unlink($port); |
unlink($port); |
|
|
|
|
|
my $server; |
unless ( |
unless ( |
$server = IO::Socket::UNIX->new(Local => $port, |
$server = IO::Socket::UNIX->new(Local => $port, |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Line 228 POSIX::setsid() or die "Can't start new
|
Line 234 POSIX::setsid() or die "Can't start new
|
# ------------------------------------------------------- Write our PID on disk |
# ------------------------------------------------------- Write our PID on disk |
|
|
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
open (PIDSAVE,">$execdir/logs/lonmaxima.pid"); |
open(PIDSAVE,">$execdir/logs/lonmaxima.pid"); |
print PIDSAVE "$$\n"; |
print PIDSAVE "$$\n"; |
close(PIDSAVE); |
close(PIDSAVE); |
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>"); |
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>"); |
Line 240 close(PIDSAVE);
|
Line 246 close(PIDSAVE);
|
|
|
# Fork off our children. |
# Fork off our children. |
for (1 .. $PREFORK) { |
for (1 .. $PREFORK) { |
&make_new_child(); |
&make_new_child($server); |
} |
} |
|
|
# Install signal handlers. |
# Install signal handlers. |
Line 253 while (1) {
|
Line 259 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($server); # top up the child pool |
} |
} |
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
|
my ($server) = @_; |
|
|
# block signal for fork |
# block signal for fork |
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
Line 281 sub make_new_child {
|
Line 288 sub make_new_child {
|
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"; |
|
|
&process_requests(); |
&process_requests($server); |
|
|
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
|
Line 293 sub make_new_child {
|
Line 300 sub make_new_child {
|
} |
} |
|
|
sub process_requests { |
sub process_requests { |
|
my ($server) = @_; |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
&status('Accepting connections'); |
&status('Accepting connections'); |
$client = $server->accept( ) or last; |
my $client = $server->accept() or last; |
while ($cmd=<$client>) { |
while (my $cmd=<$client>) { |
&status('Processing command'); |
&status('Processing command'); |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
} |
} |