From d2b28488d70d97c2e467cd7c57077024b7241b45 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Thu, 26 Oct 2017 19:02:50 +0100 Subject: [PATCH] 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. --- cmd/dx.pl | 2 +- cmd/links.pl | 6 +++--- cmd/who.pl | 7 +++++-- perl/DXChannel.pm | 3 ++- perl/DXCommandmode.pm | 8 ++++++++ perl/DXProt.pm | 1 + perl/Msg.pm | 8 +++++--- perl/cluster.pl | 12 ++++++------ 8 files changed, 31 insertions(+), 16 deletions(-) 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); } -- 2.34.1