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

Diff for /loncom/lonmaxima between versions 1.1 and 1.4

version 1.1, 2006/03/03 16:07:34 version 1.4, 2006/03/03 23:31:06
Line 29 Line 29
 #   # 
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
     
 use IPC::Open3;  use IPC::Open3;
 use IO::Select;  use IO::Select;
 # Scary: cannot use strict!!!  use IO::Socket;
 ##### use strict;  use IO::File;
   use Symbol;
   use POSIX;
   use lib '/home/httpd/lib/perl/';
   use LONCAPA::Configuration;
    
   use strict;
   
   # global variables
   my $PREFORK                = 5;        # number of children to maintain
   my $MAX_CLIENTS_PER_CHILD  = 5;        # 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
   
   use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
       $cmd_in $cmd_out $cmd_err $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');      my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
       $children{$pid} = 1;
           
     $SIG{CHLD} = sub {  
  $exitstatus="$? on $pid\n" if waitpid($pid, 0) > 0;  
     };  
   
     print $cmd_in $cmd;      print $cmd_in $cmd;
     close $cmd_in;      close $cmd_in;
   
     my $selector = IO::Select->new( );      &status("Command sent");
   
       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) {
Line 70  sub maximareply { Line 88  sub maximareply {
     }      }
     close $cmd_out;      close $cmd_out;
     close $cmd_err;      close $cmd_err;
       &status("Command processed");
     return ($reply,$error,$exitstatus);      return ($reply,$error,$exitstatus);
 }  }
    
   # ------------------------------------------------------------ Service routines 
   sub REAPER {                        # takes care of dead children 
                                       # and MAXIMA processes
       $SIG{CHLD} = \&REAPER;
       my $pid = wait;
       $children --;
       delete $children{$pid};
   }
    
   sub HUNTSMAN {                      # signal handler for SIGINT
       local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
       kill 'INT' => keys %children;
       unlink($pidfile);
       unlink($port);
       &logthis('---- Shutdown ----');
       exit;                           # clean up with dignity
   }
   
   
 print join("\n----\n",&maximareply('1234'));   
 print join("\n----\n",&maximareply('x0: 5;x1: 7;integrate (x^2, x, x0, x1);'));  # --------------------------------------------------------------------- Logging
    
   sub logthis {
       my ($message)=@_;
       my $execdir=$perlvar{'lonDaemons'};
       my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");
       my $now=time;
       my $local=localtime($now);
       $lastlog=$local.': '.$message;
       print $fh "$local ($$): $message\n";
   }
    
   # -------------------------------------------------------------- Status setting
    
   sub status {
       my ($what)=@_;
       my $now=time;
       my $local=localtime($now);
       $status=$local.': '.$what;
       $0='lonmaxima: '.$what.' '.$local;
   }
    
   # -------------------------------------------------------- Escape Special Chars
    
   sub escape {
       my ($str)=@_;
       $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
       return $str;
   }
    
   # ----------------------------------------------------- Un-Escape Special Chars
    
   sub unescape {
       my ($str)=@_;
       $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       return $str;
   }
    
   # ------------------------ grabs exception and records it to log before exiting
   sub catchexception {
       my ($signal)=@_;
       $SIG{QUIT}='DEFAULT';
       $SIG{__DIE__}='DEFAULT';
       chomp($signal);
       &logthis("<font color=red>CRITICAL: "
        ."ABNORMAL EXIT. Child $$ died through "
        ."\"$signal\"</font>");
       die("Signal abend");
   }
    
   
   
   # ---------------------------------------------------------------- Main program
   # -------------------------------- Set signal handlers to record abnormal exits
    
    
   $SIG{'QUIT'}=\&catchexception;
   $SIG{__DIE__}=\&catchexception;
    
   # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
   &status("Read loncapa.conf and loncapa_apache.conf");
   %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
    
   # ----------------------------- Make sure this process is running from user=www
   my $wwwid=getpwnam('www');
   if ($wwwid!=$<) {
      my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
      my $subj="LON: $currenthostid User ID mismatch";
      system("echo 'User ID mismatch.  lonmaxima must be run as user www.' |\
    mailto $emailto -s '$subj' > /dev/null");
      exit 1;
   }
    
   # --------------------------------------------- Check if other instance running
    
   $pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";
    
   if (-e $pidfile) {
      my $lfh=IO::File->new("$pidfile");
      my $pide=<$lfh>;
      chomp($pide);
      if (kill 0 => $pide) { die "already running"; }
   }
   # ------------------------------------------------------- Listen to UNIX socket
   &status("Opening socket");
    
   $port = "$perlvar{'lonSockDir'}/maximasock";
    
   unlink($port);
    
   
   unless (
     $server = IO::Socket::UNIX->new(Local  => $port,
                                     Type   => SOCK_STREAM,
                                     Listen => 10 )
      ) {
          my $st=120+int(rand(240));
          &logthis(
            "<font color=blue>WARNING: ".
            "Can't make server socket ($st secs):  .. exiting</font>");
          sleep($st);
          exit;
        };
       
    
   # ---------------------------------------------------- Fork once and dissociate
    
   my $fpid=fork;
   exit if $fpid;
   die "Couldn't fork: $!" unless defined ($fpid);
    
   POSIX::setsid() or die "Can't start new session: $!";
    
   # ------------------------------------------------------- Write our PID on disk
    
   my $execdir=$perlvar{'lonDaemons'};
   open (PIDSAVE,">$execdir/logs/lonmaxima.pid");
   print PIDSAVE "$$\n";
   close(PIDSAVE);
   &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
   &status('Starting');
    
    
   
   
        
   # Fork off our children.
   for (1 .. $PREFORK) {
       &make_new_child();
   }
    
   # Install signal handlers.
   $SIG{CHLD} = \&REAPER;
   $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
    
   # And maintain the population.
   while (1) {
       &status('Parent process, sleeping');
       sleep;                          # wait for a signal (i.e., child's death)
       for (my $i = $children; $i < $PREFORK; $i++) {
           &status('Parent process, starting child');
           &make_new_child();           # top up the child pool
       }
   }
                                                                                   
   sub make_new_child {
   
       # block signal for fork
       my $sigset = POSIX::SigSet->new(SIGINT);
       sigprocmask(SIG_BLOCK, $sigset)
           or die "Can't block SIGINT for fork: $!\n";
        
       die "fork: $!" unless defined (my $pid = fork);
        
       if ($pid) {
           # Parent records the child's birth and returns.
           sigprocmask(SIG_UNBLOCK, $sigset)
               or die "Can't unblock SIGINT for fork: $!\n";
           $children{$pid} = 1;
           $children++;
           return;
       } else {
           # Child can *not* return from this subroutine.
           $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
        
           # unblock signals
           sigprocmask(SIG_UNBLOCK, $sigset)
               or die "Can't unblock SIGINT for fork: $!\n";
   
    &process_requests();
   
           # tidy up gracefully and finish
   
           # this exit is VERY important, otherwise the child will become
           # a producer of more and more children, forking yourself into
           # process death.
           exit;
       }
   }
   
   sub process_requests {
       # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
       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";
    }
       }    
   }
Removed from v.1.1  
changed lines
  Added in v.1.4

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.