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 18687a6843b5780758010684d68d8c9d3e8efaad..3fd00e6bb1bce1a4e56169f231d3a378095f2331 100644 (file)
--- 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 8856ba2703a6dd1ad6ae92c5148881d795ea0b3d..35142ce6f3df2f69c29e57952ad26ac59b1d510c 100644 (file)
--- 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 b068c586aa38a381d930c04253d665966763c687..87f4ee08dd9d098848f273854eddcd0a5058db16 100644 (file)
--- 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";\r
        my $sort = "    ";\r
        if ($dxchan->is_node) {\r
-               $sort = 'ANEA' if $dxchan->is_aranea;\r
                $sort = "DXSP" if $dxchan->is_spider;\r
                $sort = "CLX " if $dxchan->is_clx;\r
                $sort = "DXNT" if $dxchan->is_dxnet;\r
                $sort = "AR-C" if $dxchan->is_arcluster;\r
                $sort = "AK1A" if $dxchan->is_ak1a;\r
+       } else {\r
+               $sort = "LOCL" if $dxchan->conn->isa('IntMsg');\r
+               $sort = "WEB " if $dxchan->is_web;\r
+               $sort = "EXT " if $dxchan->conn->isa('ExtMsg');\r
        }\r
        my $name = $dxchan->user->name || " ";\r
        my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : "     ";\r
        my $conn = $dxchan->conn;\r
        my $ip = '';\r
        if ($conn) {\r
-               $ip = $conn->{peerhost} if exists $conn->{peerhost};\r
+               $ip = $dxchan->hostname;\r
                $ip = "AGW Port ($conn->{agwport})" if exists $conn->{agwport};\r
        }\r
        push @out, sprintf "%10s $type $sort $t %-10.10s $ping $ip", $call, $name;\r

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index e4b513f6a4d0efb0b84b4e74755865dd2d1f1710..f8af917e7e3241b43b5e3b03a8c802355fa735c0 100644 (file)
--- 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 46e4e03a12dfcd1ba1ff84a31593352aca08303f..9a00febbf44ca90c58afabacf49980e10afedb97 100644 (file)
--- 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 37e4c1dcafa7eda37c8de7db38eb7715f08ac22e..68dd099ee457564acb15ddd1c2232553987b4f25 100644 (file)
--- 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 df4edd3606f0d90ae1faaf3bf07415e2ed50d558..ad09c85da0f784d98b12634f01ad1a0e421144d5 100644 (file)
--- 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 4205241aa591538a97e0e62442f0e7867c6e6ee1..ef565eb7ddebae52ad0dac1246500f1b87b4d52a 100755 (executable)
--- 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);
 }