--- loncom/Attic/lonc 2002/02/06 14:17:50 1.23.2.1 +++ loncom/Attic/lonc 2002/02/25 15:48:11 1.29 @@ -5,7 +5,7 @@ # 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 $ +# $Id: lonc,v 1.29 2002/02/25 15:48:11 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,6 +43,8 @@ # 01/10/01 Scott Harrison # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer # 12/20 Scott Harrison +# YEAR=2002 +# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -55,6 +57,8 @@ use Socket; use Fcntl; use Tie::RefHash; use Crypt::IDEA; +use Net::Ping; +use LWP::UserAgent(); my $status=''; my $lastlog=''; @@ -62,23 +66,65 @@ my $lastlog=''; # grabs exception and records it to log before exiting sub catchexception { my ($signal)=@_; - $SIG{'QUIT'}='DEFAULT'; + $SIG{QUIT}='DEFAULT'; $SIG{__DIE__}='DEFAULT'; + chomp($signal); &logthis("CRITICAL: " - ."ABNORMAL EXIT. Child $$ for server $wasserver died through " - ."\"$signal\" with this parameter->[$@]"); + ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through " + ."\"$signal\" with parameter [$@]"); die($@); } $childmaxattempts=5; +# -------------------------------------- Routines to see if other box available + +sub online { + my $host=shift; + &status("Pinging ".$host); + my $p=Net::Ping->new("tcp",20); + my $online=$p->ping("$host"); + $p->close(); + undef ($p); + return $online; +} + +sub connected { + my ($local,$remote)=@_; + &status("Checking connection $local to $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; +&status("Init exception handlers"); +$SIG{QUIT}=\&catchexception; $SIG{__DIE__}=\&catchexception; # ------------------------------------ Read httpd access.conf and get variables - +&status("Read access.conf"); open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; while ($configline=) { @@ -91,6 +137,7 @@ while ($configline=) { close(CONFIG); # ----------------------------- Make sure this process is running from user=www +&status("Check user ID"); my $wwwid=getpwnam('www'); if ($wwwid!=$<) { $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; @@ -118,8 +165,12 @@ open (CONFIG,"$perlvar{'lonTabDir'}/host while ($configline=) { my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); chomp($ip); - $hostip{$id}=$ip; + if ($ip) { + $hostip{$id}=$ip; + $hostname{$id}=$name; + } } + close(CONFIG); # -------------------------------------------------------- Routines for forking @@ -143,8 +194,7 @@ sub REAPER { # ta unlink($port); } -sub HUNTSMAN { # signal handler for SIGINT - local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children +sub hangup { foreach (keys %children) { $wasserver=$children{$_}; &status("Closing $wasserver"); @@ -152,6 +202,11 @@ sub HUNTSMAN { # si &status("Kill PID $_ for $wasserver"); kill ('INT',$_); } +} + +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"); @@ -160,13 +215,7 @@ sub HUNTSMAN { # si sub HUPSMAN { # signal handler for SIGHUP local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children - foreach (keys %children) { - $wasserver=$children{$_}; - &status("Closing $wasserver"); - &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver)); - &status("Kill PID $_ for $wasserver"); - kill ('INT',$_); - } + &hangup(); &logthis("CRITICAL: Restarting"); unlink("$execdir/logs/lonc.pid"); my $execdir=$perlvar{'lonDaemons'}; @@ -180,7 +229,7 @@ sub checkchildren { foreach (sort keys %children) { sleep 1; unless (kill 'USR1' => $_) { - &logthis ('Child '.$_.' is dead'); + &logthis ('CRITICAL: Child '.$_.' is dead'); &logstatus($$.' is dead'); } } @@ -188,12 +237,6 @@ sub checkchildren { 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(); } @@ -235,7 +278,7 @@ sub logthis { my $now=time; my $local=localtime($now); $lastlog=$local.': '.$message; - print $fh "$local ($$): $message\n"; + print $fh "$local ($$) [$status]: $message\n"; } @@ -274,7 +317,7 @@ sub status { # ---------------------------------------------------- Fork once and dissociate - +&status("Fork and dissociate"); $fpid=fork; exit if $fpid; die "Couldn't fork: $!" unless defined ($fpid); @@ -282,7 +325,7 @@ die "Couldn't fork: $!" unless defined ( POSIX::setsid() or die "Can't start new session: $!"; # ------------------------------------------------------- Write our PID on disk - +&status("Write PID"); $execdir=$perlvar{'lonDaemons'}; open (PIDSAVE,">$execdir/logs/lonc.pid"); print PIDSAVE "$$\n"; @@ -298,7 +341,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"); @@ -317,13 +362,20 @@ 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)"); + ."(".($childatt{$thisserver}?$childatt{$thisserver}:'none'). + " of $childmaxattempts attempts)"); make_new_child($thisserver); - } + } else { + &logthis( + "INFO: Skipping $thisserver " + ."($childatt{$thisserver} of $childmaxattempts attempts)"); + } + } } } @@ -364,82 +416,9 @@ $port = "$perlvar{'lonSockDir'}/$conserv unlink($port); -# ---------------------------------------------------- Client to network server - -&status("Opening TCP: $conserver"); +# -------------------------------------------------------------- Open other end -unless ( - $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, - PeerPort => $perlvar{'londPort'}, - Proto => "tcp", - Type => SOCK_STREAM) - ) { - my $st=120+int(rand(240)); - &logthis( -"WARNING: Couldn't connect $conserver ($st secs): $@"); - sleep($st); - exit; - }; -# ----------------------------------------------------------------- Init dialog - -&status("Init dialogue: $conserver"); - - $SIG{ALRM}=sub { die "timeout" }; - $SIG{__DIE__}='DEFAULT'; - eval { - alarm(60); -print $remotesock "init\n"; -$answer=<$remotesock>; -print $remotesock "$answer"; -$answer=<$remotesock>; -chomp($answer); - alarm(0); - }; - $SIG{ALRM}='DEFAULT'; - $SIG{__DIE__}=\&catchexception; - - if ($@=~/timeout/) { - &logthis("Timed out during init: $conserver"); - exit; - } - - -&logthis("Init reply for $conserver: >$answer<"); -if ($answer ne 'ok') { - my $st=120+int(rand(240)); - &logthis( -"WARNING: Init failed $conserver ($st secs)"); - sleep($st); - exit; -} -sleep 5; -&status("Ponging $conserver"); -print $remotesock "pong\n"; -$answer=<$remotesock>; -chomp($answer); -&logthis("Pong reply for $conserver: >$answer<"); -# ----------------------------------------------------------- Initialize cipher - -&status("Initialize cipher: $conserver"); -print $remotesock "ekey\n"; -my $buildkey=<$remotesock>; -my $key=$conserver.$perlvar{'lonHostID'}; -$key=~tr/a-z/A-Z/; -$key=~tr/G-P/0-9/; -$key=~tr/Q-Z/0-9/; -$key=$key.$buildkey.$key.$buildkey.$key.$buildkey; -$key=substr($key,0,32); -my $cipherkey=pack("H32",$key); -if ($cipher=new IDEA $cipherkey) { - &logthis("Secure connection initialized: $conserver"); -} else { - my $st=120+int(rand(240)); - &logthis( - "WARNING: ". - "Could not establish secure connection, $conserver ($st secs)!"); - sleep($st); - exit; -} +&openremote($conserver); # ----------------------------------------- We're online, send delayed messages &status("Checking for delayed messages"); @@ -452,7 +431,7 @@ if ($cipher=new IDEA $cipherkey) { foreach (@allbuffered) { &status("Sending delayed $conserver $_"); $dfname="$path/$_"; - &logthis($dfname); + &logthis('Sending '.$dfname); my $wcmd; { my $dfh=IO::File->new($dfname); @@ -570,14 +549,17 @@ while (1) { # Any complete requests to process? foreach $client (keys %ready) { - handle($client,$conserver); + handle($client); } # 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 ($outbuffer{$client}=~/con_lost\n$/) { unless (defined $rv) { # Whine, but move on. &logthis("I was told I could write, but I can't.\n"); @@ -603,10 +585,20 @@ while (1) { close($client); next; } + } else { +# -------------------------------------------------------- Wow, connection lost + &logthis( + "CRITICAL: Closing connection $conserver"); + &status("Connection lost $conserver"); + $remotesock->shutdown(2); + &logthis("Attempting to open new connection"); + &openremote($conserver); + } } + } } -} + # ------------------------------------------------------- End of make_new_child # handle($socket) deals with all pending requests for $client @@ -614,13 +606,21 @@ sub handle { # requests are in $ready{$client} # send output to $outbuffer{$client} my $client = shift; - my $conserver = shift; my $request; foreach $request (@{$ready{$client}}) { # ============================================================= Process request # $request is the text of the request # put text of reply into $outbuffer{$client} +# ------------------------------------------------------------ Is this the end? + if ($request eq "close_connection_exit\n") { + &status("Request close connection: $conserver"); + &logthis( + "CRITICAL: Request Close Connection $conserver"); + $remotesock->shutdown(2); + $server->close(); + exit; + } # ----------------------------------------------------------------------------- if ($request =~ /^encrypt\:/) { my $cmd=$request; @@ -641,13 +641,10 @@ 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/) { @@ -678,13 +675,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 { @@ -698,6 +695,91 @@ sub nonblock { or die "Can't make socket nonblocking: $!\n"; } + +sub openremote { +# ---------------------------------------------------- Client to network server + + my $conserver=shift; + +&status("Opening TCP: $conserver"); + +unless ( + $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver}, + PeerPort => $perlvar{'londPort'}, + Proto => "tcp", + Type => SOCK_STREAM) + ) { + my $st=120+int(rand(240)); + &logthis( +"WARNING: Couldn't connect $conserver ($st secs): $@"); + sleep($st); + exit; + }; +# ----------------------------------------------------------------- Init dialog + +&status("Init dialogue: $conserver"); + + $SIG{ALRM}=sub { die "timeout" }; + $SIG{__DIE__}='DEFAULT'; + eval { + alarm(60); +print $remotesock "init\n"; +$answer=<$remotesock>; +print $remotesock "$answer"; +$answer=<$remotesock>; +chomp($answer); + alarm(0); + }; + $SIG{ALRM}='DEFAULT'; + $SIG{__DIE__}=\&catchexception; + + if ($@=~/timeout/) { + &logthis("Timed out during init: $conserver"); + exit; + } + +if ($answer ne 'ok') { + &logthis("Init reply for $conserver: >$answer<"); + my $st=120+int(rand(240)); + &logthis( +"WARNING: Init failed $conserver ($st secs)"); + sleep($st); + exit; +} + +sleep 5; +&status("Ponging $conserver"); +print $remotesock "pong\n"; +$answer=<$remotesock>; +chomp($answer); +if ($answer!~/^$converver/) { + &logthis("Pong reply for $conserver: >$answer<"); +} +# ----------------------------------------------------------- Initialize cipher + +&status("Initialize cipher: $conserver"); +print $remotesock "ekey\n"; +my $buildkey=<$remotesock>; +my $key=$conserver.$perlvar{'lonHostID'}; +$key=~tr/a-z/A-Z/; +$key=~tr/G-P/0-9/; +$key=~tr/Q-Z/0-9/; +$key=$key.$buildkey.$key.$buildkey.$key.$buildkey; +$key=substr($key,0,32); +my $cipherkey=pack("H32",$key); +if ($cipher=new IDEA $cipherkey) { + &logthis("Secure connection initialized: $conserver"); +} else { + my $st=120+int(rand(240)); + &logthis( + "WARNING: ". + "Could not establish secure connection, $conserver ($st secs)!"); + sleep($st); + exit; +} + +} + # ----------------------------------- POD (plain old documentation, CPAN style) =head1 NAME