X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=031ec92669a6cd200729d40ddef70d9e58d92e15;hb=775fd16897916dccc374098ba6130b0f8858b636;hp=b927dc1f0700c0917e9bccbc61f0f345123c2c54;hpb=20a1e972197e2d479bd35da2deb2bce22209a10e;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index b927dc1f..031ec926 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -89,7 +89,7 @@ sub compile if ($@) { my $sort = $ref->{sort}; my $name = $ref->{name}; - dbg('err', "Error compiling $ar $sort $name: $@"); + dbg("Error compiling $ar $sort $name: $@"); Log('err', "Error compiling $ar $sort $name: $@"); } $rr = $@; @@ -107,7 +107,7 @@ sub read_in $in = undef; my $s = readfilestr($fn); my $newin = eval $s; - dbg('conn', "$@") if $@; + dbg($@) if $@; if ($in) { $newin = new('Filter::Old', $sort, $call, $flag); $newin->{filter} = $in; @@ -187,10 +187,15 @@ sub it my $filter; my @keys = sort $self->getfilkeys; my $key; + my $type = 'Dunno'; + my $asc = '?'; + my $r = @keys > 0 ? 0 : 1; foreach $key (@keys) { $filter = $self->{$key}; if ($filter->{reject} && exists $filter->{reject}->{code}) { + $type = 'reject'; + $asc = $filter->{reject}->{user}; if (&{$filter->{reject}->{code}}(\@_)) { $r = 0; last; @@ -199,6 +204,8 @@ sub it } } if ($filter->{accept} && exists $filter->{accept}->{code}) { + $type = 'accept'; + $asc = $filter->{accept}->{user}; if (&{$filter->{accept}->{code}}(\@_)) { $r = 1; last; @@ -211,6 +218,15 @@ sub it # hops are done differently (simply) my $hops = $self->{hops} if exists $self->{hops}; + if (isdbg('filter')) { + my $args = join '\',\'', @_; + my $true = $r ? "OK " : "REJ"; + my $sort = $self->{sort}; + my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; + + my $h = $hops || ''; + dbg("$true $dir: $type/$sort with $asc on '$args' $h") if isdbg('filter'); + } return ($r, $hops); } @@ -271,12 +287,12 @@ sub install my $remove = shift; my $name = uc $self->{name}; my $sort = $self->{sort}; - my ($in) = $name =~ s/^IN_//; + my $in = ""; + $in = "in" if $name =~ s/^IN_//; $name =~ s/.PL$//; my $dxchan = DXChannel->get($name); if ($dxchan) { - $in = lc $in if $in; my $n = "$in$sort" . "filter"; $dxchan->$n($remove ? undef : $self); }