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

Diff for /loncom/loncnew between versions 1.5 and 1.6

version 1.5, 2003/04/29 03:24:51 version 1.6, 2003/05/05 23:40:27
Line 49  use POSIX qw(:signal_h); Line 49  use POSIX qw(:signal_h);
 use IO::Socket;  use IO::Socket;
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Socket::UNIX;  use IO::Socket::UNIX;
   use IO::Handle;
 use Socket;  use Socket;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LONCAPA::Queue;  use LONCAPA::Queue;
Line 103  my $ConnectionCount = 0; Line 104  my $ConnectionCount = 0;
 my $IdleSeconds     = 0; # Number of seconds idle.  my $IdleSeconds     = 0; # Number of seconds idle.
   
 #  #
   #   This disconnected socket makes posible a bit more regular
   #   code when processing delayed requests:
   #
   my $NullSocket = IO::Socket->new();
   
   #
   
 =pod  =pod
   
Line 190  sub Tick { Line 197  sub Tick {
  $IdleSeconds++;   $IdleSeconds++;
  if($IdleSeconds > $IdleTimeout) { # Prune a connection...   if($IdleSeconds > $IdleTimeout) { # Prune a connection...
     $Socket = $IdleConnections->pop();      $Socket = $IdleConnections->pop();
     KillSocket($Socket, 0);      KillSocket($Socket);
  }   }
     } else {      } else {
  $IdleSeconds = 0; # Reset idle count if not idle.   $IdleSeconds = 0; # Reset idle count if not idle.
Line 302  sub ClientWritable { Line 309  sub ClientWritable {
     &Debug(6, "ClientWritable writing".$Data);      &Debug(6, "ClientWritable writing".$Data);
     &Debug(9, "Socket is: ".$Socket);      &Debug(9, "Socket is: ".$Socket);
   
     my $result = $Socket->send($Data, 0);      if($Socket->connected) {
    my $result = $Socket->send($Data, 0);
     # $result undefined: the write failed.  
     # otherwise $result is the number of bytes written.  
     # Remove that preceding string from the data.  
     # If the resulting data is empty, destroy the watcher  
     # and set up a read event handler to accept the next  
     # request.  
   
     &Debug(9,"Send result is ".$result." Defined: ".defined($result));  
     if(defined($result)) {  
  &Debug(9, "send result was defined");  
  if($result == length($Data)) { # Entire string sent.  
     &Debug(9, "ClientWritable data all written");  
     $Watcher->cancel();  
     #  
     #  Set up to read next request from socket:  
       
     my $descr     = sprintf("Connection to lonc client %d",  
     $ActiveClients{$Socket});  
     Event->io(cb    => \&ClientRequest,  
       poll  => 'r',  
       desc  => $descr,  
       data  => "",  
       fd    => $Socket);  
   
  } else { # Partial string sent.  
     $Watcher->data(substr($Data, $result));  
  }  
   
     } else { # Error of some sort...   # $result undefined: the write failed.
    # otherwise $result is the number of bytes written.
  # Some errnos are possible:   # Remove that preceding string from the data.
  my $errno = $!;   # If the resulting data is empty, destroy the watcher
  if($errno == POSIX::EWOULDBLOCK   ||   # and set up a read event handler to accept the next
    $errno == POSIX::EAGAIN        ||   # request.
    $errno == POSIX::EINTR) {  
     # No action taken?  
  } else { # Unanticipated errno.  
     &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);  
     $Watcher->cancel; # Stop the watcher.  
     $Socket->shutdown(2); # Kill connection  
     $Socket->close(); # Close the socket.  
  }  
   
    &Debug(9,"Send result is ".$result." Defined: ".defined($result));
    if(defined($result)) {
       &Debug(9, "send result was defined");
       if($result == length($Data)) { # Entire string sent.
    &Debug(9, "ClientWritable data all written");
    $Watcher->cancel();
    #
    #  Set up to read next request from socket:
   
    my $descr     = sprintf("Connection to lonc client %d",
    $ActiveClients{$Socket});
    Event->io(cb    => \&ClientRequest,
     poll  => 'r',
     desc  => $descr,
     data  => "",
     fd    => $Socket);
   
       } else { # Partial string sent.
    $Watcher->data(substr($Data, $result));
       }
       
    } else { # Error of some sort...
       
       # Some errnos are possible:
       my $errno = $!;
       if($errno == POSIX::EWOULDBLOCK   ||
          $errno == POSIX::EAGAIN        ||
          $errno == POSIX::EINTR) {
    # No action taken?
       } else { # Unanticipated errno.
    &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
    $Watcher->cancel; # Stop the watcher.
    $Socket->shutdown(2); # Kill connection
    $Socket->close(); # Close the socket.
       }
       
    }
       } else {
    $Watcher->cancel(); # A delayed request...just cancel.
     }      }
 }  }
   
