From: Dirk Koopman <djk@tobit.co.uk>
Date: Thu, 19 Jan 2023 23:36:46 +0000 (+0000)
Subject: add localhost client aliasing on spots and PC92A
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=f91073b99369ea05c42364f9462695be7a67016d;p=spider.git

add localhost client aliasing on spots and PC92A
---

diff --git a/Changes b/Changes
index 44fe04ab..f9f83e6b 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,15 @@
+19Jan23=======================================================================
+1. Introduce aliasing for localhost in DX Spots and outgoing PC92 A records
+   on login. There are two variables which can be set with the alias to use:
+      $main::localhost_alias_ipv4
+      $main::localhost_alias_ipv6 
+   These can be set in the /spider/scripts/startup, but this is only 
+   necessary if the node has more than one interface, or virtual hosts. If 
+   there is ONLY ONE ipv4 and/or ipv6 IP address on the node machine then 
+   these variables will be automatically populated on first use. But the SAFE
+   thing to do is to set them in the startup file.  
+
+   THIS FEATURE IS EXPERIMENTAL... 
 18Jan23=======================================================================
 1. Make sure than *every* channel has an IP address. Thank you (I think) Kin 
    for pointing out that PC92 A records were not going out with IP addresses.
diff --git a/cmd/dx.pl b/cmd/dx.pl
index e8e56dc1..956dc4c1 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -25,6 +25,9 @@ return (1, $self->msg('e28')) unless $self->isregistered;
 
 
 my $addr = $self->hostname || '127.0.0.1';
+$addr = $main::localhost_alias_ipv6 if $addr eq '::1' && $main::localhost_alias_ipv6;
+$addr = $main::localhost_alias_ipv4 if $addr =~ /^127\./ && $main::localhost_alias_ipv4;
+
 Log('cmd', "$self->{call}|$addr|dx|$line");
 
 my @bad;
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 56b96faa..84585ef1 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -185,7 +185,10 @@ sub alloc
 	}
 	$self->{inqueue} = [];
 
-	$self->{hostname} = $self->{conn}->peerhost if $conn;
+	if ($conn) {
+		$self->{hostname} = $self->{conn}->peerhost;
+		$self->{sockhost} = $self->{conn}->sockhost;
+	}
 
 	$count++;
 	dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 90812225..32263997 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -74,8 +74,11 @@ sub new
 	# routing, this must go out here to prevent race condx
 	my $pkg = shift;
 	my $call = shift;
-#	my @rout = $main::routeroot->add_user($call, Route::here(1));
-	DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], );
+	#	my @rout = $main::routeroot->add_user($call, Route::here(1));
+	my $ipaddr = $self->hostname;
+	$ipaddr = $main::localhost_alias_ipv6 if $ipaddr eq '::1' && $main::localhost_alias_ipv6;
+	$ipaddr = $main::localhost_alias_ipv4 if $ipaddr =~ /^127\./ && $main::localhost_alias_ipv4;
+	DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $ipaddr], );
 
 	# ALWAYS output the user
 	my $ref = Route::User::get($call);
diff --git a/perl/Listeners.pm b/perl/Listeners.pm
index 78209cc8..a012fda3 100644
--- a/perl/Listeners.pm
+++ b/perl/Listeners.pm
@@ -14,10 +14,16 @@ use vars qw(@listen);
 
 @listen = (
 # remove the '#' character from the next line to enable the listener!
-  #		   ["0.0.0.0", 7300],
+  #		   ["0.0.0.0", 7300],     # IPV4 only
+# ^
+# |
+# 		   
+# OR (IF you listen on IPV6 as well) This one!!!!!
+  #		   ["::", 7300],     # IPV4 and IPV6
 # ^
 # |
 # This one!!!!!
 );
- 
+
+$
 1;
diff --git a/perl/Msg.pm b/perl/Msg.pm
index 9a6f8d1f..c81273e2 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -137,6 +137,24 @@ sub peerhost
 	return $conn->{peerhost};
 }
 
