new style disconnect

This attempts to fix the "send the logout file" issue

diff --git a/cmd/bye.pl b/cmd/bye.pl
index 513b3055af6fa4bca41f5b1d8bddef23de27f874..9288d44264402db471db2c00af3d55c6841c0498 100644 (file)
--- a/cmd/bye.pl
+++ b/cmd/bye.pl
@@ -4,19 +4,16 @@
 #
 #
 
+
 my $self = shift;
 return (1, $self->msg('e5')) if $self->inscript;
 
-# log out text
-if ($self->is_user && -e localdata("logout")) {
-       open(I, localdata("logout")) or confess;
-       my @in = <I>;
-       close(I);
-       $self->send_now('D', @in);
-       sleep(1);
-}
+my $fn = localdata("logout");
+dbg("fn: $fn " . (-e $fn ? 'exists' : 'missing'));
 
-#$self->send_now('Z', "");
+if ($self->is_user && -e $fn) {
+       $self->send_file($fn);
+}
 
 $self->disconnect;
 

diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index b16d69e4c055b38406c7a52c30972acea6f2900f..ded2f6186a783e27eb865a1eb02d1309efa2c308 100644 (file)
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -116,12 +116,13 @@ sub print_item
        my $s = 'undef';
        
        if ($r->[1] eq 'rcmd') {
+               $r->[6] ||= 'Unknown';
                if ($r->[2] eq 'in') {
                        $r->[5] ||= "";
-                       $s = "$r->[4] (priv: $r->[3]) rcmd: $r->[5]";
+                       $s = "in: $r->[4] ($r->[6] priv: $r->[3]) rcmd: $r->[5]";
                } else {
                        $r->[4] ||= "";
-                       $s = "$r->[3] reply: $r->[4]";
+                       $s = "$r->[3] $r->[6] reply: $r->[4]";
                }
        } elsif ($r->[1] eq 'talk') {
                $r->[5] ||= "";

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 4510714684ebd7b83db6aa862b08e587a3d13309..9493637a87aef29912c66ebb217752b0fd543a02 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1126,7 +1126,7 @@ sub process_rcmd
                        $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!");
                        return;
                }
