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

Diff for /loncom/LondConnection.pm between versions 1.31 and 1.41

version 1.31, 2004/06/17 09:26:09 version 1.41, 2006/08/11 20:07:52
Line 42  use LONCAPA::lonssl; Line 42  use LONCAPA::lonssl;
   
   
   
 my $DebugLevel=11;  my $DebugLevel=0;
 my %hostshash;  my %hostshash;
 my %perlvar;  my %perlvar;
 my $LocalDns = ""; # Need not be defined for managers.  my $LocalDns = ""; # Need not be defined for managers.
Line 153  Dump the internal state of the object: F Line 153  Dump the internal state of the object: F
   
 sub Dump {  sub Dump {
     my $self   = shift;      my $self   = shift;
       my $level  = shift;
       my $now    = time;
       my $local  = localtime($now);
       
       if ($level >= $DebugLevel) {
    return;
       }
   
       
     my $key;      my $key;
     my $value;      my $value;
     print STDERR "Dumping LondConnectionObject:\n";      print STDERR "[ $local ] Dumping LondConnectionObject:\n";
       print STDERR join(':',caller(1))."\n";
     while(($key, $value) = each %$self) {      while(($key, $value) = each %$self) {
  print STDERR "$key -> $value\n";   print STDERR "$key -> $value\n";
     }      }
Line 203  host the remote lond is on. This host is Line 213  host the remote lond is on. This host is
 =cut  =cut
   
 sub new {  sub new {
       my ($class, $DnsName, $Port) = @_;
     my ($class, $Hostname, $Port) = @_;  
   
     if (!$ConfigRead) {      if (!$ConfigRead) {
  ReadConfig();   ReadConfig();
  $ConfigRead = 1;   $ConfigRead = 1;
     }      }
     &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");      &Debug(4,$class."::new( ".$DnsName.",".$Port.")\n");
   
     # The host must map to an entry in the hosts table:      # The host must map to an entry in the hosts table:
     #  We connect to the dns host that corresponds to that      #  We connect to the dns host that corresponds to that
Line 218  sub new { Line 227  sub new {
     #  negotion.  In the objec these become the Host and      #  negotion.  In the objec these become the Host and
     #  LoncapaHim fields of the object respectively.      #  LoncapaHim fields of the object respectively.
     #      #
     if (!exists $hostshash{$Hostname}) {      if (!exists $hostshash{$DnsName}) {
  &Debug(8, "No Such host $Hostname");   &Debug(8, "No Such host $DnsName");
  return undef; # No such host!!!   return undef; # No such host!!!
     }      }
     my @ConfigLine = @{$hostshash{$Hostname}};      my @ConfigLine = @{$hostshash{$DnsName}};
     my $DnsName    = $ConfigLine[3]; # 4'th item is dns of host.      my $Hostname    = $ConfigLine[0]; # 0'th item is the msu id of host.
     Debug(5, "Connecting to ".$DnsName);      Debug(5, "Connecting to ".$DnsName);
       # if it is me use loopback for connection
       if ($DnsName eq $LocalDns) { $DnsName="127.0.0.1"; }
       Debug(8, "Connecting to $DnsName I am $LocalDns");
     # Now create the object...      # Now create the object...
     my $self     = { Host               => $DnsName,      my $self     = { Host               => $DnsName,
                      LoncapaHim         => $Hostname,                       LoncapaHim         => $Hostname,
Line 233  sub new { Line 245  sub new {
      AuthenticationMode => "",       AuthenticationMode => "",
                      TransactionRequest => "",                       TransactionRequest => "",
                      TransactionReply   => "",                       TransactionReply   => "",
                        NextRequest        => "",
                      InformReadable     => 0,                       InformReadable     => 0,
                      InformWritable     => 0,                       InformWritable     => 0,
                      TimeoutCallback    => undef,                       TimeoutCallback    => undef,
Line 250  sub new { Line 263  sub new {
        Type     => SOCK_STREAM,         Type     => SOCK_STREAM,
        Proto    => "tcp",         Proto    => "tcp",
        Timeout  => 3)) {         Timeout  => 3)) {
    Debug(8, "Error? \n$@ \n$!");
  return undef; # Inidicates the socket could not be made.   return undef; # Inidicates the socket could not be made.
     }      }
     my $socket = $self->{Socket}; # For local use only.      my $socket = $self->{Socket}; # For local use only.
     #  If we are local, we'll first try local auth mode, otherwise, we'll try the       #  If we are local, we'll first try local auth mode, otherwise, we'll try
     #  ssl auth mode:      #  the ssl auth mode:
   
     Debug(8, "Connecting to $DnsName I am $LocalDns");  
     my $key;      my $key;
     my $keyfile;      my $keyfile;
     if ($DnsName eq $LocalDns) {      if ($DnsName eq '127.0.0.1') {
  $self->{AuthenticationMode} = "local";   $self->{AuthenticationMode} = "local";
  ($key, $keyfile)         = lonlocal::CreateKeyFile();   ($key, $keyfile)         = lonlocal::CreateKeyFile();
  Debug(8, "Local key: $key, stored in $keyfile");   Debug(8, "Local key: $key, stored in $keyfile");
Line 284  sub new { Line 297  sub new {
     return undef;      return undef;
  }   }
   
     }       }
     else {      else {
  $self->{AuthenticationMode} = "ssl";   #  Remote peer:  I'd like to do ssl, but if my host key or certificates
  $self->{TransactionRequest} = "init:ssl\n";   #  are not all installed, my only choice is insecure, if that's 
    #  allowed:
   
    my ($ca, $cert) = lonssl::CertificateFile;
    my $sslkeyfile  = lonssl::KeyFile;
   
    if((defined $ca)  && (defined $cert) && (defined $sslkeyfile)) {
   
       $self->{AuthenticationMode} = "ssl";
       $self->{TransactionRequest} = "init:ssl\n";
    } else {
       if($InsecureOk) { # Allowed to do insecure:
    $self->{AuthenticationMode} = "insecure";
    $self->{TransactionRequest} = "init\n";
       }
       else { # Not allowed to do insecure...
    $socket->close;
    return undef;
       }
    }
     }      }
   
     #      #
Line 315  sub new { Line 347  sub new {
     # return the object :      # return the object :
   
     Debug(9, "Initial object state: ");      Debug(9, "Initial object state: ");
     $self->Dump();      $self->Dump(9);
   
     return $self;      return $self;
 }  }
Line 476  sub Readable { Line 508  sub Readable {
     return 0;      return 0;
   
  } elsif ($self->{State} eq "ReadingVersionString") {   } elsif ($self->{State} eq "ReadingVersionString") {
     $self->{LondVersion}       = chomp($self->{TransactionReply});      chomp($self->{TransactionReply});
       $self->{LondVersion}       = $self->{TransactionReply};
     $self->Transition("SetHost");      $self->Transition("SetHost");
     $self->{InformReadable}    = 0;      $self->{InformReadable}    = 0;
     $self->{InformWritable}    = 1;      $self->{InformWritable}    = 1;
Line 527  sub Readable { Line 560  sub Readable {
     my $answer = $self->{TransactionReply};      my $answer = $self->{TransactionReply};
     if($answer =~ /^enc\:/) {      if($answer =~ /^enc\:/) {
  $answer = $self->Decrypt($answer);   $answer = $self->Decrypt($answer);
  $self->{TransactionReply} = $answer;   $self->{TransactionReply} = "$answer\n";
     }      }
       # if we have a NextRequest do it immeadiately
       if ($self->{NextRequest}) {
    $self->{TransactionRequest} = $self->{NextRequest};
    undef( $self->{NextRequest} );
    $self->{TransactionReply}   = "";
    $self->{InformWritable}     = 1;
    $self->{InformReadable}     = 0;
    $self->{Timeoutable}        = 1;
    $self->{TimeoutRemaining}   = $self->{TimeoutValue};
    $self->Transition("SendingRequest");
    return 0;
       } else {
     # finish the transaction      # finish the transaction
   
     $self->ToIdle();   $self->ToIdle();
     return 0;   return 0;
       }
  } elsif ($self->{State} eq "Disconnected") { # No connection.   } elsif ($self->{State} eq "Disconnected") { # No connection.
     return -1;      return -1;
  } else { # Internal error: Invalid state.   } else { # Internal error: Invalid state.
Line 685  sub InitiateTransaction { Line 730  sub InitiateTransaction {
  return -1; # Error indicator.   return -1; # Error indicator.
     }      }
     # if the transaction is to be encrypted encrypt the data:      # if the transaction is to be encrypted encrypt the data:
       (my $sethost, my $server,$data)=split(/:/,$data,3);
   
     if($data =~ /^encrypt\:/) {      if($data =~ /^encrypt\:/) {
  $data = $self->Encrypt($data);   $data = $self->Encrypt($data);
     }      }
   
     # Setup the trasaction      # Setup the trasaction
       # currently no version of lond supports inlining the sethost
     $self->{TransactionRequest} = $data;      if ($self->PeerVersion() <= 321) {
    if ($server ne $self->{LoncapaHim}) {
       $self->{NextRequest}        = $data;
       $self->{TransactionRequest} = "$sethost:$server\n";
       $self->{LoncapaHim}         = $server;
    } else {
       $self->{TransactionRequest}        = $data;
    }
       } else {
    $self->{LoncapaHim}         = $server;
    $self->{TransactionRequest} = "$sethost:$server:$data";
       }
     $self->{TransactionReply}   = "";      $self->{TransactionReply}   = "";
     $self->{InformWritable}     = 1;      $self->{InformWritable}     = 1;
     $self->{InformReadable}     = 0;      $self->{InformReadable}     = 0;
Line 925  sub Decrypt { Line 982  sub Decrypt {
     #  $length tells us the actual length of the decrypted string:      #  $length tells us the actual length of the decrypted string:
   
     $decrypted = substr($decrypted, 0, $length);      $decrypted = substr($decrypted, 0, $length);
       Debug(9, "Decrypted $EncryptedString to $decrypted");
   
     return $decrypted;      return $decrypted;
   
Line 978  sub CreateCipher { Line 1036  sub CreateCipher {
     if($cipher) {      if($cipher) {
  $self->{Cipher} = $cipher;   $self->{Cipher} = $cipher;
  Debug("Cipher created  dumping socket: ");   Debug("Cipher created  dumping socket: ");
  $self->Dump();   $self->Dump(9);
  return 1;   return 1;
     }      }
     else {      else {
Line 1089  this iterator returns a reference to an Line 1147  this iterator returns a reference to an
 information read from the hosts configuration file.  Array elements  information read from the hosts configuration file.  Array elements
 are used as follows:  are used as follows:
   
  [0]   - LonCapa host name.   [0]   - LonCapa host id.
  [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.
Line 1156  sub read_conf Line 1214  sub read_conf
 #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab  #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
 # formatted configuration file.  # formatted configuration file.
 #  #
 my $RequiredCount = 5; # Required item count in hosts.tab.  my $RequiredCount = 4; # Required item count in hosts.tab.
 my $DefaultMaxCon = 5; # Default value for maximum connections.  my $DefaultMaxCon = 5; # Default value for maximum connections.
 my $DefaultIdle   = 1000;       # Default connection idle time in seconds.  my $DefaultIdle   = 1000;       # Default connection idle time in seconds.
 my $DefaultMinCon = 0;          # Default value for minimum connections.  my $DefaultMinCon = 0;          # Default value for minimum connections.
Line 1165  sub read_hosts { Line 1223  sub read_hosts {
     my $Filename = shift;      my $Filename = shift;
     my %HostsTab;      my %HostsTab;
           
    open(CONFIG,'<'.$Filename) or die("Can't read $Filename");      open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
     while (my $line = <CONFIG>) {      while (my $line = <CONFIG>) {
  if (!($line =~ /^\s*\#/)) {   if ($line !~ /^\s*\#/) {
       $line=~s/\s*$//;
     my @items = split(/:/, $line);      my @items = split(/:/, $line);
     if(scalar @items >= $RequiredCount) {      if(scalar @items >= $RequiredCount) {
  if (scalar @items == $RequiredCount) { # Only required items:   if (scalar @items == $RequiredCount) { # Only required items:
Line 1182  sub read_hosts { Line 1241  sub read_hosts {
  {   {
     my @list = @items; # probably not needed but I'm unsure of       my @list = @items; # probably not needed but I'm unsure of 
     # about the scope of item so...      # about the scope of item so...
     $HostsTab{$list[0]} = \@list;       $HostsTab{$list[3]} = \@list; 
  }   }
     }      }
  }   }
Line 1199  sub read_hosts { Line 1258  sub read_hosts {
 #  #
 sub PeerVersion {  sub PeerVersion {
    my $self = shift;     my $self = shift;
         my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/);
    return $self->{LondVersion};     return $version;
 }  }
   
 1;  1;
Removed from v.1.31  
changed lines
  Added in v.1.41

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