--- loncom/lonmaxima	2006/03/08 12:57:30	1.13
+++ loncom/lonmaxima	2006/05/10 02:12:17	1.19
@@ -3,7 +3,7 @@
 # The LearningOnline Network with CAPA
 # Connect to MAXIMA CAS
 #
-# $Id: lonmaxima,v 1.13 2006/03/08 12:57:30 www Exp $
+# $Id: lonmaxima,v 1.19 2006/05/10 02:12:17 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,33 +30,30 @@
 # http://www.lon-capa.org/
 #
 
- 
+use Expect; 
 use IPC::Open3;
 use IO::Select;
 use IO::Socket;
 use IO::File;
 use Symbol;
 use POSIX;
-use Fcntl;
-use Socket;
 use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;
  
 use strict;
 
 # global variables
-my $STARTPORT              = 5664;     # port for first child's server
 my $PREFORK                = 5;        # number of children to maintain
-my $MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
+my $MAX_CLIENTS_PER_CHILD  = 50;       # number of clients each child should process
 my %children               = ();       # keys are current child process IDs
-my %usedmaximaports        = ();       # keys are the used maximaports
 my $children               = 0;        # current number of children
 my $status;                            # string for current status
 my $pidfile;                           # file containg parent process pid
 my $port;                              # path to UNIX socket file
 my %perlvar;                           # configuration file info
 my $lastlog;                           # last string that was logged
-use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children %usedmaximaports $status
+
+use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
 	    $pidfile $port %perlvar $lastlog);
  
 # ------------------------------------------------------------ Service routines 
@@ -65,7 +62,6 @@ sub REAPER {                        # ta
     $SIG{CHLD} = \&REAPER;
     my $pid = wait;
     $children--;
-    delete($usedmaximaports{$children{$pid}});
     delete($children{$pid});
 }
  
@@ -130,17 +126,7 @@ sub catchexception {
     die("Signal abend");
 }
 
-# -------------------------------------------------- make a socket non-blocking
-sub nonblock {
-    my $socket = shift;
-    my $flags;
-    if (ref($socket)) { 
-       $flags = fcntl($socket, F_GETFL, 0)
-            or die "Can't get flags for socket: $!\n";
-       fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
-            or die "Can't make socket nonblocking: $!\n";
-    }
-}
+
 
 # ---------------------------------------------------------------- Main program
 # -------------------------------- Set signal handlers to record abnormal exits
@@ -217,12 +203,10 @@ close(PIDSAVE);
 # Install signal handlers.
 $SIG{CHLD} = \&REAPER;
 $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
-
-my $maximaport=$STARTPORT; 
+ 
 # Fork off our children.
 for (1 .. $PREFORK) {
-    &make_new_child($server,$maximaport);
-    $maximaport++;
+    &make_new_child($server);
 }
  
 # And maintain the population.
