staging commt for badword and badip

diff --git a/Changes b/Changes
index fd02b7ddfb16b9eec7bd7f5f3dab82e0d495ef8c..374e1321167b0c7dfe66e54b2a2785bd36d4b53c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+04Jan23=======================================================================
+1. Fillout DXCIDR, attach checks in PC61 and logins. Login that fail will 
+   simply disconnect, like locked out callsigns
+2. Fix qrz.com URL in stock Internet.pm.
+30Dec22=======================================================================
+1. Add more BadWords (regex) checks.
 01Dec22=======================================================================
 1. Re-add some debugging to see which incoming PC protcol sentences are
    being dumped because of any bad content (words or calls) if debugging

diff --git a/cmd/show/badip.pl b/cmd/show/badip.pl
index 73db65da76df80e96329a8b84b21035844f9263a..475abde165e2856454874dcc5147be223868a916 100644 (file)
--- a/cmd/show/badip.pl
+++ b/cmd/show/badip.pl
@@ -12,7 +12,18 @@ return (1, $self->msg('e5')) if $self->priv < 6;
 my @out;
 my @added;
 my @in = split /\s+/, $line;
-my @list= DXCIDR::list();
+my $maxlth = 0;
+
+$DB::single = 1;
+
+
+my @list = map {my $s = $_; $s =~ s|/32$||; $maxlth = length $s if length $s > $maxlth; $s =~ /^1$/?undef:$s} DXCIDR::list();
+my @l;
+$maxlth //= 20;
+my $n = int (80/($maxlth+1));
+my $format = "\%-${maxlth}s " x $n;
+chop $format;
+
 foreach my $list (@list) {
        if (@in) {
                for (@in) {
@@ -22,7 +33,17 @@ foreach my $list (@list) {
                        }
                }
        } else {
-               push @out, $list;
-       } 
+               if (@l > $n) {
+                       push @out, sprintf $format, @l;
+                       @l = ();
+               }
+               push @l, $list;
+       }
+}      
+unless (@in) {
+       push @l, "" while @l < $n;
+       push @out, sprintf $format, @l;
 }
+
+push @out, "show/badip: " . scalar @list . " records found";
 return (1, @out);

diff --git a/cmd/show/badword.pl b/cmd/show/badword.pl
index 33abbc05f2bc8ba4d36cbe08f13bec1a030ad1b1..0f6703b7c352570e44aad3bb94ea0695d36b808d 100644 (file)
--- a/cmd/show/badword.pl
+++ b/cmd/show/badword.pl
@@ -1,7 +1,7 @@
 #
 # show list of bad dx callsigns
 #
-# Copyright (c) 1998 - Dirk Koopman G1TLH
+# Copyright (c) 2023 - Dirk Koopman G1TLH
 #
 #
 #

diff --git a/perl/DXCIDR.pm b/perl/DXCIDR.pm
index 495768edd5217bcc452c3e3a5030ecd6dbf6b28a..506b9693ed9e54c49f2d8d3425ba4c2e62c7f10e 100644 (file)
--- a/perl/DXCIDR.pm
+++ b/perl/DXCIDR.pm
@@ -16,6 +16,7 @@ use DXUtil;
 use DXLog;
 use IO::File;
 use File::Copy;
+use Socket qw(inet_pton inet_ntop);
 
 our $active = 0;
 our $badipfn = "badip";
