--- loncom/Attic/lonc 2001/11/27 23:11:42 1.20 +++ loncom/Attic/lonc 2002/02/19 21:49:12 1.27 @@ -5,6 +5,30 @@ # provides persistent TCP connections to the other servers in the network # through multiplexed domain sockets # +# $Id: lonc,v 1.27 2002/02/19 21:49:12 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/ +# # PID in subdir logs/lonc.pid # kill kills # HUP restarts @@ -15,8 +39,12 @@ # 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 Gerd Kortemeyer +# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer +# 12/20 Scott Harrison +# YEAR=2002 +# 2/19/02 # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -29,6 +57,8 @@ use Socket; use Fcntl; use Tie::RefHash; use Crypt::IDEA; +use Net::Ping; +use LWP::UserAgent(); my $status=''; my $lastlog=''; @@ -46,9 +76,47 @@ sub catchexception { $childmaxattempts=5; +# -------------------------------------- Routines to see if other box available + +sub online { + my $host=shift; + my $p=Net::Ping->new("tcp",20); + my $online=$p->ping("$host"); + $p->close(); + undef ($p); + return $online; +} + +sub connected { + my ($local,$remote)=@_; + $local=~s/\W//g; + $remote=~s/\W//g; + + unless ($hostname{$local}) { return 'local_unknown'; } + unless ($hostname{$remote}) { return 'remote_unknown'; } + + unless (&online($hostname{$local})) { return 'local_offline'; } + + my $ua=new LWP::UserAgent; + + my $request=new HTTP::Request('GET', + "http://".$hostname{$local}.'/cgi-bin/ping.pl?'.$remote); + + my $response=$ua->request($request); + + unless ($response->is_success) { return 'local_error'; } + + my $reply=$response->content; + $reply=(split("\n",$reply))[0]; + $reply=~s/\W//g; + if ($reply ne $remote) { return $reply; } + return 'ok'; +} + + # -------------------------------- Set signal handlers to record abnormal exits -$SIG{'QUIT'}=\&catchexception; +$SIG{QUIT}=\&catchexception; $SIG{__DIE__}=\&catchexception; # ------------------------------------ Read httpd access.conf and get variables @@ -93,7 +161,9 @@ while ($configline=) { my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); chomp($ip); $hostip{$id}=$ip; + $hostname{$id}=$name; } + close(CONFIG); # -------------------------------------------------------- Routines for forking @@ -117,15 +187,19 @@ sub REAPER { # ta unlink($port); } -sub HUNTSMAN { # signal handler for SIGINT - local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - map { +sub hangup { + foreach (keys %children) { $wasserver=$children{$_}; &status("Closing $wasserver"); &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); &status("Kill PID $_ for $wasserver"); kill ('INT',$_); - } keys %children; + } +} + +sub HUNTSMAN { # signal handler for SIGINT + local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children + &hangup(); my $execdir=$perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); &logthis("CRITICAL: Shutting down"); @@ -134,13 +208,7 @@ sub HUNTSMAN { # si sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - map { - $wasserver=$children{$_}; - &status("Closing $wasserver"); - &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); - &status("Kill PID $_ for $wasserver"); - kill ('INT',$_); - } keys %children; + &hangup(); &logthis("CRITICAL: Restarting"); unlink("$execdir/logs/lonc.pid"); my $execdir=$perlvar{'lonDaemons'}; @@ -151,23 +219,17 @@ 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 { &logthis("USR1: Trying to establish connections again"); - foreach $thisserver (keys %hostip) { - $answer=subreply("ping",$thisserver); - &logthis("USR1: Ping $thisserver " - ."(pid >$childpid{$thisserver}<, $childatt{thisserver} attempts): " - ." >$answer<"); - } %childatt=(); &checkchildren(); } @@ -182,12 +244,14 @@ sub subreply { Type => SOCK_STREAM, Timeout => 10) or return "con_lost"; + + $SIG{ALRM}=sub { die "timeout" }; $SIG{__DIE__}='DEFAULT'; eval { alarm(10); print $sclient "$cmd\n"; - my $answer=<$sclient>; + $answer=<$sclient>; chomp($answer); alarm(0); }; @@ -270,7 +334,9 @@ $SIG{HUP}=$SIG{USR1}='IGNORE'; &status("Forking ..."); foreach $thisserver (keys %hostip) { - make_new_child($thisserver); + if (&online($hostname{$thisserver})) { + make_new_child($thisserver); + } } &logthis("Done starting initial servers"); @@ -289,13 +355,19 @@ while (1) { &status("Woke up"); foreach $thisserver (keys %hostip) { if (!$childpid{$thisserver}) { - if ($childatt{$thisserver}<$childmaxattempts) { + if (($childatt{$thisserver}<$childmaxattempts) && + (&online($hostname{$thisserver}))) { $childatt{$thisserver}++; &logthis( "INFO: Trying to reconnect for $thisserver " ."($childatt{$thisserver} of $childmaxattempts attempts)"); make_new_child($thisserver); - } + } else { + &logthis( + "INFO: Skipping $thisserver " + ."($childatt{$thisserver} of $childmaxattempts attempts)"); + } + } } } @@ -421,7 +493,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); @@ -462,7 +534,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"); @@ -667,3 +739,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