X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=c81273e29b329a5070b2bd53e34e7371564e3c68;hb=f91073b99369ea05c42364f9462695be7a67016d;hp=09b0e634e6fc28c6f81ff4faac933e734ceb5109;hpb=c7a3cfda9336d765d387e9328f817d1f0e5230d1;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 09b0e634..c81273e2 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -18,18 +18,18 @@ use Mojo::IOLoop; use Mojo::IOLoop::Stream; use DXDebug; -use Timer; +use DXTimer; -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 = 1.5; -%conns; our %delqueue; @@ -44,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++; @@ -103,12 +107,6 @@ sub conns return $ref; } -# this is called as a FUNCTION i.e my $conn = Msg::get($call); -sub get -{ - return $conns{shift}; -} - # this is only called by any dependent processes going away unexpectedly sub pid_gone { @@ -135,9 +133,28 @@ sub peerhost $conn->{peerhost} ||= $conn->{sock}->handle->peerhost if $conn->{sock}; $conn->{peerhost} ||= 'UNKNOWN'; } + $conn->{peerhost} =~ s/^::ffff://; return $conn->{peerhost}; } +sub sockhost +{ + my $conn = shift; + unless ($conn->{sockhost}) { + $conn->{sockhost} ||= 'ax25' if $conn->ax25; + $conn->{sockhost} ||= $conn->{sock}->handle->sockhost if $conn->{sock}; + $conn->{sockhost} ||= 'UNKNOWN'; + } + $conn->{sockhost} =~ s/^::ffff://; + if (! defined $main::localhost_alias_ipv4 && $conn->{sockhost} =~ /\./ && $conn->{sockhost} !~ /^127\./) { + $main::localhost_alias_ipv4 = $conn->{sockhost}; + dbg("Msg: localhost_alias_ipv4 = '$main::localhost_alias_ipv4'"); + } elsif (! defined $main::localhost_alias_ipv6 && $conn->{sockhost} =~ /:/ && $conn->{sockhost} !~ /^::1$/) { + $main::localhost_alias_ipv6 = $conn->{sockhost}; + dbg("Msg: localhost_alias_ipv6 = '$main::localhost_alias_ipv6'"); + } + return $conn->{sockhost}; +} #----------------------------------------------------------------- # Send side routines @@ -153,7 +170,8 @@ 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'); + $conn->{sockhost} = eval { $handle->sockhost; }; + dbg((ref $conn) . " connected $conn->{cnum}:$conn->{sockhost} to $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg ('connect'); if ($conn->{on_connect}) { &{$conn->{on_connect}}($conn, $handle); } @@ -264,7 +282,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; } @@ -293,7 +311,8 @@ sub disconnect dbg("Buffer empty, just close $call") if $dbg; _close_it($conn); } - } else { + } + else { dbg((ref $conn) . " socket missing on $conn->{call}") if $dbg; _close_it($conn); } @@ -322,7 +341,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 @@ -352,13 +371,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"); } @@ -434,6 +454,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 $_ ? $_ : ''); @@ -446,11 +468,11 @@ sub _rcv { # Complement to _send my $msg = shift; my $sock = $conn->{sock}; return unless defined($sock); - return if $conn->{disconnecting}; + return if $conn->{disonnecting}; $total_in += length $msg; + $conn->{datain} += length $msg; - my @lines; if (isdbg('raw')) { my $call = $conn->{call} || 'none'; my $lth = length $msg; @@ -489,10 +511,10 @@ sub new_client { $sock->on(read => sub {$conn->_rcv($_[1])}); $sock->timeout(0); $sock->start; - $conn->{peerhost} = $handle->peerhost; - $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->{peerhost} = $handle->peerhost || 'unknown'; + $conn->{peerport} = $handle->peerport || 0; + $conn->{sockhost} = $handle->sockhost || ''; + dbg((ref $conn) . " accept $conn->{cnum}:$conn->{sockhost} 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) { @@ -560,8 +582,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'; @@ -570,7 +591,8 @@ sub DESTROY my $sock = $conn->{sock}; if ($sock) { - $sock->close_gracefully; + $sock->close_gracefully if $sock->can('close_gracefully'); + delete $conn->{sock}; } $noconns--;