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);
}
my $filter;
my ($flag, $call);
my $s;
- my $user;
+ my $user = '';
# 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 = '';
}
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') {
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
- $user =~ s/\&\&/ and /g;
- $user =~ s/\|\|/ or /g;
- $user =~ s/\!/ not /g;
- $user =~ s/\s+/ /g;
+ # tidy up the user string (why I have to stick in an if statement when I have initialised it I have no idea! 5.28 bug?
+ if ($user) {
+ $user =~ s/\&\&/ and /g;
+ $user =~ s/\|\|/ or /g;
+ $user =~ s/\!/ not /g;
+ $user =~ s/\s+/ /g;
+ }
return (0, $filter, $fno, $user, $s);
}
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";
$r = $filter->write;
return (1,$r) if $r;
-
+
+ $filter->install(1); # 'delete'
$filter->install;
return (0, $filter, $fno);