Initial user multiple attachments!!
authorDirk Koopman <djk@tobit.co.uk>
Sun, 10 May 2020 22:42:22 +0000 (23:42 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Sun, 10 May 2020 22:42:22 +0000 (23:42 +0100)
This will, after 3 (default) bumpoffs with 5 mins (default) it
will allow up $main::allowmultiple (if set > 1) connections with different
ssids BUT THE SAME user record.

Strip out echo and blank cmds from progress debugging unless set/debug 'echo'
is set.

Changes
cmd/bye.pl
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXUser.pm
perl/DXUtil.pm
perl/cluster.pl
perl/console.pl

diff --git a/Changes b/Changes
index e88b9091419825fcea0086e8f9c7c03aeabfd8b2..95ca1a41e88641edda332c0f3349127d59a7fa23 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+10May20=======================================================================
+1. Added basic changes so that users *could* have multiple connections to the
+   same node if it is allowed.
 09May20=======================================================================
 1. Show the route by which this PCxx came in progress debugging reports. In
    some other words: the spot/wwv/wcy/ann message arrived first from this 
index d43e257a5aa21d91ff1146aaea4a45ce9e0fc549..be2ba79ccba10390bde6f310b85283cd5993d773 100644 (file)
@@ -9,7 +9,7 @@ my $self = shift;
 return (1, $self->msg('e5')) if $self->inscript || $self->remotecmd;
 
 my $fn = localdata("logout");
-dbg("fn: $fn " . (-e $fn ? 'exists' : 'missing'));
+#dbg("fn: $fn " . (-e $fn ? 'exists' : 'missing'));
 
 if ($self->is_user && -e $fn) {
        $self->send_file($fn);
index fbdbeee310bf430b5bac3d5f7282347916f47b04..0e543e9cea6f424c9dfe4cc6634b8b97ef7dc74c 100644 (file)
@@ -161,7 +161,7 @@ sub alloc
                $self->{group} = $user->group;
                $self->{sort} = $user->sort;
        }
-       $self->{startt} = $self->{t} = time;
+       $self->{startt} = $self->{t} = $main::systime;
        $self->{state} = 0;
        $self->{oldstate} = 0;
        $self->{lang} = $main::lang if !$self->{lang};
@@ -497,7 +497,7 @@ sub disconnect
        my $self = shift;
        my $user = $self->{user};
        
-       $user->close() if defined $user;
+       $user->close($self->{startt}, $self->{hostname}) if defined $user;
        $self->{conn}->disconnect if $self->{conn};
        $self->del();
 }
index 1dd868c0aa79600c371307b1224513decb25e492..18c5807b28085d91d26b281a1ba0813bdf8c1778 100644 (file)
@@ -547,13 +547,13 @@ sub run_cmd
                                my $t0 = [gettimeofday];
                                eval { @ans = &{"${package}::handle"}($self, $args) };
                                if ($@) {
-                                       dbgprintring(25);
+                                       DXDebug::dbgprintring(25);
                                        return (DXDebug::shortmess($@));
                                }
                                if (isdbg('progress')) {
                                        my $msecs = _diffms($t0);
                                        my $s = "CMD: '$cmd $args' by $call ip: $self->{hostname} ${msecs}mS";
-                                       dbg($s);
+                                       dbg($s) if $cmd =~/(?:echo|blank)/ || isdbg('echo');     # cut down a bit on HRD and other clients' noise
                                }
                        } else {
                                dbg("cmd: $package not present") if isdbg('command');
index d385382b80fe13469bc9e8f85360ed26a54b39e0..57bef501ce8cc464f66b0e2c79598db9016276ac 100644 (file)
@@ -30,6 +30,7 @@ $lasttime = 0;
 $lrusize = 2000;
 $tooold = 86400 * 365;         # this marks an old user who hasn't given enough info to be useful
 $v3 = 0;
+our $maxconnlist = 3;                  # remember this many connection time (duration) [start, end] pairs
 
 # hash of valid elements and a simple prompt
 %valid = (
@@ -91,6 +92,8 @@ $v3 = 0;
                  believe => '1,Believable nodes,parray',
                  lastping => '1,Last Ping at,ptimelist',
                  maxconnect => '1,Max Connections',
+                 startt => '0,Start Time,cldatetime',
+                 connlist => '1,Connections,parraydifft',
                 );
 
 #no strict;
@@ -395,7 +398,14 @@ sub del
 sub close
 {
        my $self = shift;
-       $self->{lastin} = time;
+       my $startt = shift;
+       my $ip = shift;
+       $self->{lastin} = $main::systime;
+       # add a record to the connect list
+       my $ref = [$startt || $self->{startt}, $main::systime];
+       push @$ref, $ip if $ip;
+       push @{$self->{connlist}}, $ref;
+       shift @{$self->{connlist}} if @{$self->{connlist}} > $maxconnlist;
        $self->put();
 }
 
index 551a61921213ec00b90ab8a29738929bb0d647ce..b7c455198fd35633bb5214d585f85697e5a54823 100644 (file)
@@ -27,7 +27,7 @@ require Exporter;
              print_all_fields cltounix unpad is_callsign is_latlong
                         is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
                         is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv
-                        diffms _diffms
+                        diffms _diffms difft parraydifft
             );
 
 
