--- loncom/LondConnection.pm 2004/02/09 13:33:16 1.25 +++ loncom/LondConnection.pm 2004/06/01 10:05:16 1.30 @@ -1,7 +1,7 @@ # This module defines and implements a class that represents # a connection to a lond daemon. # -# $Id: LondConnection.pm,v 1.25 2004/02/09 13:33:16 albertel Exp $ +# $Id: LondConnection.pm,v 1.30 2004/06/01 10:05:16 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -89,8 +89,8 @@ sub ReadConfig { # to build up the hosts table. # sub ReadForeignConfig { - my $MyHost = shift; - my $Filename = shift; + + my ($MyHost, $Filename) = @_; &Debug(4, "ReadForeignConfig $MyHost $Filename\n"); @@ -108,8 +108,9 @@ sub ReadForeignConfig { } sub Debug { - my $level = shift; - my $message = shift; + + my ($level, $message) = @_; + if ($level < $DebugLevel) { print($message."\n"); } @@ -143,8 +144,9 @@ old state. =cut sub Transition { - my $self = shift; - my $newstate = shift; + + my ($self, $newstate) = @_; + my $oldstate = $self->{State}; $self->{State} = $newstate; $self->{TimeoutRemaining} = $self->{TimeoutValue}; @@ -174,9 +176,8 @@ host the remote lond is on. This host is =cut sub new { - my $class = shift; # class name. - my $Hostname = shift; # Name of host to connect to. - my $Port = shift; # Port to connect + + my ($class, $Hostname, $Port) = @_; if (!$ConfigRead) { ReadConfig(); @@ -216,10 +217,10 @@ sub new { Cipher => undef}; bless($self, $class); unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host}, - PeerPort => $self->{Port}, - Type => SOCK_STREAM, - Proto => "tcp", - Timeout => 3)) { + PeerPort => $self->{Port}, + Type => SOCK_STREAM, + Proto => "tcp", + Timeout => 3)) { return undef; # Inidicates the socket could not be made. } # @@ -279,7 +280,15 @@ sub Readable { my $self = shift; my $socket = $self->{Socket}; 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. unless (defined($rv) && length $data) {# Read failed, @@ -300,7 +309,7 @@ sub Readable { &Debug(9,"Received from host: ".$data); $self->{TransactionReply} .= $data; - if($self->{TransactionReply} =~ /(.*\n)/) { + if($self->{TransactionReply} =~ m/\n$/) { &Debug(8,"Readable End of line detected"); if ($self->{State} eq "Initialized") { # We received the challenge: if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have @@ -309,7 +318,7 @@ sub Readable { $socket->close(); return -1; } - + &Debug(8," Transition out of Initialized"); $self->{TransactionRequest} = $self->{TransactionReply}; $self->{InformWritable} = 1; @@ -395,7 +404,7 @@ sub Readable { } return 0; - + } @@ -410,11 +419,21 @@ mark the object as waiting for readabili Returns 0 if successful, or -1 if not. =cut - sub Writable { my $self = shift; # Get reference to the object. 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; unless (defined $nwritten) { if($errno != POSIX::EINTR) { @@ -429,41 +448,41 @@ sub Writable { ($errno == POSIX::EINTR) || ($errno == 0)) { substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part - if(length $self->{TransactionRequest} == 0) { - $self->{InformWritable} = 0; - $self->{InformReadable} = 1; - $self->{TransactionReply} = ''; - # - # Figure out the next state: - # - if($self->{State} eq "Connected") { - $self->Transition("Initialized"); - } elsif($self->{State} eq "ChallengeReceived") { - $self->Transition("ChallengeReplied"); - } elsif($self->{State} eq "RequestingVersion") { - $self->Transition("ReadingVersionString"); - } elsif ($self->{State} eq "SetHost") { - $self->Transition("HostSet"); - } elsif($self->{State} eq "RequestingKey") { - $self->Transition("ReceivingKey"); + if(length $self->{TransactionRequest} == 0) { + $self->{InformWritable} = 0; + $self->{InformReadable} = 1; + $self->{TransactionReply} = ''; + # + # Figure out the next state: + # + if($self->{State} eq "Connected") { + $self->Transition("Initialized"); + } elsif($self->{State} eq "ChallengeReceived") { + $self->Transition("ChallengeReplied"); + } elsif($self->{State} eq "RequestingVersion") { + $self->Transition("ReadingVersionString"); + } elsif ($self->{State} eq "SetHost") { + $self->Transition("HostSet"); + } elsif($self->{State} eq "RequestingKey") { + $self->Transition("ReceivingKey"); # $self->{InformWritable} = 0; # $self->{InformReadable} = 1; # $self->{TransactionReply} = ''; - } elsif ($self->{State} eq "SendingRequest") { - $self->Transition("ReceivingReply"); - $self->{TimeoutRemaining} = $self->{TimeoutValue}; - } elsif ($self->{State} eq "Disconnected") { - return -1; - } - return 0; - } - } else { # The write failed (e.g. partner disconnected). - $self->Transition("Disconnected"); - $socket->close(); - return -1; - } + } elsif ($self->{State} eq "SendingRequest") { + $self->Transition("ReceivingReply"); + $self->{TimeoutRemaining} = $self->{TimeoutValue}; + } elsif ($self->{State} eq "Disconnected") { + return -1; + } + return 0; + } + } else { # The write failed (e.g. partner disconnected). + $self->Transition("Disconnected"); + $socket->close(); + return -1; + } + } - =pod =head2 Tick @@ -517,8 +536,8 @@ timout, and to request writability notif =cut sub InitiateTransaction { - my $self = shift; - my $data = shift; + + my ($self, $data) = @_; Debug(1, "initiating transaction: ".$data); if($self->{State} ne "Idle") { @@ -569,8 +588,9 @@ established callback or undef if there w =cut sub SetTimeoutCallback { - my $self = shift; - my $callback = shift; + + my ($self, $callback) = @_; + my $oldCallback = $self->{TimeoutCallback}; $self->{TimeoutCallback} = $callback; return $oldCallback; @@ -698,8 +718,8 @@ The output string can be directly sent t =cut 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. @@ -741,8 +761,8 @@ Decrypt a response from the server. The =cut 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: