From: Dirk Koopman <djk@tobit.co.uk>
Date: Sun, 10 May 2020 22:42:22 +0000 (+0100)
Subject: Initial user multiple attachments!!
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=102b51ca564ef29e7f84d2cf65d0eaa5fdab671a;p=spider.git

Initial user multiple attachments!!

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.
---

diff --git a/Changes b/Changes
index e88b9091..95ca1a41 100644
--- 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 
diff --git a/cmd/bye.pl b/cmd/bye.pl
index d43e257a..be2ba79c 100644
--- a/cmd/bye.pl
+++ b/cmd/bye.pl
@@ -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);
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index fbdbeee3..0e543e9c 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -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();
 }
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 1dd868c0..18c5807b 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -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');
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index d385382b..57bef501 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -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();
 }
 
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 551a6192..b7c45519 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -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;
+}
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 18460f14..6c0ff3d6 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -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');
 	}
 	
 
diff --git a/perl/console.pl b/perl/console.pl
index 66361808..cd4a4492 100755
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -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') {