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

Diff for /loncom/Attic/lonc between versions 1.19 and 1.25

version 1.19, 2001/11/27 19:32:46 version 1.25, 2002/02/06 14:15:37
Line 5 Line 5
 # 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
 #  #
   # $Id$
   #
   # 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  # PID in subdir logs/lonc.pid
 # kill kills  # kill kills
 # HUP restarts  # HUP restarts
Line 15 Line 39
 # 2/8,7/25 Gerd Kortemeyer  # 2/8,7/25 Gerd Kortemeyer
 # 12/05 Scott Harrison  # 12/05 Scott Harrison
 # 12/05 Gerd Kortemeyer  # 12/05 Gerd Kortemeyer
   # YEAR=2001
 # 01/10/01 Scott Harrison  # 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
 #   # 
 # based on nonforker from Perl Cookbook  # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking  # - server who multiplexes without forking
Line 119  sub REAPER {                        # ta Line 145  sub REAPER {                        # ta
   
 sub HUNTSMAN {                      # signal handler for SIGINT  sub HUNTSMAN {                      # signal handler for SIGINT
     local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';   # we're going to kill our children
     map {      foreach (keys %children) {
         $wasserver=$children{$_};          $wasserver=$children{$_};
         &status("Closing $wasserver");          &status("Closing $wasserver");
         &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));          &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
         &status("Kill PID $_ for $wasserver");          &status("Kill PID $_ for $wasserver");
  kill ('INT',$_);   kill ('INT',$_);
     } keys %children;      }
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lonc.pid");      unlink("$execdir/logs/lonc.pid");
     &logthis("<font color=red>CRITICAL: Shutting down</font>");      &logthis("<font color=red>CRITICAL: Shutting down</font>");
Line 134  sub HUNTSMAN {                      # si Line 160  sub HUNTSMAN {                      # si
   
 sub HUPSMAN {                      # signal handler for SIGHUP  sub HUPSMAN {                      # signal handler for SIGHUP
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children      local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     map {      foreach (keys %children) {
         $wasserver=$children{$_};          $wasserver=$children{$_};
         &status("Closing $wasserver");          &status("Closing $wasserver");
         &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));          &logthis('Closing '.$wasserver.': '.&subreply('exit',$wasserver));
         &status("Kill PID $_ for $wasserver");          &status("Kill PID $_ for $wasserver");
  kill ('INT',$_);   kill ('INT',$_);
     } keys %children;      }
     &logthis("<font color=red>CRITICAL: Restarting</font>");      &logthis("<font color=red>CRITICAL: Restarting</font>");
     unlink("$execdir/logs/lonc.pid");      unlink("$execdir/logs/lonc.pid");
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
Line 151  sub checkchildren { Line 177  sub checkchildren {
     &initnewstatus();      &initnewstatus();
     &logstatus();      &logstatus();
     &logthis('Going to check on the children');      &logthis('Going to check on the children');
     map {      foreach (sort keys %children) {
  sleep 1;   sleep 1;
         unless (kill 'USR1' => $_) {          unless (kill 'USR1' => $_) {
     &logthis ('Child '.$_.' is dead');      &logthis ('Child '.$_.' is dead');
             &logstatus($$.' is dead');              &logstatus($$.' is dead');
         }           } 
     } sort keys %children;      }
 }  }
   
 sub USRMAN {  sub USRMAN {
Line 182  sub subreply { Line 208  sub subreply {
                                       Type    => SOCK_STREAM,                                        Type    => SOCK_STREAM,
                                       Timeout => 10)                                        Timeout => 10)
        or return "con_lost";         or return "con_lost";
   
   
     $SIG{ALRM}=sub { die "timeout" };      $SIG{ALRM}=sub { die "timeout" };
     $SIG{__DIE__}='DEFAULT';      $SIG{__DIE__}='DEFAULT';
     eval {      eval {
      alarm(10);       alarm(10);
      print $sclient "$cmd\n";       print $sclient "$cmd\n";
      my $answer=<$sclient>;       $answer=<$sclient>;
      chomp($answer);       chomp($answer);
      alarm(0);       alarm(0);
     };      };
Line 352  unless ( Line 380  unless (
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
 # --------------------------------------- Send a ping to make other end do USR1  # ----------------------------------------------------------------- Init dialog
   
 &status("Init dialogue: $conserver");  &status("Init dialogue: $conserver");
   
        $SIG{ALRM}=sub { die "timeout" };
        $SIG{__DIE__}='DEFAULT';
        eval {
            alarm(60);
 print $remotesock "init\n";  print $remotesock "init\n";
 $answer=<$remotesock>;  $answer=<$remotesock>;
 print $remotesock "$answer";  print $remotesock "$answer";
 $answer=<$remotesock>;  $answer=<$remotesock>;
 chomp($answer);  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<");  &logthis("Init reply for $conserver: >$answer<");
 if ($answer ne 'ok') {  if ($answer ne 'ok') {
        my $st=120+int(rand(240));         my $st=120+int(rand(240));
Line 406  if ($cipher=new IDEA $cipherkey) { Line 449  if ($cipher=new IDEA $cipherkey) {
     @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;      @allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;
     closedir(DIRHANDLE);      closedir(DIRHANDLE);
     my $dfname;      my $dfname;
     map {      foreach (@allbuffered) {
         &status("Sending delayed $conserver $_");          &status("Sending delayed $conserver $_");
         $dfname="$path/$_";          $dfname="$path/$_";
         &logthis($dfname);          &logthis($dfname);
Line 430  if ($cipher=new IDEA $cipherkey) { Line 473  if ($cipher=new IDEA $cipherkey) {
             }              }
             $cmd="enc:$cmdlength:$encrequest\n";              $cmd="enc:$cmdlength:$encrequest\n";
         }          }
       $SIG{ALRM}=sub { die "timeout" };
       $SIG{__DIE__}='DEFAULT';
       eval {
           alarm(60);
         print $remotesock "$cmd\n";          print $remotesock "$cmd\n";
         $answer=<$remotesock>;          $answer=<$remotesock>;
  chomp($answer);   chomp($answer);
         if ($answer ne '') {          alarm(0);
       };
       $SIG{ALRM}='DEFAULT';
       $SIG{__DIE__}=\&catchexception;
   
           if (($answer ne '') && ($@!~/timeout/)) {
     unlink("$dfname");      unlink("$dfname");
             &logthis("Delayed $cmd to $conserver: >$answer<");              &logthis("Delayed $cmd to $conserver: >$answer<");
             &logperm("S:$conserver:$bcmd");              &logperm("S:$conserver:$bcmd");
         }                  }        
     } @allbuffered;      }
   
 # ------------------------------------------------------- Listen to UNIX socket  # ------------------------------------------------------- Listen to UNIX socket
 &status("Opening socket $conserver");  &status("Opening socket $conserver");
Line 644  sub nonblock { Line 695  sub nonblock {
             or die "Can't make socket nonblocking: $!\n";              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
Removed from v.1.19  
changed lines
  Added in v.1.25

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