extend the Web interface protocol further

[spider.git] / perl / Msg.pm

diff --git a/perl/Msg.pm b/perl/Msg.pm
index fadab099783cd36d42463cbb932910a515e399c1..ad09c85da0f784d98b12634f01ad1a0e421144d5 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -61,14 +61,14 @@ sub set_error
 {
        my $conn = shift;
        my $callback = shift;
-       $conn->{sock}->on(error => sub {$callback->($conn, $_[1]);});
+       $conn->{sock}->on(error => sub {$callback->($_[1]);});
 }
 
 sub set_on_eof
 {
        my $conn = shift;
        my $callback = shift;
-       $conn->{sock}->on(close => sub {$callback->($conn);});
+       $conn->{sock}->on(close => sub {$callback->()});
 }
 
 sub set_rproc
@@ -120,9 +120,11 @@ sub ax25
 sub peerhost
 {
        my $conn = shift;
-       $conn->{peerhost} ||= 'ax25' if $conn->ax25;
-       $conn->{peerhost} ||= $conn->{sock}->handle->peerhost if $conn->{sock};
-       $conn->{peerhost} ||= 'UNKNOWN';
+       unless ($conn->{peerhost}) {
+               $conn->{peerhost} ||= 'ax25' if $conn->ax25;
+               $conn->{peerhost} ||= $conn->{sock}->handle->peerhost if $conn->{sock};
+               $conn->{peerhost} ||= 'UNKNOWN';
+       }
        return $conn->{peerhost};
 }
 
@@ -136,14 +138,14 @@ sub _on_connect
        undef $conn->{sock};
        my $sock = $conn->{sock} = Mojo::IOLoop::Stream->new($handle);
        $sock->on(read => sub {$conn->_rcv($_[1]);} );
-       $sock->on(error => sub {$conn->disconnect;});
-       $sock->on(close => sub {$conn->disconnect;});
+       $sock->on(error => sub {delete $conn->{sock}; $conn->disconnect;});
+       $sock->on(close => sub {delete $conn->{sock}; $conn->disconnect;});
        $sock->timeout(0);
        $sock->start;
        $conn->{peerhost} = eval { $handle->peerhost; };
        dbg((ref $conn) . " connected $conn->{cnum} to $conn->{peerhost}:$conn->{peerport}") if isdbg('connll');
        if ($conn->{on_connect}) {
-               &{$conn->{on_connect}}($conn);
+               &{$conn->{on_connect}}($conn, $handle);
        }
 }
 
@@ -155,12 +157,13 @@ sub is_connected
 }
 
 sub connect {
-    my ($pkg, $to_host, $to_port, $rproc,  %args) = @_;
+    my ($pkg, $to_host, $to_port, %args) = @_;
        my $timeout = delete $args{timeout} || $connect_timeout;
        
     # Create a connection end-point object
     my $conn = $pkg;
        unless (ref $pkg) {
+               my $rproc = delete $args{rproc}; 
                $conn = $pkg->new($rproc);
        }
        $conn->{peerhost} = $to_host;
@@ -172,7 +175,7 @@ sub connect {
        my $sock;
        $conn->{sock} = $sock = Mojo::IOLoop::Client->new;
        $sock->on(connect => sub {$conn->_on_connect($_[1])} );
-       $sock->on(error => sub {$conn->disconnect});
+       $sock->on(error => sub {&{$conn->{eproc}}($conn, $_[1]) if exists $conn->{eproc}; $conn->disconnect});
        $sock->on(close => sub {$conn->disconnect});
 
        # copy any args like on_connect, on_disconnect etc
@@ -264,9 +267,8 @@ sub disconnect
                }
        }
 
-       if (defined($sock)) {
-               $sock->close_gracefully;
-       }
+       $sock->close_gracefully if defined $sock && $sock->can('close_gracefully');
+       undef $sock;
        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
@@ -278,6 +280,9 @@ sub _send_stuff
        my $conn = shift;
        my $rq = $conn->{outqueue};
     my $sock = $conn->{sock};
+       return unless defined $sock;
+       return if $conn->{disconnecting};
+       
        while (@$rq) {
                my $data = shift @$rq;
                my $lth = length $data;
@@ -289,7 +294,7 @@ sub _send_stuff
                }
                if (defined $sock) {
                        $sock->write($data);
-                       $total_out = $lth;
+                       $total_out += $lth;
                } else {
                        dbg("_send_stuff $call ending data ignored: $data");
                }
@@ -377,6 +382,9 @@ sub _rcv {                     # Complement to _send
        my $msg = shift;
     my $sock = $conn->{sock};
     return unless defined($sock);
+       return if $conn->{disconnecting};
+
+       $total_in += length $msg;
 
        my @lines;
        if (isdbg('raw')) {
@@ -410,16 +418,16 @@ sub _rcv {                     # Complement to _send
 
 sub new_client {
        my $server_conn = shift;
-       my $client = shift;
+       my $handle = shift;
        
        my $conn = $server_conn->new($server_conn->{rproc});
-       my $sock = $conn->{sock} = Mojo::IOLoop::Stream->new($client);
+       my $sock = $conn->{sock} = Mojo::IOLoop::Stream->new($handle);
        $sock->on(read => sub {$conn->_rcv($_[1])});
        $sock->timeout(0);
        $sock->start;
        dbg((ref $conn) . "accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll');
 
-       my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $client->peerhost, $conn->{peerport} = $client->peerport);
+       my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $handle->peerhost, $conn->{peerport} = $handle->peerport);
        $conn->{sort} = 'Incoming';
        if ($eproc) {
                $conn->{eproc} = $eproc;
@@ -485,6 +493,10 @@ sub DESTROY
        my $call = $conn->{call} || 'unallocated';
        my $host = $conn->{peerhost} || '';
        my $port = $conn->{peerport} || '';
+       my $sock = $conn->{sock};
+
+       $sock->close_gracefully if defined $sock && $sock->can('close_gracefully');
+       
        $noconns--;
        dbg((ref $conn) . " Connection $conn->{cnum} $call [$host $port] being destroyed (total $noconns)") if isdbg('connll');
 }