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

Diff for /loncom/LondConnection.pm between versions 1.9 and 1.22

version 1.9, 2003/08/26 09:21:01 version 1.22, 2004/01/05 09:30: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;
   
   #
   #  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 "-------------------------------\n";
 }  }
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 154  sub new { Line 218  sub new {
        PeerPort => $self->{Port},         PeerPort => $self->{Port},
        Type     => SOCK_STREAM,         Type     => SOCK_STREAM,
        Proto    => "tcp",         Proto    => "tcp",
        Timeout  => 5)) {         Timeout  => 3)) {
  return undef; # Inidicates the socket could not be made.   return undef; # Inidicates the socket could not be made.
     }      }
     #      #
Line 169  sub new { Line 233  sub new {
     # 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 238  sub Readable { Line 302  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 273  sub Readable { Line 337  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 338  sub Writable { Line 402  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 498  Shuts down the socket. Line 562  Shuts down the socket.
 sub Shutdown {  sub Shutdown {
     my $self = shift;      my $self = shift;
     my $socket = $self->GetSocket();      my $socket = $self->GetSocket();
     $socket->shutdown(2);      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  =pod
Line 655  sub Decrypt { Line 727  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 686  are used as follows: Line 758  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 698  sub GetHostIterator { Line 770  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);
   }
   
   
 1;  1;
   
 =pod  =pod
Removed from v.1.9  
changed lines
  Added in v.1.22

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.