@@ -231,16 +215,12 @@ while (1) {
     sleep;                          # wait for a signal (i.e., child's death)
     for (my $i = $children; $i < $PREFORK; $i++) {
         &status('Parent process, starting child');
-        my $newport;
-        foreach $newport ($STARTPORT .. $STARTPORT+$PREFORK-1) {
-            if (!defined($usedmaximaports{$newport})) { last; }
-        }
-        &make_new_child($server,$newport);           # top up the child pool
+        &make_new_child($server);           # top up the child pool
     }
 }
                                                                                 
 sub make_new_child {
-    my ($server,$maximaport) = @_;
+    my ($server) = @_;
 
     # block signal for fork
     my $sigset = POSIX::SigSet->new(SIGINT);
@@ -253,7 +233,7 @@ sub make_new_child {
         # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)
             or die("Can't unblock SIGINT for fork: $!\n");
-        $children{$pid} = $maximaport;
+        $children{$pid} = 1;
         $children++;
         return;
     } else {
@@ -263,48 +243,38 @@ sub make_new_child {
         # unblock signals
         sigprocmask(SIG_UNBLOCK, $sigset)
             or die("Can't unblock SIGINT for fork: $!\n");
-        
-        # open the MAXIMA port
-        my $maximaserver = IO::Socket::INET->new(LocalPort => $maximaport,
-                                              Type      => SOCK_STREAM,
-                                              Proto     => 'tcp',
-                                              Reuse     => 1,
-                                              Listen    => 10 )
-                        or die "making socket: $@\n";
-        &nonblock($maximaserver);
-        my $maximaselect=IO::Select->new($maximaserver);
-
-        # open MAXIMA to talk to that port
-        my ($cmd_in, $cmd_out, $cmd_err);
-        my $maximapid = open3($cmd_in, $cmd_out, $cmd_err, "maxima -s $maximaport");
-        $children{$maximapid} = 1;
-        my $prompt=<$cmd_out>;
-        &logthis("Maxima $maximapid: $prompt");
-
-        # hopefully, MAXIMA calls us back
-        &status("Waiting $maximapid on $maximaport");
-        my $maximaclient=$maximaserver->accept();
-        $maximaselect->add($maximaclient);
-        &nonblock($maximaclient);
-        &status("$maximapid on $maximaport connected.");
-        &logthis("Maxima $maximapid on port $maximaport connected.");
-        &logthis('Initial reply: '.&maximareply($maximaselect));
-        # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
+
+        &logthis('New process started');
+
+        my $command=Expect->spawn('maxima');
+        $command->log_stdout(0);
+
+        &getmaximaoutput($command);
+
         for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
-            &status('Accepting connections for '.$maximapid.' on '.$maximaport);
-            my $client = $server->accept()     or last;
-            while (my $cmd=<$client>) {
-                &status('Processing command by '.$maximapid.' on '.$maximaport);
-                print $maximaclient &unescape($cmd).";\n";
-                print $client &escape(&maximareply($maximaselect))."\n";
-            }
+           &status('Accepting connections');
+           my $client = $server->accept()     or last;
+           print $command "kill(all);reset();\n";
+           &sync($command);
+           while (my $cmd=<$client>) {
+              &status('Processing command');
+              print $command &unescape($cmd);
+              my $reply=&getmaximaoutput($command);
+              print $client &escape($reply)."\n";
+              if ($reply=~/^Error\:/) {
+                 &logthis('Died through '.$reply);
+                 $client->close();
+                 $command->hard_close();     
+                 exit;
+              }	      
+	      &sync($command);
+              &status('Waiting for commands');
+           }
         }
 
         # tidy up gracefully and finish
 
-        if (ref($cmd_out)) { close($cmd_out); }
-        if (ref($cmd_err)) { close($cmd_err); }
-        if (ref($cmd_in)) { close($cmd_in); }
+        $command->soft_close();
 
         # this exit is VERY important, otherwise the child will become
         # a producer of more and more children, forking yourself into
@@ -313,14 +283,39 @@ sub make_new_child {
     }
 }
 
-sub maximareply {
-   my ($maximaselect)=@_;
-   my $output='';
-   foreach my $ready ($maximaselect->can_read(1)) {
-       my $data = '';
-       my $rv   = $ready->recv($data, POSIX::BUFSIZ, 0);
-       $output.=$data;
-   }
-   return $output;
+{
+    my $counter;
+    sub sync {
+	my ($command)=@_;
+	$counter++;
+	my $expect=$counter.time;
+	print $command "$expect;\n";
+	while (1) {
+	    my $output=&getmaximaoutput($command);
+	    if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
+		return;
+	    }
+	}
+    }
 }
 
+sub getmaximaoutput {
+    my ($command)=@_;
+    my (undef,$error,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)');
+    if ($error) {
+       return 'Error: '.$error;
+    }
+    my $foundoutput=0;
+    my $realoutput='';
+    foreach my $line (split(/\n/,$output)) {
+       if ($line=~/\;/) { $foundoutput=1; next; }
+       if (!$foundoutput) { next; }
+       my ($label)=($line=~s/^(\(\%o\d+\))//);
+       if ($label) {
+          $label=~s/\S/ /g;
+          $line=$label.$line;
+       }
+       $realoutput.=$line."\n";
+    }
+    return $realoutput;
+}