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

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

version 1.15, 2003/10/28 11:15:10 version 1.30, 2004/06/01 10:05:16
Line 46  my %hostshash; Line 46  my %hostshash;
 my %perlvar;  my %perlvar;
   
 #  #
   #  Set debugging level
   #
   sub SetDebug {
       $DebugLevel = shift;
   }
   
   #
 #   The config read is done in this way to support the read of  #   The config read is done in this way to support the read of
 #   the non-default configuration file in the  #   the non-default configuration file in the
 #   event we are being used outside of loncapa.  #   event we are being used outside of loncapa.
Line 60  sub ReadConfig { Line 67  sub ReadConfig {
     my $perlvarref = read_conf('loncapa.conf');      my $perlvarref = read_conf('loncapa.conf');
     %perlvar    = %{$perlvarref};      %perlvar    = %{$perlvarref};
     my $hoststab   = 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!!";
     %hostshash  = %{$hoststab};      %hostshash  = %{$hoststab};
       $ConfigRead = 1;
           
 }  }
   
Line 81  sub ReadConfig { Line 89  sub ReadConfig {
 #                 to build up the hosts table.  #                 to build up the hosts table.
 #  #
 sub ReadForeignConfig {  sub ReadForeignConfig {
     my $MyHost   = shift;  
     my $Filename = shift;      my ($MyHost, $Filename) = @_;
   
       &Debug(4, "ReadForeignConfig $MyHost $Filename\n");
   
     $perlvar{lonHostID} = $MyHost; # Rmember my host.      $perlvar{lonHostID} = $MyHost; # Rmember my host.
     my $hosttab = read_hosts($Filename) ||      my $hosttab = read_hosts($Filename) ||
  die "Can't read hosts table!!";   die "Can't read hosts table!!";
     %hostshash = %{$hosttab}      %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 $message = shift;      my ($level, $message) = @_;
   
     if ($level < $DebugLevel) {      if ($level < $DebugLevel) {
  print($message."\n");   print($message."\n");
     }      }
Line 112  sub Dump { Line 128  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 STDERR "$key -> $value\n";   print STDERR "$key -> $value\n";
     }      }
     print "-------------------------------\n";      print STDERR "-------------------------------\n";
 }  }
   
 =pod  =pod
Line 128  old state. Line 144  old state.
 =cut  =cut
   
 sub Transition {  sub Transition {
     my $self     = shift;  
     my $newstate = shift;      my ($self, $newstate) = @_;
   
     my $oldstate = $self->{State};      my $oldstate = $self->{State};
     $self->{State} = $newstate;      $self->{State} = $newstate;
     $self->{TimeoutRemaining} = $self->{TimeoutValue};      $self->{TimeoutRemaining} = $self->{TimeoutValue};
Line 159  host the remote lond is on. This host is Line 176  host the remote lond is on. This host is
 =cut  =cut
   
 sub new {  sub new {
     my $class    = shift; # class name.  
     my $Hostname = shift; # Name of host to connect to.      my ($class, $Hostname, $Port) = @_;
     my $Port     = shift; # Port to connect   
   
     if (!$ConfigRead) {      if (!$ConfigRead) {
  ReadConfig();   ReadConfig();
Line 176  sub new { Line 192  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 183  sub new { Line 200  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       => 30,                       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},
Line 262  sub Readable { Line 280  sub Readable {
     my $self    = shift;      my $self    = shift;
     my $socket  = $self->{Socket};      my $socket  = $self->{Socket};
     my $data    = '';      my $data    = '';
     my $rv      = $socket->recv($data, POSIX::BUFSIZ,  0);      my $rv;
       if ($socket) {
    eval {
       $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
    }
       } else {
    $self->Transition("Disconnected");
    return -1;
       }
     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,
Line 283  sub Readable { Line 309  sub Readable {
   
     &Debug(9,"Received from host: ".$data);      &Debug(9,"Received from host: ".$data);
     $self->{TransactionReply} .= $data;      $self->{TransactionReply} .= $data;
     if($self->{TransactionReply} =~ /(.*\n)/) {      if($self->{TransactionReply} =~ m/\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\n") { # Remote doesn't have      if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
Line 300  sub Readable { Line 326  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 377  Returns  0 if successful, or -1 if not. Line 422  Returns  0 if successful, or -1 if not.
 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};
     my $nwritten = $socket->send($self->{TransactionRequest}, 0);      my $nwritten;
       if ($socket) {
    eval {
       $nwritten = $socket->send($self->{TransactionRequest}, 0);
    }
       } else {
    # For whatever reason, there's no longer a socket left.
   
   
    $self->Transition("Disconnected");
    return -1;
       }
     my $errno    = $! + 0;      my $errno    = $! + 0;
     unless (defined $nwritten) {      unless (defined $nwritten) {
  if($errno != POSIX::EINTR) {   if($errno != POSIX::EINTR) {
Line 392  sub Writable { Line 448  sub Writable {
  ($errno == POSIX::EINTR)          ||   ($errno == POSIX::EINTR)          ||
  ($errno ==  0)) {   ($errno ==  0)) {
  substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part   substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
  if(length $self->{TransactionRequest} == 0) {        if(length $self->{TransactionRequest} == 0) {
     $self->{InformWritable} = 0;           $self->{InformWritable} = 0;
     $self->{InformReadable} = 1;           $self->{InformReadable} = 1;
     $self->{TransactionReply} = '';           $self->{TransactionReply} = '';
     #           #
     # Figure out the next state:           # Figure out the next state:
     #           #
     if($self->{State} eq "Connected") {           if($self->{State} eq "Connected") {
  $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 "RequestingKey") {           } elsif($self->{State} eq "RequestingVersion") {
  $self->Transition("ReceivingKey");              $self->Transition("ReadingVersionString");
  $self->{InformWritable} = 0;           } elsif ($self->{State} eq "SetHost") {
  $self->{InformReadable} = 1;              $self->Transition("HostSet");
  $self->{TransactionReply} = '';           } elsif($self->{State} eq "RequestingKey") {
     } elsif ($self->{State} eq "SendingRequest") {              $self->Transition("ReceivingKey");
  $self->Transition("ReceivingReply");  #            $self->{InformWritable} = 0;
  $self->{TimeoutRemaining} = $self->{TimeoutValue};  #            $self->{InformReadable} = 1;
     } elsif ($self->{State} eq "Disconnected") {  #            $self->{TransactionReply} = '';
  return -1;           } elsif ($self->{State} eq "SendingRequest") {
     }              $self->Transition("ReceivingReply");
     return 0;              $self->{TimeoutRemaining} = $self->{TimeoutValue};
  }           } elsif ($self->{State} eq "Disconnected") {
     } else { # The write failed (e.g. partner disconnected).              return -1;
  $self->Transition("Disconnected");           }
  $socket->close();           return 0;
  return -1;        }
     }     } else { # The write failed (e.g. partner disconnected).
         $self->Transition("Disconnected");
         $socket->close();
         return -1;
      }
   
 }  }
 =pod  =pod
Line 476  timout, and to request writability notif Line 536  timout, and to request writability notif
 =cut  =cut
   
 sub InitiateTransaction {  sub InitiateTransaction {
     my $self   = shift;  
     my $data   = shift;      my ($self, $data) = @_;
   
     Debug(1, "initiating transaction: ".$data);      Debug(1, "initiating transaction: ".$data);
     if($self->{State} ne "Idle") {      if($self->{State} ne "Idle") {
Line 528  established callback or undef if there w Line 588  established callback or undef if there w
 =cut  =cut
   
 sub SetTimeoutCallback {  sub SetTimeoutCallback {
     my $self                 = shift;  
     my $callback             = shift;      my ($self, $callback) = @_;
   
     my $oldCallback          = $self->{TimeoutCallback};      my $oldCallback          = $self->{TimeoutCallback};
     $self->{TimeoutCallback} = $callback;      $self->{TimeoutCallback} = $callback;
     return $oldCallback;      return $oldCallback;
Line 546  Shuts down the socket. Line 607  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 649  The output string can be directly sent t Line 718  The output string can be directly sent t
 =cut  =cut
   
 sub Encrypt {  sub Encrypt {
     my $self    = shift; # Reference to the object.      
     my $request = shift;        # Text to send.      my ($self, $request) = @_;
   
         
     # Split the encrypt: off the request and figure out it's length.      # Split the encrypt: off the request and figure out it's length.
Line 692  Decrypt a response from the server.  The Line 761  Decrypt a response from the server.  The
 =cut  =cut
   
 sub Decrypt {  sub Decrypt {
     my $self      = shift; # Recover reference to object  
     my $encrypted = shift; # This is the encrypted data.      my ($self, $encrypted) = @_;
   
     #  Bust up the response into length, and encryptedstring:      #  Bust up the response into length, and encryptedstring:
   
Line 768  sub read_conf Line 837  sub read_conf
     my %perlvar;      my %perlvar;
     foreach my $filename (@conf_files,'loncapa_apache.conf')      foreach my $filename (@conf_files,'loncapa_apache.conf')
       {        {
     if($DebugLevel > 3) {
         print("Going to read $confdir.$filename\n");
     }
  open(CONFIG,'<'.$confdir.$filename) or   open(CONFIG,'<'.$confdir.$filename) or
     die("Can't read $confdir$filename");      die("Can't read $confdir$filename");
  while (my $configline=<CONFIG>)   while (my $configline=<CONFIG>)
Line 781  sub read_conf Line 853  sub read_conf
   }    }
  close(CONFIG);   close(CONFIG);
       }        }
       if($DebugLevel > 3) {
    print "Dumping perlvar:\n";
    foreach my $var (keys %perlvar) {
       print "$var = $perlvar{$var}\n";
    }
       }
     my $perlvarref=\%perlvar;      my $perlvarref=\%perlvar;
     return ($perlvarref);      return $perlvarref;
   }  }
   
 #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab  #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
 # formatted configuration file.  # formatted configuration file.
Line 797  sub read_hosts { Line 875  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*\#/)) {
     my @items = split(/:/, $line);      my @items = split(/:/, $line);
Line 823  sub read_hosts { Line 901  sub read_hosts {
     my $hostref = \%HostsTab;      my $hostref = \%HostsTab;
     return ($hostref);      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;
   
Removed from v.1.15  
changed lines
  Added in v.1.30

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