From abbcfa7500858a2eba4135b0af5db9f3fca8d68e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 18 Apr 2020 22:07:56 +0100 Subject: [PATCH] new style disconnect This attempts to fix the "send the logout file" issue --- cmd/bye.pl | 15 ++++----- perl/DXLogPrint.pm | 5 +-- perl/DXProt.pm | 4 +-- perl/Msg.pm | 81 ++++++++++++++++++++++++++++++++++++++++------ perl/cluster.pl | 5 ++- 5 files changed, 85 insertions(+), 25 deletions(-) diff --git a/cmd/bye.pl b/cmd/bye.pl index 513b3055..9288d442 100644 --- 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 = ; - 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 b16d69e4..ded2f618 100644 --- 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 45107146..9493637a 100644 --- 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 ad09c85d..e3385d91 100644 --- 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 87811af8..9e14396b 100755 --- 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(); -- 2.34.1