@@ -28,8 +29,8 @@ my $count6 = 0;
 sub load
 {
        if ($active) {
-               $count4 = _get($ipv4, 4);
-               $count6 = _get($ipv6, 6);
+               $count4 = _load($ipv4, 4);
+               $count6 = _load($ipv6, 6);
        }
        LogDbg('DXProt', "DXCIDR: loaded $count4 IPV4 addresses and $count6 IPV6 addresses");
        return $count4 + $count6;
@@ -37,10 +38,10 @@ sub load
 
 sub _fn
 {
-       return localdata($badipfn) . "$_[0]";
+       return localdata($badipfn) . ".$_[0]";
 }
 
-sub _get
+sub _load
 {
        my $list = shift;
        my $sort = shift;
@@ -52,11 +53,13 @@ sub _get
                while (<$fh>) {
                        chomp;
                        next if /^\s*\#/;
-                       $list->add($_);
+                       next unless /[\.:]/;
+                       $list->add_any($_);
                        ++$count;
                }
                $fh->close;
                $list->clean if $count;
+               $list->prep_find;
        } elsif (-r $fn) {
                LogDbg('err', "DXCIDR: $fn not found ($!)");
        }
@@ -82,18 +85,25 @@ sub _put
 
 sub add
 {
-       for (@_) {
+       for my $ip (@_) {
                # protect against stupid or malicious
                next if /^127\./;
                next if /^::1$/;
                if (/\./) {
-                       $ipv4->add($_);
+                       if ($ipv4->find($ip)) {
+                               LogDbg('DXProt', "DXCIDR: Ignoring existing IPV4 $ip");
+                               next;
+                       } 
+                       $ipv4->add_any($ip);
                        ++$count4;
-                       LogDbg('DXProt', "DXCIDR: Added IPV4 $_ address");
-               } else {
-                       $ipv6->add($_);
+               } elsif (/:/) {
+                       if ($ipv6->find($ip)) {
+                               LogDbg('DXProt', "DXCIDR: Ignoring existing IPV6 $ip");
+                               next;
+                       } 
+                       $ipv6->add_any($ip);
                        ++$count6;
-                       LogDbg('DXProt', "DXCIDR: Added IPV6 $_ address");
+                       LogDbg('DXProt', "DXCIDR: Added IPV6 $ip address");
                }
        }
        if ($ipv4 && $count4) {
@@ -109,25 +119,34 @@ sub add
 sub save
 {
        return 0 unless $active;
-       my $list = $ipv4->list;
-       _put($list, 4) if $list;
-       $list = $ipv6->list;
-       _put($list, 6) if $list;
+       _put($ipv4, 4) if $count4;
+       _put($ipv6, 6) if $count6;
+}
+
+sub _sort
+{
+       my @in;
+       my @out;
+       for (@_) {
+               push @in, [inet_pton($_), split m|/|];
+       }
+       @out = sort {$a->[0] <=> $b->[0]} @in;
+       return map { "$_->[1]/$_->[2]"} @out;
 }
 
 sub list
 {
        my @out;
-       push @out, $ipv4->list;
-       push @out, $ipv6->list;
-       return (1, sort @out);
+       push @out, $ipv4->list if $count4;
+       push @out, $ipv6->list if $count6;
+       return _sort(@out);
 }
 
 sub find
 {
        return 0 unless $active;
        return 0 unless $_[0];
-       
+
        if ($_[0] =~ /\./) {
                return $ipv4->find($_[0]) if $count4;
        }
@@ -147,8 +166,8 @@ sub init
        $ipv4 = Net::CIDR::Lite->new;
        $ipv6 = Net::CIDR::Lite->new;
 
-       load();
        $active = 1;
+       load();
 }
 
 

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 006d8d9dfb9c70bd43c06e635748c3a5a2a745ac..90812225dfe772c4bd8b2671f6ff3600bc70a521 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -401,12 +401,12 @@ sub normal
                }
                $self->send_ans(@ans);
        } else {
-               if (@bad = BadWords::check($cmdline)) {
-                       $self->badcount(($self->badcount||0) + @bad);
-                       LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'");
-               } else {
+#              if (@bad = BadWords::check($cmdline)) {
+#                      $self->badcount(($self->badcount||0) + @bad);
+#                      LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'");
+#              } else {
                        $self->send_ans(run_cmd($self, $cmdline));
-               }
+#              }
        } 
 
        # check for excessive swearing

diff --git a/perl/DXHash.pm b/perl/DXHash.pm
index 28dc77d3ba4656ac03f5773db147a9531ea647d1..cf9f05211c202ff10cd42798f22542822921dd36 100644 (file)
--- a/perl/DXHash.pm
+++ b/perl/DXHash.pm
@@ -31,7 +31,7 @@ sub new
 
        # move existing file
        localdata_mv($name);
-       my $s = readfilestr($main::local_data, localdata($name));
+       my $s = readfilestr($main::local_data, $name);
        my $self = undef;
        $self = eval $s if $s;
        dbg("error in reading $name in DXHash $@") if $@;

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 67dc56632d80b4d2e06abcb509daa2d239c7c71e..ac675f7cafefa6496064a65172c27a9a6bc32e88 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1082,7 +1082,7 @@ sub get_hops
 {
        my $pcno = shift;
        my $hops = $DXProt::hopcount{$pcno};
-       $hops = $DXProt::def_hopcount if !$hops;
+       $hops = $DXProt::def_hopcount unless $hops;
        return "H$hops";
 }
 

diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index efc6c159abd5414d5c3aff2b67abe3195a634870..8a35bbbf137c47369637619354823928618a9637 100644 (file)
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -201,7 +201,8 @@ sub handle_11
                $ip =~ s/,/:/g;
                $ip =~ s/^::ffff://;
                if (DXCIDR::find($ip)) {
-                       
+                       dbg("DXProt: Spot ignore $pc->[8] in badip list") if dbg('badip');
+                       return;
                }
        }
 

diff --git a/perl/Internet.pm b/perl/Internet.pm
index 53df5fd29c21a8043444377515a2cbfcbc5c093e..f79424c7fbf4134343bee5836e449d0909fbb85a 100644 (file)
--- a/perl/Internet.pm
+++ b/perl/Internet.pm
@@ -64,7 +64,7 @@ $http_proxy_port = undef;
 # can be changed if necessary.
 #
 
-$qrz_url = 'www.qrz.com';     # used by show/qrz
+$qrz_url = 'xmldata.qrz.com';     # used by show/qrz
 $wm7d_url = 'www.wm7d.net';   # used by show/wm7d
 $db0sdx_url = 'www.qslinfo.de'; # used by show/db0sdx
 $db0sdx_path = '/qslinfo';

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 9e5976ee92686250a80f53dba340a14380c57101..2cbdee688139498d087762a3e62d9d45c339dccd 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -301,13 +301,20 @@ sub new_channel
                }
 
                # now deal with the lock
+               my $host = $conn->peerhost;
                if ($lock) {
-                       my $host = $conn->peerhost;
                        LogDbg('', "$call on $host is locked out, disconnected");
                        $conn->disconnect;
                        return;
                }
 
+               # Is he from a badip?
+               if (DXCIDR::find($host)) {
+                       LogDbg('', "$call on $host is from a badip $host, disconnected");
+                       $conn->disconnect;
+                       return;
+               }
+
                # set up the basic channel info for "Normal" Users
                # is there one already connected to me - locally?