--- loncom/Attic/lonc	2002/02/06 14:15:37	1.25
+++ 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.25 2002/02/06 14:15:37 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("<font color=red>CRITICAL: "
-     ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
-     ."\"$signal\" with this parameter->[$@]</font>");
+     ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
+     ."\"$signal\" with parameter [$@]</font>");
     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=<CONFIG>) {
@@ -91,6 +137,7 @@ while ($configline=<CONFIG>) {
 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=<CONFIG>) {
     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("<font color=red>CRITICAL: Shutting down</font>");
@@ -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("<font color=red>CRITICAL: Restarting</font>");
     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 ('<font color=red>CRITICAL: Child '.$_.' is dead</font>');
             &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(
    "<font color=yellow>INFO: Trying to reconnect for $thisserver "
-  ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
+  ."(".($childatt{$thisserver}?$childatt{$thisserver}:'none').
+   " of $childmaxattempts attempts)</font>"); 
                make_new_child($thisserver);
-	    }
+	   } else {
+               &logthis(
+   "<font color=yellow>INFO: Skipping $thisserver "
+  ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");
+           } 
+               
         }       
     }
 }
@@ -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(
-"<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");
-       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(
-"<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");
-       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(
-     "<font color=blue>WARNING: ".
-     "Could not establish secure connection, $conserver ($st secs)!</font>");
-   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);
@@ -579,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");
@@ -604,7 +585,17 @@ while (1) {
             close($client);
             next;
         }
+      } else {
+# -------------------------------------------------------- Wow, connection lost
+         &logthis(
+     "<font color=red>CRITICAL: Closing connection $conserver</font>");
+	 &status("Connection lost $conserver");
+         $remotesock->shutdown(2);
+         &logthis("Attempting to open new connection");
+         &openremote($conserver);          
+      }
     }
+   
 }
 }
 
@@ -621,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(
+     "<font color=red>CRITICAL: Request Close Connection $conserver</font>");
+           $remotesock->shutdown(2);
+           $server->close();
+           exit;
+        }
 # -----------------------------------------------------------------------------
         if ($request =~ /^encrypt\:/) {
 	    my $cmd=$request;
@@ -695,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(
+"<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");
+       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(
+"<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");
+       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(
+     "<font color=blue>WARNING: ".
+     "Could not establish secure connection, $conserver ($st secs)!</font>");
+   sleep($st);
+   exit;
+}
+
+}
+
 # ----------------------------------- POD (plain old documentation, CPAN style)
 
 =head1 NAME