made the censoring of PC10,11,12 optional with $censorpc = 0
[spider.git] / perl / DXProt.pm
index 4f9e22202f88b044668590f58b06c0fd4339ac12..60e0391f2e34e7e3bb73a061e40b7d0b274a9ea6 100644 (file)
@@ -29,11 +29,12 @@ use AnnTalk;
 use Geomag;
 use WCY;
 use Time::HiRes qw(gettimeofday tv_interval);
+use BadWords;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
                        $last_hour %pings %rcmds
-                       %nodehops @baddx $baddxfn 
+                       %nodehops @baddx $baddxfn $censorpc
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
 $me = undef;                                   # the channel id for this cluster
@@ -45,53 +46,54 @@ $last_hour = time;                          # last time I did an hourly periodic update
 %rcmds = ();                    # outstanding rcmd requests outbound
 %nodehops = ();                 # node specific hop control
 @baddx = ();                    # list of illegal spotted callsigns
-
+$censorpc = 0;                                 # Do a BadWords::check on text fields and reject things
 
 $baddxfn = "$main::data/baddx.pl";
 
 @checklist = 
 (
- qw(c c m p bc c),                             # pc10
- qw(f c m d t c c h),                  # pc11
- qw(c bc m p c p h),                   # pc12
- qw(c h),
- qw(c h),
- qw(c m h),
- undef,                                                        # pc16 has to be validated manually
- qw(c c h),                                            # pc17
- qw(c m n),                                            # pc18
- undef,                                                        # pc19 has to be validated manually
- undef,                                                        # pc20 no validation
- qw(c m h),                                            # pc21
- undef,                                                        # pc22 no validation
- qw(d t n n n m c c h),                        # pc23
- qw(c p h),                                            # pc24
- qw(c c n n),                                  # pc25
- qw(f c m d t c c),                            # pc26
- qw(d t n n n m c c),                  # pc27
- qw(c c c c d t p m bp n p bp c), # pc28
- qw(c c n m),                                  # pc29
- qw(c c n),                                            # pc30
- qw(c c n),                                            # pc31
- qw(c c n),                                            # pc32
- qw(c c n),                                            # pc33
- qw(c c m),                                            # pc34
- qw(c c m),                                            # pc35
- qw(c c m),                                            # pc36
- qw(c c n m),                                  # pc37
- qw(c m),                                              # pc39
- qw(c c m p n),                                        # pc40
- qw(c n m h),                                  # pc41
- qw(c c n),                                            # pc42
+ [ qw(c c m bp bc c) ],                        # pc10
+ [ qw(f m d t m c c h) ],              # pc11
+ [ qw(c bc m bp bm p h) ],             # pc12
+ [ qw(c h) ],                                  # 
+ [ qw(c h) ],                                  # 
+ [ qw(c m h) ],                                        # 
+ undef ,                                               # pc16 has to be validated manually
+ [ qw(c c h) ],                                        # pc17
+ [ qw(m n) ],                                  # pc18
+ undef ,                                               # pc19 has to be validated manually
+ undef ,                                               # pc20 no validation
+ [ qw(c m h) ],                                        # pc21
+ undef ,                                               # pc22 no validation
+ [ qw(d n n n n m c c h) ],            # pc23
+ [ qw(c p h) ],                                        # pc24
+ [ qw(c c n n) ],                              # pc25
+ [ qw(f m d t m c c bc) ],             # pc26
+ [ qw(d n n n n m c c bc) ],   # pc27
+ [ qw(c c c c d t p m bp n p bp bc) ], # pc28
+ [ qw(c c n m) ],                              # pc29
+ [ qw(c c n) ],                                        # pc30
+ [ qw(c c n) ],                                        # pc31
+ [ qw(c c n) ],                                        # pc32
+ [ qw(c c n) ],                                        # pc33
+ [ qw(c c m) ],                                        # pc34
+ [ qw(c c m) ],                                        # pc35
+ [ qw(c c m) ],                                        # pc36
+ [ qw(c c n m) ],                              # pc37
+ undef,                                                        # pc38 not interested
+ [ qw(c m) ],                                  # pc39
+ [ qw(c c m p n) ],                            # pc40
+ [ qw(c n m h) ],                              # pc41
+ [ qw(c c n) ],                                        # pc42
  undef,                                                        # pc43 don't handle it
qw(c c n m m c),                              # pc44
qw(c c n m),                                  # pc45
qw(c c n),                                            # pc46
[ qw(c c n m m c) ],                  # pc44
[ qw(c c n m) ],                              # pc45
[ qw(c c n) ],                                        # pc46
  undef,                                                        # pc47
  undef,                                                        # pc48
qw(c m h),                                            # pc49
qw(c n h),                                            # pc50
qw(c c n),                                            # pc51
[ qw(c m h) ],                                        # pc49
[ qw(c n h) ],                                        # pc50
[ qw(c c n) ],                                        # pc51
  undef,
  undef,
  undef,
@@ -113,7 +115,7 @@ $baddxfn = "$main::data/baddx.pl";
  undef,                                                        # pc70
  undef,
  undef,
qw(d t n n n n n n m m m c c),        # pc73
[ qw(d n n n n n n m m m c c h) ],    # pc73
  undef,
  undef,
  undef,
@@ -124,8 +126,8 @@ $baddxfn = "$main::data/baddx.pl";
  undef,
  undef,
  undef,
qw(c c c m),                                  # pc84
qw(c c c m),                                  # pc85
[ qw(c c c m) ],                              # pc84
[ qw(c c c m) ],                              # pc85
 );
 
 # use the entry in the check list to check the field list presented
