From: Dirk Koopman <djk@tobit.co.uk>
Date: Thu, 26 Oct 2017 18:02:50 +0000 (+0100)
Subject: extend the Web interface protocol further
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2b28488d70d97c2e467cd7c57077024b7241b45;p=spider.git

extend the Web interface protocol further

Also clarify things like the ultimate hostname if it is an IP based system.
This means that stuff coming in on the web will be identified by the IP
address that they connect to, rather than the IP address of the channel. Basically
a Web interface is a proxy and therefore the connection object needs the address
of the web server, but things like DX spots need the proxy address.
---

diff --git a/cmd/dx.pl b/cmd/dx.pl
index 18687a68..3fd00e6b 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -123,7 +123,7 @@ return (1, @out) unless $valid;
 my $ipaddr;
 
 if ($self->conn && $self->conn->peerhost) {
-	my $addr = $self->conn->peerhost;
+	my $addr = $self->hostname;
 	$ipaddr = $addr unless !is_ipaddr($addr) || $addr =~ /^127\./ || $addr =~ /^::[0-9a-f]+$/;
 } elsif ($self->inscript) {
 	$ipaddr = "script";
diff --git a/cmd/links.pl b/cmd/links.pl
index 8856ba27..35142ce6 100644
--- a/cmd/links.pl
+++ b/cmd/links.pl
@@ -54,9 +54,9 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) {
 	$sort = "AK1A" if $dxchan->is_ak1a;
 	my $ipaddr;
 
-	if ($dxchan->conn->peerhost) {
-		my $addr = $dxchan->conn->peerhost;
-		$ipaddr = $addr if is_ipaddr($addr);
+	my $addr = $dxchan->hostname;
+	if ($addr) {
+	    $ipaddr = $addr if is_ipaddr($addr);
 		$ipaddr = 'local' if $addr =~ /^127\./ || $addr =~ /^::[0-9a-f]+$/;
 	}
 	$ipaddr = 'ax25' if $dxchan->conn->ax25;
diff --git a/cmd/who.pl b/cmd/who.pl
index b068c586..87f4ee08 100644
--- a/cmd/who.pl
+++ b/cmd/who.pl
@@ -19,19 +19,22 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) {
 	my $type = $dxchan->is_node ? "NODE" : "USER";
 	my $sort = "    ";
 	if ($dxchan->is_node) {
-		$sort = 'ANEA' if $dxchan->is_aranea;
 		$sort = "DXSP" if $dxchan->is_spider;
 		$sort = "CLX " if $dxchan->is_clx;
 		$sort = "DXNT" if $dxchan->is_dxnet;
 		$sort = "AR-C" if $dxchan->is_arcluster;
 		$sort = "AK1A" if $dxchan->is_ak1a;
+	} else {
+		$sort = "LOCL" if $dxchan->conn->isa('IntMsg');
+		$sort = "WEB " if $dxchan->is_web;
+		$sort = "EXT " if $dxchan->conn->isa('ExtMsg');
 	}
 	my $name = $dxchan->user->name || " ";
 	my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : "     ";
 	my $conn = $dxchan->conn;
 	my $ip = '';
 	if ($conn) {
-		$ip = $conn->{peerhost} if exists $conn->{peerhost};
+		$ip = $dxchan->hostname;
 		$ip = "AGW Port ($conn->{agwport})" if exists $conn->{agwport};
 	}
 	push @out, sprintf "%10s $type $sort $t %-10.10s $ping $ip", $call, $name;
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index e4b513f6..f8af917e 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -125,6 +125,7 @@ $count = 0;
 		  inqueue => '9,Input Queue,parray',
 		  next_pc92_update => '9,Next PC92 Update,atime',
 		  next_pc92_keepalive => '9,Next PC92 KeepAlive,atime',
+		  hostname => '0,(Proxied)Hostname',
 		 );
 
 $maxerrors = 20;				# the maximum number of concurrent errors allowed before disconnection
@@ -717,7 +718,7 @@ sub process_one
 			$self->normal($line);
 		} elsif ($sort eq 'G') {
 			$self->enhanced($line);
-		} elsif ($sort eq 'A' || $sort eq 'O') {
+		} elsif ($sort eq 'A' || $sort eq 'O' || $sort eq 'W') {
 			$self->start($line, $sort);
 		} elsif ($sort eq 'Z') {
 			$self->disconnect;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 46e4e03a..9a00febb 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -41,6 +41,7 @@ use DXXml;
 use AsyncMsg;
 use JSON;
 use Time::HiRes qw(gettimeofday tv_interval);
+use Regexp::IPv6 qw($IPv6_re);
 
 use Mojo::IOLoop;
 use Mojo::IOLoop::ForkCall;
@@ -111,6 +112,13 @@ sub start
 	$pagelth = $default_pagelth unless defined $pagelth;
 	$self->{pagelth} = $pagelth;
 	($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//;
+	if ($line =~ /host=/) {
+		($self->{hostname}) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/; $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+//;
+		unless ($self->{hostname}) {
+			($self->{hostname}) = $line =~ /host=($IPv6_re)/; 
+            $line =~ s/\s*host=$IPv6_re//;
+		}
+	}
 	$self->{width} = 80 unless $self->{width} && $self->{width} > 80;
 	$self->{consort} = $line;	# save the connection type
 	
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 37e4c1dc..68dd099e 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -292,6 +292,7 @@ sub start
 	my $host = $self->{conn}->peerhost;
 	$host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
 	$host ||= "unknown";
+	$self->{hostname} = $host if is_ipaddr($host);
 
 	Log('DXProt', "$call connected from $host");
 
diff --git a/perl/Msg.pm b/perl/Msg.pm
index df4edd36..ad09c85d 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -120,9 +120,11 @@ sub ax25
 sub peerhost
 {
 	my $conn = shift;
-	$conn->{peerhost} ||= 'ax25' if $conn->ax25;
-	$conn->{peerhost} ||= $conn->{sock}->handle->peerhost if $conn->{sock};
-	$conn->{peerhost} ||= 'UNKNOWN';
+	unless ($conn->{peerhost}) {
+		$conn->{peerhost} ||= 'ax25' if $conn->ax25;
+		$conn->{peerhost} ||= $conn->{sock}->handle->peerhost if $conn->{sock};
+		$conn->{peerhost} ||= 'UNKNOWN';
+	}
 	return $conn->{peerhost};
 }
 
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 4205241a..ef565eb7 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -210,17 +210,15 @@ sub new_channel
 			$user->wantbeep(0);
 			$user->name('web');
 			$user->qth('on the web');
-			$user->homenode($main::call);
+			$user->homenode($main::mycall);
 			$user->lat($main::mylatitude);
 			$user->long($main::mylongitude);
 			$user->qra($main::mylocator);
-			$user->put;
 		}
+		$conn->conns($call);
 		$dxchan = Web->new($call, $conn, $user);
-		$dxchan->sort('W');
 		$dxchan->enhanced(1);
 		$dxchan->ve7cc(1);
-		$conn->conns($call);
 		$msg =~ s/^A#WEB|/A$call|/;
 		$conn->send_now("C$call");
 	} else {
@@ -292,8 +290,6 @@ sub new_channel
 			$dxchan = DXProt->new($call, $conn, $user);
 		} elsif ($user->is_user) {
 			$dxchan = DXCommandmode->new($call, $conn, $user);
-			#	} elsif ($user->is_bbs) {                                  # there is no support so
-			#		$dxchan = BBS->new($call, $conn, $user);               # don't allow it!!!
 		} else {
 			die "Invalid sort of user on $call = $sort";
 		}
@@ -307,6 +303,10 @@ sub new_channel
 	$conn->set_error(sub {my $err = shift; LogDbg('DXCommand', "Comms error '$err' received for call $dxchan->{call}"); $dxchan->disconnect(1);});
 	$conn->set_on_eof(sub {$dxchan->disconnect});
 	$conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);});
+	if ($sort eq 'W') {
+		$dxchan->enhanced(1);
+		$dxchan->sort('W');
+	}
 	$dxchan->rec($msg);
 }