Return to lonsql CVS log

Up to [LON-CAPA] / loncom

file for refereeing database/SQL processes

#!/usr/bin/perl

# The LearningOnline Network
# lonsql
# provides unix domain sockets to receive queries from lond and send replies to lonc
#
# PID in subdir logs/lonc.pid
# kill kills
# HUP restarts
# USR1 tries to open connections again

# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
# 10/8,10/9,10/15,11/18,12/22,
# 2/8 Gerd Kortemeyer 
# based on nonforker from Perl Cookbook
# - server who multiplexes without forking

use POSIX;
use IO::Socket;
use IO::Select;
use IO::File;
use Socket;
use Fcntl;
use Tie::RefHash;
use Crypt::IDEA;
use DBI;


$childmaxattempts=10;
$run =0;
# ------------------------------------ Read httpd access.conf and get variables

open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";

while ($configline=<CONFIG>) {
    if ($configline =~ /PerlSetVar/) {
	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
        chomp($varvalue);
        $perlvar{$varname}=$varvalue;
    }
}
close(CONFIG);

# ------------------------------------------------------------- Read hosts file
#$PREFORK=4; # number of children to maintain, at least four spare

open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";

while ($configline=<CONFIG>) {
    my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
    chomp($ip);

    #$hostip{$ip}=$id;
    $hostip{$id}=$ip;

    if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }

    #$PREFORK++;
}
close(CONFIG);


# -------------------------------------------------------- Routines for forking
# global variables
#$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
%childpid               = ();       # the other way around

%childatt               = ();       # number of attempts to start server
                                    # for ID


