#!/usr/bin/perl
#
# The LearningOnline Network with CAPA
# Connect to MAXIMA CAS
#
# $Id: lonmaxima,v 1.2 2006/03/03 22:35:09 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#

# 
# http://www.lon-capa.org/
#

# global variables
$PREFORK                = 5;        # number of children to maintain
$MAX_CLIENTS_PER_CHILD  = 5;        # number of clients each child should process
%children               = ();       # keys are current child process IDs
$children               = 0;        # current number of children
 
use IPC::Open3;
use IO::Select;
use IO::Socket;
use IO::File;
use Symbol;
use POSIX;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
 
# Scary: cannot use strict!!!
##### use strict;
 
sub maximareply {
    my $cmd=shift;
    my $reply='';
    my $error='';
    my $exitstatus='';

    unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }
    my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
    $children{$pid} = 1;
    
    print $cmd_in $cmd;
    close $cmd_in;

    &status("Command sent");

    my $selector = IO::Select->new();
    $selector->add($cmd_err, $cmd_out);
    
    while (my @ready = $selector->can_read) {
	foreach my $fh (@ready) {
	    if (fileno($fh) == fileno($cmd_err)) {
		$error.=<$cmd_err>;
	    } else {
		my $line = scalar <$cmd_out>;
                if ($line=~/^(\(\%o|\s)/) {
                   $line=~s/^\(.*\)/     /; 
                   $reply.=$line; 
	       }
	    }
	    $selector->remove($fh) if eof($fh);
	}
    }
    close $cmd_out;
    close $cmd_err;
    &status("Command processed");
    return ($reply,$error,$exitstatus);
}
 
# ------------------------------------------------------------ Service routines 
sub REAPER {                        # takes care of dead children 
                                    # and MAXIMA processes
    $SIG{CHLD} = \&REAPER;
    my $pid = wait;
    $children --;
    delete $children{$pid};
}
 
sub HUNTSMAN {                      # signal handler for SIGINT
    local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
    kill 'INT' => keys %children;
    unlink($pidfile);
    unlink($port);
    &logthis('---- Shutdown ----');
    exit;                           # clean up with dignity
}


 
# --------------------------------------------------------------------- Logging
 
sub logthis {
    my $message=shift;
    my $execdir=$perlvar{'lonDaemons'};
    my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");
    my $now=time;
    my $local=localtime($now);
    $lastlog=$local.': '.$message;
    print $fh "$local ($$): $message\n";
}
 
# -------------------------------------------------------------- Status setting
 
sub status {
    my $what=shift;
    my $now=time;
    my $local=localtime($now);
    $status=$local.': '.$what;
    $0='lonmaxima: '.$what.' '.$local;
}
 
# -------------------------------------------------------- Escape Special Chars
 
sub escape {
    my $str=shift;
    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
    return $str;
}
 
# ----------------------------------------------------- Un-Escape Special Chars
 
sub unescape {
    my $str=shift;
    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    return $str;
}
 
# ------------------------ grabs exception and records it to log before exiting
sub catchexception {
    my ($signal)=@_;
    $SIG{QUIT}='DEFAULT';
    $SIG{__DIE__}='DEFAULT';
    chomp($signal);
    &logthis("<font color=red>CRITICAL: "
     ."ABNORMAL EXIT. Child $$ died through "
     ."\"$signal\"</font>");
    die("Signal abend");
}
 


# ---------------------------------------------------------------- Main program
# -------------------------------- Set signal handlers to record abnormal exits
 
 
$SIG{'QUIT'}=\&catchexception;
$SIG{__DIE__}=\&catchexception;
 
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf
&status("Read loncapa.conf and loncapa_apache.conf");
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
%perlvar=%{$perlvarref};
undef $perlvarref;
 
# ----------------------------- Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
   my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
   my $subj="LON: $currenthostid User ID mismatch";
   system("echo 'User ID mismatch.  lonmaxima must be run as user www.' |\
 mailto $emailto -s '$subj' > /dev/null");
   exit 1;
}
 
# --------------------------------------------- Check if other instance running
 
$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";
 
if (-e $pidfile) {
   my $lfh=IO::File->new("$pidfile");
   my $pide=<$lfh>;
   chomp($pide);
   if (kill 0 => $pide) { die "already running"; }
}
# ------------------------------------------------------- Listen to UNIX socket
&status("Opening socket");
 
$port = "$perlvar{'lonSockDir'}/maximasock";
 
unlink($port);
 

unless (
  $server = IO::Socket::UNIX->new(Local  => $port,
                                  Type   => SOCK_STREAM,
                                  Listen => 10 )
   ) {
       my $st=120+int(rand(240));
       &logthis(
         "<font color=blue>WARNING: ".
         "Can't make server socket ($st secs):  .. exiting</font>");
       sleep($st);
       exit;
     };
    
 
# ---------------------------------------------------- Fork once and dissociate
 
my $fpid=fork;
exit if $fpid;
die "Couldn't fork: $!" unless defined ($fpid);
 
POSIX::setsid() or die "Can't start new session: $!";
 
# ------------------------------------------------------- Write our PID on disk
 
my $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonmaxima.pid");
print PIDSAVE "$$\n";
close(PIDSAVE);
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
&status('Starting');
 
 


     
# Fork off our children.
for (1 .. $PREFORK) {
    make_new_child( );
}
 
# Install signal handlers.
$SIG{CHLD} = \&REAPER;
$SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
 
# And maintain the population.
while (1) {
    &status('Parent process, sleeping');
    sleep;                          # wait for a signal (i.e., child's death)
    for ($i = $children; $i < $PREFORK; $i++) {
        &status('Parent process, starting child');
        make_new_child( );           # top up the child pool
    }
}
                                                                                
sub make_new_child {
    my $pid;
    my $sigset;
     
    # block signal for fork
    $sigset = POSIX::SigSet->new(SIGINT);
    sigprocmask(SIG_BLOCK, $sigset)
        or die "Can't block SIGINT for fork: $!\n";
     
    die "fork: $!" unless defined ($pid = fork);
     
    if ($pid) {
        # Parent records the child's birth and returns.
        sigprocmask(SIG_UNBLOCK, $sigset)
            or die "Can't unblock SIGINT for fork: $!\n";
        $children{$pid} = 1;
        $children++;
        return;
    } else {
        # Child can *not* return from this subroutine.
        $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
     
        # unblock signals
        sigprocmask(SIG_UNBLOCK, $sigset)
            or die "Can't unblock SIGINT for fork: $!\n";
         
        # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
        for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
	    &status('Accepting connections');     
            $client = $server->accept( )     or last;
            while ($cmd=<$client>) {
		&status('Processing command');
		print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";
	    }
        }
     
        # tidy up gracefully and finish

        # this exit is VERY important, otherwise the child will become
        # a producer of more and more children, forking yourself into
        # process death.
        exit;
    }
}