2 # The User/Sysop Filter module
4 # The way this works is that the filter routine is actually
5 # a predefined function that returns 0 if it is OK and 1 if it
6 # is not when presented with a list of things.
8 # This set of routines provide a means of maintaining the filter
9 # scripts which are compiled in when an entity connects.
11 # Copyright (c) 1999 Dirk Koopman G1TLH
15 # The NEW INSTRUCTIONS
17 # use the commands accept/spot|ann|wwv|wcy and reject/spot|ann|wwv|wcy
18 # also show/filter spot|ann|wwv|wcy
20 # The filters live in a directory tree of their own in $main::root/filter
22 # Each type of filter (e.g. spot, wwv) live in a tree of their own so you
23 # can have different filters for different things for the same callsign.
36 use vars qw ($filterbasefn $in);
38 $filterbasefn = "$main::root/filter";
41 # initial filter system
49 my ($class, $sort, $call, $flag) = @_;
50 $flag = ($flag) ? "in_" : "";
51 return bless {sort => $sort, name => "$flag$call.pl" }, $class;
54 # this reads in a filter statement and returns it as a list
56 # The filter is stored in straight perl so that it can be parsed and read
57 # in with a 'do' statement. The 'do' statement reads the filter into
58 # @in which is a list of references
62 my ($sort, $call, $flag) = @_;
65 $flag = ($flag) ? "in_" : "";
67 my $fn = "$filterbasefn/$sort/$flag$call.pl";
72 $fn = "$filterbasefn/$sort/$flag$call.pl";
78 my $s = readfilestr($fn);
80 dbg('conn', "$@") if $@;
82 $newin = new('Filter::Old', $sort, $call, $flag);
83 $newin->{filter} = $in;
91 # this routine accepts a composite filter with a reject component and then an accept
92 # the filter returns 0 if an entry is matched by any reject rule and also if any
93 # accept rule fails otherwise it returns 1
95 # the either set of rules may be missing meaning an implicit 'ok'
97 # reject rules are implicitly 'or' logic (any reject rules which fires kicks it out)
98 # accept rules are implicitly 'and' logic (all accept rules must pass to indicate a match)
100 # unlike the old system, this is kept as a hash of hashes so that you can
101 # easily change them by program.
103 # you can have a [any] number of 'filters', they are tried in random order until one matches
105 # an example in machine readable form:-
107 # name => 'G7BRN.pl',
114 # by_dxcc => [6, 'n', 226,197],
120 # freq => [0, 'r', 0, 30000],
126 # by_zone => '14,15,16',
129 # freq => [0, 'r', 50000,52000,70000,70500,144000,148000],
130 # by_zone => [11, 'n', 14,15,16],
138 # accept/spots 1 freq 0/30000
139 # reject/spots 1 by_dxcc W,VE
140 # accept/spots 2 freq vhf
141 # accept/spots 2 by_zone 14,15,16
143 # no filter no implies filter 1
145 # The field nos are the same as for the 'Old' filters
147 # The user_* fields are there so that the structure can be listed easily
148 # in human readable form when required. They are not used in the filtering
151 # This defines an HF filter and a VHF filter (as it happens)
162 my ($key, $ref, $field, $fieldsort, $comp);
163 L1: foreach $key (grep {/^filter/ } keys %$self) {
164 my $filter = $self->{$key};
166 if ($filter->{reject}) {
167 foreach $ref (values %{$filter->{reject}}) {
168 ($field, $fieldsort) = @$ref[0,1];
169 my $val = $_[$field];
170 if ($fieldsort eq 'n') {
171 next L1 if grep $_ == $val, @{$ref}[2..$#$ref];
172 } elsif ($fieldsort eq 'r') {
174 for ($i = 2; $i < @$ref; $i += 2) {
175 next L1 if $val >= $ref->[$i] && $val <= $ref->[$i+1];
177 } elsif ($fieldsort eq 'a') {
178 next L1 if grep $val =~ m{$_}, @$ref[2..$#$ref];
182 if ($filter->{accept}) {
183 foreach $ref (values %{$filter->{accept}}) {
184 ($field, $fieldsort) = @$ref[0,1];
185 my $val = $_[$field];
186 if ($fieldsort eq 'n') {
187 next L1 unless grep $_ == $val, @{$ref}[2..$#$ref];
188 } elsif ($fieldsort eq 'r') {
190 for ($i = 2; $i < @$ref; $i += 2) {
191 next L1 unless $val >= $ref->[$i] && $val <= $ref->[$i+1];
193 } elsif ($fieldsort eq 'a') {
194 next L1 unless grep $val =~ m{$_}, @{$ref}[2..$#$ref];
202 # hops are done differently
205 while (($comp, $ref) = each %{$self->{hops}}) {
206 ($field, $h) = @$ref;
207 if ($_[$field] =~ m{$comp}) {
216 # this writes out the filter in a form suitable to be read in by 'read_in'
217 # It expects a list of references to filter lines
221 my $sort = $self->{sort};
222 my $name = $self->{name};
223 my $dir = "$filterbasefn/$sort";
224 my $fn = "$dir/$name";
226 mkdir $dir, 0775 unless -e $dir;
227 rename $fn, "$fn.o" if -e $fn;
228 $fh = new IO::File ">$fn";
230 my $dd = new Data::Dumper([ $self ]);
233 $dd->Quotekeys($] < 5.005 ? 1 : 0);
234 $fh->print($dd->Dumpxs);
237 rename "$fn.o", $fn if -e "$fn.o";
246 return $self->{name};
255 # the OLD instructions!
257 # Each filter file has the same structure:-
261 # [ action, fieldno, fieldsort, comparison, action data ],
265 # The action is usually 1 or 0 but could be any numeric value
267 # The fieldno is the field no in the list of fields that is presented
270 # The fieldsort is the type of field that we are dealing with which
271 # currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is
272 # numeric, 'r' is ranges of pairs of numeric values and 'd' is default.
274 # Filter::it basically goes thru the list of comparisons from top to
275 # bottom and when one matches it will return the action and the action data as a list.
277 # are the element nos of the list that is presented to Filter::it. Element
278 # 0 is the first field of the list.
282 # takes the reference to the filter (the first argument) and applies
283 # it to the subsequent arguments and returns the action specified.
288 my $filter = $self->{filter}; # this is now a bless ref of course but so what
290 my ($action, $field, $fieldsort, $comp, $actiondata);
293 # default action is 1
296 return ($action, $actiondata) if !$filter;
298 for $ref (@{$filter}) {
299 ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
300 if ($fieldsort eq 'n') {
301 my $val = $_[$field];
302 return ($action, $actiondata) if grep $_ == $val, @{$comp};
303 } elsif ($fieldsort eq 'r') {
304 my $val = $_[$field];
306 my @range = @{$comp};
307 for ($i = 0; $i < @range; $i += 2) {
308 return ($action, $actiondata) if $val >= $range[$i] && $val <= $range[$i+1];
310 } elsif ($fieldsort eq 'a') {
311 return ($action, $actiondata) if $_[$field] =~ m{$comp};
313 return ($action, $actiondata); # the default action