Diff for /loncom/LondConnection.pm between versions 1.11 and 1.23

version 1.11, 2003/09/30 10:46:57 version 1.23, 2004/01/06 09:35:22
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
 package LondConnection;  package LondConnection;
   
 use strict;  use strict;
Line 35  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 65  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
   
Line 73  sub Dump { Line 127  sub Dump {
     my $self   = shift;      my $self   = shift;
     my $key;      my $key;
     my $value;      my $value;
     print "Dumping LondConnectionObject:\n";      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 100  sub Transition { Line 154  sub Transition {
 }  }
   
   
   
 =pod  =pod
   
 =head2 new  =head2 new
Line 122  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 131  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 157  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 276  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 501  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 701  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.11  
changed lines
  Added in v.1.23


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.