fix DXCron, lockout and close_gracefully

[spider.git] / perl / Msg.pm

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 9ea2bc10c9aaad10a3f9e8ca0d96b6d95b522b69..13833962d3d316d26f997e8861a431d143bda478 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -20,9 +20,10 @@ 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;
 
@@ -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++;
@@ -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;
        }
@@ -315,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
@@ -345,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");
                }
@@ -427,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 $_ ? $_ : '');
@@ -442,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;
@@ -484,7 +492,7 @@ sub new_client {
        $sock->start;
        $conn->{peerhost} = $handle->peerhost || 'unknown';
        $conn->{peerhost} =~ s|^::ffff:||; # chop off leading pseudo IPV6 stuff on dual stack listeners
-       $conn->{peerport} = $handle->peerport;
+       $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';
@@ -553,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';
@@ -563,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--;