[BACK]Return to lonc CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lonc between versions 1.29 and 1.31

version 1.29, 2002/02/25 15:48:11 version 1.31, 2002/03/03 18:13:07
Line 60  use Crypt::IDEA; Line 60  use Crypt::IDEA;
 use Net::Ping;  use Net::Ping;
 use LWP::UserAgent();  use LWP::UserAgent();
   
 my $status='';  $status='';
 my $lastlog='';  $lastlog='';
   $conserver='SHELL';
 # grabs exception and records it to log before exiting  
 sub catchexception {  
     my ($signal)=@_;  
     $SIG{QUIT}='DEFAULT';  
     $SIG{__DIE__}='DEFAULT';  
     chomp($signal);  
     &logthis("<font color=red>CRITICAL: "  
      ."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  # -------------------------------- Set signal handlers to record abnormal exits
   
Line 182  close(CONFIG); Line 129  close(CONFIG);
 %childatt               = ();       # number of attempts to start server  %childatt               = ();       # number of attempts to start server
                                     # for ID                                      # for ID
   
 sub REAPER {                        # takes care of dead children  $childmaxattempts=5;
     $SIG{CHLD} = \&REAPER;  
     my $pid = wait;  
     my $wasserver=$children{$pid};  
     &logthis("<font color=red>CRITICAL: "  
      ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");  
     delete $children{$pid};  
     delete $childpid{$wasserver};  
     my $port = "$perlvar{'lonSockDir'}/$wasserver";  
     unlink($port);  
 }  
   
 sub hangup {  
     foreach (keys %children) {  
         $wasserver=$children{$_};  
         &status("Closing $wasserver");  
         &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));  
         &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>");  
     exit;                           # clean up with dignity  
 }  
   
 sub HUPSMAN {                      # signal handler for SIGHUP  
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children  
     &hangup();  
     &logthis("<font color=red>CRITICAL: Restarting</font>");  
     unlink("$execdir/logs/lonc.pid");  
     my $execdir=$perlvar{'lonDaemons'};  
     exec("$execdir/lonc");         # here we go again  
 }  
   
 sub checkchildren {  
     &initnewstatus();  
     &logstatus();  
     &logthis('Going to check on the children');  
     foreach (sort keys %children) {  
  sleep 1;  
         unless (kill 'USR1' => $_) {  
     &logthis ('<font color=red>CRITICAL: Child '.$_.' is dead</font>');  
             &logstatus($$.' is dead');  
         }   
     }  
 }  
   
 sub USRMAN {  
     &logthis("USR1: Trying to establish connections again");  
     %childatt=();  
     &checkchildren();  
 }  
   
 # -------------------------------------------------- Non-critical communication  
 sub subreply {   
  my ($cmd,$server)=@_;  
  my $answer='';  
  if ($server ne $perlvar{'lonHostID'}) {   
     my $peerfile="$perlvar{'lonSockDir'}/$server";  
     my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",  
                                       Type    => SOCK_STREAM,  
                                       Timeout => 10)  
        or return "con_lost";  
   
   
     $SIG{ALRM}=sub { die "timeout" };  
     $SIG{__DIE__}='DEFAULT';  
     eval {  
      alarm(10);  
      print $sclient "$cmd\n";  
      $answer=<$sclient>;  
      chomp($answer);  
      alarm(0);  
     };  
     if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }  
     $SIG{ALRM}='DEFAULT';  
     $SIG{__DIE__}=\&catchexception;  
  } else { $answer='self_reply'; }  
  return $answer;  
 }  
   
 # --------------------------------------------------------------------- Logging  
   
 sub logthis {  
     my $message=shift;  
     my $execdir=$perlvar{'lonDaemons'};  
     my $fh=IO::File->new(">>$execdir/logs/lonc.log");  
     my $now=time;  
     my $local=localtime($now);  
     $lastlog=$local.': '.$message;  
     print $fh "$local ($$) [$status]: $message\n";  
 }  
   
   
 sub logperm {  
     my $message=shift;  
     my $execdir=$perlvar{'lonDaemons'};  
     my $now=time;  
     my $local=localtime($now);  
     my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");  
     print $fh "$now:$message:$local\n";  
 }  
 # ------------------------------------------------------------------ Log status  
   
 sub logstatus {  
     my $docdir=$perlvar{'lonDocRoot'};  
     my $fh=IO::File->new(">>$docdir/lon-status/loncstatus.txt");  
     print $fh $$."\t".$status."\t".$lastlog."\n";  
 }  
   
 sub initnewstatus {  
     my $docdir=$perlvar{'lonDocRoot'};  
     my $fh=IO::File->new(">$docdir/lon-status/loncstatus.txt");  
     my $now=time;  
     my $local=localtime($now);  
     print $fh "LONC status $local - parent $$\n\n";  
 }  
   
 # -------------------------------------------------------------- Status setting  
   
 sub status {  
     my $what=shift;  
     my $now=time;  
     my $local=localtime($now);  
     $status=$local.': '.$what;  
 }  
   
   
 # ---------------------------------------------------- Fork once and dissociate  # ---------------------------------------------------- Fork once and dissociate
 &status("Fork and dissociate");  &status("Fork and dissociate");
