[BACK]Return to lonmaxima CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lonmaxima between versions 1.4 and 1.8

version 1.4, 2006/03/03 23:31:06 version 1.8, 2006/03/04 06:44:11
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 62  sub maximareply {
     my $exitstatus='';      my $exitstatus='';
   
     unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }      unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }
     my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');  
     $children{$pid} = 1;      my ($cmd_in, $cmd_out, $cmd_err);
       my $maximapid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
       $children{$maximapid} = 1;
           
     print $cmd_in $cmd;      print $cmd_in $cmd;
     close $cmd_in;      close($cmd_in);
   
     &status("Command sent");      &status("Command sent");
   
       $SIG{ALRM} = sub { kill 9 => $maximapid; }; 
       alarm(5);
       no strict 'refs';
   
     my $selector = IO::Select->new();      my $selector = IO::Select->new();
   
     $selector->add($cmd_err, $cmd_out);      $selector->add($cmd_err, $cmd_out);
           
     while (my @ready = $selector->can_read) {      while (my @ready = $selector->can_read()) {
  foreach my $fh (@ready) {   foreach my $fh (@ready) {
     if (fileno($fh) == fileno($cmd_err)) {      if (fileno($fh) == fileno($cmd_err)) {
  $error.=<$cmd_err>;   $error.=<$cmd_err>;
     } 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;      alarm(0);
     close $cmd_err;      $SIG{ALRM} = 'DEFAULT';
       close($cmd_out);
       close($cmd_err);
       use strict 'refs';
     &status("Command processed");      &status("Command processed");
     return ($reply,$error,$exitstatus);      return ($reply,$error,$exitstatus);
 }  }
Line 97  sub REAPER {                        # ta Line 108  sub REAPER {                        # ta
                                     # and MAXIMA processes                                      # and MAXIMA processes
     $SIG{CHLD} = \&REAPER;      $SIG{CHLD} = \&REAPER;
     my $pid = wait;      my $pid = wait;
     $children --;      $children--;
     delete $children{$pid};      delete($children{$pid});
 }  }
     
 sub HUNTSMAN {                      # signal handler for SIGINT  sub HUNTSMAN {                      # signal handler for SIGINT
     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
     kill 'INT' => keys %children;      kill('INT' => keys(%children));
     unlink($pidfile);      unlink($pidfile);
     unlink($port);      unlink($port);
     &logthis('---- Shutdown ----');      &logthis('---- Shutdown ----');
Line 156  sub catchexception { Line 167  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 189  $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 201  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 215  $port = "$perlvar{'lonSockDir'}/maximaso
 unlink($port);  unlink($port);
     
   
 unless (  my $server = IO::Socket::UNIX->new(Local  => $port,
   $server = IO::Socket::UNIX->new(Local  => $port,     Type   => SOCK_STREAM,
                                   Type   => SOCK_STREAM,     Listen => 10 );
                                   Listen => 10 )  if (!$server) {
    ) {      my $st=120+int(rand(240));
        my $st=120+int(rand(240));  
        &logthis(      &logthis("<font color=blue>WARNING: ".
          "<font color=blue>WARNING: ".       "Can't make server socket ($st secs):  .. exiting</font>");
          "Can't make server socket ($st secs):  .. exiting</font>");  
        sleep($st);      sleep($st);
        exit;      exit;
      };  }
           
     
 # ---------------------------------------------------- Fork once and dissociate  # ---------------------------------------------------- Fork once and dissociate
     
 my $fpid=fork;  my $fpid=fork;
 exit if $fpid;  exit if $fpid;
 die "Couldn't fork: $!" unless defined ($fpid);  die("Couldn't fork: $!") unless defined($fpid);
     
 POSIX::setsid() or die "Can't start new session: $!";  POSIX::setsid() or die "Can't start new session: $!";
     
 # ------------------------------------------------------- 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>");
 &status('Starting');  &status('Starting');
    
    
   
   
             
   
 # 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 262  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);
     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 (my $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.
         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");
         $children{$pid} = 1;          $children{$pid} = 1;
         $children++;          $children++;
         return;          return;
Line 279  sub make_new_child { Line 289  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");
   
  &process_requests();   &process_requests($server);
   
         # tidy up gracefully and finish          # tidy up gracefully and finish
   
Line 293  sub make_new_child { Line 303  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";
  }   }
Removed from v.1.4  
changed lines
  Added in v.1.8

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.