+03Feb23=======================================================================
+1. Fix is_ipaddr to accept trailing '::' on IPV6 addresses.
+2. Fix and extend the TEST program 'showdx' so that it now works on the mojo
+ branch. Type 'showxd -?' for more information or read the source. This is
+ NOT a user program, but is will accept most sh/dx expressions.
+3. Fix create_master_badip_files.pl so that it does not emit IP addresses
+ that the system is_ipaddr() function fails.
01Feb23=======================================================================
1. Harden DXCIDR (badip stuff) against format errors in downloaded badip files
downloaded using wget from the crontab. If these problems persist PLEASE
%bands = (); # the 'raw' band data
%regions = (); # list of regions for shortcuts eg vhf ssb
%aliases = (); # list of aliases
+
$bandsfn = localdata("bands.pl");
%valid = (
$c =~ s/\t/ /g;
my $comment = substr (($c || ''), 0, $clth);
$comment .= ' ' x ($clth - (length($comment)));
-
- if (!$slot1 && $self->{user}->wantgrid) {
- my $ref = DXUser::get_current($_[1]);
- if ($ref && $ref->qra) {
- $slot1 = ' ' . substr($ref->qra, 0, 4);
+
+ if ($self->{user}) { # to allow the standalone program 'showdx' to work
+ if (!$slot1 && $self->{user}->wantgrid) {
+ my $ref = DXUser::get_current($_[1]);
+ if ($ref && $ref->qra) {
+ $slot1 = ' ' . substr($ref->qra, 0, 4);
+ }
}
- }
- if (!$slot1 && $self->{user}->wantusstate) {
- $slot1 = " $_[12]" if $_[12];
- }
- unless ($slot1) {
- if ($self->{user}->wantdxitu) {
- $slot1 = sprintf(" %2d", $_[8]) if defined $_[8];
- } elsif ($self->{user}->wantdxcq) {
- $slot1 = sprintf(" %2d", $_[9]) if defined $_[9];
+ if (!$slot1 && $self->{user}->wantusstate) {
+ $slot1 = " $_[12]" if $_[12];
}
- }
- $comment = substr($comment, 0, $clth-length($slot1)) . $slot1 if $slot1;
+ unless ($slot1) {
+ if ($self->{user}->wantdxitu) {
+ $slot1 = sprintf(" %2d", $_[8]) if defined $_[8];
+ }
+ elsif ($self->{user}->wantdxcq) {
+ $slot1 = sprintf(" %2d", $_[9]) if defined $_[9];
+ }
+ }
+ $comment = substr($comment, 0, $clth-length($slot1)) . $slot1 if $slot1;
- if (!$slot2 && $self->{user}->wantgrid) {
- my $origin = $_[4];
- $origin =~ s/-#$//; # sigh......
- my $ref = DXUser::get_current($origin);
- if ($ref && $ref->qra) {
- $slot2 = ' ' . substr($ref->qra, 0, 4);
+ if (!$slot2 && $self->{user}->wantgrid) {
+ my $origin = $_[4];
+ $origin =~ s/-#$//; # sigh......
+ my $ref = DXUser::get_current($origin);
+ if ($ref && $ref->qra) {
+ $slot2 = ' ' . substr($ref->qra, 0, 4);
+ }
}
- }
- if (!$slot2 && $self->{user}->wantusstate) {
- $slot2 = " $_[13]" if $_[13];
- }
- unless ($slot2) {
- if ($self->{user}->wantdxitu) {
- $slot2 = sprintf(" %2d", $_[10]) if defined $_[10];
- } elsif ($self->{user}->wantdxcq) {
- $slot2 = sprintf(" %2d", $_[11]) if defined $_[11];
+ if (!$slot2 && $self->{user}->wantusstate) {
+ $slot2 = " $_[13]" if $_[13];
+ }
+ unless ($slot2) {
+ if ($self->{user}->wantdxitu) {
+ $slot2 = sprintf(" %2d", $_[10]) if defined $_[10];
+ }
+ elsif ($self->{user}->wantdxcq) {
+ $slot2 = sprintf(" %2d", $_[11]) if defined $_[11];
+ }
}
}
$self->state('init');
my $parent = Route::Node::get($self->{call});
-
+
+ my ($software, $version, $build) = (undef, 0, 0);
+
# record the type and version offered
- if (my ($software, $version) = $pc->[1] =~ /(DXSpider|CC\s*Cluster)\s+Version: (\d+(?:\.\d+)?)/i) {
+ if (($software, $version) = $pc->[1] =~ /(DXSpider|CC\s*Cluster)\s+Version: (\d+(?:\.\d+)?)/i) {
$version += 0;
$version += 53 if $version < 6;
$self->{version} = $version;
$self->sort('S');
}
# $self->{handle_xml}++ if DXXml::available() && $pc->[1] =~ /\bxml/;
- } elsif (my ($software, $version, $build) = $pc->[1] =~ /(AR-Cluster)\s+Version:\s+(\d+\.\d+).?(\d+\.\d+)?/) {
+ } elsif (($software, $version, $build) = $pc->[1] =~ /(AR-Cluster)\s+Version:\s+(\d+\.\d+).?(\d+\.\d+)?/) {
dbg("$self->{call} = $software version $version build $build");
$self->{version} = $version;
$self->user->version($version);
goto &$AUTOLOAD;
}
+my $readonly;
+
#use strict;
#
$dbm = tie (%u, 'DB_File', $filename, O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn ($!) [rebuild it from user_json?]";
}
}
+ $readonly = !$mode;
+
die "Cannot open $filename ($!)\n" unless $dbm || $mode == 2;
return;
}
sub finish
{
- dbg('DXUser finished');
+ dbg('DXUser finished') unless $readonly;
$dbm->sync;
undef $dbm;
untie %u;
sub END
{
if ($dbm) {
- print "DXUser Ended\n";
+ print "DXUser Ended\n" unless $readonly;
finish();
}
}
# is it an ip address?
sub is_ipaddr
{
- return $_[0] =~ /^(?:(?:\:\:)?\d+\.\d+\.\d+\.\d+)|(?:[0-9a-f]{1,4}\:)?(?:\:[0-9a-f]{1,4}){1,6}$/i;
+ return $_[0] =~ /^(?:(?:\:\:)?\d+\.\d+\.\d+\.\d+)|(?:[0-9a-f]{1,4}\:)?(?:\:[0-9a-f]{1,4}(?:\:\:)?){1,6}$/i;
}
# is it a zulu time hhmmZ
use JSON;
use Date::Parse;
use File::Copy;
+use DXUtil;
DXDebug::dbginit();
my $now = time;
my $ecount = 0;
my $rcount = 0;
+my $error = 0;
my $rand = rand;
open RELAY, ">$relayfn.$rand" or die "$0: cannot open $relayfn $!";
my $es = join ', ', @exit;
dbg "$0: $e->{nickname} $e->{last_seen} relays: [$ors] exits: [$es]" if $debug;
for (@or) {
- print RELAY "$_\n";
- ++$rcount;
+ if (is_ipaddr($_)) {
+ print RELAY "$_\n";
+ ++$rcount;
+ } else {
+ print STDERR "$_\n";
+ ++$error;
+ }
}
for (@exit) {
- print EXIT "$_\n";
- ++$ecount;
+ if (is_ipaddr($_)) {
+ print EXIT "$_\n";
+ ++$ecount;
+ } else {
+ print STDERR "$_\n";
+ ++$error;
+ }
}
}
close RELAY;
close EXIT;
-dbg("$0: $rcount relays $ecount exits found");
+dbg("$0: $rcount relays $ecount exits $error error(s) found.");
move "$relayfn.$rand", $relayfn if $rcount;
move "$exitfn.$rand", $exitfn if $ecount;
unlink "$relayfn.$rand";
unlink "$exitfn.$rand";
-exit 0;
+exit $error;
sub clean_addr
{
#
# Implement an external "show/dx" command
#
-# Copyright (c) 1998-2000 Dirk Koopman G1TLH
+# Copyright (c) 1998-2023 Dirk Koopman G1TLH
#
+package main;
# search local then perl directories
BEGIN {
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
+
+ our $local_data = "$root/local_data";
+ our $data = "$root/data";
}
+#no warnings;
+
use IO::Handle;
use DXUtil;
use Bands;
use Spot;
use VE7CC;
+use DXCommandmode;
+use DXUser;
+use DXM;
+
+$Spot::spotcachedays = 0;
+$Spot::readback = 0;
+
+
+STDOUT->autoflush(1);
+Spot::init();
+Bands::load();
+Prefix::init();
+DXUser::init(0);
+DXM::load();
+
+my $call = 'N0CALL';
+my $self = bless {_nospawn => 1, width => 80, call=>$call, lang=>'en' }, 'DXCommandmode' ;
+$self->{user} = DXUser::get($call);
+my $wantreal = 0;
+
+while ($ARGV[0] =~ /^-+/) {
+ if ($ARGV[0] =~ /^-+[?h]/i) {
+ help();
+ exit(2);
+ }
+ $wantreal = 1 if $ARGV[0] =~ /^-+r/i;
+ $ve7cc = 1 if $ARGV[0] =~ /^-+v/i;
+ if ($ARGV[0] =~ /^-+w$/i && $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
+ $self->{width} = $ARGV[1];
+ shift @ARGV;
+ }
+ if ($ARGV[0] =~ /^-+c/i && $ARGV[1] && is_callsign(uc $ARGV[1])) {
+ $call = uc $ARGV[1];
+ my $ref = DXUser::get($call);
+ if ($ref) {
+ $self->{call} = $call;
+ $self->{user} = $ref;
+ }
+ shift @ARGV;
+ }
+ $self->{user}->wantgrid(1), ++$wantreal if $self->{user} && $ARGV[0] =~ /^-+(wa|wg)/i;
+ $self->{user}->wantusstate(1), ++$wantreal if $self->{user} && $ARGV[0] =~ /^-+(wa|wu)/i;
+ $self->{user}->wantdxitu(1), ++$wantreal if $self->{user} && $ARGV[0] =~ /^-+(wa|wi)/i;
+ $self->{user}->wantdxcq(1), ++$wantreal if $self->{user} && $ARGV[0] =~ /^-+(wa|wc)/i;
+
+ shift @ARGV;
+}
+
+$self->{ve7cc} = $ve7cc;
$dxdir = "/spider/cmd/show";
$dxcmd = "dx.pl";
$s = readfilestr($dxdir, $dxcmd);
-$dxproc = eval "sub { $s }";
+
+eval $s;
die $@ if $@;
-STDOUT->autoflush(1);
-Spot::init();
-Bands::load();
$expr = join ' ', @ARGV if @ARGV;
for (;;) {
if ($expr) {
$myexpr = $expr;
+ $myexpr = 'real ' . $myexpr if $wantreal && $myexpr !~ /\breal\b/;
} else {
print "show/dx: ";
$myexpr = <STDIN>;
last unless defined $myexpr;
chomp $myexpr;
last if $myexpr =~ /^q$/i;
+ $myexpr = 'real ' . $myexpr if $wantreal && $myexpr !~ /\breal\b/;
}
- my @out = map {"$_\n"} &$dxproc(undef, $myexpr);
+
+ my @out = map {"$_\n"} handle($self, $myexpr);
shift @out; # remove return code
print @out;
last if $expr;
}
-exit(0);
+exit @out > 0 ? 0 : 1;
+
+sub help
+{
+ print qq{A static TEST Program that allows standalone sh/dx queries
+from the command line.
+
+$0: Usage (examples)
+ showdx on 40m
+ showdx 50 on 40m
+ showdx by g1tlh
+ showdx -v -c g1tlh by g1tlh
+ showdx -w 132 -wc -wg -wu 50 on 40m
+
+$0: Arguments:
+ -?:
+ -h: print this text.
+ -c <callsign>: pretend to be this callsign
+ -r: set 'real' mode (a.k.a show/fdx) (saves typing 'real ' in the query)
+ -v: output in VE7CC computer friendly mode.
+ -w <width>: use this width
+ -wc: set want cq zones
+ -wg: set want grid squares
+ -wi: set want itu zones
+ -wu: set want US states
+ -wa: set all of the above
+
+ NOTE: setting any of -wc, -wg, -wi, -wu flags implies adding 'real ' to
+ the query, if not already present.
+};
+}
+
+sub dbg {};
+sub isdbg {};