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

Diff for /loncom/lonmaxima between versions 1.4 and 1.19

version 1.4, 2006/03/03 23:31:06 version 1.19, 2006/05/10 02:12:17
Line 30 Line 30
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
    use Expect; 
 use IPC::Open3;  use IPC::Open3;
 use IO::Select;  use IO::Select;
 use IO::Socket;  use IO::Socket;
Line 44  use strict; Line 44  use strict;
   
 # global variables  # global variables
 my $PREFORK                = 5;        # number of children to maintain  my $PREFORK                = 5;        # number of children to maintain
 my $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process  my $MAX_CLIENTS_PER_CHILD  = 50;       # number of clients each child should process
 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 {  
     my ($cmd) = @_;  
     my $reply='';  
     my $error='';  
     my $exitstatus='';  
   
     unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }  
     my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');  
     $children{$pid} = 1;  
       
     print $cmd_in $cmd;  
     close $cmd_in;  
   
     &status("Command sent");  
   
     my $selector = IO::Select->new();  
     $selector->add($cmd_err, $cmd_out);  
       
     while (my @ready = $selector->can_read) {  
  foreach my $fh (@ready) {  
     if (fileno($fh) == fileno($cmd_err)) {  
  $error.=<$cmd_err>;  
     } else {  
  my $line = scalar <$cmd_out>;  
                 if ($line=~/^(\(\%o|\s)/) {  
                    $line=~s/^\(.*\)/     /;   
                    $reply.=$line;   
        }  
     }  
     $selector->remove($fh) if eof($fh);  
  }  
     }  
     close $cmd_out;  
     close $cmd_err;  
     &status("Command processed");  
     return ($reply,$error,$exitstatus);  
 }  
     
 # ------------------------------------------------------------ Service routines   # ------------------------------------------------------------ Service routines 
 sub REAPER {                        # takes care of dead children   sub REAPER {                        # takes care of dead children 
                                     # 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 120  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 142  $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 154  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 168  $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.  
 for (1 .. $PREFORK) {  
     &make_new_child();  
 }  
    
 # Install signal handlers.  # Install signal handlers.
 $SIG{CHLD} = \&REAPER;  $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;  $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
     
   # Fork off our children.
   for (1 .. $PREFORK) {
       &make_new_child($server);
   }
    
 # And maintain the population.  # And maintain the population.
 while (1) {  while (1) {
     &status('Parent process, sleeping');      &status('Parent process, sleeping');
     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 242  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");
   
           &logthis('New process started');
   
  &process_requests();          my $command=Expect->spawn('maxima');
           $command->log_stdout(0);
   
           &getmaximaoutput($command);
   
           for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
              &status('Accepting connections');
              my $client = $server->accept()     or last;
              print $command "kill(all);reset();\n";
              &sync($command);
              while (my $cmd=<$client>) {
                 &status('Processing command');
                 print $command &unescape($cmd);
                 my $reply=&getmaximaoutput($command);
                 print $client &escape($reply)."\n";
                 if ($reply=~/^Error\:/) {
                    &logthis('Died through '.$reply);
                    $client->close();
                    $command->hard_close();     
                    exit;
                 }      
         &sync($command);
                 &status('Waiting for commands');
              }
           }
   
         # tidy up gracefully and finish          # tidy up gracefully and finish
   
           $command->soft_close();
   
         # this exit is VERY important, otherwise the child will become          # this exit is VERY important, otherwise the child will become
         # a producer of more and more children, forking yourself into          # a producer of more and more children, forking yourself into
         # process death.          # process death.
Line 292  sub make_new_child { Line 283  sub make_new_child {
     }      }
 }  }
   
 sub process_requests {  {
     # handle connections until we've reached $MAX_CLIENTS_PER_CHILD      my $counter;
     for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {      sub sync {
  &status('Accepting connections');        my ($command)=@_;
  $client = $server->accept( )     or last;   $counter++;
  while ($cmd=<$client>) {   my $expect=$counter.time;
     &status('Processing command');   print $command "$expect;\n";
     print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";   while (1) {
       my $output=&getmaximaoutput($command);
       if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
    return;
       }
  }   }
     }          }
   }
   
   sub getmaximaoutput {
       my ($command)=@_;
       my (undef,$error,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)');
       if ($error) {
          return 'Error: '.$error;
       }
       my $foundoutput=0;
       my $realoutput='';
       foreach my $line (split(/\n/,$output)) {
          if ($line=~/\;/) { $foundoutput=1; next; }
          if (!$foundoutput) { next; }
          my ($label)=($line=~s/^(\(\%o\d+\))//);
          if ($label) {
             $label=~s/\S/ /g;
             $line=$label.$line;
          }
          $realoutput.=$line."\n";
       }
       return $realoutput;
 }  }
Removed from v.1.4  
changed lines
  Added in v.1.19

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.