@@ -134,15 +136,16 @@ sub check
 {
        my $n = shift;
        $n -= 10;
-       return 0 if $n < 10 || $n > @checklist; 
+       return 0 if $n < 0 || $n > @checklist; 
        my $ref = $checklist[$n];
        return 0 unless ref $ref;
        
        my $i;
        shift;    # not interested in the first field
-       for ($i = 0; $i < @_; $i++) {
+       for ($i = 0; $i < @$ref; $i++) {
                my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
-               next if $blank && $_[$i] eq ' ';
+               return 0 unless $act;
+               next if $blank && $_[$i] =~ /^[ \*]$/;
                if ($act eq 'c') {
                        return $i+1 unless is_callsign($_[$i]);
                } elsif ($act eq 'm') {
@@ -152,7 +155,7 @@ sub check
                } elsif ($act eq 'f') {
                        return $i+1 unless is_freq($_[$i]);
                } elsif ($act eq 'n') {
-                       return $i+1 if $_[$i] !~ /^[^\d ]$/;
+                       return $i+1 unless $_[$i] =~ /^[\d ]+$/;
                } elsif ($act eq 'h') {
                        return $i+1 unless $_[$i] =~ /^H\d\d?$/;
                } elsif ($act eq 'd') {
@@ -173,16 +176,16 @@ sub init
        $me->{state} = "indifferent";
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
-       #  $me->{sort} = 'M';    # M for me
+       $me->{sort} = 'S';    # S for spider
 
        # now prime the spot and wwv  duplicates file with data
-    my @today = Julian::unixtoj(time);
-       for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) {
-               Spot::dup(@{$_}[0..3]);
-       }
-       for (Geomag::readfile(time)) {
-               Geomag::dup(@{$_}[1..5]);
-       }
+#    my @today = Julian::unixtoj(time);
+#      for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) {
+#              Spot::dup(@{$_}[0..3]);
+#      }
+#      for (Geomag::readfile(time)) {
+#              Geomag::dup(@{$_}[1..5]);
+#      }
 
        # load the baddx file
        do "$baddxfn" if -e "$baddxfn";
@@ -237,7 +240,7 @@ sub start
 
        # send initialisation string
        unless ($self->{outbound}) {
-               $self->send(pc38()) if DXNode->get_all();
+#              $self->send(pc38()) if DXNode->get_all();
                $self->send(pc18());
                $self->{lastping} = $main::systime;
        } else {
@@ -261,6 +264,8 @@ sub normal
 {
        my ($self, $line) = @_;
        my @field = split /\^/, $line;
+       return unless @field;
+       
        pop @field if $field[-1] eq '~';
        
 #      print join(',', @field), "\n";
@@ -290,20 +295,27 @@ sub normal
        
  SWITCH: {
                if ($pcno == 10) {              # incoming talk
-                       
+
+                       # will we allow it at all?
+                       if ($censorpc) {
+                               my @bad;
+                               if (@bad = BadWords::check($field[3])) {
+                                       dbg('chan', "Bad words: @bad, dropped" );
+                                       return;
+                               }
+                       }
+
                        # is it for me or one of mine?
                        my ($to, $via, $call, $dxchan);
                        if ($field[5] gt ' ') {
                                $call = $via = $field[2];
                                $to = $field[5];
-                               unless (is_callsign($to)) {
-                                       dbg('chan', "Corrupt talk, rejected");
-                                       return;
-                               }
                        } else {
                                $call = $to = $field[2];
                        }
-                       if ($dxchan = DXChannel->get($call)) {
+                       $dxchan = DXChannel->get($call);
+                       if ($dxchan && $dxchan->is_user) {
+                               $field[3] =~ s/\%5E/^/g;
                                $dxchan->talk($field[1], $to, $via, $field[3]);
                        } else {
                                $self->route($field[2], $line); # relay it on its way
@@ -347,6 +359,13 @@ sub normal
                                dbg('chan', "Duplicate Spot ignored\n");
                                return;
                        }
+                       if ($censorpc) {
+                               my @bad;
+                               if (@bad = BadWords::check($field[5])) {
+                                       dbg('chan', "Bad words: @bad, dropped" );
+                                       return;
+                               }
+                       }
                        
                        my @spot = Spot::add($field[1], $field[2], $d, $field[5], $field[6], $field[7]);
 
@@ -420,9 +439,17 @@ sub normal
                        # announce duplicate checking
                        $field[3] =~ s/^\s+//;  # remove leading blanks
                        if (AnnTalk::dup($field[1], $field[2], $field[3])) {
-                               dbg('chan', "Duplicate Announce ignored\n");
+                               dbg('chan', "Duplicate Announce ignored");
                                return;
                        }
+
+                       if ($censorpc) {
+                               my @bad;
+                               if (@bad = BadWords::check($field[3])) {
+                                       dbg('chan', "Bad words: @bad, dropped" );
+                                       return;
+                               }
+                       }
                        
                        if ($field[2] eq '*' || $field[2] eq $main::mycall) {
                                
@@ -613,12 +640,16 @@ sub normal
                        if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
                                my $node = DXCluster->get_exact($call);
                                if ($node) {
+                                       if ($call eq $self->{call}) {
+                                               dbg('chan', "LOOP: Trying to disconnect myself with PC21");
+                                               return;
+                                       } 
                                        if ($node->dxchan != $self) {
                                                dbg('chan', "LOOP: $call come in on wrong channel");
                                                return;
                                        }
                                        my $dxchan;
-                                       if (($dxchan = DXChannel->get($call)) && $dxchan != $self) {
+                                       if ($dxchan = DXChannel->get($call)) {
                                                dbg('chan', "LOOP: $call connected locally");
                                                return;
                                        }
@@ -723,7 +754,7 @@ sub normal
                        if ($pcno == 49 || $field[1] eq $main::mycall) {
                                DXMsg::process($self, $line);
                        } else {
-                               $self->route($field[1], $line);
+                               $self->route($field[1], $line) unless $self->is_clx;
                        }
                        return;
                }
@@ -884,6 +915,13 @@ sub normal
                        return;
                }
 
+               if ($pcno == 75) {              # dunno but route it
+                       if ($field[1] ne $main::mycall) {
+                               $self->route($field[1], $line);
+                       }
+                       return;
+               }
+
                if ($pcno == 73) {  # WCY broadcasts
                        
                        # do some de-duping
@@ -1025,9 +1063,9 @@ sub process
        my $val;
        my $cutoff;
        if ($main::systime - 3600 > $last_hour) {
-               Spot::process;
-               Geomag::process;
-               AnnTalk::process;
+#              Spot::process;
+#              Geomag::process;
+#              AnnTalk::process;
                $last_hour = $main::systime;
        }
 }
@@ -1110,6 +1148,7 @@ sub send_dx_spot
                } elsif ($dxchan->is_user && $dxchan->{dx}) {
                        my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]);
                        $buf .= "\a\a" if $dxchan->{beep};
+                       $buf =~ s/\%5E/^/g;
                        if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
                        } else {
@@ -1257,9 +1296,13 @@ sub send_announce
                                $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
                                
                        }
-               } elsif ($dxchan->is_user && $dxchan->{ann}) {
+               } elsif ($dxchan->is_user) {
+                       unless ($dxchan->{ann}) {
+                               next if $_[0] ne $main::myalias && $_[0] ne $main::mycall;
+                       }
                        next if $target eq 'SYSOP' && $dxchan->{priv} < 5;
                        my $buf = "$to$target de $_[0]: $text";
+                       $buf =~ s/\%5E/^/g;
                        $buf .= "\a\a" if $dxchan->{beep};
                        if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
@@ -1342,7 +1385,7 @@ sub broadcast_ak1a
 {
        my $s = shift;                          # the line to be rebroadcast
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
-       my @dxchan = DXChannel::get_all_ak1a();
+       my @dxchan = DXChannel::get_all_nodes();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -1359,7 +1402,7 @@ sub broadcast_all_ak1a
 {
        my $s = shift;                          # the line to be rebroadcast
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
-       my @dxchan = DXChannel::get_all_ak1a();
+       my @dxchan = DXChannel::get_all_nodes();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count