Line 379  sub CompleteTransaction { Line 390  sub CompleteTransaction {
     my $Client = shift;      my $Client = shift;
   
     my $data   = $Socket->GetReply(); # Data to send.      my $data   = $Socket->GetReply(); # Data to send.
       StartClientReply($Client, $data);
   }
   =pod
   =head1 StartClientReply
   
      Initiates a reply to a client where the reply data is a parameter.
   
   =cut
   sub StartClientReply {
       my $Client   = shift;
       my $data     = shift;
   
     &Debug(8," Reply was: ".$data);      &Debug(8," Reply was: ".$data);
     my $Serial         = $ActiveClients{$Client};      my $Serial         = $ActiveClients{$Client};
     my $desc           = sprintf("Connection to lonc client %d",      my $desc           = sprintf("Connection to lonc client %d",
   
  $Serial);   $Serial);
     Event->io(fd       => $Client,      Event->io(fd       => $Client,
       poll     => "w",        poll     => "w",
Line 407  Parameters: Line 430  Parameters:
 sub FailTransaction {  sub FailTransaction {
     my $client = shift;      my $client = shift;
   
     &Debug(8, "Failing transaction due to disconnect");      StartClientReply($client, "con_lost");
     my $Serial = $ActiveClients{$client};  
     my $desc   = sprintf("Connection to lonc client %d", $Serial);  
     my $data   = "error: Connection to lond lost\n";  
   
     Event->io(fd     => $client,  
       poll   => "w",  
       desc   => $desc,  
       cb     => \&ClientWritable,  
       data   => $data);  
   
 }  }
   
 =pod  =pod
   =head1  EmptyQueue
     Fails all items in the work queue with con_lost.
   =cut
   sub EmptyQueue {
       while($WorkQueue->Count()) {
    my $request = $WorkQUeue->dequeue(); # Just to help it become empty.
    my $client  = $ClientQueue->dequeue(); #  Need to con_lost this guy.
    FailTransaction($client);
       }
   }
   
   =pod
   
 =head2 KillSocket  =head2 KillSocket
     
Line 444  nonzero if we are allowed to create a ne Line 470  nonzero if we are allowed to create a ne
 =cut  =cut
 sub KillSocket {  sub KillSocket {
     my $Socket = shift;      my $Socket = shift;
     my $Restart= shift;  
   
     #  If the socket came from the active connection set, delete it.      #  If the socket came from the active connection set, delete it.
     # otherwise it came from the idle set and has already been destroyed:      # otherwise it came from the idle set and has already been destroyed:
Line 456  sub KillSocket { Line 481  sub KillSocket {
  delete($ActiveConnections{$Socket});   delete($ActiveConnections{$Socket});
     }      }
     $ConnectionCount--;      $ConnectionCount--;
     if( ($ConnectionCount = 0) && ($Restart)) {  
  MakeLondConnection();  
     }  
   
       #  If the connection count has gone to zero and there is work in the
       #  work queue, the work all gets failed with con_lost.
       #
       if($ConnectionCount == 0) {
    EmptyQueue;
       }
 }  }
   
 =pod  =pod
Line 541  sub LondReadable { Line 569  sub LondReadable {
     FailTransaction($ActiveTransactions{$Socket});      FailTransaction($ActiveTransactions{$Socket});
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  KillSocket($Socket, 1);   KillSocket($Socket);
  return;   return;
     }      }
     SocketDump(6,$Socket);      SocketDump(6,$Socket);
Line 582  sub LondReadable { Line 610  sub LondReadable {
  }   }
  $Watcher->cancel();   $Watcher->cancel();
  ServerToIdle($Socket); # Next work unit or idle.   ServerToIdle($Socket); # Next work unit or idle.
   
     } elsif ($State eq "SendingRequest") {      } elsif ($State eq "SendingRequest") {
  #  We need to be writable for this and probably don't belong   #  We need to be writable for this and probably don't belong
  #  here inthe first place.   #  here inthe first place.
Line 684  sub LondWritable { Line 712  sub LondWritable {
     # We'll treat this as if the socket got disconnected:      # We'll treat this as if the socket got disconnected:
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
  }   }
  #  "init" is being sent...   #  "init" is being sent...
Line 706  sub LondWritable { Line 734  sub LondWritable {
  if($Socket->Writable() != 0) {   if($Socket->Writable() != 0) {
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
  }   }
   
Line 727  sub LondWritable { Line 755  sub LondWritable {
     # Write resulted in an error.      # Write resulted in an error.
   
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
   
  }   }
Line 749  sub LondWritable { Line 777  sub LondWritable {
  FailTransaction($ActiveTransactions{$Socket});   FailTransaction($ActiveTransactions{$Socket});
     }      }
     $Watcher->cancel();      $Watcher->cancel();
     KillSocket($Socket, 1);      KillSocket($Socket);
     return;      return;
           
  }   }
Line 771  sub LondWritable { Line 799  sub LondWritable {
     }      }
           
 }  }
   =pod
       
   =cut
   sub QueueDelayed {
       my $path = "$perlvar{'lonSockDir'}/delayed";
       opendir(DIRHANDLE, $path);
       @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
       closedir(DIRHANDLE);
       my $dfname;
       my $reqfile
       foreach $reqfile (sort @alldelayed) {
    $reqfile = $path/$reqfile;
    my $Handle = IO::File->new($reqfile);
    my $cmd    = <$Handle>;
    chomp($cmd);
    QueueTransaction($NullSocket, $cmd);
       }
       
   }
   
 =pod  =pod
   
Line 815  sub MakeLondConnection { Line 862  sub MakeLondConnection {
  $ActiveConnections{$Connection} = $event;   $ActiveConnections{$Connection} = $event;
   
  $ConnectionCount++;   $ConnectionCount++;
    if($ConnectionCount == 1) { # First Connection:
       QueueDelayed;
    }
     }      }
           
 }  }
Line 1125  sub CreateChild { Line 1175  sub CreateChild {
 #  #
   
   
   
   
 ShowStatus("Parent writing pid file:");  ShowStatus("Parent writing pid file:");
 $execdir = $perlvar{'lonDaemons'};  $execdir = $perlvar{'lonDaemons'};
 open (PIDSAVE, ">$execdir/logs/lonc.pid");  open (PIDSAVE, ">$execdir/logs/lonc.pid");
 print PIDSAVE "$$\n";  print PIDSAVE "$$\n";
 close(PIDSAVE);  close(PIDSAVE);
   
   ShowStatus("Forming new session");
   my $childpid = fork;
   if ($childpid != 0) {
       sleep 4; # Give child a chacne to break to
       exit 0; # a new sesion.
   }
   
   if (POSIX::setsid() < 0) {
       print "Could not create new session\n";
       exit -1;
   }
   
 ShowStatus("Forking node servers");  ShowStatus("Forking node servers");
   
 my $HostIterator = LondConnection::GetHostIterator;  my $HostIterator = LondConnection::GetHostIterator;
Removed from v.1.5  
changed lines
  Added in v.1.6

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