--- loncom/Attic/lonc 2002/02/19 21:49:12 1.27 +++ 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.27 2002/02/19 21:49:12 www Exp $ +# $Id: lonc,v 1.29 2002/02/25 15:48:11 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,7 +44,7 @@ # 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer # 12/20 Scott Harrison # YEAR=2002 -# 2/19/02 +# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer # # based on nonforker from Perl Cookbook # - server who multiplexes without forking @@ -66,11 +66,12 @@ 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($@); } @@ -80,6 +81,7 @@ $childmaxattempts=5; sub online { my $host=shift; + &status("Pinging ".$host); my $p=Net::Ping->new("tcp",20); my $online=$p->ping("$host"); $p->close(); @@ -89,6 +91,7 @@ sub online { sub connected { my ($local,$remote)=@_; + &status("Checking connection $local to $remote"); $local=~s/\W//g; $remote=~s/\W//g; @@ -116,11 +119,12 @@ sub connected { # -------------------------------- Set signal handlers to record abnormal exits +&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=) { @@ -133,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'}"; @@ -160,8 +165,10 @@ open (CONFIG,"$perlvar{'lonTabDir'}/host while ($configline=) { my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); chomp($ip); - $hostip{$id}=$ip; - $hostname{$id}=$name; + if ($ip) { + $hostip{$id}=$ip; + $hostname{$id}=$name; + } } close(CONFIG); @@ -222,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'); } } @@ -271,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"; } @@ -310,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); @@ -318,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"; @@ -360,7 +367,8 @@ while (1) { $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( @@ -408,82 +416,9 @@ $port = "$perlvar{'lonSockDir'}/$conserv unlink($port); -# ---------------------------------------------------- Client to network server - -&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 +# -------------------------------------------------------------- Open other end -&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"); @@ -496,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); @@ -623,6 +558,8 @@ while (1) { 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"); @@ -648,7 +585,17 @@ 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); + } } + } } @@ -665,6 +612,15 @@ sub handle { # ============================================================= 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; @@ -739,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