loncom/lonmaxima - view

File: [LON-CAPA] / loncom / lonmaxima
Revision 1.23: download - view: text, annotated - select for diffs
Sat Feb 3 04:09:30 2007 UTC (17 years, 4 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Tested on FC5 and FC6: 32 bit/64 bit using perl-Expect, perl-IO-Tty, gmp, maxima, maxima-runtime-gcl and sbcl from fedora extras.

^M (Windows-style) line breaks needed to be removed.

Results of computations were being reported by maxima after $reply to client had already been set (as ''). Caused by duplicate input line ($i\d+) entry: e.g. from maxima transactions:
(%i2) trigsimp(trigreduce(4*a*x^3-4*a*x^3));
(%i2) trigsimp(trigreduce(4*a*x^3-4*a*x^3));
(%o2)                                  0

Now check for output line and make two passes if necessary. (Should this be a while() loop for the case where N passes are needed?).

Substitution of \(%o\d+\) label now functional.

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

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.