X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=6359b319dfd14c2d839dbd334e812a4e7e7afd45;hb=956e3acab807900fdbccc0e2fa5e999327a1c1ce;hp=6a0dad7a9b5debfcdfd27168acc5284101e2481a;hpb=211b54d504170a8c9dad2bf25b9ed686d5eeac11;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index 6a0dad7a..6359b319 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -76,6 +76,27 @@ sub getfn # in with a 'do' statement. The 'do' statement reads the filter into # @in which is a list of references # +sub compile +{ + my $self = shift; + my $fname = shift; + my $ar = shift; + my $ref = $self->{$fname}; + my $rr; + + if ($ref->{$ar} && exists $ref->{$ar}->{asc}) { + $ref->{$ar}->{code} = eval "sub { my \$r=shift; return $ref->{$ar}->{asc}; }" ; + if ($@) { + my $sort = $ref->{sort}; + my $name = $ref->{name}; + dbg('err', "Error compiling $ar $sort $name: $@"); + Log('err', "Error compiling $ar $sort $name: $@"); + } + $rr = $@; + } + return $rr; +} + sub read_in { my ($sort, $call, $flag) = @_; @@ -94,25 +115,8 @@ sub read_in my $filter; my $key; foreach $key ($newin->getfilkeys) { - $filter = $newin->{$key}; - if ($filter->{reject} && exists $filter->{reject}->{asc}) { - $filter->{reject}->{code} = eval $filter->{reject}->{asc} ; - if ($@) { - my $sort = $newin->{sort}; - my $name = $newin->{name}; - dbg('err', "Error compiling reject $sort $key $name: $@"); - Log('err', "Error compiling reject $sort $key $name: $@"); - } - } - if ($filter->{accept} && exists $filter->{accept}->{asc}) { - $filter->{accept}->{code} = eval $filter->{accept}->{asc} ; - if ($@) { - my $sort = $newin->{sort}; - my $name = $newin->{name}; - dbg('err', "Error compiling accept $sort $key $name: $@"); - Log('err', "Error compiling accept $sort $key $name: $@"); - } - } + $newin->compile($key, 'reject'); + $newin->compile($key, 'accept'); } } return $newin; @@ -143,12 +147,15 @@ sub getfilkeys # The filter returns 0 if an entry is matched by any reject rule and also if any # accept rule fails otherwise it returns 1 # -# Either set of rules may be missing meaning an implicit 'ok' +# Either set of rules may be missing meaning an implicit 'opposite' ie if it +# a reject then ok else if an accept then not ok. +# +# you can set a default with either an accept/xxxx all or reject/xxxx all # # Unlike the old system, this is kept as a hash of hashes so that you can # easily change them by program. # -# You can have a [any] number of 'filters', they are tried in random order until +# You can have 10 filter lines (0->9), they are tried in order until # one matches # # There is a parser that takes a Filter::Cmd object which describes all the possible @@ -178,19 +185,29 @@ sub it my $self = shift; my $hops = undef; - my $r = 1; my $filter; - foreach $filter ($self->getfilters) { - $r = 0; + my @keys = sort $self->getfilkeys; + my $key; + my $r = @keys > 0 ? 0 : 1; + foreach $key (@keys) { + $filter = $self->{$key}; if ($filter->{reject} && exists $filter->{reject}->{code}) { - next if &{$filter->{reject}->{code}}(\@_); + if (&{$filter->{reject}->{code}}(\@_)) { + $r = 0; + last; + } else { + $r = 1; + } } if ($filter->{accept} && exists $filter->{accept}->{code}) { - next unless &{$filter->{accept}->{code}}(\@_); + if (&{$filter->{accept}->{code}}(\@_)) { + $r = 1; + last; + } else { + $r = 0; + } } - $r = 1; - last; } # hops are done differently @@ -247,10 +264,10 @@ sub print foreach $key (sort $self->getfilkeys) { my $filter = $self->{$key}; if ($filter->{reject} && exists $filter->{reject}->{user}) { - push @out, ' ' . join(' ', $key, 'reject', $filter->{reject}->{user}); + push @out, ' ' . join(' ', $key, 'reject', $filter->{reject}->{user}); } if ($filter->{accept} && exists $filter->{accept}->{user}) { - push @out, ' ' . join(' ', $key, 'accept', $filter->{accept}->{user}); + push @out, ' ' . join(' ', $key, 'accept', $filter->{accept}->{user}); } } return @out; @@ -293,6 +310,7 @@ sub delete # get rid if ($filter->{hops} || $filter->getfilkeys) { $filter->install; + $filter->write; } else { $filter->install(1); unlink $fn; @@ -303,6 +321,9 @@ sub delete package Filter::Cmd; use strict; +use DXVars; +use DXUtil; +use DXDebug; use vars qw(@ISA); @ISA = qw(Filter); @@ -310,7 +331,7 @@ use vars qw(@ISA); # this is called as a subroutine not as a method sub parse { - my ($self, $dxchan, $line) = @_; + my ($self, $dxchan, $sort, $line) = @_; my $ntoken = 0; my $fno = 1; my $filter; @@ -319,7 +340,7 @@ sub parse my $user; # check the line for non legal characters - return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\*\/\(\)]/; + return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)]/; # add some spaces for ease of parsing $line =~ s/([\(\)])/ $1 /g; @@ -331,7 +352,7 @@ sub parse while (@f) { if ($ntoken == 0) { - if (@f && $dxchan->priv >= 8 && (DXUser->get($f[0]) || $f[0] =~ /(?:node|user)_default/)) { + if (@f && $dxchan->priv >= 8 && ((is_callsign(uc $f[0]) && DXUser->get(uc $f[0])) || $f[0] =~ /(?:node|user)_default/)) { $call = shift @f; if ($f[0] eq 'input') { shift @f; @@ -345,8 +366,8 @@ sub parse $fno = shift @f; } - $filter = Filter::read_in('spots', $call, $flag); - $filter = Filter->new('spots', $call, $flag) unless $filter; + $filter = Filter::read_in($sort, $call, $flag); + $filter = Filter->new($sort, $call, $flag) unless $filter; $ntoken++; next; @@ -375,6 +396,10 @@ sub parse $s .= $tok; $user .= $tok; next; + } elsif ($tok eq 'all') { + $s .= '1'; + $user .= $tok; + last; } elsif ($tok eq 'or') { $conj = ' || ' if $conj ne ' || '; next; @@ -460,12 +485,43 @@ sub parse $user =~ s/\!/ not /g; $user =~ s/\s+/ /g; - return (0, $filter, $fno, $user, "sub { my \$r = shift; return $s }"); + return (0, $filter, $fno, $user, "$s"); +} + +# a filter accept/reject command +sub cmd +{ + my ($self, $dxchan, $sort, $type, $line) = @_; + + return $dxchan->msg('filter5') unless $line; + + my ($r, $filter, $fno, $user, $s) = $self->parse($dxchan, $sort, $line); + return (1,$filter) if $r; + + my $fn = "filter$fno"; + + $filter->{$fn} = {} unless exists $filter->{$fn}; + $filter->{$fn}->{$type} = {} unless exists $filter->{$fn}->{$type}; + + $filter->{$fn}->{$type}->{user} = $user; + $filter->{$fn}->{$type}->{asc} = $s; + $r = $filter->compile($fn, $type); + return (1,$r) if $r; + + $r = $filter->write; + return (1,$r) if $r; + + $filter->install; + + return (0, $filter, $fno); } package Filter::Old; use strict; +use DXVars; +use DXUtil; +use DXDebug; use vars qw(@ISA); @ISA = qw(Filter);