From: djk Date: Sun, 21 Feb 1999 17:41:31 +0000 (+0000) Subject: added filter code X-Git-Tag: R_1_24~9 X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=8942c27356acc5d5f5a20134461bcf7e6bd6a044 added filter code fiddled a bit with the dx commands to allow multiple freq ranges --- diff --git a/Changes b/Changes index 884a861d..50528a69 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +21Feb99======================================================================== +1. Allowed multiple 'on ' for show/dx +2. Made sure the 'on 20m/ssb' thing worked (also 'on hf/cw'). +3. first cut of the Filtering code, no user commands yet but the file +format is defined and manually added filters should work for spots 17Feb99======================================================================== 1. added export_user.pl to export user files (for interest and safety) 2. changed DXUser::init to allow O_RDONLY access which may limit the number @@ -19,7 +24,7 @@ off which means that the netrom/ax25 call programs terminate properly (and not loop as fast as their little legs can paddle, soaking up CPU time). 2. Implemented read receipts as an especial request from G4PDQ. 3. Fiddled with DXUser a bit to see whether I can stop it core dumping on new -users in PC16s on his machine. +users in PC16s on G0RDI's machine. 4. Added E4 (Palestine) to Prefix data. 30Jan99======================================================================== 1. Some of the dates we get can cause crashes, tried to make it more robust (oh diff --git a/cmd/dx.pl b/cmd/dx.pl index b80d89bf..308371fd 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -65,7 +65,6 @@ if (!$valid) { } - push @out, $self->msg('dx1', $freq) if !$valid; # check we have a callsign :-) @@ -85,10 +84,11 @@ if (grep $_ eq $spotted, @DXProt::baddx) { my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter); push @out, $buf; } else { - if (Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall)) { + my @spot = Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall); + if (@spot) { # send orf to the users my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter); - DXProt::broadcast_users($buf, 'dx', $buf); + DXProt::broadcast_users($buf, 'dx', \@spot); # send it orf to the cluster (hang onto your tin helmets) DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line)); diff --git a/cmd/set/language.pl b/cmd/set/language.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index 06cc5d04..c9869996 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -32,11 +32,12 @@ while ($f = shift @list) { # next field if (lc $f eq 'on' && $list[0]) { # is it freq range? # print "yup freq\n"; my @r = split '/', $list[0]; - # print "r0: $r[0] r1: $r[1]\n"; - @freq = Bands::get_freq($r[0], $r[1]); - if (@freq) { # yup, get rid of extranous param - # print "freq: ", join(',', @freq), "\n"; + # print "r0: $r[0] r1: $r[1]\n"; + my @fr = Bands::get_freq($r[0], $r[1]); + if (@fr) { # yup, get rid of extranous param + # print "freq: ", join(',', @fr), "\n"; shift @list; + push @freq, @fr; # add these to the list next; } } @@ -50,7 +51,7 @@ while ($f = shift @list) { # next field $info = shift @list; next; } - if (lc $f eq 'spotter' && $list[0]) { + if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) { # print "got spotter\n"; $spotter = uc shift @list; next; diff --git a/filter/spots/GB7DJK.pl.issue b/filter/spots/GB7DJK.pl.issue new file mode 100644 index 00000000..006ea2bf --- /dev/null +++ b/filter/spots/GB7DJK.pl.issue @@ -0,0 +1,27 @@ +# +# This is an example filter for the 'isolated' node k1xx +# +# I give him any spots that have a spotter or a spotted in the +# US. In other filters on the UK side I do the opposite see +# GB7DJK.pl.issue +# +# The element list is:- +# 0 = frequency +# 1 = call +# 2 = date in unix format +# 3 = comment +# 4 = spotter +# 5 = spotted dxcc country +# 6 = spotter's dxcc country +# 7 = origin +# 8 = spotted itu +# 9 = spotted cq +# 10 = spotter's itu +# 11 = spotter's cq +# + +$in = [ + [ 1, 9, 'n', [ 14,15 ] ], # 14 and 15 is CQ region for europe + [ 1, 11, 'n', [ 14,15 ] ], + [ 0, 0, 'd' ], +]; diff --git a/filter/spots/K1XX.pl.issue b/filter/spots/K1XX.pl.issue new file mode 100644 index 00000000..3f226ef1 --- /dev/null +++ b/filter/spots/K1XX.pl.issue @@ -0,0 +1,27 @@ +# +# This is an example filter for the 'isolated' node k1xx +# +# I give him any spots that have a spotter or a spotted in the +# US. In other filters on the UK side I do the opposite see +# GB7DJK.pl.issue +# +# The element list is:- +# 0 = frequency +# 1 = call +# 2 = date in unix format +# 3 = comment +# 4 = spotter +# 5 = spotted dxcc country +# 6 = spotter's dxcc country +# 7 = origin +# 8 = spotted itu +# 9 = spotted cq +# 10 = spotter's itu +# 11 = spotter's cq +# + +$in = [ + [ 1, 5, 'n', [ 226 ] ], # dxcc country 226 is the US + [ 1, 6, 'a', [ 226 ] ], + [ 0, 0, 'd' ], # default action (don't forward) +]; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index b3929c1f..2b4fda78 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -70,6 +70,9 @@ use vars qw(%channels %valid); group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other isolate => '9,Isolate network,yesno', delayed => '9,Delayed messages,parray', + annfilter => '9,Announce Filter', + wwvfilter => '9,WWV Filter', + spotfilter => '9,Spot Filter', ); # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 2094cbfa..bce0255f 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -22,6 +22,7 @@ use DXLogPrint; use DXBearing; use CmdAlias; use FileHandle; +use Filter; use Carp; use strict; @@ -87,6 +88,9 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('msgnew')) if DXMsg::for_me($call); + + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call); $self->send($self->msg('pr', $call)); } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index dd6d178e..5a796935 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -11,6 +11,7 @@ # # PC28 field 11 is the RR required flag # PC28 field 12 is a VIA routing (ie it is a node call) +# package DXMsg; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5797c63f..a16789c7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -22,6 +22,7 @@ use DXLog; use Spot; use DXProtout; use DXDebug; +use Filter; use Local; use Carp; @@ -106,6 +107,11 @@ sub start $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type $self->{here} = 1; + + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call); + $self->{wwvfilter} = Filter::read_in('wwv', $call); + $self->{annfilter} = Filter::read_in('ann', $call); # set unbuffered $self->send_now('B',"0"); @@ -207,29 +213,45 @@ sub normal # # @spot at this point contains:- - # freq, spotted call, time, text, spotter, spotted cc, spotters cc, - # orig node, spotted itu, spotted cq, spotters itu, spotters cq + # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node + # then spotted itu, spotted cq, spotters itu, spotters cq # you should be able to route on any of these # # local processing my $r; eval { - $r = Local::spot($self, $freq, $field[2], $d, $text, $spotter, $field[7]); + $r = Local::spot($self, @spot); }; # dbg('local', "Local::spot1 error $@") if $@; return if $r; + # DON'T be silly and send on PC26s! + return if $pcno == 26; + + # send out the filtered spots + my @dxchan = get_all_ak1a(); + my $dxchan; + + # send it if it isn't the except list and isn't isolated and still has a hop count + foreach $dxchan (@dxchan) { + next if $dxchan == $self; + my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name + my $filter = Filter::it($dxchan->{spotfilter}, @spot) if $dxchan->{spotfilter}; + if ($filter) { + $dxchan->send($routeit) if $routeit; + } else { + $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit; + } + } + # send orf to the users - if (@spot && $pcno == 11) { + if (@spot) { my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter); broadcast_users("$buf\a\a", 'dx', $spot[0]); } - # DON'T be silly and send on PC26s! - return if $pcno == 26; - - last SWITCH; + return; } if ($pcno == 12) { # announces @@ -781,13 +803,19 @@ sub broadcast_list my $dxchan; foreach $dxchan (@_) { + my $filter = 1; - next if $sort eq 'dx' && !$dxchan->{dx}; + if ($sort eq 'dx') { + next unless $dxchan->{dx}; + $filter = Filter::it($dxchan->{spotfilter}, @{$fref}) if ref $fref; + next unless $filter; + } next if $sort eq 'ann' && !$dxchan->{ann}; next if $sort eq 'wwv' && !$dxchan->{wwv}; next if $sort eq 'wx' && !$dxchan->{wx}; $s =~ s/\a//og unless $dxchan->{beep}; + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { $dxchan->send($s); } else { diff --git a/perl/Filter.pm b/perl/Filter.pm index bc622e36..1e1913a2 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -12,32 +12,147 @@ # # $Id$ # +# The INSTRUCTIONS +# +# The filters live in a directory tree of their own in $main::root/filter +# +# Each type of filter (e.g. spot, wwv) live in a tree of their own so you +# can have different filters for different things for the same callsign. +# +# Each filter file has the same structure:- +# +# +# @in = ( +# [ action, fieldno, fieldsort, comparison ], +# ... +# ); +# +# The action is usually 1 or 0 but could be any numeric value +# +# The fieldno is the field no in the list of fields that is presented +# to 'Filter::it' +# +# The fieldsort is the type of field that we are dealing with which +# currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is +# numeric, 'r' is ranges of pairs of numeric values and 'd' is default. +# +# Filter::it basically goes thru the list of comparisons from top to +# bottom and when one matches it will return the action. The fields +# are the element nos of the list that is presented to Filter::it. Element +# 0 is the first field of the list. +# package Filter; use DXVars; -use DXUtils; +use DXUtil; use DXDebug; +use Carp; + +use strict; + +use vars qw ($filterbasefn); + +$filterbasefn = "$main::root/filter"; # initial filter system sub init { + } -sub compile +# +# takes the reference to the filter (the first argument) and applies +# it to the subsequent arguments and returns the action specified. +# +sub it { - + my $filter = shift; + my $ref; + + # default action is 1 + return 1 if !$filter; + + for $ref (@{$filter}) { + my ($action, $field, $fieldsort, $comp) = @{$ref}; + if ($fieldsort eq 'n') { + my $val = $_[$field]; + return $action if grep $_ == $val, @{$comp}; + } elsif ($fieldsort eq 'r') { + my $val = $_[$field]; + my $i; + my @range = @{$comp}; + for ($i = 0; $i < @range; $i += 2) { + return $action if $val >= $range[$i] && $val <= $range[$i+1]; + } + } elsif ($fieldsort eq 'a') { + return $action if $_[$field] =~ m{$comp}; + } else { + return $action; # the default action + } + } } +# this reads in a filter statement and returns it as a list +# +# The filter is stored in straight perl so that it can be parsed and read +# in with a 'do' statement. The 'do' statement reads the filter into +# @in which is a list of references +# +sub read_in +{ + my ($sort, $call) = @_; + my $fn = "$filterbasefn/$sort/$call.pl"; + my $in; + + if (-e $fn) { + do $fn; + return $in; + } + return undef; +} - - - - - - - - +# this writes out the filter in a form suitable to be read in by 'read_in' +# It expects a list of references to filter lines +sub write_out +{ + my $sort = shift; + my $call = shift; + my $fn = "$filterbasefn/$sort"; + + + # make the output directory + mkdir $fn, 0777 unless -e $fn; + + # write out the file + $fn = "$fn/$call.pl"; + unless (open FILTER, ">$fn") { + warn "can't open $fn $!" ; + return; + } + + my $today = localtime; + print FILTER "# +# Filter for $call stored $today +# +\$in = [ +"; + + my $ref; + for $ref (@_) { + my ($action, $field, $fieldsort, $comp) = @{$ref}; + print FILTER "\t[ $action, $field, $fieldsort,"; + if ($fieldsort eq 'n' || $fieldsort eq 'r') { + print FILTER "[ ", join (',', $comp), " ],"; + } elsif ($fieldsort eq 'a') { + my $f = $comp; + print FILTER "'$f'"; + } + print FILTER " ],\n"; + } + print FILTER "];\n"; + close FILTER; +} 1; __END__ diff --git a/perl/Spot.pm b/perl/Spot.pm index c2917e2e..6f21535a 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -69,7 +69,7 @@ sub add # automagically closes the output file (if any)). $fp->writeunix($out[2], $buf); - return ($buf, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq); + return (@spot, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq); } # search the spot database for records based on the field no and an expression @@ -83,7 +83,10 @@ sub add # $f2 = date in unix format # $f3 = comment # $f4 = spotter -# $f5 = dxcc country +# $f5 = spotted dxcc country +# $f6 = spotter dxcc country +# $f7 = origin +# # # In addition you can specify a range of days, this means that it will start searching # from days less than today to days less than today diff --git a/perl/cluster.pl b/perl/cluster.pl index 0de499f6..2ae98efc 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -55,6 +55,7 @@ use Prefix; use Bands; use Geomag; use CmdAlias; +use Filter; use Local; use Fcntl ':flock';