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

Diff for /loncom/lonmaxima between versions 1.2 and 1.24

version 1.2, 2006/03/03 22:35:09 version 1.24, 2007/02/08 06:28:30
Line 30 Line 30
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
 # global variables  use Expect; 
 $PREFORK                = 5;        # number of children to maintain  
 $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process  
 %children               = ();       # keys are current child process IDs  
 $children               = 0;        # current number of children  
    
 use IPC::Open3;  
 use IO::Select;  use IO::Select;
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
Line 45  use POSIX; Line 39  use POSIX;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
     
 # Scary: cannot use strict!!!  use strict;
 ##### use strict;  
    
 sub maximareply {  
     my $cmd=shift;  
     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");  # global variables
   my $PREFORK                = 5;        # number of children to maintain
   my $MAX_CLIENTS_PER_CHILD  = 50;       # number of clients each child should process
   my %children               = ();       # keys are current child process IDs
   my $children               = 0;        # current number of children
   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
   
     my $selector = IO::Select->new();  use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
     $selector->add($cmd_err, $cmd_out);      $pidfile $port %perlvar $lastlog);
       
     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 109  sub HUNTSMAN {                      # si Line 78  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 121  sub logthis { Line 90  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 131  sub status { Line 100  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 139  sub escape { Line 108  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 150  sub catchexception { Line 119  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 167  $SIG{__DIE__}=\&catchexception; Line 136  $SIG{__DIE__}=\&catchexception;
     
 # ---------------------------------- Read loncapa_apache.conf and loncapa.conf  # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
 &status("Read loncapa.conf and loncapa_apache.conf");  &status("Read loncapa.conf and loncapa_apache.conf");
 my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
 %perlvar=%{$perlvarref};  
 undef $perlvarref;  
     
 # ----------------------------- 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 186  if ($wwwid!=$<) { Line 153  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 199  $port = "$perlvar{'lonSockDir'}/maximaso Line 167  $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 ($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 $pid;      my ($server) = @_;
     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.
         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 277  sub make_new_child { Line 241  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          &logthis('New process started');
         for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {  
     &status('Accepting connections');               my $command=Expect->spawn('maxima');
             $client = $server->accept( )     or last;          $command->log_stdout(0);
             while ($cmd=<$client>) {  
  &status('Processing command');          &getmaximaoutput($command);
  print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";  
     }          for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
              &status('Accepting connections');
              my $client = $server->accept()     or last;
              print $command "kill(all);\n";
      &getmaximaoutput($command);
              &sync($command);
              while (my $cmd=<$client>) {
                 &status('Processing command');
                 print $command &unescape($cmd);
                 my ($reply,$finished,$syntaxerr);
                 while ((!$finished) && (!$syntaxerr) && ($reply !~ /^Error\:/)) {
                     ($reply,$finished,$syntaxerr) = &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.
         exit;          exit;
     }      }
 }  }
   
   {
       my $counter;
       sub sync {
    my ($command)=@_;
    $counter++;
    my $expect=$counter.time;
    print $command "$expect;\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;
       }
       $output =~ s/\r+//g; # Remove Windows-style linebreaks
       my $hasoutput=0;
       my $foundoutput=0;
       my $syntaxerr=0;
       my $realoutput='';
       foreach my $line (split(/\n/,$output)) {
          if ($line=~/\;/) { $foundoutput=1; next; }
          if (!$foundoutput) { next; }
          if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; }
          (my $label, $line) = ($line=~ /^(\(\%o\d+\))(.+)$/);
          if ($label) {
             $label=~s/\S/ /g;
             $line=$label.$line;
             $hasoutput = 1;
          }
          $realoutput.=$line."\n";
       }
       if (wantarray) {
           return ($realoutput,$hasoutput,$syntaxerr);
       } else {
           return $realoutput;
       }
   }
Removed from v.1.2  
changed lines
  Added in v.1.24

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.