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

Diff for /loncom/LondConnection.pm between versions 1.4 and 1.25

version 1.4, 2003/06/11 02:04:35 version 1.25, 2004/02/09 13:33:16
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=4;  
   
   
   
   my $DebugLevel=0;
   my %hostshash;
   my %perlvar;
   
   #
   #  Set debugging level
   #
   sub SetDebug {
       $DebugLevel = shift;
   }
   
   #
   #   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};
       $ConfigRead = 1;
       
   }
   
 close(CONFIG);  #
   #  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;
   
       &Debug(4, "ReadForeignConfig $MyHost $Filename\n");
   
       $perlvar{lonHostID} = $MyHost; # Rmember my host.
       my $hosttab = read_hosts($Filename) ||
    die "Can't read hosts table!!";
       %hostshash = %{$hosttab};
       if($DebugLevel > 3) {
    foreach my $host (keys %hostshash) {
       print "host $host => $hostshash{$host}\n";
    }
       }
       $ConfigRead = 1;
   
   }
   
 sub Debug {  sub Debug {
     my $level   = shift;      my $level   = shift;
Line 64  sub Debug { Line 119  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;
     print "Dumping LondConnectionObject:\n";      my $key;
       my $value;
       print STDERR "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 STDERR "-------------------------------\n";
 }  }
   
 =pod  =pod
Line 97  sub Transition { Line 154  sub Transition {
 }  }
   
   
   
 =pod  =pod
   
 =head2 new  =head2 new
Line 119  sub new { Line 177  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 128  sub new { Line 191  sub new {
     #  LoncapaHim fields of the object respectively.      #  LoncapaHim fields of the object respectively.
     #      #
     if (!exists $hostshash{$Hostname}) {      if (!exists $hostshash{$Hostname}) {
    &Debug(8, "No Such host $Hostname");
  return undef; # No such host!!!   return undef; # No such host!!!
     }      }
     my @ConfigLine = @{$hostshash{$Hostname}};      my @ConfigLine = @{$hostshash{$Hostname}};
Line 135  sub new { Line 199  sub new {
     Debug(5, "Connecting to ".$DnsName);      Debug(5, "Connecting to ".$DnsName);
     # Now create the object...      # Now create the object...
     my $self     = { Host               => $DnsName,      my $self     = { Host               => $DnsName,
      LoncapaHim         => $Hostname,                       LoncapaHim         => $Hostname,
              Port               => $Port,                       Port               => $Port,
              State              => "Initialized",                       State              => "Initialized",
              TransactionRequest => "",                       TransactionRequest => "",
              TransactionReply   => "",                       TransactionReply   => "",
              InformReadable     => 0,                       InformReadable     => 0,
              InformWritable     => 0,                       InformWritable     => 0,
      TimeoutCallback    => undef,                       TimeoutCallback    => undef,
      TransitionCallback => undef,                       TransitionCallback => undef,
              Timeoutable        => 0,                       Timeoutable        => 0,
              TimeoutValue       => 60,                       TimeoutValue       => 30,
              TimeoutRemaining   => 0,                       TimeoutRemaining   => 0,
      CipherKey          => "",                       CipherKey          => "",
      Cipher             => undef};                       LondVersion        => "Unknown",
                        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 227  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 282  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 303  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();
  return -1;   return -1;
     }      }
       
     &Debug(8," Transition out of Initialized");      &Debug(8," Transition out of Initialized");
     $self->{TransactionRequest} = $self->{TransactionReply};      $self->{TransactionRequest} = $self->{TransactionReply};
     $self->{InformWritable}     = 1;      $self->{InformWritable}     = 1;
Line 251  sub Readable { Line 317  sub Readable {
     $self->Transition("ChallengeReceived");      $self->Transition("ChallengeReceived");
     $self->{TimeoutRemaining}   = $self->{TimeoutValue};      $self->{TimeoutRemaining}   = $self->{TimeoutValue};
     return 0;      return 0;
  } elsif ($self->{State} eq "ChallengeReplied") { # should be ok.   }  elsif ($self->{State} eq "ChallengeReplied") {
     if($self->{TransactionReply} != "ok\n") {      if($self->{TransactionReply} ne "ok\n") {
    $self->Transition("Disconnected");
    $socket->close();
    return -1;
       }
       $self->Transition("RequestingVersion");
       $self->{InformReadable}   = 0;
       $self->{InformWritable}   = 1;
       $self->{TransactionRequest} = "version\n";
       return 0;
    } elsif ($self->{State} eq "ReadingVersionString") {
       $self->{LondVersion}       = chomp($self->{TransactionReply});
       $self->Transition("SetHost");
       $self->{InformReadable}    = 0;
       $self->{InformWritable}    = 1;
       my $peer = $self->{LoncapaHim};
       $self->{TransactionRequest}= "sethost:$peer\n";
       return 0;
    } elsif ($self->{State} eq "HostSet") { # should be ok.
       if($self->{TransactionReply} ne "ok\n") {
  $self->Transition("Disconnected");   $self->Transition("Disconnected");
  $socket->close();   $socket->close();
  return -1;   return -1;
Line 272  sub Readable { Line 357  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 310  sub Readable { Line 395  sub Readable {
     }      }
   
     return 0;      return 0;
       
 }  }
   
   
Line 325  mark the object as waiting for readabili Line 410  mark the object as waiting for readabili
 Returns  0 if successful, or -1 if not.  Returns  0 if successful, or -1 if not.
   
 =cut  =cut
   
 sub Writable {  sub Writable {
     my $self     = shift; # Get reference to the object.      my $self     = shift; # Get reference to the object.
     my $socket   = $self->{Socket};      my $socket   = $self->{Socket};
Line 337  sub Writable { Line 423  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 354  sub Writable { Line 440  sub Writable {
  $self->Transition("Initialized");   $self->Transition("Initialized");
     } elsif($self->{State} eq "ChallengeReceived") {      } elsif($self->{State} eq "ChallengeReceived") {
  $self->Transition("ChallengeReplied");   $self->Transition("ChallengeReplied");
       } elsif($self->{State} eq "RequestingVersion") {
    $self->Transition("ReadingVersionString");
       } elsif ($self->{State} eq "SetHost") {
    $self->Transition("HostSet");
     } elsif($self->{State} eq "RequestingKey") {      } elsif($self->{State} eq "RequestingKey") {
  $self->Transition("ReceivingKey");   $self->Transition("ReceivingKey");
  $self->{InformWritable} = 0;  #            $self->{InformWritable} = 0;
  $self->{InformReadable} = 1;  #            $self->{InformReadable} = 1;
  $self->{TransactionReply} = '';  #            $self->{TransactionReply} = '';
     } elsif ($self->{State} eq "SendingRequest") {      } elsif ($self->{State} eq "SendingRequest") {
  $self->Transition("ReceivingReply");   $self->Transition("ReceivingReply");
  $self->{TimeoutRemaining} = $self->{TimeoutValue};   $self->{TimeoutRemaining} = $self->{TimeoutValue};
Line 372  sub Writable { Line 462  sub Writable {
  $socket->close();   $socket->close();
  return -1;   return -1;
     }      }
   
 }  }
   
 =pod  =pod
   
 =head2 Tick  =head2 Tick
Line 488  sub SetTimeoutCallback { Line 578  sub SetTimeoutCallback {
   
 =pod  =pod
   
   =head2 Shutdown:
   
   Shuts down the socket.
   
   =cut
   
   sub Shutdown {
       my $self = shift;
       my $socket = $self->GetSocket();
       Debug(5,"socket is -$socket-");
       if ($socket) {
    # Ask lond to exit too.  Non blocking so
    # there is no cost for failure.
    eval {
       $socket->send("exit\n", 0);
       $socket->shutdown(2);
    }
       }
   }
   
   =pod
   
 =head2 GetState  =head2 GetState
   
 selector for the object state.  selector for the object state.
Line 512  sub GetSocket { Line 624  sub GetSocket {
     return $self->{Socket};      return $self->{Socket};
 }  }
   
   
 =pod  =pod
   
 =head2 WantReadable  =head2 WantReadable
Line 639  sub Decrypt { Line 752  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 670  are used as follows: Line 783  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 682  sub GetHostIterator { Line 795  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')
         {
     if($DebugLevel > 3) {
         print("Going to read $confdir.$filename\n");
     }
    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);
         }
       if($DebugLevel > 3) {
    print "Dumping perlvar:\n";
    foreach my $var (keys %perlvar) {
       print "$var = $perlvar{$var}\n";
    }
       }
       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);
   }
   #
   #   Get the version of our peer.  Note that this is only well
   #   defined if the state machine has hit the idle state at least
   #   once (well actually if it has transitioned out of 
   #   ReadingVersionString   The member data LondVersion is returned.
   #
   sub PeerVersion {
      my $self = shift;
      
      return $self->{LondVersion};
   }
   
 1;  1;
   
 =pod  =pod
Line 838  peer (assumes the text is a command). Line 1049  peer (assumes the text is a command).
 Decrypts a block of text according to the cipher negotiated with the  Decrypts a block of text according to the cipher negotiated with the
 peer (assumes the block was a reply.  peer (assumes the block was a reply.
   
   =item Shutdown:
   
   Shuts off the socket.
   
 =head2 The following are selector member functions:  =head2 The following are selector member functions:
   
 =item GetState:  =item GetState:
Removed from v.1.4  
changed lines
  Added in v.1.25

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