@@ -522,3 +522,42 @@ sub diffms
        $s .= " $no lines" if $no;
        DXDebug::dbg($s);
 }
+
+# expects either an array reference or two times (in the correct order [start, end])
+sub difft
+{
+       my $b = shift;
+       my $t;
+       if (ref $b eq 'ARRAY') {
+               $t = $b->[1] - $b->[0];
+       } else {
+               $t = shift() - $b;
+       }
+       return '-(ve)' if $t < 0;
+       my ($d,$h,$m,$s);
+       my $out = '';
+       $d = int $t / 86400;
+       $out .= "${d}d" if $d;
+       $t -= $d * 86400;
+       $h = int $t / 3600;
+       $out .= "${h}h" if $h || $d;
+       $t -= $h * 3600;
+       $m = int $t / 60;
+       $out .= "${m}m" if $m || $h || $d;
+       $s = int $t % 60;
+       $out .= "${s}s";
+       return $out;
+}
+
+# print an array ref of difft refs
+sub parraydifft
+{
+       my $r = shift;
+       my $out = '';
+       for (@$r) {
+               my $s = $_->[2] ? "($_->[2])" : '';
+               $out .= sprintf "%s=%s$s, ", atime($_->[0]), difft($_->[0], $_->[1]);
+       }
+       $out =~ s/,\s*$//;
+       return $out;
+}
index 18460f14298a942753c7abba3025e892427ec4d6..6c0ff3d691490d4db977e2d03108ec6f31ca1071 100755 (executable)
@@ -166,6 +166,16 @@ $starttime = 0;                 # the starting time of the cluster
 @listeners = ();                               # list of listeners
 $reqreg = 0;                                   # 1 = registration required, 2 = deregister people
 $bumpexisting = 1;                             # 1 = allow new connection to disconnect old, 0 - don't allow it
+our $allowmultiple = 0;                                # This is used in conjunction with $bumpexisting, in a rather weird way.
+our $min_reconnection_rate = 5*60;             # minimum value of seconds between connections per user to allow co-existing users
+our $max_ssid = 15;                                    # highest ssid to be searched for a spare one on multiple connections
+
+# If $allowmultiple > 0 and the $reconnection_rate is some value of seconds
+# based on the average connection time calculated from the $user->conntimel entries / frequency is
+# less than $reconnection_rate then we assume that there is more than one device (probably HRD) trying
+# to connect "at once". In which case we probe for a spare SSID for a user callsign to allow up to 
+# $allowmultiple connections per callsign. 
+
 $allowdxby = 0;                                        # 1 = allow "dx by <othercall>", 0 - don't allow it
 $maxconnect_user = 3;                  # the maximum no of concurrent connections a user can have at a time
 $maxconnect_node = 0;                  # Ditto but for nodes. In either case if a new incoming connection
@@ -220,6 +230,7 @@ sub new_channel
                        $user->long($main::mylongitude);
                        $user->qra($main::mylocator);
                }
+               $user->startt($main::systime);
                $conn->conns($call);
                $dxchan = Web->new($call, $conn, $user);
                $dxchan->enhanced(1);
@@ -233,27 +244,73 @@ sub new_channel
                        return;
                }
 
+               # is he locked out ?
+               my $basecall = $call;
+               $basecall =~ s/-\d+$//; # remember this for later multiple user processing
+               my $baseuser = DXUser::get_current($basecall);
+               my $lock = $user->lockout if $user;
+               if ($baseuser && $baseuser->lockout || $lock) {
+                       if (!$user || !defined $lock || $lock) {
+                               my $host = $conn->peerhost;
+                               LogDbg('DXCommand', "$call on $host is locked out, disconnected");
+                               $conn->disconnect;
+                               return;
+                       }
+               }
+
                # set up the basic channel info for "Normal" Users
                # is there one already connected to me - locally?
-       
+
                $user = DXUser::get_current($call);
                $dxchan = DXChannel::get($call);
