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

Diff for /loncom/LondConnection.pm between versions 1.6 and 1.15

version 1.6, 2003/06/13 02:56:45 version 1.15, 2003/10/28 11:15:10
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
 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 34  use IO::File; Line 36  use IO::File;
 use Fcntl;  use Fcntl;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LONCAPA::Configuration;  
 use LONCAPA::HashIterator;  
   
   
   
 my $DebugLevel=0;  my $DebugLevel=0;
   my %hostshash;
   my %perlvar;
   
   #
   #   The config read is done in this way to support the read of
   #   the non-default configuration file in the
   #   event we are being used outside of loncapa.
   #
   
   my $ConfigRead = 0;
   
 #   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 = read_conf('loncapa.conf');
 my $hoststab   =       %perlvar    = %{$perlvarref};
     LONCAPA::Configuration::read_hosts(      my $hoststab   = read_hosts(
             "$perlvar{'lonTabDir'}/hosts.tab") ||    "$perlvar{'lonTabDir'}/hosts.tab") || 
     die "Can't read host table!!";   die "Can't read host table!!";
 my %hostshash  = %{$hoststab};      %hostshash  = %{$hoststab};
       
   }
   
   #
   #  Read a foreign configuration.
   #  This sub is intended for the cases where the package
   #  will be read from outside the LonCAPA environment, in that case
   #  the client will need to explicitly provide:
   #   - A file in hosts.tab format.
   #   - Some idea of the 'lonCAPA' name of the local host (for building
   #     the encryption key).
   #
   #  Parameters:
   #      MyHost   - Name of this host as far as LonCAPA is concerned.
   #      Filename - Name of a hosts.tab formatted file that will be used
   #                 to build up the hosts table.
   #
   sub ReadForeignConfig {
       my $MyHost   = shift;
       my $Filename = shift;
   
       $perlvar{lonHostID} = $MyHost; # Rmember my host.
       my $hosttab = read_hosts($Filename) ||
    die "Can't read hosts table!!";
       %hostshash = %{$hosttab}
   
 close(CONFIG);  
   }
   
 sub Debug {  sub Debug {
     my $level   = shift;      my $level   = shift;
Line 64  sub Debug { Line 104  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 97  sub Transition { Line 139  sub Transition {
 }  }
   
   
   
 =pod  =pod
   
 =head2 new  =head2 new
Line 119  sub new { Line 162  sub new {
     my $class    = shift; # class name.      my $class    = shift; # class name.
     my $Hostname = shift; # Name of host to connect to.      my $Hostname = shift; # Name of host to connect to.
     my $Port     = shift; # Port to connect       my $Port     = shift; # Port to connect 
   
       if (!$ConfigRead) {
    ReadConfig();
    $ConfigRead = 1;
       }
     &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");      &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");
   
     # The host must map to an entry in the hosts table:      # The host must map to an entry in the hosts table:
Line 145  sub new { Line 193  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  => 3)) {
  return undef; # Inidicates the socket could not be made.   return undef; # Inidicates the socket could not be made.
     }      }
     #      #
Line 161  sub new { Line 210  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 265  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)) { # 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 286  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 272  sub Readable { Line 321  sub Readable {
     $key=substr($key,0,32);      $key=substr($key,0,32);
     my $cipherkey=pack("H32",$key);      my $cipherkey=pack("H32",$key);
     $self->{Cipher} = new IDEA $cipherkey;      $self->{Cipher} = new IDEA $cipherkey;
     if($self->{Cipher} == undef) {      if($self->{Cipher} eq undef) {
  $self->Transition("Disconnected");   $self->Transition("Disconnected");
  $socket->close();   $socket->close();
  return -1;   return -1;
Line 337  sub Writable { Line 386  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 703  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 734  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.
Line 697  sub GetHostIterator { Line 746  sub GetHostIterator {
     return HashIterator->new(\%hostshash);          return HashIterator->new(\%hostshash);    
 }  }
   
   ###########################################################
   #
   #  The following is an unashamed kludge that is here to
   # allow LondConnection to be used outside of the
   # loncapa environment (e.g. by lonManage).
   # 
   #   This is a textual inclusion of pieces of the
   #   Configuration.pm module.
   #
   
   
   my $confdir='/etc/httpd/conf/';
   
   # ------------------- Subroutine read_conf: read LON-CAPA server configuration.
   # This subroutine reads PerlSetVar values out of specified web server
   # configuration files.
   sub read_conf
     {
       my (@conf_files)=@_;
       my %perlvar;
       foreach my $filename (@conf_files,'loncapa_apache.conf')
         {
    open(CONFIG,'<'.$confdir.$filename) or
       die("Can't read $confdir$filename");
    while (my $configline=<CONFIG>)
     {
       if ($configline =~ /^[^\#]*PerlSetVar/)
         {
    my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
    chomp($varvalue);
    $perlvar{$varname}=$varvalue;
         }
     }
    close(CONFIG);
         }
       my $perlvarref=\%perlvar;
       return ($perlvarref);
     }
   
   #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
   # formatted configuration file.
   #
   my $RequiredCount = 5; # Required item count in hosts.tab.
   my $DefaultMaxCon = 5; # Default value for maximum connections.
   my $DefaultIdle   = 1000;       # Default connection idle time in seconds.
   my $DefaultMinCon = 0;          # Default value for minimum connections.
   
   sub read_hosts {
       my $Filename = shift;
       my %HostsTab;
       
       open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
       while (my $line = <CONFIG>) {
    if (!($line =~ /^\s*\#/)) {
       my @items = split(/:/, $line);
       if(scalar @items >= $RequiredCount) {
    if (scalar @items == $RequiredCount) { # Only required items:
       $items[$RequiredCount] = $DefaultMaxCon;
    }
    if(scalar @items == $RequiredCount + 1) { # up through maxcon.
       $items[$RequiredCount+1] = $DefaultIdle;
    }
    if(scalar @items == $RequiredCount + 2) { # up through idle.
       $items[$RequiredCount+2] = $DefaultMinCon;
    }
    {
       my @list = @items; # probably not needed but I'm unsure of 
       # about the scope of item so...
       $HostsTab{$list[0]} = \@list; 
    }
       }
    }
       }
       close(CONFIG);
       my $hostref = \%HostsTab;
       return ($hostref);
   }
   
   
 1;  1;
   
 =pod  =pod
Removed from v.1.6  
changed lines
  Added in v.1.15

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