X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=867c8ddfe73533fea29a6e3b09f5f0dcd106e2d5;hb=a6a9fc181ae90c318bf47a84c8bb9695ec7a39c6;hp=fd9111826d209c25c1557b191cc1edd4f2048e08;hpb=d39d2e24fb9497d577080e8d0317794e096c27f4;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index fd911182..867c8ddf 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -231,13 +231,15 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { + 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); } @@ -375,12 +377,18 @@ sub parse # check the line for non legal characters 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; my @f = split /\s+/, $line; + my $conj = ' && '; my $not = ""; my $lasttok = ''; @@ -485,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') { @@ -533,9 +542,9 @@ 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; } @@ -554,13 +563,13 @@ sub parse 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"; @@ -574,7 +583,8 @@ sub cmd $r = $filter->write; return (1,$r) if $r; - + + $filter->install(1); # 'delete' $filter->install; return (0, $filter, $fno);