File:
[LON-CAPA] /
loncom /
lonmaxima
Revision
1.38:
download - view:
text,
annotated -
select for diffs
Tue Aug 19 09:46:36 2008 UTC (16 years, 1 month ago) by
riegler
Branches:
MAIN
CVS tags:
HEAD
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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>