+               my $newcall = $call;
                if ($dxchan) {
                        if ($user && $user->is_node) {
                                already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
                                return;
                        }
-                       if ($bumpexisting) {
-                               my $ip = $dxchan->hostname;
-                               $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip));
-                               LogDbg('DXCommand', "$call bumped off by $ip, disconnected");
-                               $dxchan->disconnect;
-                       } else {
-                               already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
-                               return;
+                       if ($allowmultiple && $user->is_user) {
+                               # determine whether we are a candidate, have we flip-flopped frequently enough?
+                               my @lastconns = @{$user->connlist} if $user->connlist;
+                               my $allow = 0;
+                               if (@lastconns >= $DXUser::maxconnlist) {
+                                       $allow = $lastconns[-1]->[0] - $lastconns[0]->[0] < $min_reconnection_rate;
+                               }
+                               # search for a spare ssid
+                       L1:     for (my $count = $call =~ /-\d+$/?0:1; $allow && $count < $allowmultiple; ) { # remember we have one call already
+                                       my $lastid = 1;
+                                       for (; $lastid < $max_ssid && $count < $allowmultiple; ++$lastid) {
+                                               my $chan = DXChannel::get("$basecall-$lastid");
+                                               if ($chan) {
+                                                       ++$count;
+                                                       next;
+                                               }
+                                               # we have a free call-ssid, save it
+                                               $newcall = "$basecall-$lastid";
+                                               last L1;
+                                       }
+                               }
                        }
+
+                       # handle "normal" (non-multiple) connections in the existing way
+                       if ($call eq $newcall) {
+                               if ($bumpexisting) {
+                                       my $ip = $dxchan->hostname;
+                                       $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip));
+                                       LogDbg('DXCommand', "$call bumped off by $ip, disconnected");
+                                       $dxchan->disconnect;
+                               } else {
+                                       already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
+                                       return;
+                               }
+                       }
+
+                       # make sure that the conn has the (possibly) new callsign
+                       $conn->conns($newcall);
+                       $msg =~ s/$call/$newcall/;
                }
-               
+
+
                # (fairly) politely disconnect people that are connected to too many other places at once
                my $r = Route::get($call);
                if ($conn->{sort} && $conn->{sort} =~ /^I/ && $r && $user) {
@@ -262,7 +319,7 @@ sub new_channel
                        my $c = $user->maxconnect;
                        my $v;
                        $v = defined $c ? $c : $m;
-                       if ($v && @n >= $v) {
+                       if ($v && @n >= $v+$allowmultiple) {
                                my $nodes = join ',', @n;
                                LogDbg('DXCommand', "$call has too many connections ($v) at $nodes - disconnected");
                                already_conn($conn, $call, DXM::msg($lang, 'contomany', $call, $v, $nodes));
@@ -270,20 +327,6 @@ sub new_channel
                        }
                }
                
-               # is he locked out ?
-               my $basecall = $call;
-               $basecall =~ s/-\d+$//;
-               my $baseuser = DXUser::get_current($basecall);
-               my $lock = $user->lockout if $user;
-               if ($baseuser && $baseuser->lockout || $lock) {
-                       if (!$user || !defined $lock || $lock) {
-                               my $host = $conn->peerhost;
-                               LogDbg('DXCommand', "$call on $host is locked out, disconnected");
-                               $conn->disconnect;
-                               return;
-                       }
-               }
-
                if ($user) {
                        $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
                } else {
@@ -291,16 +334,16 @@ sub new_channel
                }
 
                # create the channel
+               # NOTE we are SHARING the same $user if $allowmultiple is > 1
+               
+               $user->startt($systime); # mark the start time of this connection
                if ($user->is_node) {
                        $dxchan = DXProt->new($call, $conn, $user);
                } elsif ($user->is_user) {
-                       $dxchan = DXCommandmode->new($call, $conn, $user);
+                       $dxchan = DXCommandmode->new($newcall, $conn, $user);
                } else {
                        die "Invalid sort of user on $call = $sort";
                }
-               
-               # check that the conn has a callsign
-               $conn->conns($call) if $conn->isa('IntMsg');
        }
        
 
index 663618080dc1a69e444c6251d954cfcd0177a889..cd4a44927e5799c8bf13a2858bb5c11a97972f56 100755 (executable)
@@ -261,7 +261,10 @@ sub rec_socket
                cease(1);
        }
        if (defined $msg) {
-               my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+               my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+
+               # change my call if my node says "tonight Michael you are Jane" or something like that...
+               $call = $incall if $call ne $incall;
                
                $line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
                if ($sort && $sort eq 'D') {