-               Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd);
+               Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd, $user);
                my $cref = Route::Node::get($fromnode);
                unless ($cref && UNIVERSAL::isa($cref, 'Route')) {
                        dbg("DXProt process_rcmd: Route $fromnode isn't a reference (tell G1TLH)"); 
@@ -1174,7 +1174,7 @@ sub send_rcmd_reply
        while (@_) {
                my $line = shift;
                $line =~ s/\s*$//;
-               Log('rcmd', 'out', $fromnode, $line);
+               Log('rcmd', 'out', $fromnode, $line, $user);
                if ($self->is_clx) {
                        $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line"));
                } else {

diff --git a/perl/Msg.pm b/perl/Msg.pm
index ad09c85da0f784d98b12634f01ad1a0e421144d5..e3385d9166585436dad106bd94e8b94aa6b0c411 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -20,7 +20,7 @@ use Mojo::IOLoop::Stream;
 use DXDebug;
 use Timer;
 
-use vars qw($now %conns $noconns $cnum $total_in $total_out $connect_timeout);
+use vars qw($now %conns $noconns $cnum $total_in $total_out $connect_timeout $disc_waittime);
 
 $total_in = $total_out = 0;
 
@@ -28,6 +28,9 @@ $now = time;
 
 $cnum = 0;
 $connect_timeout = 5;
+$disc_waittime = 3;
+
+our %delqueue;
 
 #
 #-----------------------------------------------------------------
@@ -237,16 +240,61 @@ sub start_program
        return $pid;
 }
 
-sub disconnect 
+sub disconnect
 {
-    my $conn = shift;
-       return if exists $conn->{disconnecting};
+       my $conn = shift;
+       my $count = $conn->{disconnecting}++;
+       if (isdbg('connll')) {
+               my ($pkg, $fn, $line) = caller;
+               dbg((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line ");
+       }
+       return if $count;
+
+       
+       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;
+               }
+               $conn->{delay} = Mojo::IOLoop->delay (
+#                               Mojo::IOLoop->delay (
+                                                                                         sub {
+                                                                                                 my $delay = shift;
+                                                                                                 dbg("before drain $call");
+                                                                                                 $sock->on(drain => $delay->begin);
+                                                                                                 1;
+                                                                                         },
+                                                                                         sub {
+                                                                                                 my $delay = shift;
+                                                                                                 _close_it($conn);
+                                                                                                 1;
+                                                                                         }
+                                                                                        );
+               $conn->{delay}->wait;
+               
+               $delqueue{$conn} = $conn; # save this connection until everything is finished
+       } else {
+               dbg((ref $conn) . " socket missing on $conn->{call}") if isdbg('connll');
+               _close_it($conn);
+       }
+}
 
-       $conn->{disconnecting} = 1;
+sub _close_it
+{
+    my $conn = shift;
     my $sock = delete $conn->{sock};
        $conn->{state} = 'E';
        $conn->{timeout}->del if $conn->{timeout};
 
+       if (isdbg('connll')) {
+               my ($pkg, $fn, $line) = caller;
+               dbg((ref $conn) . "::_close_it on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line ");
+       }
+
        # be careful to delete the correct one
        my $call;
        if ($call = $conn->{call}) {
@@ -254,12 +302,18 @@ sub disconnect
                delete $conns{$call} if $ref && $ref == $conn;
        }
        $call ||= 'unallocated';
-       dbg((ref $conn) . " Connection $conn->{cnum} $call disconnected") if isdbg('connll');
+
+       dbg((ref $conn) . " Connection $conn->{cnum} $call starting to close") if isdbg('connll');
        
        if ($conn->{on_disconnect}) {
                &{$conn->{on_disconnect}}($conn);
        }
 
+       if ($sock) {
+               dbg((ref $conn) . " Connection $conn->{cnum} $call closing gracefully") if isdbg('connll');
+               $sock->close_gracefully;
+       }
+       
        # get rid of any references
        for (keys %$conn) {
                if (ref($conn->{$_})) {
@@ -267,8 +321,7 @@ sub disconnect
                }
        }
 
-       $sock->close_gracefully if defined $sock && $sock->can('close_gracefully');
-       undef $sock;
+       delete $delqueue{$conn};        # finally remove the $conn
        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
@@ -490,12 +543,22 @@ sub sleep
 sub DESTROY
 {
        my $conn = shift;
+       my $call = $conn->{call} || 'unallocated';
+
+       if (isdbg('connll')) {
+               my ($pkg, $fn, $line) = caller;
+               dbg((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
+               
+       }
+
        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');
+       if ($sock) {
+               $sock->close_gracefully;
+       }
        
        $noconns--;
        dbg((ref $conn) . " Connection $conn->{cnum} $call [$host $port] being destroyed (total $noconns)") if isdbg('connll');

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 87811af8457f11004dc972e114e56d728443d8b2..9e14396b9018ed5a4d1f7e66173e5174113a3636 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -634,6 +634,8 @@ our $io_disconnected;
 sub idle_loop
 {
        BPQMsg::process();
+       DXCommandmode::process(); # process ongoing command mode stuff
+       DXProt::process();              # process ongoing ak1a pcxx stuff
 
        if (defined &Local::process) {
                eval {
@@ -679,9 +681,7 @@ sub per_sec
        }
        IsoTime::update($systime);
        DXCron::process();      # do cron jobs
-       DXCommandmode::process(); # process ongoing command mode stuff
        DXXml::process();
-       DXProt::process();              # process ongoing ak1a pcxx stuff
        DXConnect::process();
        DXMsg::process();
        DXDb::process();
@@ -689,7 +689,6 @@ sub per_sec
        DXDupe::process();
        DXCron::process();                      # do cron jobs
        IsoTime::update($systime);
-       DXProt::process();                      # process ongoing ak1a pcxx stuff
        DXConnect::process();
        DXUser::process();
        AGWMsg::process();