Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

- some style police

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network with CAPA
    4: # Connect to MAXIMA CAS
    5: #
    6: # $Id: lonmaxima,v 1.4 2006/03/03 23:31:06 albertel Exp $
    7: #
    8: # Copyright Michigan State University Board of Trustees
    9: #
   10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   11: #
   12: # LON-CAPA is free software; you can redistribute it and/or modify
   13: # it under the terms of the GNU General Public License as published by
   14: # the Free Software Foundation; either version 2 of the License, or
   15: # (at your option) any later version.
   16: #
   17: # LON-CAPA is distributed in the hope that it will be useful,
   18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20: # GNU General Public License for more details.
   21: #
   22: # You should have received a copy of the GNU General Public License
   23: # along with LON-CAPA; if not, write to the Free Software
   24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   25: #
   26: # /home/httpd/html/adm/gpl.txt
   27: #
   28: 
   29: # 
   30: # http://www.lon-capa.org/
   31: #
   32: 
   33:  
   34: use IPC::Open3;
   35: use IO::Select;
   36: use IO::Socket;
   37: use IO::File;
   38: use Symbol;
   39: use POSIX;
   40: use lib '/home/httpd/lib/perl/';
   41: use LONCAPA::Configuration;
   42:  
   43: use strict;
   44: 
   45: # global variables
   46: my $PREFORK                = 5;        # number of children to maintain
   47: my $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
   48: my %children               = ();       # keys are current child process IDs
   49: my $children               = 0;        # current number of children
   50: my $status;                            # string for current status
   51: 
   52: use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
   53: 	    $cmd_in $cmd_out $cmd_err $pidfile $port %perlvar $lastlog
   54: 	    $currenthostid $client $server $cmd
   55: 	    );
   56:  
   57: sub maximareply {
   58:     my ($cmd) = @_;
   59:     my $reply='';
   60:     my $error='';
   61:     my $exitstatus='';
   62: 
   63:     unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }
   64:     my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
   65:     $children{$pid} = 1;
   66:     
   67:     print $cmd_in $cmd;
   68:     close $cmd_in;
   69: 
   70:     &status("Command sent");
   71: 
   72:     my $selector = IO::Select->new();
   73:     $selector->add($cmd_err, $cmd_out);
   74:     
   75:     while (my @ready = $selector->can_read) {
   76: 	foreach my $fh (@ready) {
   77: 	    if (fileno($fh) == fileno($cmd_err)) {
   78: 		$error.=<$cmd_err>;
   79: 	    } else {
   80: 		my $line = scalar <$cmd_out>;
   81:                 if ($line=~/^(\(\%o|\s)/) {
   82:                    $line=~s/^\(.*\)/     /; 
   83:                    $reply.=$line; 
   84: 	       }
   85: 	    }
   86: 	    $selector->remove($fh) if eof($fh);
   87: 	}
   88:     }
   89:     close $cmd_out;
   90:     close $cmd_err;
   91:     &status("Command processed");
   92:     return ($reply,$error,$exitstatus);
   93: }
   94:  
   95: # ------------------------------------------------------------ Service routines 
   96: sub REAPER {                        # takes care of dead children 
   97:                                     # and MAXIMA processes
   98:     $SIG{CHLD} = \&REAPER;
   99:     my $pid = wait;
  100:     $children --;
  101:     delete $children{$pid};
  102: }
  103:  
  104: sub HUNTSMAN {                      # signal handler for SIGINT
  105:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
  106:     kill 'INT' => keys %children;
  107:     unlink($pidfile);
  108:     unlink($port);
  109:     &logthis('---- Shutdown ----');
  110:     exit;                           # clean up with dignity
  111: }
  112: 
  113: 
  114:  
  115: # --------------------------------------------------------------------- Logging
  116:  
  117: sub logthis {
  118:     my ($message)=@_;
  119:     my $execdir=$perlvar{'lonDaemons'};
  120:     my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");
  121:     my $now=time;
  122:     my $local=localtime($now);
  123:     $lastlog=$local.': '.$message;
  124:     print $fh "$local ($$): $message\n";
  125: }
  126:  
  127: # -------------------------------------------------------------- Status setting
  128:  
  129: sub status {
  130:     my ($what)=@_;
  131:     my $now=time;
  132:     my $local=localtime($now);
  133:     $status=$local.': '.$what;
  134:     $0='lonmaxima: '.$what.' '.$local;
  135: }
  136:  
  137: # -------------------------------------------------------- Escape Special Chars
  138:  
  139: sub escape {
  140:     my ($str)=@_;
  141:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  142:     return $str;
  143: }
  144:  
  145: # ----------------------------------------------------- Un-Escape Special Chars
  146:  
  147: sub unescape {
  148:     my ($str)=@_;
  149:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  150:     return $str;
  151: }
  152:  
  153: # ------------------------ grabs exception and records it to log before exiting
  154: sub catchexception {
  155:     my ($signal)=@_;
  156:     $SIG{QUIT}='DEFAULT';
  157:     $SIG{__DIE__}='DEFAULT';
  158:     chomp($signal);
  159:     &logthis("<font color=red>CRITICAL: "
  160:      ."ABNORMAL EXIT. Child $$ died through "
  161:      ."\"$signal\"</font>");
  162:     die("Signal abend");
  163: }
  164:  
  165: 
  166: 
  167: # ---------------------------------------------------------------- Main program
  168: # -------------------------------- Set signal handlers to record abnormal exits
  169:  
  170:  
  171: $SIG{'QUIT'}=\&catchexception;
  172: $SIG{__DIE__}=\&catchexception;
  173:  
  174: # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
  175: &status("Read loncapa.conf and loncapa_apache.conf");
  176: %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  177:  
  178: # ----------------------------- Make sure this process is running from user=www
  179: my $wwwid=getpwnam('www');
  180: if ($wwwid!=$<) {
  181:    my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  182:    my $subj="LON: $currenthostid User ID mismatch";
  183:    system("echo 'User ID mismatch.  lonmaxima must be run as user www.' |\
  184:  mailto $emailto -s '$subj' > /dev/null");
  185:    exit 1;
  186: }
  187:  
  188: # --------------------------------------------- Check if other instance running
  189:  
  190: $pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";
  191:  
  192: if (-e $pidfile) {
  193:    my $lfh=IO::File->new("$pidfile");
  194:    my $pide=<$lfh>;
  195:    chomp($pide);
  196:    if (kill 0 => $pide) { die "already running"; }
  197: }
  198: # ------------------------------------------------------- Listen to UNIX socket
  199: &status("Opening socket");
  200:  
  201: $port = "$perlvar{'lonSockDir'}/maximasock";
  202:  
  203: unlink($port);
  204:  
  205: 
  206: unless (
  207:   $server = IO::Socket::UNIX->new(Local  => $port,
  208:                                   Type   => SOCK_STREAM,
  209:                                   Listen => 10 )
  210:    ) {
  211:        my $st=120+int(rand(240));
  212:        &logthis(
  213:          "<font color=blue>WARNING: ".
  214:          "Can't make server socket ($st secs):  .. exiting</font>");
  215:        sleep($st);
  216:        exit;
  217:      };
  218:     
  219:  
  220: # ---------------------------------------------------- Fork once and dissociate
  221:  
  222: my $fpid=fork;
  223: exit if $fpid;
  224: die "Couldn't fork: $!" unless defined ($fpid);
  225:  
  226: POSIX::setsid() or die "Can't start new session: $!";
  227:  
  228: # ------------------------------------------------------- Write our PID on disk
  229:  
  230: my $execdir=$perlvar{'lonDaemons'};
  231: open (PIDSAVE,">$execdir/logs/lonmaxima.pid");
  232: print PIDSAVE "$$\n";
  233: close(PIDSAVE);
  234: &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
  235: &status('Starting');
  236:  
  237:  
  238: 
  239: 
  240:      
  241: # Fork off our children.
  242: for (1 .. $PREFORK) {
  243:     &make_new_child();
  244: }
  245:  
  246: # Install signal handlers.
  247: $SIG{CHLD} = \&REAPER;
  248: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
  249:  
  250: # And maintain the population.
  251: while (1) {
  252:     &status('Parent process, sleeping');
  253:     sleep;                          # wait for a signal (i.e., child's death)
  254:     for (my $i = $children; $i < $PREFORK; $i++) {
  255:         &status('Parent process, starting child');
  256:         &make_new_child();           # top up the child pool
  257:     }
  258: }
  259:                                                                                 
  260: sub make_new_child {
  261: 
  262:     # block signal for fork
  263:     my $sigset = POSIX::SigSet->new(SIGINT);
  264:     sigprocmask(SIG_BLOCK, $sigset)
  265:         or die "Can't block SIGINT for fork: $!\n";
  266:      
  267:     die "fork: $!" unless defined (my $pid = fork);
  268:      
  269:     if ($pid) {
  270:         # Parent records the child's birth and returns.
  271:         sigprocmask(SIG_UNBLOCK, $sigset)
  272:             or die "Can't unblock SIGINT for fork: $!\n";
  273:         $children{$pid} = 1;
  274:         $children++;
  275:         return;
  276:     } else {
  277:         # Child can *not* return from this subroutine.
  278:         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
  279:      
  280:         # unblock signals
  281:         sigprocmask(SIG_UNBLOCK, $sigset)
  282:             or die "Can't unblock SIGINT for fork: $!\n";
  283: 
  284: 	&process_requests();
  285: 
  286:         # tidy up gracefully and finish
  287: 
  288:         # this exit is VERY important, otherwise the child will become
  289:         # a producer of more and more children, forking yourself into
  290:         # process death.
  291:         exit;
  292:     }
  293: }
  294: 
  295: sub process_requests {
  296:     # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
  297:     for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
  298: 	&status('Accepting connections');     
  299: 	$client = $server->accept( )     or last;
  300: 	while ($cmd=<$client>) {
  301: 	    &status('Processing command');
  302: 	    print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";
  303: 	}
  304:     }    
  305: }