X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=867c8ddfe73533fea29a6e3b09f5f0dcd106e2d5;hb=a6a9fc181ae90c318bf47a84c8bb9695ec7a39c6;hp=6b5cad94e5b682ed504d1f03e9568a90751c62fb;hpb=65f4d068c56ddb6e25d1f62b7ca6fd43741386b3;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index 6b5cad94..867c8ddf 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -208,7 +208,7 @@ sub it if ($filter->{reject} && exists $filter->{reject}->{code}) { $type = 'reject'; $asc = $filter->{reject}->{user}; - if (&{$filter->{reject}->{code}}(\@_)) { + if (&{$filter->{reject}->{code}}(ref $_[0] ? $_[0] : \@_)) { $r = 0; last; } else { @@ -218,7 +218,7 @@ sub it if ($filter->{accept} && exists $filter->{accept}->{code}) { $type = 'accept'; $asc = $filter->{accept}->{user}; - if (&{$filter->{accept}->{code}}(\@_)) { + if (&{$filter->{accept}->{code}}(ref $_[0] ? $_[0] : \@_)) { $r = 1; last; } else { @@ -231,13 +231,15 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { - my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} @_; + my $call = $self->{name}; + my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} (ref $_[0] ? @{$_[0]} : @_); my $true = $r ? "OK " : "REJ"; my $sort = $self->{sort}; my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; - + + $call =~ s/\.PL$//i; my $h = $hops || ''; - dbg("$true $dir: $type/$sort with $asc on '$args' $h") if isdbg('filter'); + dbg("Filter: $call $true $dir: $type/$sort with '$asc' on '$args' $h") if isdbg('filter'); } return ($r, $hops); } @@ -364,7 +366,7 @@ use vars qw(@ISA); # this is called as a subroutine not as a method sub parse { - my ($self, $dxchan, $sort, $line) = @_; + my ($self, $dxchan, $sort, $line, $forcenew) = @_; my $ntoken = 0; my $fno = 1; my $filter; @@ -373,19 +375,27 @@ sub parse my $user; # check the line for non legal characters - return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)!]/; + dbg("Filter::parse line: '$line'") if isdbg('filter'); + return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\-\*\/\(\)\$!]/; + + $line = lc $line; + + # disguise regexes + $line =~ s/\{(.*)\}/'{'. unpack('H*', $1) . '}'/eg; + dbg("Filter parse line after regex check: '$line'") if isdbg('filter'); # add some spaces for ease of parsing - $line =~ s/([\(\)])/ $1 /g; - $line = lc $line; + $line =~ s/([\(\!\)])/ $1 /g; my @f = split /\s+/, $line; + my $conj = ' && '; my $not = ""; + my $lasttok = ''; while (@f) { if ($ntoken == 0) { - if (@f && $dxchan->priv >= 8 && ((is_callsign(uc $f[0]) && DXUser::get(uc $f[0])) || $f[0] =~ /(?:node|user)_default/)) { + if (!$forcenew && @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; @@ -399,7 +409,7 @@ sub parse $fno = shift @f; } - $filter = Filter::read_in($sort, $call, $flag); + $filter = Filter::read_in($sort, $call, $flag) unless $forcenew; $filter = Filter->new($sort, $call, $flag) if !$filter || $filter->isa('Filter::Old'); $ntoken++; @@ -411,9 +421,12 @@ sub parse my $tok = shift @f; if ($tok eq '(') { if ($s) { - $s .= $conj; - $user .= $conj; + unless ($lasttok eq '(') { + $s .= $conj ; + $user .= $conj; + } $conj = ""; + $lasttok = $tok; } if ($not) { $s .= $not; @@ -422,12 +435,14 @@ sub parse } $s .= $tok; $user .= $tok; + $lasttok = $tok; next; } elsif ($tok eq ')') { $conj = ' && '; $not =""; $s .= $tok; $user .= $tok; + $lasttok = $tok; next; } elsif ($tok eq 'all') { $s .= '1'; @@ -435,12 +450,14 @@ sub parse last; } elsif ($tok eq 'or') { $conj = ' || ' if $conj ne ' || '; + $lasttok = $tok; next; } elsif ($tok eq 'and') { $conj = ' && ' if $conj ne ' && '; next; } elsif ($tok eq 'not' || $tok eq '!') { - $not = '!'; + $not = '! '; + $lasttok = $tok; next; } if (@f) { @@ -448,11 +465,12 @@ sub parse my @val = split /,/, $val; if ($s) { - $s .= $conj ; - $user .= $conj; - $conj = ' && '; + unless ($lasttok eq '(') { + $s .= $conj ; + $user .= $conj; + $conj = ' && '; + } } - if ($not) { $s .= $not; $user .= $not; @@ -475,14 +493,15 @@ sub parse } if ($fref->[1] eq 'a' || $fref->[1] eq 't') { my @t; - for (@val) { - s/\*//g; # remove any trailing * - if (/^\{.*\}$/) { # we have a regex - s/^\{//; - s/\}$//; - return ('regex', $dxchan->msg('e38', $_)) unless (qr{$_}) + foreach my $v (@val) { + $v =~ s/\*//g; # remove any trailing * + if (my ($r) = $v =~ /^\{(.*)\}$/) { # we have a regex + dbg("Filter::parse regex b: '\{$r\}'") if isdbg('filter'); + $v = pack('H*', $r); + dbg("Filter::parse regex a: '$v'") if isdbg('filter'); + return ('regex', $dxchan->msg('e38', $v)) unless (qr{$v}); } - push @t, "\$r->[$fref->[2]]=~m{$_}i"; + push @t, "\$r->[$fref->[2]]=~m{$v}i"; } $s .= "(" . join(' || ', @t) . ")"; } elsif ($fref->[1] eq 'c') { @@ -523,12 +542,12 @@ sub parse last; } } - return ('unknown', $dxchan->msg('e20', $tok)) unless $found; + return (1, $dxchan->msg('e20', $tok)) unless $found; } else { - return ('no', $dxchan->msg('filter2', $tok)); + return (1, $dxchan->msg('filter2', $tok)); } + $lasttok = $tok; } - } # tidy up the user string @@ -537,20 +556,20 @@ sub parse $user =~ s/\!/ not /g; $user =~ s/\s+/ /g; - return (0, $filter, $fno, $user, "$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 $u = DXUser::get_current($user); return (1, $dxchan->msg('isow', $user)) if $u && $u->isolate; - return (1, $filter) if $r; my $fn = "filter$fno"; @@ -564,7 +583,8 @@ sub cmd $r = $filter->write; return (1,$r) if $r; - + + $filter->install(1); # 'delete' $filter->install; return (0, $filter, $fno);