+sub sockhost
+{
+	my $conn = shift;
+	unless ($conn->{sockhost}) {
+		$conn->{sockhost} ||= 'ax25' if $conn->ax25;
+		$conn->{sockhost} ||= $conn->{sock}->handle->sockhost if $conn->{sock};
+		$conn->{sockhost} ||= 'UNKNOWN';
+	}
+	$conn->{sockhost} =~ s/^::ffff://;
+	if (! defined $main::localhost_alias_ipv4 && $conn->{sockhost} =~ /\./ && $conn->{sockhost} !~ /^127\./) {
+		$main::localhost_alias_ipv4 = $conn->{sockhost};
+		dbg("Msg: localhost_alias_ipv4 = '$main::localhost_alias_ipv4'");
+	} elsif (! defined $main::localhost_alias_ipv6 && $conn->{sockhost} =~ /:/ && $conn->{sockhost} !~ /^::1$/) {
+		$main::localhost_alias_ipv6 = $conn->{sockhost};
+		dbg("Msg: localhost_alias_ipv6 = '$main::localhost_alias_ipv6'");
+	}
+	return $conn->{sockhost};
+}
 #-----------------------------------------------------------------
 # Send side routines
 
@@ -152,7 +170,8 @@ sub _on_connect
 	$sock->timeout(0);
 	$sock->start;
 	$conn->{peerhost} = eval { $handle->peerhost; };
-	dbg((ref $conn) . " connected $conn->{cnum} to $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg ('connect');
+	$conn->{sockhost} = eval { $handle->sockhost; };
+	dbg((ref $conn) . " connected $conn->{cnum}:$conn->{sockhost} to $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg ('connect');
 	if ($conn->{on_connect}) {
 		&{$conn->{on_connect}}($conn, $handle);
 	}
@@ -449,7 +468,7 @@ sub _rcv {                     # Complement to _send
 	my $msg = shift;
     my $sock = $conn->{sock};
     return unless defined($sock);
-	return if $conn->{disconnecting};
+	return if $conn->{disonnecting};
 
 	$total_in += length $msg;
 	$conn->{datain} += length $msg;
@@ -493,9 +512,9 @@ sub new_client {
 	$sock->timeout(0);
 	$sock->start;
 	$conn->{peerhost} = $handle->peerhost || 'unknown';
-	$conn->{peerhost} =~ s|^::ffff:||; # chop off leading pseudo IPV6 stuff on dual stack listeners
 	$conn->{peerport} = $handle->peerport || 0;
-	dbg((ref $conn) . " accept $conn->{cnum} from $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg('connect');
+	$conn->{sockhost} = $handle->sockhost || '';
+	dbg((ref $conn) . " accept $conn->{cnum}:$conn->{sockhost} from $conn->{peerhost}:$conn->{peerport}") if isdbg('conn') || isdbg('connect');
 	my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport});
 	$conn->{sort} = 'Incoming';
 	if ($eproc) {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 177009ea..5d26be28 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -218,6 +218,10 @@ our $clssecs;					# the amount of cpu time the DXSpider process have consumed
 our $cldsecs;					# the amount of cpu time any child processes have consumed
 our $allowslashcall;			# Allow / in connecting callsigns (ie PA0/G1TLH, or even PA0/G1TLH/2) 
 
+our $localhost_alias_ipv4;		# these are the IPV4 & 6 aliases for localhost connected clients
+our $localhost_alias_ipv6;		# for things (PC92, PC61 etc) that expose IP addresses. These *may*
+                                # be set by Msg.pm stuff if they are left undefined but, if you need
+                                # certanty then set/var them in the startup file.
 
 use vars qw($version $subversion $build $gitversion $gitbranch);
 
@@ -515,7 +519,6 @@ sub AGWrestart
 	AGWMsg::init(\&new_channel);
 }
 
-
 sub setup_start
 {
 	#############################################################