--- loncom/Attic/lonc 2001/11/28 21:19:58 1.21 +++ loncom/Attic/lonc 2002/02/06 14:17:50 1.23.2.1 @@ -5,6 +5,30 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # +# $Id: lonc,v 1.23.2.1 2002/02/06 14:17:50 albertel 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/ +# # PID in subdir logs/lonc.pid # kill kills # HUP restarts @@ -15,8 +39,10 @@ # 2/8,7/25 Gerd Kortemeyer # 12/05 Scott Harrison # 12/05 Gerd Kortemeyer +# YEAR=2001 # 01/10/01 Scott Harrison # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer +# 12/20 Scott Harrison # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -119,13 +145,13 @@ sub REAPER { # ta sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - map { + foreach (keys %children) { $wasserver=$children{$_}; &status("Closing $wasserver"); &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); &status("Kill PID $_ for $wasserver"); kill ('INT',$_); - } keys %children; + } my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); &logthis("CRITICAL: Shutting down"); @@ -134,13 +160,13 @@ sub HUNTSMAN { # si sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - map { + foreach (keys %children) { $wasserver=$children{$_}; &status("Closing $wasserver"); &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); &status("Kill PID $_ for $wasserver"); kill ('INT',$_); - } keys %children; + } &logthis("CRITICAL: Restarting"); unlink("$execdir/logs/lonc.pid"); my $execdir=$perlvar{'lonDaemons'}; @@ -151,13 +177,13 @@ sub checkchildren { &initnewstatus(); &logstatus(); &logthis('Going to check on the children'); - map { + foreach (sort keys %children) { sleep 1; unless (kill 'USR1' => $_) { &logthis ('Child '.$_.' is dead'); &logstatus($$.' is dead'); } - } sort keys %children; + } } sub USRMAN { @@ -423,7 +449,7 @@ if ($cipher=new IDEA $cipherkey) { @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; closedir(DIRHANDLE); my $dfname; - map { + foreach (@allbuffered) { &status("Sending delayed $conserver $_"); $dfname="$path/$_"; &logthis($dfname); @@ -464,7 +490,7 @@ if ($cipher=new IDEA $cipherkey) { &logthis("Delayed $cmd to $conserver: >$answer<"); &logperm("S:$conserver:$bcmd"); } - } @allbuffered; + } # ------------------------------------------------------- Listen to UNIX socket &status("Opening socket $conserver"); @@ -544,14 +570,13 @@ while (1) { # Any complete requests to process? foreach $client (keys %ready) { - handle($client); + handle($client,$conserver); } # Buffers to flush? foreach $client ($select->can_write(1)) { # Skip this client if we have nothing to say next unless exists $outbuffer{$client}; - $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { # Whine, but move on. @@ -581,7 +606,7 @@ while (1) { } } } - +} # ------------------------------------------------------- End of make_new_child # handle($socket) deals with all pending requests for $client @@ -589,6 +614,7 @@ sub handle { # requests are in $ready{$client} # send output to $outbuffer{$client} my $client = shift; + my $conserver = shift; my $request; foreach $request (@{$ready{$client}}) { @@ -615,10 +641,13 @@ sub handle { eval { alarm(300); &status("Sending $conserver: $request"); + &logthis("Sending $conserver: $request"); print $remotesock "$request"; &status("Waiting for reply from $conserver: $request"); + &logthis("Waiting for reply from $conserver: $request"); $answer=<$remotesock>; &status("Received reply: $request"); + &logthis("Received reply $conserver: $answer"); alarm(0); }; if ($@=~/timeout/) { @@ -649,13 +678,13 @@ sub handle { } # ===================================================== Done processing request + &logthis("Completed $conserver: $request"); } delete $ready{$client}; &status("Completed $conserver: $request"); # -------------------------------------------------------------- End non-forker } # ---------------------------------------------------------- End make_new_child -} # nonblock($socket) puts socket into nonblocking mode sub nonblock { @@ -669,3 +698,50 @@ sub nonblock { or die "Can't make socket nonblocking: $!\n"; } +# ----------------------------------- POD (plain old documentation, CPAN style) + +=head1 NAME + +lonc - LON TCP-MySQL-Server Daemon for handling database requests. + +=head1 SYNOPSIS + +Should only be run as user=www. This is a command-line script which +is invoked by loncron. + +=head1 DESCRIPTION + +Provides persistent TCP connections to the other servers in the network +through multiplexed domain sockets + + PID in subdir logs/lonc.pid + kill kills + HUP restarts + USR1 tries to open connections again + +=head1 README + +Not yet written. + +=head1 PREREQUISITES + +POSIX +IO::Socket +IO::Select +IO::File +Socket +Fcntl +Tie::RefHash +Crypt::IDEA + +=head1 COREQUISITES + +=head1 OSNAMES + +linux + +=head1 SCRIPT CATEGORIES + +Server/Process + +=cut