Line 324  die "Couldn't fork: $!" unless defined ( Line 139  die "Couldn't fork: $!" unless defined (
   
 POSIX::setsid() or die "Can't start new session: $!";  POSIX::setsid() or die "Can't start new session: $!";
   
   $conserver='PARENT';
   
 # ------------------------------------------------------- Write our PID on disk  # ------------------------------------------------------- Write our PID on disk
 &status("Write PID");  &status("Write PID");
 $execdir=$perlvar{'lonDaemons'};  $execdir=$perlvar{'lonDaemons'};
Line 360  while (1) { Line 177  while (1) {
     sleep;                          # wait for a signal (i.e., child's death)      sleep;                          # wait for a signal (i.e., child's death)
                                     # See who died and start new one                                      # See who died and start new one
     &status("Woke up");      &status("Woke up");
       my $skipping='';
     foreach $thisserver (keys %hostip) {      foreach $thisserver (keys %hostip) {
         if (!$childpid{$thisserver}) {          if (!$childpid{$thisserver}) {
     if (($childatt{$thisserver}<$childmaxattempts) &&      if (($childatt{$thisserver}<$childmaxattempts) &&
Line 367  while (1) { Line 185  while (1) {
        $childatt{$thisserver}++;         $childatt{$thisserver}++;
                &logthis(                 &logthis(
    "<font color=yellow>INFO: Trying to reconnect for $thisserver "     "<font color=yellow>INFO: Trying to reconnect for $thisserver "
   ."(".($childatt{$thisserver}?$childatt{$thisserver}:'none').    ."($childatt{$thisserver} of $childmaxattempts attempts)</font>"); 
    " of $childmaxattempts attempts)</font>");   
                make_new_child($thisserver);                 make_new_child($thisserver);
    } else {     } else {
                &logthis(                 $skipping.=$thisserver.' ';
    "<font color=yellow>INFO: Skipping $thisserver "  
   ."($childatt{$thisserver} of $childmaxattempts attempts)</font>");  
            }              } 
                                 
         }                 }       
     }      }
       if ($skipping) { 
          &logthis("<font color=blue>WARNING: Skipped $skipping</font>");
       }
 }  }
   
   
 sub make_new_child {  sub make_new_child {
         
     my $conserver=shift;      $newserver=shift;
     my $pid;      my $pid;
     my $sigset;      my $sigset;
     &logthis("Attempting to start child for server $conserver");      &logthis("Attempting to start child for server $newserver");
     # block signal for fork      # block signal for fork
     $sigset = POSIX::SigSet->new(SIGINT);      $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)      sigprocmask(SIG_BLOCK, $sigset)
Line 398  sub make_new_child { Line 216  sub make_new_child {
         # Parent records the child's birth and returns.          # Parent records the child's birth and returns.
         sigprocmask(SIG_UNBLOCK, $sigset)          sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $conserver;          $children{$pid} = $newserver;
         $childpid{$conserver} = $pid;          $childpid{$conserver} = $pid;
         return;          return;
     } else {      } else {
           $conserver=$newserver;
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
Line 429  unlink($port); Line 248  unlink($port);
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     my $dfname;      my $dfname;
     foreach (@allbuffered) {      foreach (@allbuffered) {
         &status("Sending delayed $conserver $_");          &status("Sending delayed: $_");
         $dfname="$path/$_";          $dfname="$path/$_";
         &logthis('Sending '.$dfname);          &logthis('Sending '.$dfname);
         my $wcmd;          my $wcmd;
Line 466  unlink($port); Line 285  unlink($port);
   
         if (($answer ne '') && ($@!~/timeout/)) {          if (($answer ne '') && ($@!~/timeout/)) {
     unlink("$dfname");      unlink("$dfname");
             &logthis("Delayed $cmd to $conserver: >$answer<");              &logthis("Delayed $cmd: >$answer<");
             &logperm("S:$conserver:$bcmd");              &logperm("S:$conserver:$bcmd");
         }                  }        
     }      }
   
 # ------------------------------------------------------- Listen to UNIX socket  # ------------------------------------------------------- Listen to UNIX socket
 &status("Opening socket $conserver");  &status("Opening socket");
 unless (  unless (
   $server = IO::Socket::UNIX->new(Local  => $port,    $server = IO::Socket::UNIX->new(Local  => $port,
                                   Type   => SOCK_STREAM,                                    Type   => SOCK_STREAM,
Line 481  unless ( Line 300  unless (
        my $st=120+int(rand(240));         my $st=120+int(rand(240));
        &logthis(         &logthis(
          "<font color=blue>WARNING: ".           "<font color=blue>WARNING: ".
          "Can't make server socket $conserver ($st secs): $@</font>");           "Can't make server socket ($st secs): $@</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
Line 529  while (1) { Line 348  while (1) {
                 delete $outbuffer{$client};                  delete $outbuffer{$client};
                 delete $ready{$client};                  delete $ready{$client};
   
                 &status("Idle $conserver");                  &status("Idle");
                 $select->remove($client);                  $select->remove($client);
                 close $client;                  close $client;
                 next;                  next;
Line 559  while (1) { Line 378  while (1) {
   
         $rv = $client->send($outbuffer{$client}, 0);          $rv = $client->send($outbuffer{$client}, 0);
   
       unless ($outbuffer{$client}=~/con_lost\n$/) {        unless ($outbuffer{$client} eq "con_lost\n") {
         unless (defined $rv) {          unless (defined $rv) {
             # Whine, but move on.              # Whine, but move on.
             &logthis("I was told I could write, but I can't.\n");              &logthis("I was told I could write, but I can't.\n");
Line 588  while (1) { Line 407  while (1) {
       } else {        } else {
 # -------------------------------------------------------- Wow, connection lost  # -------------------------------------------------------- Wow, connection lost
          &logthis(           &logthis(
      "<font color=red>CRITICAL: Closing connection $conserver</font>");       "<font color=red>CRITICAL: Closing connection</font>");
  &status("Connection lost $conserver");   &status("Connection lost");
          $remotesock->shutdown(2);           $remotesock->shutdown(2);
          &logthis("Attempting to open new connection");           &logthis("Attempting to open new connection");
          &openremote($conserver);                     &openremote($conserver);          
Line 614  sub handle { Line 433  sub handle {
         # put text of reply into $outbuffer{$client}          # put text of reply into $outbuffer{$client}
 # ------------------------------------------------------------ Is this the end?  # ------------------------------------------------------------ Is this the end?
         if ($request eq "close_connection_exit\n") {          if ($request eq "close_connection_exit\n") {
     &status("Request close connection: $conserver");      &status("Request close connection");
            &logthis(             &logthis(
      "<font color=red>CRITICAL: Request Close Connection $conserver</font>");       "<font color=red>CRITICAL: Request Close Connection</font>");
            $remotesock->shutdown(2);             $remotesock->shutdown(2);
            $server->close();             $server->close();
            exit;             exit;
Line 640  sub handle { Line 459  sub handle {
     $SIG{__DIE__}='DEFAULT';      $SIG{__DIE__}='DEFAULT';
     eval {      eval {
         alarm(300);          alarm(300);
         &status("Sending $conserver: $request");          &status("Sending: $request");
         print $remotesock "$request";          print $remotesock "$request";
         &status("Waiting for reply from $conserver: $request");          &status("Waiting for reply from $conserver: $request");
         $answer=<$remotesock>;          $answer=<$remotesock>;
Line 650  sub handle { Line 469  sub handle {
     if ($@=~/timeout/) {       if ($@=~/timeout/) { 
        $answer='';         $answer='';
        &logthis(         &logthis(
         "<font color=red>CRITICAL: Timeout $conserver: $request</font>");          "<font color=red>CRITICAL: Timeout: $request</font>");
     }        }  
     $SIG{ALRM}='DEFAULT';      $SIG{ALRM}='DEFAULT';
     $SIG{__DIE__}=\&catchexception;      $SIG{__DIE__}=\&catchexception;
Line 674  sub handle { Line 493  sub handle {
            $outbuffer{$client} .= "con_lost\n";             $outbuffer{$client} .= "con_lost\n";
         }          }
   
        &status("Completed: $request");
   
 # ===================================================== Done processing request  # ===================================================== Done processing request
     }      }
     delete $ready{$client};      delete $ready{$client};
     &status("Completed $conserver: $request");  
 # -------------------------------------------------------------- End non-forker  # -------------------------------------------------------------- End non-forker
 }  }
 # ---------------------------------------------------------- End make_new_child  # ---------------------------------------------------------- End make_new_child
Line 701  sub openremote { Line 521  sub openremote {
   
     my $conserver=shift;      my $conserver=shift;
   
 &status("Opening TCP: $conserver");  &status("Opening TCP");
   
 unless (  unless (
   $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},    $remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
Line 711  unless ( Line 531  unless (
    ) {      ) { 
        my $st=120+int(rand(240));         my $st=120+int(rand(240));
        &logthis(         &logthis(
 "<font color=blue>WARNING: Couldn't connect $conserver ($st secs): $@</font>");  "<font color=blue>WARNING: Couldn't connect ($st secs): $@</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
Line 734  chomp($answer); Line 554  chomp($answer);
      $SIG{__DIE__}=\&catchexception;       $SIG{__DIE__}=\&catchexception;
     
      if ($@=~/timeout/) {       if ($@=~/timeout/) {
  &logthis("Timed out during init: $conserver");   &logthis("Timed out during init");
          exit;           exit;
      }       }
   
 if ($answer ne 'ok') {  if ($answer ne 'ok') {
        &logthis("Init reply for $conserver: >$answer<");         &logthis("Init reply: >$answer<");
        my $st=120+int(rand(240));         my $st=120+int(rand(240));
        &logthis(         &logthis(
 "<font color=blue>WARNING: Init failed $conserver ($st secs)</font>");  "<font color=blue>WARNING: Init failed ($st secs)</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
 }  }
   
 sleep 5;  sleep 5;
 &status("Ponging $conserver");  &status("Ponging");
 print $remotesock "pong\n";  print $remotesock "pong\n";
 $answer=<$remotesock>;  $answer=<$remotesock>;
 chomp($answer);  chomp($answer);
 if ($answer!~/^$converver/) {  if ($answer!~/^$conserver/) {
    &logthis("Pong reply for $conserver: >$answer<");     &logthis("Pong reply: >$answer<");
 }  }
 # ----------------------------------------------------------- Initialize cipher  # ----------------------------------------------------------- Initialize cipher
   
 &status("Initialize cipher: $conserver");  &status("Initialize cipher");
 print $remotesock "ekey\n";  print $remotesock "ekey\n";
 my $buildkey=<$remotesock>;  my $buildkey=<$remotesock>;
 my $key=$conserver.$perlvar{'lonHostID'};  my $key=$conserver.$perlvar{'lonHostID'};
Line 768  $key=$key.$buildkey.$key.$buildkey.$key. Line 588  $key=$key.$buildkey.$key.$buildkey.$key.
 $key=substr($key,0,32);  $key=substr($key,0,32);
 my $cipherkey=pack("H32",$key);  my $cipherkey=pack("H32",$key);
 if ($cipher=new IDEA $cipherkey) {  if ($cipher=new IDEA $cipherkey) {
    &logthis("Secure connection initialized: $conserver");     &logthis("Secure connection initialized");
 } else {  } else {
    my $st=120+int(rand(240));     my $st=120+int(rand(240));
    &logthis(     &logthis(
      "<font color=blue>WARNING: ".       "<font color=blue>WARNING: ".
      "Could not establish secure connection, $conserver ($st secs)!</font>");       "Could not establish secure connection ($st secs)!</font>");
    sleep($st);     sleep($st);
    exit;     exit;
 }  }
   
 }  }
   
   
   
   # grabs exception and records it to log before exiting
   sub catchexception {
       my ($signal)=@_;
       $SIG{QUIT}='DEFAULT';
       $SIG{__DIE__}='DEFAULT';
       chomp($signal);
       &logthis("<font color=red>CRITICAL: "
        ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
        ."\"$signal\" with parameter [$@]</font>");
       die($@);
   }
   
   # -------------------------------------- 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';
   }
   
   
   sub REAPER {                        # takes care of dead children
       $SIG{CHLD} = \&REAPER;
       my $pid = wait;
       my $wasserver=$children{$pid};
       &logthis("<font color=red>CRITICAL: "
        ."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");
       delete $children{$pid};
       delete $childpid{$wasserver};
       my $port = "$perlvar{'lonSockDir'}/$wasserver";
       unlink($port);
   }
   
   sub hangup {
       foreach (keys %children) {
           $wasserver=$children{$_};
           &status("Closing $wasserver");
           &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
           &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>");
       exit;                           # clean up with dignity
   }
   
   sub HUPSMAN {                      # signal handler for SIGHUP
       local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
       &hangup();
       &logthis("<font color=red>CRITICAL: Restarting</font>");
       unlink("$execdir/logs/lonc.pid");
       my $execdir=$perlvar{'lonDaemons'};
       exec("$execdir/lonc");         # here we go again
   }
   
   sub checkchildren {
       &initnewstatus();
       &logstatus();
       &logthis('Going to check on the children');
       foreach (sort keys %children) {
    sleep 1;
           unless (kill 'USR1' => $_) {
       &logthis ('<font color=red>CRITICAL: Child '.$_.' is dead</font>');
               &logstatus($$.' is dead');
           } 
       }
   }
   
   sub USRMAN {
       &logthis("USR1: Trying to establish connections again");
       %childatt=();
       &checkchildren();
   }
   
   # -------------------------------------------------- Non-critical communication
   sub subreply { 
    my ($cmd,$server)=@_;
    my $answer='';
    if ($server ne $perlvar{'lonHostID'}) { 
       my $peerfile="$perlvar{'lonSockDir'}/$server";
       my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                         Type    => SOCK_STREAM,
                                         Timeout => 10)
          or return "con_lost";
   
   
       $SIG{ALRM}=sub { die "timeout" };
       $SIG{__DIE__}='DEFAULT';
       eval {
        alarm(10);
        print $sclient "$cmd\n";
        $answer=<$sclient>;
        chomp($answer);
        alarm(0);
       };
       if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }
       $SIG{ALRM}='DEFAULT';
       $SIG{__DIE__}=\&catchexception;
    } else { $answer='self_reply'; }
    return $answer;
   }
   
   # --------------------------------------------------------------------- Logging
   
   sub logthis {
       my $message=shift;
       my $execdir=$perlvar{'lonDaemons'};
       my $fh=IO::File->new(">>$execdir/logs/lonc.log");
       my $now=time;
       my $local=localtime($now);
       $lastlog=$local.': '.$message;
       print $fh "$local ($$) [$conserver] [$status]: $message\n";
   }
   
   
   sub logperm {
       my $message=shift;
       my $execdir=$perlvar{'lonDaemons'};
       my $now=time;
       my $local=localtime($now);
       my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
       print $fh "$now:$message:$local\n";
   }
   # ------------------------------------------------------------------ Log status
   
   sub logstatus {
       my $docdir=$perlvar{'lonDocRoot'};
       my $fh=IO::File->new(">>$docdir/lon-status/loncstatus.txt");
       print $fh $$."\t".$conserver."\t".$status."\t".$lastlog."\n";
   }
   
   sub initnewstatus {
       my $docdir=$perlvar{'lonDocRoot'};
       my $fh=IO::File->new(">$docdir/lon-status/loncstatus.txt");
       my $now=time;
       my $local=localtime($now);
       print $fh "LONC status $local - parent $$\n\n";
   }
   
   # -------------------------------------------------------------- Status setting
   
   sub status {
       my $what=shift;
       my $now=time;
       my $local=localtime($now);
       $status=$local.': '.$what;
   }
   
   
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Line 788  lonc - LON TCP-MySQL-Server Daemon for h Line 797  lonc - LON TCP-MySQL-Server Daemon for h
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
   Usage: B<lonc>
   
 Should only be run as user=www.  This is a command-line script which  Should only be run as user=www.  This is a command-line script which
 is invoked by loncron.  is invoked by B<loncron>.  There is no expectation that a typical user
   will manually start B<lonc> from the command-line.  (In other words,
   DO NOT START B<lonc> YOURSELF.)
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Provides persistent TCP connections to the other servers in the network  Provides persistent TCP connections to the other servers in the network
 through multiplexed domain sockets  through multiplexed domain sockets
   
  PID in subdir logs/lonc.pid  B<lonc> forks off children processes that correspond to the other servers
  kill kills  in the network.  Management of these processes can be done at the
  HUP restarts  parent process level or the child process level.
  USR1 tries to open connections again  
   B<logs/lonc.log> is the location of log messages.
   
   The process management is now explained in terms of linux shell commands,
   subroutines internal to this code, and signal assignments:
   
   =over 4
   
   =item *
   
   PID is stored in B<logs/lonc.pid>
   
   This is the process id number of the parent B<lonc> process.
   
   =item *
   
   SIGTERM and SIGINT
   
   Parent signal assignment:
    $SIG{INT}  = $SIG{TERM} = \&HUNTSMAN;
   
   Child signal assignment:
    $SIG{INT}  = 'DEFAULT'; (and SIGTERM is DEFAULT also)
   (The child dies and a SIGALRM is sent to parent, awaking parent from slumber
    to restart a new child.)
   
   Command-line invocations:
    B<kill> B<-s> SIGTERM I<PID>
    B<kill> B<-s> SIGINT I<PID>
   
   Subroutine B<HUNTSMAN>:
    This is only invoked for the B<lonc> parent I<PID>.
   This kills all the children, and then the parent.
   The B<lonc.pid> file is cleared.
   
   =item *
   
   SIGHUP
   
   Current bug:
    This signal can only be processed the first time
   on the parent process.  Subsequent SIGHUP signals
   have no effect.
   
   Parent signal assignment:
    $SIG{HUP}  = \&HUPSMAN;
   
   Child signal assignment:
    none (nothing happens)
   
   Command-line invocations:
    B<kill> B<-s> SIGHUP I<PID>
   
   Subroutine B<HUPSMAN>:
    This is only invoked for the B<lonc> parent I<PID>,
   This kills all the children, and then the parent.
   The B<lonc.pid> file is cleared.
   
   =item *
   
   SIGUSR1
   
   Parent signal assignment:
    $SIG{USR1} = \&USRMAN;
   
   Child signal assignment:
    $SIG{USR1}= \&logstatus;
   
   Command-line invocations:
    B<kill> B<-s> SIGUSR1 I<PID>
   
   Subroutine B<USRMAN>:
    When invoked for the B<lonc> parent I<PID>,
   SIGUSR1 is sent to all the children, and the status of
   each connection is logged.
   
   =item *
   
   SIGCHLD
   
   Parent signal assignment:
    $SIG{CHLD} = \&REAPER;
   
   Child signal assignment:
    none
   
   Command-line invocations:
    B<kill> B<-s> SIGCHLD I<PID>
   
 =head1 README  Subroutine B<REAPER>:
    This is only invoked for the B<lonc> parent I<PID>.
   Information pertaining to the child is removed.
   The socket port is cleaned up.
   
 Not yet written.  =back
   
 =head1 PREREQUISITES  =head1 PREREQUISITES
   
Removed from v.1.29  
changed lines
  Added in v.1.31

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>