--- loncom/lonsql 2000/05/08 15:14:27 1.1 +++ loncom/lonsql 2000/06/26 02:42:42 1.2 @@ -1,35 +1,21 @@ #!/usr/bin/perl +# lonsql-based on the preforker:harsha jagasia:date:5/10/00 -# 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 Symbol; +use POSIX; 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 +$run =0;#running counter to generate the query-id +# ------------------------------------ Read httpd access.conf and get variables open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; while ($configline=) { @@ -42,7 +28,7 @@ while ($configline=) { close(CONFIG); # ------------------------------------------------------------- Read hosts file -#$PREFORK=4; # number of children to maintain, at least four spare +$PREFORK=4; # number of children to maintain, at least four spare open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; @@ -50,44 +36,37 @@ while ($configline=) { my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); chomp($ip); - #$hostip{$ip}=$id; - $hostip{$id}=$ip; + $hostip{$ip}=$id; if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } - #$PREFORK++; + $PREFORK++; } close(CONFIG); +$unixsock = "mysqlsock"; +my $localfile="$perlvar{'lonSockDir'}/$unixsock"; +my $server; +unlink ($localfile); +unless ($server=IO::Socket::UNIX->new(Local =>"$localfile", + Type => SOCK_STREAM, + Listen => 10)) +{ + print "in socket error:$@\n"; +} # -------------------------------------------------------- Routines for forking # global variables -#$MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process +$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 - +$children = 0; # current number of children 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("CRITICAL: " - ."Child $pid for server $wasserver died ($childatt{$wasserver})"); + $children --; + &logthis("Child $pid died"); delete $children{$pid}; - delete $childpid{$wasserver}; - my $port = "$perlvar{'lonSockDir'}/$wasserver"; - unlink($port); - - } sub HUNTSMAN { # signal handler for SIGINT @@ -96,6 +75,9 @@ sub HUNTSMAN { # si my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonsql.pid"); &logthis("CRITICAL: Shutting down"); + $unixsock = "mysqlsock"; + my $port="$perlvar{'lonSockDir'}/$unixsock"; + unlink(port); exit; # clean up with dignity } @@ -105,85 +87,20 @@ sub HUPSMAN { # sig close($server); # free up socket &logthis("CRITICAL: Restarting"); my $execdir=$perlvar{'lonDaemons'}; + $unixsock = "mysqlsock"; + my $port="$perlvar{'lonSockDir'}/$unixsock"; + unlink(port); 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 $fh=IO::File->new(">>$execdir/logs/lonsqlfinal.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( - "WARNING: $peerfile still not there, giving up"); - } else { - &logthis( - "CRITICAL: " - ."lonc at pid $loncpid not responding, giving up"); - } - } else { - &logthis('CRITICAL: lonc not running, giving up'); - } -} - -# -------------------------------------------------- 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; @@ -201,21 +118,13 @@ close(PIDSAVE); # ----------------------------- 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); +# ------------------------------------------------------- Now we are on our own +# Fork off our children. +for (1 .. $PREFORK) { + make_new_child(); } -&logthis("Done starting initial servers"); -# ----------------------------------------------------- Install signal handlers - +# Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; $SIG{HUP} = \&HUPSMAN; @@ -223,38 +132,23 @@ $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( - "INFO: Trying to reconnect for $thisserver " - ."($childatt{$thisserver} of $childmaxattempts attempts)"); - make_new_child($thisserver); - } - } + for ($i = $children; $i < $PREFORK; $i++) { + make_new_child(); # top up the child pool } } + 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 - + die "fork: $!" unless defined ($pid = fork); + if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) @@ -263,80 +157,108 @@ sub make_new_child { $children++; return; } else { - # Child can *not* return from this subroutine. + # 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 + + + #open database handle + # making dbh global to avoid garbage collector unless ( - my $dbh = DBI->connect("DBI:mysql:loncapa","root","mysql",{ RaiseError =>1,}) + $dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>1,}) ) { my $st=120+int(rand(240)); &logthis("WARNING: Couldn't connect to database ($st secs): $@"); + print "database handle error\n"; sleep($st); - exit;#do I need to cleanup before exit if can't connect to database - }; - + exit; + + }; + # make sure that a database disconnection occurs with ending kill signals + $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT; + # 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); - - } -# ============================================================================= + $run = $run+1; + my $userinput = <$client>; + chomp($userinput); + + my ($conserver,$query)=split(/&/,$userinput); + + #send query id which is pid_unixdatetime_runningcounter + $queryid = $thisserver; + $queryid .="_".($$)."_"; + $queryid .= time."_"; + $queryid .= $run; + print $client "$queryid\n"; + + #prepare and execute the query +# my $sth = $dbh->prepare($query); +# unless ($sth->execute()) +# { +# &logthis( +# "WARNING: Could not retrieve from database: $@" +# ); +# } +# my $result=$sth->fetch(???); + $result="123"; + &reply("queryreply:$queryid:$result",$conserver); + } # tidy up gracefully and finish + + #close the database handle + $dbh->disconnect + or &logthis("WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@"); # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death. exit; } -} - - - - - - - - - +} +sub DISCONNECT { + $dbh->disconnect or + &logthis("WARNING: Couldn't disconnect from database $DBI::errstr ($st secs): $@"); + exit; +} +# -------------------------------------------------- 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); + $answer=subreply($cmd,$server); + } + } else { + $answer='self_reply'; + } + return $answer; +}