fix DXCron, lockout and close_gracefully

[spider.git] / perl / Msg.pm

diff --git a/perl/Msg.pm b/perl/Msg.pm
index aa9993e7ff966bf2b15ae5d3dc9782e96a421271..13833962d3d316d26f997e8861a431d143bda478 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -20,15 +20,16 @@ use Mojo::IOLoop::Stream;
 use DXDebug;
 use Timer;
 
-use vars qw($now %conns $noconns $cnum $total_in $total_out $connect_timeout $disc_waittime);
+use vars qw($now %conns $noconns $cnum $total_in $total_out $total_lines_in $total_lines_out $connect_timeout $disc_waittime);
 
 $total_in = $total_out = 0;
+$total_lines_in = $total_lines_out = 0;
 
 $now = time;
 
 $cnum = 0;
 $connect_timeout = 5;
-$disc_waittime = 3;
+$disc_waittime = 1.5;
 
 our %delqueue;
 
@@ -43,15 +44,19 @@ sub new
        my $class = $obj || $pkg;
 
     my $conn = {
-        rproc => $rproc,
-               inqueue => [],
-               outqueue => [],
-               state => 0,
-               lineend => "\r\n",
-               csort => 'telnet',
-               timeval => 60,
-               blocking => 0,
-               cnum => (($cnum < 999) ? (++$cnum) : ($cnum = 1)),
+                               rproc => $rproc,
+                               inqueue => [],
+                               outqueue => [],
+                               state => 0,
+                               lineend => "\r\n",
+                               csort => 'telnet',
+                               timeval => 60,
+                               blocking => 0,
+                               cnum => (($cnum < 999) ? (++$cnum) : ($cnum = 1)),
+                               linesin => 0,
+                               linesout => 0,
+                               datain => 0,
+                               dataout => 0,
     };
 
        $noconns++;
@@ -146,7 +151,7 @@ sub _on_connect
        $sock->timeout(0);
        $sock->start;
        $conn->{peerhost} = eval { $handle->peerhost; };
-       dbg((ref $conn) . " connected $conn->{cnum} to $conn->{peerhost}:$conn->{peerport}") if isdbg('connll');
+       dbg((ref $conn) . " connected $conn->{cnum} to $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg ('connect');
        if ($conn->{on_connect}) {
                &{$conn->{on_connect}}($conn, $handle);
        }
@@ -257,7 +262,7 @@ sub disconnect
        my ($pkg, $fn, $line) = caller if $dbg;
 
        if ($count >= 2) {
-               dbg((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line FORCING CLOSE ") if $dbg;
+               dbgtrace((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line FORCING CLOSE ") if $dbg;
                _close_it($conn);
                return;
        }
@@ -276,14 +281,16 @@ sub disconnect
        $delqueue{$conn} = $conn; # save this connection until everything is finished
        my $sock = $conn->{sock};
        if ($sock) {
-
-               # remove me from the active list
-               my $call;
-               if ($call = $conn->{call}) {
-                       my $ref = $conns{$call};
-                       delete $conns{$call} if $ref && $ref == $conn;
+               if ($sock->{buffer}) {
+                       my $lth = length $sock->{buffer};
+                       Mojo::IOLoop->timer($disc_waittime, sub {
+                                                                       dbg("Buffer contained $lth characters, coordinated for $disc_waittime secs, now disconnecting $call") if $dbg;
+                                                                       _close_it($conn);
+                                                               });
+               } else {
+                       dbg("Buffer empty, just close $call") if $dbg;
+                       _close_it($conn);
                }
-               _close_it($conn);
        } else {
                dbg((ref $conn) . " socket missing on $conn->{call}") if $dbg;
                _close_it($conn);
@@ -313,7 +320,7 @@ sub _close_it
 
        if ($sock) {
                dbg((ref $conn) . " Connection $conn->{cnum} $call closing gracefully") if isdbg('connll');
-               $sock->close_gracefully;
+               $sock->close_gracefully if $sock->can('close_gracefully');
        }
        
        # get rid of any references
@@ -343,13 +350,14 @@ sub _send_stuff
                my $lth = length $data;
                my $call = $conn->{call} || 'none';
                if (isdbg('raw')) {
-                       if (isdbg('raw')) {
-                               dbgdump('raw', "$call send $lth: ", $lth);
-                       }
+                       dbgdump('raw', "$call send $lth:", $data);
                }
                if (defined $sock) {
                        $sock->write($data);
                        $total_out += $lth;
+                       $conn->{dataout} += $lth;
+                       ++$conn->{linesout};
+                       ++$total_lines_out;
                } else {
                        dbg("_send_stuff $call ending data ignored: $data");
                }
@@ -425,6 +433,8 @@ sub dequeue
                } else {
                        $conn->{msg} = pop @lines;
                }
+               $conn->{linesin} += @lines;
+               $total_lines_in += @lines;
                for (@lines) {
                        last if $conn->{disconnecting};
                        &{$conn->{rproc}}($conn, defined $_ ? $_ : '');
@@ -440,8 +450,8 @@ sub _rcv {                     # Complement to _send
        return if $conn->{disconnecting};
 
        $total_in += length $msg;
+       $conn->{datain} += length $msg;
 
-       my @lines;
        if (isdbg('raw')) {
                my $call = $conn->{call} || 'none';
                my $lth = length $msg;
@@ -480,10 +490,10 @@ sub new_client {
        $sock->on(read => sub {$conn->_rcv($_[1])});
        $sock->timeout(0);
        $sock->start;
-       $conn->{peerhost} = $handle->peerhost;
+       $conn->{peerhost} = $handle->peerhost || 'unknown';
        $conn->{peerhost} =~ s|^::ffff:||; # chop off leading pseudo IPV6 stuff on dual stack listeners
-       $conn->{peerport} = $handle->peerport;
-       dbg((ref $conn) . " accept $conn->{cnum} from $conn->{peerhost}:$conn->{peerport}") if isdbg('connll');
+       $conn->{peerport} = $handle->peerport || 0;
+       dbg((ref $conn) . " accept $conn->{cnum} from $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg('connect');
        my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport});
        $conn->{sort} = 'Incoming';
        if ($eproc) {
@@ -551,8 +561,7 @@ sub DESTROY
 
        if (isdbg('connll')) {
                my ($pkg, $fn, $line) = caller;
-               dbg((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
-               
+               dbgtrace((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
        }
 
        my $call = $conn->{call} || 'unallocated';
@@ -561,7 +570,8 @@ sub DESTROY
        my $sock = $conn->{sock};
 
        if ($sock) {
-               $sock->close_gracefully;
+               $sock->close_gracefully if $sock->can('close_gracefully');
+               delete $conn->{sock};
        }
        
        $noconns--;