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

Diff for /loncom/lonmaxima between versions 1.3 and 1.9

version 1.3, 2006/03/03 23:25:47 version 1.9, 2006/03/04 06:51:02
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=shift;      my ($cmd) = @_;
     my $reply='';      my $reply='';
     my $error='';      my $error='';
     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);
   
     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 (ref($fh) 
    && ref($cmd_err)
    && 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';
       if (ref($cmd_out)) { close($cmd_out); }
       if (ref($cmd_err)) { close($cmd_err); }
   
     &status("Command processed");      &status("Command processed");
     return ($reply,$error,$exitstatus);      return ($reply,$error,$exitstatus);
 }  }
Line 97  sub REAPER {                        # ta Line 109  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 115  sub HUNTSMAN {                      # si Line 127  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 139  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 149  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 157  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 156  sub catchexception { Line 168  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 190  $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 202  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 216  $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 263  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 $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 281  sub make_new_child { Line 290  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($server);
         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 302  sub make_new_child {
         exit;          exit;
     }      }
 }  }
   
   sub process_requests {
       my ($server) = @_;
       # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
       for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
    &status('Accepting connections');     
    my $client = $server->accept()     or last;
    while (my $cmd=<$client>) {
       &status('Processing command');
       print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";
    }
       }    
   }
Removed from v.1.3  
changed lines
  Added in v.1.9

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.