From: Dirk Koopman Date: Fri, 3 Feb 2023 23:43:29 +0000 (+0000) Subject: Fix showdx, is_ipaddr, create_master_badip_files.pl X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=378cbf24f1b918e78d8b93c9e7ce3cf46fe28ec7 Fix showdx, is_ipaddr, create_master_badip_files.pl --- diff --git a/Changes b/Changes index 6639a0b9..a42d8e28 100644 --- 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 diff --git a/perl/Bands.pm b/perl/Bands.pm index aa5bc9e0..e3b014b5 100644 --- a/perl/Bands.pm +++ b/perl/Bands.pm @@ -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 = ( diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 510adac2..2c49fabe 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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]; + } } } diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index b04536e4..c4f31232 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -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); diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 7b2ad7a7..a4e52a26 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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(); } } diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index b42d808d..30f12733 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -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 diff --git a/perl/create_master_badip_files.pl b/perl/create_master_badip_files.pl index 3244983b..37e1747a 100755 --- a/perl/create_master_badip_files.pl +++ b/perl/create_master_badip_files.pl @@ -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 { diff --git a/perl/showdx b/perl/showdx index b84d34ba..869519f3 100755 --- a/perl/showdx +++ b/perl/showdx @@ -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 = ; 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 : 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 : 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 {};