Fix showdx, is_ipaddr, create_master_badip_files.pl
authorDirk Koopman <djk@tobit.co.uk>
Fri, 3 Feb 2023 23:43:29 +0000 (23:43 +0000)
committerDirk Koopman <djk@tobit.co.uk>
Fri, 3 Feb 2023 23:43:29 +0000 (23:43 +0000)
Changes
perl/Bands.pm
perl/DXCommandmode.pm
perl/DXProtHandle.pm
perl/DXUser.pm
perl/DXUtil.pm
perl/create_master_badip_files.pl
perl/showdx

diff --git a/Changes b/Changes
index 6639a0b9f15497d1e934f2c35101f814418062e7..a42d8e281fb9685d40dcfa98bd41a801e1b75c29 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,10 @@
+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 
index aa5bc9e03abb2dd175ffa7d7da8e16b0eb5a48ef..e3b014b51942663783c97232d67eb560ab278f41 100644 (file)
@@ -18,6 +18,7 @@ use vars qw(%bands %regions %aliases $bandsfn %valid);
 %bands = ();                                   # the 'raw' band data
 %regions = ();                                 # list of regions for shortcuts eg vhf ssb
 %aliases = ();                                 # list of aliases
+
 $bandsfn = localdata("bands.pl");
 
 %valid = (
index 510adac255f8a7caa397d1f88daf866f2057569d..2c49fabe07cb7422ef8536efb981a5fce5c980c5 100644 (file)
@@ -1030,41 +1030,45 @@ sub format_dx_spot
        $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]; 
+                       }
                }
        }
 
index b04536e4bc2e374f8b4be35f788bef16d9848181..c4f31232ea0ce2537d6b0bc8ee0f395f74b8399f 100644 (file)
@@ -863,9 +863,11 @@ sub handle_18
        $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;
@@ -885,7 +887,7 @@ sub handle_18
                        $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);
index 7b2ad7a7ba0ad037f15bd4207799d47921de3760..a4e52a26abb1e97a21cc8d657a81c5653c0852e1 100644 (file)
@@ -132,6 +132,8 @@ sub AUTOLOAD
        goto &$AUTOLOAD;
 }
 
+my $readonly;
+
 #use strict;
 
 #
@@ -161,6 +163,8 @@ sub init
                        $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;
 }
@@ -190,7 +194,7 @@ sub process
 
 sub finish
 {
-       dbg('DXUser finished');
+       dbg('DXUser finished') unless $readonly;
        $dbm->sync;
        undef $dbm;
        untie %u;
@@ -982,7 +986,7 @@ sub recover
 sub END
 {
        if ($dbm) {
-               print "DXUser Ended\n";
+               print "DXUser Ended\n" unless $readonly;
                finish();
        }
 }
index b42d808d0e0aaa149b444e212e108e43420bb5d0..30f12733216915cd13105b923e6528b2694150f7 100644 (file)
@@ -448,7 +448,7 @@ sub is_latlong
 # 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
index 3244983b0191d1c735aff3643f749740873e9fc8..37e1747a618923800220d8ecd366b01f5207a11a 100755 (executable)
@@ -33,6 +33,7 @@ use LWP::Simple;
 use JSON;
 use Date::Parse;
 use File::Copy;
+use DXUtil;
 
 DXDebug::dbginit();
 
@@ -69,6 +70,7 @@ my $data = decode_json($content);
 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 $!";
@@ -85,25 +87,35 @@ foreach my $e (@{$data->{relays}}) {
        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
 {
index b84d34ba4871bb05e1691a8f2ae39fac074d98e0..869519f39089953b55fee8e24121ab61f88e4d11 100755 (executable)
@@ -2,9 +2,10 @@
 #
 # 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 {
@@ -14,40 +15,128 @@ 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 {};