[BACK]Return to LondConnection.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/LondConnection.pm between versions 1.7 and 1.12

version 1.7, 2003/07/02 01:12:35 version 1.12, 2003/10/07 11:23:26
Line 27 Line 27
 #  #
 package LondConnection;  package LondConnection;
   
   use strict;
 use IO::Socket;  use IO::Socket;
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Handle;  use IO::Handle;
Line 37  use Crypt::IDEA; Line 38  use Crypt::IDEA;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::HashIterator;  use LONCAPA::HashIterator;
   
   
   
   
 my $DebugLevel=0;  my $DebugLevel=0;
   my %hostshash;
   my %perlvar;
   
 #   Read the configuration file for apache to get the perl  #   Read the configuration file for apache to get the perl
 #   variable set.  #   variable set.
   
 my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');  sub ReadConfig {
 my %perlvar    = %{$perlvarref};      my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
 my $hoststab   =       %perlvar    = %{$perlvarref};
     LONCAPA::Configuration::read_hosts(      my $hoststab   = 
             "$perlvar{'lonTabDir'}/hosts.tab") ||    LONCAPA::Configuration::read_hosts(
     die "Can't read host table!!";     "$perlvar{'lonTabDir'}/hosts.tab") || 
 my %hostshash  = %{$hoststab};     die "Can't read host table!!";
       %hostshash  = %{$hoststab};
       
       close(CONFIG);
   }
   
   
 close(CONFIG);  ReadConfig; # Make sure it gets read on init.
   
 sub Debug {  sub Debug {
     my $level   = shift;      my $level   = shift;
Line 64  sub Debug { Line 75  sub Debug {
   
 =head2 Dump  =head2 Dump
   
 Dump the internal state of the object: For debugging purposes.  Dump the internal state of the object: For debugging purposes, to stderr.
   
 =cut  =cut
   
 sub Dump {  sub Dump {
     my $self   = shift;      my $self   = shift;
       my $key;
       my $value;
     print "Dumping LondConnectionObject:\n";      print "Dumping LondConnectionObject:\n";
     while(($key, $value) = each %$self) {      while(($key, $value) = each %$self) {
  print "$key -> $value\n";   print STDERR "$key -> $value\n";
     }      }
     print "-------------------------------\n";      print "-------------------------------\n";
 }  }
Line 145  sub new { Line 158  sub new {
      TimeoutCallback    => undef,       TimeoutCallback    => undef,
      TransitionCallback => undef,       TransitionCallback => undef,
              Timeoutable        => 0,               Timeoutable        => 0,
              TimeoutValue       => 60,               TimeoutValue       => 30,
              TimeoutRemaining   => 0,       TimeoutRemaining   => 0,
      CipherKey          => "",       CipherKey          => "",
      Cipher             => undef};       Cipher             => undef};
     bless($self, $class);      bless($self, $class);
     unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},      unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
        PeerPort => $self->{Port},         PeerPort => $self->{Port},
        Type     => SOCK_STREAM,         Type     => SOCK_STREAM,
        Proto    => "tcp")) {         Proto    => "tcp",
          Timeout  => 5)) {
  return undef; # Inidicates the socket could not be made.   return undef; # Inidicates the socket could not be made.
     }      }
     #      #
Line 161  sub new { Line 175  sub new {
     #      #
     $self->Transition("Connected");      $self->Transition("Connected");
     $self->{InformWritable}     = 1;    # When  socket is writable we send init      $self->{InformWritable}     = 1;    # When  socket is writable we send init
       $self->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
     $self->{TransactionRequest} = "init\n";      $self->{TransactionRequest} = "init\n";
           
     #      #
     # Set socket to nonblocking I/O.      # Set socket to nonblocking I/O.
     #      #
     my $socket = $self->{Socket};      my $socket = $self->{Socket};
     $flags    = fcntl($socket->fileno, F_GETFL,0);      my $flags    = fcntl($socket->fileno, F_GETFL,0);
     if($flags == -1) {      if($flags == -1) {
  $socket->close;   $socket->close;
  return undef;   return undef;
Line 215  sub Readable { Line 230  sub Readable {
     my $rv      = $socket->recv($data, POSIX::BUFSIZ,  0);      my $rv      = $socket->recv($data, POSIX::BUFSIZ,  0);
     my $errno   = $! + 0;             # Force numeric context.      my $errno   = $! + 0;             # Force numeric context.
   
     unless (defined($rv) && (length($data)> 0)) {# Read failed,      unless (defined($rv) && length $data) {# Read failed,
  if(($errno == POSIX::EWOULDBLOCK)   ||   if(($errno == POSIX::EWOULDBLOCK)   ||
    ($errno == POSIX::EAGAIN)        ||     ($errno == POSIX::EAGAIN)        ||
    ($errno == POSIX::EINTR)         ||     ($errno == POSIX::EINTR)) {
    ($errno == 0)) {  
     return 0;      return 0;
  }   }
   
Line 237  sub Readable { Line 251  sub Readable {
     if($self->{TransactionReply} =~ /(.*\n)/) {      if($self->{TransactionReply} =~ /(.*\n)/) {
  &Debug(8,"Readable End of line detected");   &Debug(8,"Readable End of line detected");
  if ($self->{State}  eq "Initialized") { # We received the challenge:   if ($self->{State}  eq "Initialized") { # We received the challenge:
     if($self->{TransactionReply} eq "refused") { # Remote doesn't have      if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
   
  $self->Transition("Disconnected"); # in host tables.   $self->Transition("Disconnected"); # in host tables.
  $socket->close();   $socket->close();
Line 337  sub Writable { Line 351  sub Writable {
  }   }
               
     }      }
     if (($rv >= 0)                        ||      if (($nwritten >= 0)                        ||
         ($errno == POSIX::EWOULDBLOCK)    ||          ($errno == POSIX::EWOULDBLOCK)    ||
  ($errno == POSIX::EAGAIN)         ||   ($errno == POSIX::EAGAIN)         ||
  ($errno == POSIX::EINTR)          ||   ($errno == POSIX::EINTR)          ||
Line 654  sub Decrypt { Line 668  sub Decrypt {
     # Decode the data in 8 byte blocks.  The string is encoded      # Decode the data in 8 byte blocks.  The string is encoded
     # as hex digits so there are two characters per byte:      # as hex digits so there are two characters per byte:
   
     $decrpyted = "";      my $decrypted = "";
     for(my $index = 0; $index < length($EncryptedString);      for(my $index = 0; $index < length($EncryptedString);
  $index += 16) {   $index += 16) {
  $decrypted .= $self->{Cipher}->decrypt(   $decrypted .= $self->{Cipher}->decrypt(
Line 685  are used as follows: Line 699  are used as follows:
  [1]   - LonCapa domain name.   [1]   - LonCapa domain name.
  [2]   - Loncapa role (e.g. library or access).   [2]   - Loncapa role (e.g. library or access).
  [3]   - DNS name server hostname.   [3]   - DNS name server hostname.
  [4]   - IP address (result of e.g. nslooup [3]).   [4]   - IP address (result of e.g. nslookup [3]).
  [5]   - Maximum connection count.   [5]   - Maximum connection count.
  [6]   - Idle timeout for reducing connection count.   [6]   - Idle timeout for reducing connection count.
  [7]   - Minimum connection count.   [7]   - Minimum connection count.
Removed from v.1.7  
changed lines
  Added in v.1.12

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