sub REAPER {                        # takes care of dead children
    $SIG{CHLD} = \&REAPER;
    my $pid = wait;

    #$children --;
    #&logthis("Child $pid died");
    #delete $children{$pid};
    
    my $wasserver=$children{$pid};
    &logthis("<font color=red>CRITICAL: "
     ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");
    delete $children{$pid};
    delete $childpid{$wasserver};
    my $port = "$perlvar{'lonSockDir'}/$wasserver";
    unlink($port);


}

sub HUNTSMAN {                      # signal handler for SIGINT
    local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
    kill 'INT' => keys %children;
    my $execdir=$perlvar{'lonDaemons'};
    unlink("$execdir/logs/lonsql.pid");
    &logthis("<font color=red>CRITICAL: Shutting down</font>");
    exit;                           # clean up with dignity
}

sub HUPSMAN {                      # signal handler for SIGHUP
    local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
    kill 'INT' => keys %children;
    close($server);                # free up socket
    &logthis("<font color=red>CRITICAL: Restarting</font>");
    my $execdir=$perlvar{'lonDaemons'};
    exec("$execdir/lonsql");         # here we go again
}

sub logthis {
    my $message=shift;
    my $execdir=$perlvar{'lonDaemons'};
    my $fh=IO::File->new(">>$execdir/logs/lonsql.log");
    my $now=time;
    my $local=localtime($now);
    print $fh "$local ($$): $message\n";
}

# ----------------------------------------------------------- Send USR1 to lonc
sub reconlonc {
    my $peerfile=shift;
    &logthis("Trying to reconnect for $peerfile");
    my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
    if (my $fh=IO::File->new("$loncfile")) {
	my $loncpid=<$fh>;
        chomp($loncpid);
        if (kill 0 => $loncpid) {
	    &logthis("lonc at pid $loncpid responding, sending USR1");
            kill USR1 => $loncpid;
            sleep 1;
            if (-e "$peerfile") { return; }
            &logthis("$peerfile still not there, give it another try");
            sleep 5;
            if (-e "$peerfile") { return; }
            &logthis(
 "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
        } else {
	    &logthis(
              "<font color=red>CRITICAL: "
             ."lonc at pid $loncpid not responding, giving up</font>");
        }
    } else {
      &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
    }
}

# -------------------------------------------------- Non-critical communication
sub subreply {
    my ($cmd,$server)=@_;
    my $peerfile="$perlvar{'lonSockDir'}/$server";
    my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                      Type    => SOCK_STREAM,
                                      Timeout => 10)
       or return "con_lost";
    print $sclient "$cmd\n";
    my $answer=<$sclient>;
    chomp($answer);
    if (!$answer) { $answer="con_lost"; }
    return $answer;
}

sub reply {
  my ($cmd,$server)=@_;
  my $answer;
  if ($server ne $perlvar{'lonHostID'}) { 
    $answer=subreply($cmd,$server);
    if ($answer eq 'con_lost') {
	$answer=subreply("ping",$server);
        if ($answer ne $server) {
           &reconlonc("$perlvar{'lonSockDir'}/$server");
        }
        $answer=subreply($cmd,$server);
    }
  } else {
    $answer='self_reply';
  } 
  return $answer;
}

$unixsock = "msua1_sql";
my $localfile="$perlvar{'lonSockDir'}/$unixsock";
my $server=IO::Socket::UNIX->new(LocalAddr    =>"$localfile",
				  Type    => SOCK_STREAM,
				  Timeout => 10);

# ---------------------------------------------------- Fork once and dissociate
$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

$execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonsql.pid");
print PIDSAVE "$$\n";
close(PIDSAVE);
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");

# ----------------------------- Ignore signals generated during initial startup
$SIG{HUP}=$SIG{USR1}='IGNORE';

# ------------------------------------------------------- Now we are on our own
#Fork of children one for every server

#for (1 .. $PREFORK) {
#    make_new_child($thisserver);
#}

foreach $thisserver (keys %hostip) { 
    make_new_child($thisserver);
}

&logthis("Done starting initial servers");
# ----------------------------------------------------- Install signal handlers

$SIG{CHLD} = \&REAPER;
$SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
$SIG{HUP}  = \&HUPSMAN;

# And maintain the population.
while (1) {
    sleep;                          # wait for a signal (i.e., child's death)

    #for ($i = $children; $i < $PREFORK; $i++) {
    #   make_new_child();           # top up the child pool
    #}
    
    foreach $thisserver (keys %hostip) {
        if (!$childpid{$thisserver}) {
	    if ($childatt{$thisserver}<=$childmaxattempts) {
	       $childatt{$thisserver}++;
               &logthis(
   "<font color=yellow>INFO: Trying to reconnect for $thisserver "
  ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
               make_new_child($thisserver);
	    }
        }       
    }
}

sub make_new_child {
    my $conserver=shift;
    my $pid;
    my $sigset;
    my $queryid;

    &logthis("Attempting to start child");    
    # 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);#do the forking of children
	
    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";

        #connect to the database
	unless (
		my $dbh = DBI->connect("DBI:mysql:loncapa","root","mysql",{ RaiseError =>1,})
		) { 
	            my $st=120+int(rand(240));
		    &logthis("<font color=blue>WARNING: Couldn't connect to database  ($st secs): $@</font>");
		    sleep($st);
		    exit;#do I need to cleanup before exit if can't connect to database 
		};
	
        # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
        for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
            $client = $server->accept()     or last;
	    $run = $run+1;
# =============================================================================
            # do something with the connection
# -----------------------------------------------------------------------------
	    my $userinput = "1";
	    #while (my $userinput=<$client>) {
	    while (my $userinput="1") {
	    print ("here we go\n");
		 chomp($userinput);
		 
		 #send query id which is pid_unixdatetime_runningcounter
		 $queryid = $conserver; 
		 $queryid .=($$)."_";
		 $queryid .= time."_";
		 $queryid .= run;
		 print $client "$queryid\n";

		 #prepare and execute the query
		 
		 my $sth = $dbh->prepare("select * into outfile \"$queryid\" from resource");#can't use $userinput directly since we the query to write to a file which depends on the query id generated 
		 
		 $sth->execute();
		 if (-e "$queryid") { print "Oops ,file is already there!\n";}
		 else
		 {
		     print "error reading into file\n";
		 }
		 
                 #connect to lonc and send the query results
		 $reply = reply($queryid,$conserver);
		  
	     }
# =============================================================================
        }
    
        # 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;
    }
}