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

Diff for /loncom/Attic/lonc between versions 1.32 and 1.36

version 1.32, 2002/03/08 03:56:19 version 1.36, 2002/03/27 04:07:02
Line 45 Line 45
 # 12/20 Scott Harrison  # 12/20 Scott Harrison
 # YEAR=2002  # YEAR=2002
 # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer  # 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
 #   # 3/07/02 Ron Fox 
 # based on nonforker from Perl Cookbook  # based on nonforker from Perl Cookbook
 # - server who multiplexes without forking  # - server who multiplexes without forking
   
Line 279  unlink($port); Line 279  unlink($port);
             }              }
             $cmd="enc:$cmdlength:$encrequest\n";              $cmd="enc:$cmdlength:$encrequest\n";
         }          }
     $SIG{ALRM}=sub { die "timeout" };   $answer = londtransaction($remotesock, $cmd, 60);
     $SIG{__DIE__}='DEFAULT';  
     eval {  
         alarm(60);  
         print $remotesock "$cmd\n";  
         $answer=<$remotesock>;  
  chomp($answer);   chomp($answer);
         alarm(0);  
     };  
     $SIG{ALRM}='DEFAULT';  
     $SIG{__DIE__}=\&catchexception;  
   
         if (($answer ne '') && ($@!~/timeout/)) {          if (($answer ne '') && ($@!~/timeout/)) {
     unlink("$dfname");      unlink("$dfname");
Line 309  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 ($st secs): $@ .. exiting</font>");           "Can't make server socket ($st secs):  .. exiting</font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
Line 323  unless ( Line 314  unless (
 %inbuffer  = ();  %inbuffer  = ();
 %outbuffer = ();  %outbuffer = ();
 %ready     = ();  %ready     = ();
   %servers   = (); # To be compatible with make filevector.  indexed by
    # File descriptors, values are file descriptors.
    # note that the accept socket is omitted.
   
 tie %ready, 'Tie::RefHash';  tie %ready, 'Tie::RefHash';
   
Line 335  while (1) { Line 329  while (1) {
     my $rv;      my $rv;
     my $data;      my $data;
   
     # check for new information on the connections we have      my $infdset; # bit vec of fd's to select on input.
       my $inreadyset; # Bit vec of fd's ready for input.
   
       my $outfdset; # Bit vec of fd's to select on output.
       my $outreadyset; # bit vec of fds ready for output.
   
   
       $infdset = MakeFileVector(\%servers);
       $outfdset= MakeFileVector(\%outbuffer);
   
       # check for new information on the connections we have
     # anything to read or accept?      # anything to read or accept?
   
     foreach $client ($select->can_read(100.0)) {      foreach $client ($select->can_read(00.10)) {
         if ($client == $server) {          if ($client == $server) {
             # accept a new connection              # accept a new connection
             &status("Accept new connection: $conserver");              &status("Accept new connection: $conserver");
Line 430  while (1) { Line 433  while (1) {
   
 # ------------------------------------------------------- End of make_new_child  # ------------------------------------------------------- End of make_new_child
   
   
   #
   #  Make a vector of file descriptors to wait for in a select.
   #  parameters:
   #     \%fdhash  -reference to a hash which has IO::Socket's as indices.  
   #                We only care about the indices, not the values.
   #  A select vector is created from all indices of the hash.
   
   sub MakeFileVector
   {
       my $fdhash = shift;
       my $selvar = "";
   
       foreach $socket (keys %fdhash) {
    vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1;
       }
       return $selvar;
   }
   
   
   #
   #  HandleOutput:
   #    Processes output on a buffered set of file descriptors which are
   #    ready to be read.
   #  Parameters:
   #    $selvector - Vector of writable file descriptors which are writable.
   #    \%sockets  - Vector of socket references indexed by socket.
   #    \%buffers  - Reference to a hash containing output buffers.
   #                 Hashes are indexed by sockets.  The file descriptors of some
   #                 of those sockets will be present in $selvector.
   #                 For each one of those, we will attempt to write the output
   #                 buffer to the socket.  Note that we will assume that
   #                 the sockets are being run in non blocking mode.
   #   \%inbufs    - Reference to hash containing input buffers.
   #   \%readys    - Reference to hash containing flags for items with complete
   #                 requests.
   #
   sub HandleOutput
   {
       my $selvector = shift;
       my $sockets   = shift;
       my $buffers   = shift;
       my $inbufs    = shift;
       my $readys    = shift;
   
       foreach $sock (keys %buffers) {
    my $socket = $sockets->{$sock};
    if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable.
       my $rv = $$socket->send($buffers->{$sock}, 0);
       $errno = $!;
       unless ($buffers->{$sock} eq "con_lost\n") {
    unless (defined $rv) { # Write failed... could be EINTR
       unless ($errno == POSIX::EINTR) {
    &logthis("Write failed on writable socket");
       } # EINTR is not an error .. just retry.
       next;
    }
    if( ($rv == length $buffers->{$sock})    ||
       ($errno == POSIX::EWOULDBLOCK)       ||
       ($errno == POSIX::EAGAIN)            || # same as above.
       ($errno == POSIX::EINTR)             || # signal during IO
       ($errno == 0)) {
       substr($buffers->{$sock}, 0, $rv)=""; # delete written part
       delete $buffers->{$sock} unless length $buffers->{$sock};
    } else {
       # For some reason the write failed with an error code
       # we didn't look for.  Shutdown the socket.
       &logthis("Unable to write data with ".$errno.": ".
        "Dropping data: ".length($buffers->{$sock}).
        ", $rv");
       #
       # kill off the buffers in the hash:
   
       delete $buffers->{$sock};
       delete $inbufs->{$sock};
       delete $readys->{$sock};
   
       close($$socket); # Close the client socket.
       next;
    }
       } else { # Kludgy way to mark lond connection lost.
    &logthis(
    "<font color=red>CRITICAL lond connection lost</font>");
    status("Connection lost");
    $remotesock->shutdown(2);
    &logthis("Attempting to open a new connection");
    &openremot($conserver);
       }
      
    }
       }
   
   }
   #
   #   HandleInput - Deals with input on client sockets.
   #                 Each socket has an associated input buffer.
   #                 For each readable socket, the currently available
   #                 data is appended to this buffer.
   #                 If necessary, the buffer is created.
   #                 On various failures, we may shutdown the client.
   #  Parameters:
   #     $selvec   - Vector of readable sockets.
   #     \%sockets - Refers to the  Hash of sockets indexed by sockets.  
   #                 Each of these may or may not have it's fd bit set 
   #                 in the $selvec.
   #     \%ibufs   - Refers to the hash of input buffers indexed by socket.
   #     \%obufs   - Hash of output buffers indexed by socket. 
   #     \%ready   - Hash of ready flags indicating the existence of a completed
   #                 Request.
   sub HandleInput 
   {
   
       # Marshall the parameters.   Note that the hashes are actually
       # references not values.
   
       my $selvec  = shift;
       my $sockets = shift;
       my $ibufs   = shift;
       my $obufs   = shift;
       my $ready   = shift;
   
       foreach $sock (keys %sockets) {
    my $socket = $sockets->{$sock};
    if(vec($selvec, $$socket->fileno, 1)) { # Socket which is readable.
   
       #  Attempt to read the data and do error management.
       my $data = '';
       my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0);
       unless (defined($rv) && length $data) {
   
    # Read an end of file.. this is a disconnect from the peer.
   
    delete $sockets->{$sock};
    delete $ibufs->{$sock};
    delete $obufs->{$sock};
    delete $ready->{$sock};
   
    status("Idle");
    close $$socket;
    next;
       }
       #  Append the read data to the input buffer. If the buffer
       # now contains a \n the request is complete and we can 
       # mark this in the $ready hash (one request for each \n.)
   
       $ibufs->{$sock} .= $data;
       while($ibufs->{$sock} =~ s/(.*\n)//) {
    push(@{$ready->{$sock}}, $1);
       }
       
    }
       }
       #  Now handle any requests which are ready:
   
       foreach $client (keys %ready) {
    handle($client);
       }
   }
   
   # DoSelect:  does a select with no timeout.  On signal (errno == EINTR), 
   #            the select is retried until there are items in the returned
   #            vectors.  
   #
   # Parameters:
   #   \$readvec   - Reference to a vector of file descriptors to 
   #                 check for readability.
   #   \$writevec  - Reference to a vector of file descriptors to check for
   #                 writability.
   #  On exit, the referents are modified with vectors indicating which 
   #  file handles are readable/writable.
   #
   sub DoSelect {
       my $readvec = shift;
       my $writevec= shift;
       my $outs;
       my $ins;
   
       while (1) {
    my $nfds = select($outs = $$writevec, $ins = $$readvec, undef, undef);
    if($nfound) {
       $$readvec  = $ins;
       $$writevec = $outs;
       return;
    } else {
       die "Select failed" unless $! == EINTR;
    }
       }
   }
   
 # handle($socket) deals with all pending requests for $client  # handle($socket) deals with all pending requests for $client
   #
 sub handle {  sub handle {
     # requests are in $ready{$client}      # requests are in $ready{$client}
     # send output to $outbuffer{$client}      # send output to $outbuffer{$client}
Line 441  sub handle { Line 634  sub handle {
         # $request is the text of the request          # $request is the text of the request
         # put text of reply into $outbuffer{$client}          # put text of reply into $outbuffer{$client}
 # ------------------------------------------------------------ Is this the end?  # ------------------------------------------------------------ Is this the end?
    chomp($request);
  if($DEBUG) {   if($DEBUG) {
      &logthis("<font color=green> Request $request processing starts</font>");       &logthis("<font color=green> Request $request processing starts</font>");
         }          }
Line 464  sub handle { Line 658  sub handle {
                 $encrequest.=                  $encrequest.=
                     unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));                      unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));
             }              }
             $request="enc:$cmdlength:$encrequest\n";              $request="enc:$cmdlength:$encrequest";
         }          }
 # --------------------------------------------------------------- Main exchange  # --------------------------------------------------------------- Main exchange
     $SIG{ALRM}=sub { die "timeout" };   $answer = londtransaction($remotesock, $request, 300);
     $SIG{__DIE__}='DEFAULT';  
     eval {   if($DEBUG) { 
         alarm(300);      &logthis("<font color=green> Request data exchange complete");
         &status("Sending: $request");   }
         print $remotesock "$request";   if ($@=~/timeout/) { 
         &status("Waiting for reply from $conserver: $request");      $answer='';
         $answer=<$remotesock>;      &logthis(
         &status("Received reply: $request");       "<font color=red>CRITICAL: Timeout: $request</font>");
         alarm(0);   }  
     };  
     if($DEBUG) {   
  &logthis("<font color=green> Request data exchange complete");  
     }  
     if ($@=~/timeout/) {   
        $answer='';  
        &logthis(  
         "<font color=red>CRITICAL: Timeout: $request</font>");  
     }    
     $SIG{ALRM}='DEFAULT';  
     $SIG{__DIE__}=\&catchexception;  
   
   
         if ($answer) {          if ($answer) {
Line 503  sub handle { Line 686  sub handle {
       $answer=substr($answer,0,$cmdlength);        $answer=substr($answer,0,$cmdlength);
       $answer.="\n";        $answer.="\n";
    }     }
      if($DEBUG) {
          &logthis("sending $answer to client\n");
      }
            $outbuffer{$client} .= $answer;             $outbuffer{$client} .= $answer;
         } else {          } else {
            $outbuffer{$client} .= "con_lost\n";             $outbuffer{$client} .= "con_lost\n";
Line 552  unless ( Line 738  unless (
    ) {      ) { 
   
        &logthis(         &logthis(
 "<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): $@</font>");  "<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): </font>");
        sleep($st);         sleep($st);
        exit;          exit; 
      };       };
Line 561  unless ( Line 747  unless (
 &logthis("<font color=green>INFO Connected to $conserver, initing </font>");  &logthis("<font color=green>INFO Connected to $conserver, initing </font>");
 &status("Init dialogue: $conserver");  &status("Init dialogue: $conserver");
   
      $SIG{ALRM}=sub { die "timeout" };      $answer = londtransaction($remotesock, "init", 60);
      $SIG{__DIE__}='DEFAULT';      chomp($answer);
      eval {      $answer = londtransaction($remotesock, $answer, 60);
          alarm(60);      chomp($answer);
 print $remotesock "init\n";  
 $answer=<$remotesock>;  
 print $remotesock "$answer";  
 $answer=<$remotesock>;  
 chomp($answer);  
           alarm(0);  
      };  
      $SIG{ALRM}='DEFAULT';  
      $SIG{__DIE__}=\&catchexception;  
     
      if ($@=~/timeout/) {       if ($@=~/timeout/) {
  &logthis("Timed out during init.. exiting");   &logthis("Timed out during init.. exiting");
Line 632  sub catchexception { Line 809  sub catchexception {
     chomp($signal);      chomp($signal);
     &logthis("<font color=red>CRITICAL: "      &logthis("<font color=red>CRITICAL: "
      ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "       ."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
      ."\"$signal\" with parameter [$@]</font>");       ."\"$signal\" with parameter </font>");
     die($@);      die("Signal abend");
 }  }
   
 # -------------------------------------- Routines to see if other box available  # -------------------------------------- Routines to see if other box available
Line 736  sub subreply { Line 913  sub subreply {
        or return "con_lost";         or return "con_lost";
   
   
     $SIG{ALRM}=sub { die "timeout" };      $answer = londtransaction($sclient, $cmd, 10);
     $SIG{__DIE__}='DEFAULT';  
     eval {  
      alarm(10);  
      print $sclient "$cmd\n";  
      $answer=<$sclient>;  
      chomp($answer);  
      alarm(0);  
     };  
     if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }      if ((!$answer) || ($@=~/timeout/)) { $answer="con_lost"; }
     $SIG{ALRM}='DEFAULT';      $SIG{ALRM}='DEFAULT';
     $SIG{__DIE__}=\&catchexception;      $SIG{__DIE__}=\&catchexception;
Line 764  sub logthis { Line 934  sub logthis {
     print $fh "$local ($$) [$conserver] [$status]: $message\n";      print $fh "$local ($$) [$conserver] [$status]: $message\n";
 }  }
   
   #--------------------------------------  londtransaction:
   #  
   #  Performs a transaction with lond with timeout support.
   #    result = londtransaction(socket,request,timeout)
   #
   sub londtransaction {
       my ($socket, $request, $tmo) = @_;
   
       if($DEBUG) {
    &logthis("londtransaction request: $request");
       }
   
       # Set the signal handlers: ALRM for timeout and disble the others.
   
       $SIG{ALRM} = sub { die "timeout" };
       $SIG{__DIE__} = 'DEFAULT';
       
       # Disable all but alarm so that only that can interupt the
       # send /receive.
       #
       my $sigset = POSIX::SigSet->new(QUIT, USR1, HUP, INT, TERM);
       my $priorsigs = POSIX::SigSet->new;
       unless (defined sigprocmask(SIG_BLOCK, $sigset, $priorsigs)) {
    &logthis("<font color=red> CRITICAL -- londtransaction ".
    "failed to block signals </font>");
    die "could not block signals in londtransaction";
       }
       $answer = '';
       #
       #  Send request to lond.
       #
       eval { 
    alarm($tmo);
    print $socket "$request\n";
    alarm(0);
       };
       #  If request didn't timeout, try for the response.
       #
   
       if ($@!~/timeout/) {
    eval {
       alarm($tmo);
       $answer = <$socket>;
       if($DEBUG) {
    &logthis("Received $answer in londtransaction");
       }
       alarm(0);
    };
       } else {
    if($DEBUG) {
       &logthis("Timeout on send in londtransaction");
    }
       }
       if( ($@ =~ /timeout/)  && ($DEBUG)) {
    &logthis("Timeout on receive in londtransaction");
       }
       #
       # Restore the initial sigmask set.
       #
       unless (defined sigprocmask(SIG_UNBLOCK, $priorsigs)) {
    &logthis("<font color=red> CRITICAL -- londtransaction ".
    "failed to re-enable signal processing. </font>");
    die "londtransaction failed to re-enable signals";
       }
       #
       # go back to the prior handler set.
       #
       $SIG{ALRM} = 'DEFAULT';
       $SIG{__DIE__} = \&cathcexception;
   
       #    chomp $answer;
       if ($DEBUG) {
    &logthis("Returning $answer in londtransaction");
       }
       return $answer;
   
   }
   
 sub logperm {  sub logperm {
     my $message=shift;      my $message=shift;
Line 824  B<lonc> forks off children processes tha Line 1071  B<lonc> forks off children processes tha
 in the network.  Management of these processes can be done at the  in the network.  Management of these processes can be done at the
 parent process level or the child process level.  parent process level or the child process level.
   
     After forking off the children, B<lonc> the B<parent> 
   executes a main loop which simply waits for processes to exit.
   As a process exits, a new process managing a link to the same
   peer as the exiting process is created.  
   
 B<logs/lonc.log> is the location of log messages.  B<logs/lonc.log> is the location of log messages.
   
 The process management is now explained in terms of linux shell commands,  The process management is now explained in terms of linux shell commands,
Line 899  Subroutine B<USRMAN>: Line 1151  Subroutine B<USRMAN>:
 SIGUSR1 is sent to all the children, and the status of  SIGUSR1 is sent to all the children, and the status of
 each connection is logged.  each connection is logged.
   
 =item *  
   
 SIGCHLD  
   
   
 Child signal assignment:  
  none  
   
 Command-line invocations:  
  B<kill> B<-s> SIGCHLD I<PID>  
   
 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.  
   
 =back  =back
   
Removed from v.1.32  
changed lines
  Added in v.1.36

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