add the ability to limit no of connections

Add the ability to limit the no of connections an incoming user/node
has. If a node/user is already connected elsewhere more than the maximum
no of times then this incoming connection is refused.

Changes

@@ -1,5 +1,10 @@
 01Oct08=======================================================================
 1. added CTY-1809 prefix data
+2. added new config variables to allow an incoming users to have (as default)
+up to 2 other connections to other nodes and incoming nodes up to 8 other
+parents. Note that you can switch off this behaviour by setting
+$main::maxconnect_user or $main::maxconnect_node = 0 (or set them to whatever
+you need).
 28Jun08=======================================================================
 1. Made buddies work again on PC92.
 26Jun08=======================================================================

cmd/stat/nodeconfig.pl

@@ -15,7 +15,7 @@ foreach my $nref (@nodes) {
 	my $ncall = $nref->call;
 	next if @list && !grep $ncall =~ m|$_|, @list;
 	my $call = $nref->user_call;
-	my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort @{$nref->parent});
+	my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort $nref->parents);
 	push @out, "$call->$l";
 }
 

cmd/stat/userconfig.pl

@@ -15,7 +15,7 @@ foreach my $uref (@users) {
 	my $ucall = $uref->call;
 	next if @list && !grep $ucall =~ m|$_|, @list;
 	my $call = $uref->user_call;
-	my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort @{$uref->parent});
+	my $l = join ',', (map {my $ref = Route::Node::get($_); $ref ? ($ref->user_call) : ("$_?")} sort $uref->parents);
 	push @out, "$call->$l";
 }
 

perl/DXCommandmode.pm

@@ -218,7 +218,7 @@ sub start
 	foreach my $call (@{$user->buddies}) {
 		my $ref = Route::User::get($call);
 		if ($ref) {
-			foreach my $node (@{$ref->parent}) {
+			foreach my $node ($ref->parents) {
 				$self->send($self->msg($node eq $main::mycall ? 'loginb' : 'loginbn', $call, $node));
 			} 
 		}

perl/DXProtHandle.pm

@@ -1860,7 +1860,7 @@ sub find_pc9x_routes
 	if ($ref->isa('Route::User')) {
 		my $dxchan = DXChannel::get($to);
 		push @parent, $to if $dxchan;
-		push @parent, @{$ref->parent};
+		push @parent, $ref->parents;
 	} else {
 		@parent = $to;
 	}

perl/Messages

@@ -36,6 +36,7 @@ package DXM;
 				chattoomany => 'Not allowed, already in $_[1], use /chat $_[0]',
 				conother => 'Sorry $_[0] you are connected to me on another port',
 				concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])',
+				contomany => 'Sorry $_[0] but you are already connected to $_[1] other nodes (on $_[2])',
 				conscript => 'no connect script called \"$_[0]\" found in $main::root/connect',
 				confail => 'connection to $_[0] failed ($_[1])',
 				constart => 'connection to $_[0] started',

perl/Route.pm

@@ -375,7 +375,6 @@ sub delete_interface
 
 }
 
-
 #
 # track destruction
 #

perl/Route/Node.pm

@@ -221,12 +221,6 @@ sub nodes
 	return @{$self->{nodes}};
 }
 
-sub parents
-{
-	my $self = shift;
-	return @{$self->{parent}};
-}
-
 sub rnodes
 {
 	my $self = shift;

perl/Route/User.pm

@@ -92,6 +92,8 @@ sub delparent
     return $self->_dellist('parent', @_);
 }
 
+
+
 #
 # generic AUTOLOAD for accessors
 #

perl/Version.pm

@@ -11,6 +11,6 @@ use vars qw($version $subversion $build);
 
 $version = '1.55';
 $subversion = '0';
-$build = '27';
+$build = '28';
 
 1;

perl/cluster.pl

@@ -118,7 +118,7 @@ use vars qw(@inqueue $systime $starttime $lockfn @outstanding_connects
 			$zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr
 			$clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting
 			$allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart
-			$can_encode
+			$can_encode $maxconnect_user $maxconnect_node
 		   );
 
 @inqueue = ();					# the main input queue, an array of hashes
@@ -129,7 +129,10 @@ $starttime = 0;                 # the starting time of the cluster
 $reqreg = 0;					# 1 = registration required, 2 = deregister people
 $bumpexisting = 1;				# 1 = allow new connection to disconnect old, 0 - don't allow it
 $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 = 8;			# Ditto but for nodes. In either case if a new incoming connection
+								# takes the no of references in the routing table above these numbers
+								# then the connection is refused. This only affects INCOMING connections.
 
 # send a message to call on conn and disconnect
 sub already_conn
@@ -182,6 +185,19 @@ sub new_channel
 		}
 	}
 
+	# (fairly) politely disconnect people that are connected to too many other places at once
+	my $r = Route::get($call);
+	if ($r) {
+		my @n = $r->parents;
+		my $v = $r->isa('Route::Node') ? $maxconnect_node : $maxconnect_user;
+		if ($v && @n >= $v) {
+			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));
+			return;
+		}
+	}
+
 	# is he locked out ?
 	my $basecall = $call;
 	$basecall =~ s/-\d+$//;