Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

We are quite often using the simp flag in maxima. It is quite handy for problems of type "simplify the following expression". However, simp is not reset to its default value (true) by the kill(all) incantation. reset() does the job.

If reset is not wanted here for other reasons, I recommend replacing it by
simp:true;
in order to do the job intended here.

    1: #!/usr/bin/perl
    2: #
    3: # The LearningOnline Network with CAPA
    4: # Connect to MAXIMA CAS
    5: #
    6: # $Id: lonmaxima,v 1.38 2008/08/19 09:46:36 riegler 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: use Expect; 
   34: use IO::Select;
   35: use IO::Socket;
   36: use IO::File;
   37: use Symbol;
   38: use POSIX;
   39: use lib '/home/httpd/lib/perl/';
   40: use LONCAPA::Configuration;
   41:  
   42: use strict;
   43: 
   44: # global variables
   45: my $PREFORK                = 5;        # number of children to maintain
   46: my $MAX_CLIENTS_PER_CHILD  = 50;       # number of clients each child should process
   47: my $extra_children         = 0;
   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: my $pidfile;                           # file containg parent process pid
   52: my $port;                              # path to UNIX socket file
   53: my %perlvar;                           # configuration file info
   54: my $lastlog;                           # last string that was logged
   55: 
   56: use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
   57: 	    $pidfile $port %perlvar $lastlog);
   58:  
   59: # ------------------------------------------------------------ Service routines 
   60: sub REAPER {                        # takes care of dead children 
   61:                                     # and MAXIMA processes
   62:     $SIG{CHLD} = \&REAPER;
   63:     my $pid = wait;
   64:     if (exists($children{$pid})) {
   65: 	$children--;
   66: 	delete($children{$pid});
   67: 	if ($extra_children) {
   68: 	    $extra_children--;
   69: 	}
   70:     }    
   71: }
   72:  
   73: sub HUNTSMAN {                      # signal handler for SIGINT
   74:     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
   75:     kill('INT' => keys(%children));
   76:     unlink($pidfile);
   77:     unlink($port);
   78:     &logthis('---- Shutdown ----');
   79:     exit;                           # clean up with dignity
   80: }
   81: 
   82: 
   83:  
   84: # --------------------------------------------------------------------- Logging
   85:  
   86: sub logthis {
   87:     my ($message)=@_;
   88:     my $execdir=$perlvar{'lonDaemons'};
   89:     my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");
   90:     my $now=time;
   91:     my $local=localtime($now);
   92:     $lastlog=$local.': '.$message;
   93:     print $fh "$local ($$): $message\n";
   94: }
   95:  
   96: # -------------------------------------------------------------- Status setting
   97:  
   98: sub status {
   99:     my ($what)=@_;
  100:     my $now=time;
  101:     my $local=localtime($now);
  102:     $status=$local.': '.$what;
  103:     $0='lonmaxima: '.$what.' '.$local;
  104: }
  105:  
  106: # -------------------------------------------------------- Escape Special Chars
  107:  
  108: sub escape {
  109:     my ($str)=@_;
  110:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
  111:     return $str;
  112: }
  113:  
  114: # ----------------------------------------------------- Un-Escape Special Chars
  115:  
  116: sub unescape {
  117:     my ($str)=@_;
  118:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  119:     return $str;
  120: }
  121:  
  122: # ------------------------ grabs exception and records it to log before exiting
  123: sub catchexception {
  124:     my ($signal)=@_;
  125:     $SIG{QUIT}='DEFAULT';
  126:     $SIG{__DIE__}='DEFAULT';
  127:     chomp($signal);
  128:     &logthis("<font color=\"red\">CRITICAL: "
  129: 	     ."ABNORMAL EXIT. Child $$ died through "
  130: 	     ."\"$signal\"</font>");
  131:     die("Signal abend");
  132: }
  133: 
  134: 
  135: sub child_announce_death {
  136:     $SIG{USR1} = \&child_announce_death;
  137:     if ($extra_children < $PREFORK*10) {
  138: 	$extra_children++;
  139:     }
  140: }
  141: 
  142: # ---------------------------------------------------------------- Main program
  143: # -------------------------------- Set signal handlers to record abnormal exits
  144:  
  145:  
  146: $SIG{'QUIT'}=\&catchexception;
  147: $SIG{__DIE__}=\&catchexception;
  148: $SIG{USR1} = \&child_announce_death;
  149:  
  150: # ---------------------------------- Read loncapa_apache.conf and loncapa.conf
  151: &status("Read loncapa.conf and loncapa_apache.conf");
  152: %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
  153:  
  154: # ----------------------------- Make sure this process is running from user=www
  155: my $wwwid=getpwnam('www');
  156: if ($wwwid!=$<) {
  157:     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
  158:     my $subj="LON: User ID mismatch";
  159:     system("echo 'User ID mismatch.  lonmaxima must be run as user www.' |\
  160:  mailto $emailto -s '$subj' > /dev/null");
  161:     exit 1;
  162: }
  163:  
  164: # --------------------------------------------- Check if other instance running
  165:  
  166: $pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";
  167:  
  168: if (-e $pidfile) {
  169:     my $lfh=IO::File->new("$pidfile");
  170:     my $pide=<$lfh>;
  171:     chomp($pide);
  172:     if (kill(0 => $pide)) { die "already running"; }
  173: }
  174: 
  175: # ------------------------------------------------------- Listen to UNIX socket
  176: &status("Opening socket");
  177:  
  178: $port = "$perlvar{'lonSockDir'}/maximasock";
  179:  
  180: unlink($port);
  181:  
  182: 
  183: my $server = IO::Socket::UNIX->new(Local  => $port,
  184: 				   Type   => SOCK_STREAM,
  185: 				   Listen => 10 );
  186: if (!$server) {
  187:     my $st=120+int(rand(240));
  188: 
  189:     &logthis("<font color=blue>WARNING: ".
  190: 	     "Can't make server socket ($st secs):  .. exiting</font>");
  191: 
  192:     sleep($st);
  193:     exit;
  194: }
  195:     
  196:  
  197: # ---------------------------------------------------- Fork once and dissociate
  198:  
  199: my $fpid=fork;
  200: exit if $fpid;
  201: die("Couldn't fork: $!") unless defined($fpid);
  202:  
  203: POSIX::setsid() or die "Can't start new session: $!";
  204:  
  205: # ------------------------------------------------------- Write our PID on disk
  206:  
  207: my $execdir=$perlvar{'lonDaemons'};
  208: open(PIDSAVE,">$execdir/logs/lonmaxima.pid");
  209: print PIDSAVE "$$\n";
  210: close(PIDSAVE);
  211: &logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
  212: &status('Starting');
  213:      
  214: 
  215: # Install signal handlers.
  216: $SIG{CHLD} = \&REAPER;
  217: $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
  218:  
  219: # Fork off our children.
  220: for (1 .. $PREFORK) {
  221:     &make_new_child($server);
  222: }
  223:  
  224: # And maintain the population.
  225: while (1) {
  226:     &status('Parent process, sleeping');
  227:     sleep;                          # wait for a signal (i.e., child's death)
  228:     for (my $i = $children; $i < $PREFORK+$extra_children; $i++) {
  229:         &status('Parent process, starting child');
  230:         &make_new_child($server);           # top up the child pool
  231:     }
  232: }
  233:                                                                                 
  234: sub make_new_child {
  235:     my ($server) = @_;
  236: 
  237:     # block signal for fork
  238:     my $sigset = POSIX::SigSet->new(SIGINT);
  239:     sigprocmask(SIG_BLOCK, $sigset)
  240:         or die("Can't block SIGINT for fork: $!\n");
  241:      
  242:     die("fork: $!") unless defined(my $pid = fork);
  243:      
  244:     if ($pid) {
  245:         # Parent records the child's birth and returns.
  246:         sigprocmask(SIG_UNBLOCK, $sigset)
  247:             or die("Can't unblock SIGINT for fork: $!\n");
  248:         $children{$pid} = 1;
  249:         $children++;
  250:         return;
  251:     } else {
  252:         # Child can *not* return from this subroutine.
  253:         
  254: 	my $ppid = getppid();
  255:      
  256:         # unblock signals
  257:         sigprocmask(SIG_UNBLOCK, $sigset)
  258:             or die("Can't unblock SIGINT for fork: $!\n");
  259: 
  260:         &logthis('New process started');
  261: 
  262:         my $command=Expect->spawn('maxima');
  263: 	# soft/hard_close can take awhile and we really
  264:         # don't care we just want it gone
  265: 	$SIG{INT} = sub {
  266: 	    my $pid = $command->pid();
  267: 	    kill('KILL'=>$pid);
  268: 	    exit; 
  269: 	};
  270: 
  271: 	$command->log_stdout(0);
  272: 	#$command->log_file("$execdir/logs/lonmaxima.session.log");
  273: 
  274:         for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
  275:             &status('Accepting connections');
  276:             my $client = $server->accept()     or last;
  277:             &sync($command);
  278:             print $command ("display2d:false;kill(all);reset();\n");
  279: 	    &getmaximaoutput($command,2);
  280:             &sync($command);
  281:             my $syntaxerr = 0;
  282:             while (my $cmd=<$client>) {
  283:                 &status('Processing command');
  284:                 print $command &unescape($cmd);
  285:                 my ($reply,$syntaxerr) = &getmaximaoutput($command,1);
  286:                 print $client &escape($reply)."\n";
  287:                 if ($syntaxerr) {
  288:                     last;
  289:                 } elsif ($reply=~/^Error\:/) {
  290:                     &logthis('Died through '.$reply);
  291: 		    kill('USR1' => $ppid);
  292:                     $client->close();
  293:                     $command->hard_close();     
  294:                     exit;
  295:                 }
  296: 	        &sync($command);
  297:                 &status('Waiting for commands');
  298:             }
  299:         }
  300: 
  301: 	kill('USR1' => $ppid);
  302: 	print $command ("quit();\n");
  303:         # tidy up gracefully and finish
  304: 	sleep(15);
  305:         $command->soft_close();
  306: 
  307:         # this exit is VERY important, otherwise the child will become
  308:         # a producer of more and more children, forking yourself into
  309:         # process death.
  310:         exit;
  311:     }
  312: }
  313: 
  314: {
  315:     my $counter;
  316:     sub sync {
  317: 	my ($command)=@_;
  318: 	$counter++;
  319: 	my $expect=$counter.time;
  320: 	print $command "$expect;\n";
  321: 	while (1) {
  322: 	    my $output=&getmaximaoutput($command,1);
  323: 	    if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
  324: 		return;
  325: 	    }
  326: 	}
  327:     }
  328: }
  329: 
  330: sub getmaximaoutput {
  331:     my ($command,$numcheck)=@_;
  332:     my $regexp = '\(\%i\d+\)';
  333:     my $syntaxerr=0;
  334:     if ($numcheck) {
  335:        	if ($numcheck eq 2) {
  336: 	    # command was the killall so should get a full reset on
  337: 	    # command numbers
  338: 	    $regexp = '(\(\%i(1)\)|Incorrect syntax\:)';
  339: 	} elsif ($command->match() =~ /\(\%i(\d+)\)/) {
  340:             my $nextmatch = $1+1;
  341:             $regexp = '(\(\%i'.$nextmatch.'\)|Incorrect syntax\:)';
  342:         }
  343:     }
  344:     my $timeout = 20;
  345:     my (undef,$error,$matched,$output) =
  346: 	$command->expect($timeout, -re => $regexp);
  347: 
  348:     if ($numcheck && $matched eq 'Incorrect syntax:') {
  349: 	$syntaxerr = 1;
  350: 	if (wantarray) {
  351: 	    return ($matched,$syntaxerr);
  352: 	} else {
  353: 	    return $matched;
  354: 	}
  355:     }
  356:     if ($error) {
  357: 	return 'Error: '.$error;
  358:     }
  359:     $output =~ s/\r+//g; # Remove Windows-style linebreaks
  360:     my $foundoutput=0;
  361:     my $found_label=0;
  362:     my $realoutput='';
  363:     foreach my $line (split(/\n/,$output)) {
  364:        if ($line=~/\;/) { $foundoutput=1; next; }
  365:        if (!$foundoutput) { next; }
  366:        if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; }
  367:        if ($line=~ /^(\(\%o\d+\))(.+)$/){
  368:            my $label = $1;
  369:            $line = $2;
  370:            $label =~s/\S/ /g;
  371:            $line=$label.$line;
  372: 	   $found_label=1;
  373:        }
  374:        if ($found_label) {
  375: 	   $realoutput.=$line."\n";
  376:        }
  377:     }
  378:     if (wantarray) {
  379:         return ($realoutput,$syntaxerr);
  380:     } else {
  381:         return $realoutput;
  382:     }
  383: }