add some extra info around connects for tracking connections

diff --git a/Changes b/Changes
index 4cb272e4d307bc379fc0a42e46a9a93c021f5fe1..7c565d2cb71d50060b914ae873e57ee979823737 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@
 1. altered PC21 logic somewhat to eliminate dup PC21s
 2. disconnect should remove dangling local users in the routing table.
 3. fixed nasty recursive timer bug
 1. altered PC21 logic somewhat to eliminate dup PC21s
 2. disconnect should remove dangling local users in the routing table.
 3. fixed nasty recursive timer bug

+4. added some extra info to make connect tracking a bit easier.

 09Apr01=======================================================================
 1. changed lockfile name to cluster.lck (from .lock) for MSWin's benefit
 08Apr01=======================================================================
 09Apr01=======================================================================
 1. changed lockfile name to cluster.lck (from .lock) for MSWin's benefit
 08Apr01=======================================================================

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index cc938bd822223706de2e50369d5cd29fe1b0590c..8a5e4612926b9b5da6a8212f6404090f62c78fab 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -129,6 +129,7 @@ sub new_client {
                $conn->{blocking} = 0;
                
                my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
                $conn->{blocking} = 0;
                
                my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());

+               dbg('connll', "accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}");

                if ($eproc) {
                        $conn->{eproc} = $eproc;
                        Msg::set_event_handler ($sock, "error" => $eproc);
                if ($eproc) {
                        $conn->{eproc} = $eproc;
                        Msg::set_event_handler ($sock, "error" => $eproc);


@@ -363,8 +364,9 @@ sub _send_file
                if ($f) {
                        while (<$f>) {
                                chomp;
                if ($f) {
                        while (<$f>) {
                                chomp;

-                               dbg('connll', $_);
-                               $conn->send_raw($_ . $conn->{lineend});
+                               my $l = $_;
+                               dbg('connll', "connect $conn->{cnum}: $l");
+                               $conn->send_raw($l . $conn->{lineend});

                        }
                        $f->close;
                }
                        }
                        $f->close;
                }

diff --git a/perl/Msg.pm b/perl/Msg.pm
index f1f60edfb6f845e5e04604a41c1a49785380a33f..815937963962169d8fb2e4d8e0808cb8675bc2a4 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -73,9 +73,9 @@ sub new
                csort => 'telnet',
                timeval => 60,
                blocking => 0,
                csort => 'telnet',
                timeval => 60,
                blocking => 0,

+               cnum => ++$noconns,

     };
 
     };
 

-       $noconns++;

        dbg('connll', "Connection created ($noconns)");
        return bless $conn, $class;
 }
        dbg('connll', "Connection created ($noconns)");
        return bless $conn, $class;
 }


@@ -121,7 +121,7 @@ sub conns
                confess "changing $pkg->{call} to $call" if exists $pkg->{call} && $call ne $pkg->{call};
                $pkg->{call} = $call;
                $ref = $conns{$call} = $pkg;
                confess "changing $pkg->{call} to $call" if exists $pkg->{call} && $call ne $pkg->{call};
                $pkg->{call} = $call;
                $ref = $conns{$call} = $pkg;

-               dbg('connll', "Connection $call stored");
+               dbg('connll', "Connection $pkg->{cnum} $call stored");

        } else {
                $ref = $conns{$call};
        }
        } else {
                $ref = $conns{$call};
        }


@@ -194,7 +194,7 @@ sub disconnect {
                delete $conns{$call} if $ref && $ref == $conn;
        }
        $call ||= 'unallocated';
                delete $conns{$call} if $ref && $ref == $conn;
        }
        $call ||= 'unallocated';

-       dbg('connll', "Connection $call disconnected");
+       dbg('connll', "Connection $conn->{cnum} $call disconnected");

        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};


@@ -522,7 +522,9 @@ sub DESTROY
 {
        my $conn = shift;
        my $call = $conn->{call} || 'unallocated';
 {
        my $conn = shift;
        my $call = $conn->{call} || 'unallocated';

-       dbg('connll', "Connection $call being destroyed ($noconns)");
+       my $host = $conn->{peerhost} || '';
+       my $port = $conn->{peerport} || '';
+       dbg('connll', "Connection $conn->{cnum} $call [$host $port] being destroyed");

        $noconns--;
 }
 
        $noconns--;
 }