source: trunk/dnsbl/DNSBL.pm@ 71

Last change on this file since 71 was 71, checked in by Kris Deugau, 6 years ago

/trunk/dnsbl

Fix missed fragment in adding exclusions in r66
  • Property svn:keywords set to Date Rev Author Id
File size: 19.5 KB
Line 
1# DNSBL
2# Functions for interacting with the DNSBL database
3##
4# $Id: DNSBL.pm 71 2018-07-19 22:19:34Z kdeugau $
5# Copyright 2009-2012,2014,2018 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
20
21package DNSBL;
22
23use strict;
24use warnings;
25use Exporter;
26use DBI;
27use NetAddr::IP;
28
29use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
30
31$VERSION = 2.2;
32@ISA = qw(Exporter);
33@EXPORT_OK = qw(
34 );
35
36@EXPORT = (); # Export nothing by default.
37%EXPORT_TAGS = ( ALL => [qw(
38 )]
39 );
40
41## "constants"
42
43# w00t! somewhere along the line, by accident or intent, SA's
44# check_dnsbl_sub can now check up to 24 bits of an DNSBL return value!
45# 1 not available so we don't $self->shoot(foot)
46our %bitfields = (
47 # ip
48 ip => 2,
49 # "I'm a total spamming moron!" - per-IP only!
50 slist => 128,
51
52 # Block listings. Ordering for levels 0, 1, 2 not ideal due to evolution of code.
53 # Levels 3 and higher are more coherently ordered
54
55 # Automatically listed blocks based on IP counts
56 0 => 16,
57 1 => 8,
58 2 => 4,
59 3 => 4096,
60 4 => 32768,
61 5 => 262144,
62 6 => 2097152,
63
64 # Out-of-band
65 org0 => 32,
66 block0 => 64,
67 org1 => 256,
68 org2 => 512,
69 block1 => 1024,
70 block2 => 2048,
71 org3 => 8192,
72 block3 => 16384,
73 org4 => 65536,
74 block4 => 131072,
75 org5 => 524288,
76 block5 => 1048576,
77 org6 => 4194304,
78 block6 => 8388608,
79
80);
81
82# probably needs some tuning; even 7 hits in a /24 is a pretty small percentage
83# number of IPs in a block of the given masklength needed to have that block automatically listed
84# defaults: (overridden by entries in db:autolist)
85our %autolist = (
86 31 => 1,
87 30 => 1,
88 29 => 2,
89 28 => 3,
90 27 => 4,
91 26 => 5,
92 25 => 6,
93 24 => 7,
94 23 => 8,
95 22 => 10,
96 21 => 13,
97 20 => 16,
98 19 => 19,
99 18 => 22,
100 17 => 26,
101 16 => 30,
102 15 => 34,
103 14 => 38,
104 13 => 42,
105 12 => 46,
106 11 => 50,
107 10 => 54,
108 9 => 58,
109 8 => 62,
110 7 => 2**31,
111 6 => 2**31,
112 5 => 2**31,
113 4 => 2**31,
114 3 => 2**31,
115 2 => 2**31,
116 1 => 2**31,
117 0 => 2**31
118);
119
120# le sigh. constants for masklength iterationing
121our @howmany = (1,128,64,32,16,8,4,2,1,128,64,32,16,8,4,2,1,128,64,32,16,8,4,2,1,128,64,32,16,8,4,2);
122
123# hard max depth. There are not enough bits in a 32-bit IP in 127/8 for more than 7 sets of 3 block-level
124# flags, plus one for the IP, plus one for an "alternate" IP flag, plus reserving the least significant bit
125# as a "don't use this because Reasons"
126our $maxlvl = 6;
127
128# variables
129our $dbh;
130
131our $err;
132our $errstr = '';
133
134# basic object subs
135sub new {
136# iff we want to start taking arguments, or doing other things on instantiation
137# my $self = {};
138# bless $self, "DNSBL";
139# return $self;
140 bless {};
141}
142
143sub DESTROY {
144 my $self = shift;
145 $self->dbclose() if $dbh;
146}
147
148# JIC someone wants to close the db but not finish the script
149sub dbclose {
150 $dbh->rollback;
151 $dbh->disconnect;
152}
153
154## specific object subs:
155
156sub connect {
157 my $self = shift;
158 my $dbhost = shift;
159 my $dbname = shift;
160 my $dbuser = shift;
161 my $dbpass = shift;
162 ## want to NOT autocommit everything, it's unlikely we'll step on our own toes but...
163 $dbh = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname", $dbuser, $dbpass, {
164 AutoCommit => 0,
165 PrintError => 1
166 })
167 or die "database inaccessible: ".$DBI::errstr;
168 my $sth = $dbh->prepare("SELECT masklen,ipcount FROM autolist");
169 $sth->execute;
170 while (my ($masklen,$ipcount) = $sth->fetchrow_array) {
171 $autolist{$masklen} = $ipcount;
172 }
173 return $dbh;
174}
175
176
177## DNSBLDB::initexport()
178# Prepare a couple of statement handles for later processing in export(). Assists in ~3x speed increase.
179my $parsth;
180my $sthmoron;
181sub initexport {
182 $parsth = $dbh->prepare("SELECT count(i.ip),b.block,b.level,b.listme AS oobblock,o.listme AS ooborg ".
183 "FROM iplist i INNER JOIN blocks b ON i.parent = b.block INNER JOIN orgs o ON b.orgid = o.orgid ".
184 "WHERE b.block >>= ? ".
185 "GROUP BY b.block,b.level,b.listme,o.listme ORDER BY b.block");
186 $sthmoron = $dbh->prepare("SELECT ip,s4list,exclude FROM iplist WHERE parent = ?");
187}
188
189
190## DNSBL::ipexists()
191# return report count if the IP has been reported, otherwise return undef
192sub ipexists {
193 my $self = shift;
194 my $ip = shift;
195 my $sth = $dbh->prepare("SELECT count, exclude FROM iplist WHERE ip=?");
196 $sth->execute($ip);
197 my $ret = $sth->fetchrow_arrayref();
198 return $ret;
199} # end ipexists()
200
201
202# report an IP or URI to the db
203# increments a hit counter iff the reported IP or URI exists, otherwise it adds it
204sub report {
205 my $self = shift;
206 my $rep = shift;
207 my $exclude = shift || 'n';
208 my $sth;
209 my $rows = 0;
210 if ($rep =~ /^[\d.]+$/) {
211 # weesa gonna ASS-U-ME IP addresses are sanely formatted.
212 eval {
213 $sth = $dbh->prepare("SELECT count FROM iplist WHERE ip=?");
214 $sth->execute($rep) or die "eep? ".$dbh->errstr."\n";
215 $rows = $sth->rows;
216 if ($rows == 0) {
217 $sth = $dbh->prepare("INSERT INTO iplist (ip,parent,exclude) VALUES ".
218 "(?,(SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1),?)");
219 $sth->execute($rep,$rep,($exclude ? 'y' : 'n')) or die "couldn't add entry for $rep: ".$dbh->errstr."\n";
220 } elsif ($rows == 1) {
221 $sth = $dbh->prepare("UPDATE iplist SET count=count+1,".
222 " exclude=".($exclude ? "'y'" : "'n'"). " WHERE ip=?");
223 $sth->execute($exclude, $rep) or die "couldn't update listing for $rep: ".$dbh->errstr."\n";
224 } else {
225 die "db corrupt: found $rows matches on $rep\n";
226 }
227 $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ?");
228 $sth->execute($rep);
229 my $updsth = $dbh->prepare("UPDATE blocks SET ipcount=(".
230 "SELECT count(*) FROM iplist i JOIN blocks b ON b.block=i.parent WHERE i.ip << ? AND i.exclude='n' AND b.exclude='n'".
231 ") WHERE block=?");
232 while (my ($block) = $sth->fetchrow_array) {
233 $updsth->execute($block,$block);
234 }
235 $dbh->commit;
236 };
237 if ($@) {
238 my $msg = $@;
239 return "failed adding $rep: $msg";
240 }
241 } else {
242 return;
243 }
244 return $rows;
245} # end report()
246
247
248# add a new org
249# return the orgid
250# if the org exists, return the orgid anyway
251sub addorg {
252 my $self = shift;
253 my $orgname = shift;
254 my $listme = shift || 'n';
255 my $ret = $self->orgexists($orgname);
256 return $ret if $ret;
257 my $sth = $dbh->prepare("INSERT INTO orgs (orgname,listme) VALUES (?,?)");
258 $sth->execute($orgname,$listme) or die "couldn't add org $orgname: ".$dbh->errstr."\n";
259 $dbh->commit;
260 $sth = $dbh->prepare("SELECT orgid FROM orgs WHERE orgname=?");
261 $sth->execute($orgname);
262 my ($orgid) = $sth->fetchrow_array();
263 return $orgid;
264} # end addorg
265
266
267# checks for existence - nb, exact match! No way to really handle anything else. :/
268sub orgexists {
269 my $self = shift;
270 my $org = shift;
271 my $sth = $dbh->prepare("SELECT orgid FROM orgs WHERE orgname=?");
272 $sth->execute($org);
273 my ($ret) = $sth->fetchrow_array();
274 return $ret;
275} # end orgexists();
276
277
278# take an arbitrary IP range and an IP, and return the CIDR block (if any) the IP is in.
279sub range2cidr {
280 my $self = shift;
281 my $rstart = shift;
282 my $rend = shift;
283 my $ip = shift;
284
285 $rstart = new NetAddr::IP $rstart;
286 $rend = new NetAddr::IP $rend;
287 # Basic algoithm: Set the mask on the IP, and see if both $rstart and $rend
288 # are within the range defined by that IP/mask. Continue making the mask
289 # larger until success.
290
291 my $mask;
292 for ($mask = 32; $mask > 0; $mask--) {
293 my $ip = NetAddr::IP->new("$ip/$mask");
294 if (NetAddr::IP->new($ip->network->addr) >= $rstart &&
295 NetAddr::IP->new($ip->broadcast->addr) <= $rend) {
296 next;
297 } else {
298 $mask++;
299 last;
300 }
301 }
302 my $realnet = NetAddr::IP->new("$ip/$mask")->network;
303
304 return "$realnet";
305} # end range2cidr()
306
307
308# add a block. requires the orgid
309##fixme needs error handling
310sub addblock {
311 my $self = shift;
312 my $blockin = shift;
313 my $orgid = shift;
314 my $level = shift;
315 my $exclude = shift;
316 my $comment = shift;
317 $blockin =~ s/^\s+//;
318 $blockin =~ s/\s+$//;
319 my $block = new NetAddr::IP "$blockin"; # need this to clean up messes like ranges. sigh.
320
321 return "$blockin not a single CIDR range" if !$block;
322
323# local $dbh->{AutoCommit} = 1; # force autocommit
324
325 my $sth;
326 eval {
327 my $parent = '0/0';
328 if ($level > 0) {
329 $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1");
330 $sth->execute("$block");
331 ($parent) = $sth->fetchrow_array;
332 }
333 $sth = $dbh->prepare("INSERT INTO blocks (block,orgid,level,parent,exclude,comments,ipcount) VALUES (?,?,?,?,?,?,".
334 "(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n'))");
335 $sth->execute("$block",$orgid,$level,$parent,$exclude,$comment,"$block");
336 $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
337 $sth->execute("$block",$parent,"$block");
338 $dbh->commit;
339 };
340 if ($@) {
341 my $msg = $@;
342 eval { dbh->rollback; };
343 return "failed to add $block: $msg";
344 }
345 # nb: no need to return anything, since the CIDR block is the key
346}
347
348
349# Update a netblock entry. Supports (un)setting the exclude flag and the comment.
350# Does NOT do any magic around leftover IPs within the block
351sub updateblock {
352 my $self = shift;
353 my $blockin = shift;
354 my $orgid = shift;
355 my $level = shift;
356 my $exclude = shift;
357 my $comment = shift;
358 $blockin =~ s/^\s+//;
359 $blockin =~ s/\s+$//;
360 my $block = new NetAddr::IP "$blockin"; # need this to clean up messes like ranges. sigh.
361
362 return "$blockin not a single CIDR range" if !$block;
363
364 local $dbh->{AutoCommit} = 0;
365 local $dbh->{RaiseError} = 1;
366
367 my $sth;
368 eval {
369 my $parent = '0/0';
370 if ($level > 0) {
371 $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1");
372 $sth->execute("$block");
373 ($parent) = $sth->fetchrow_array;
374 }
375 $sth = $dbh->prepare("UPDATE blocks SET exclude = ?, comments = ?, ipcount = ".
376 "(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n')".
377 " WHERE block = ?");
378 $sth->execute($exclude, $comment, "$block", "$block");
379 $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
380 $sth->execute("$block", $parent, "$block");
381 $dbh->commit;
382 };
383 if ($@) {
384 my $msg = $@;
385 eval { dbh->rollback; };
386 return "failed to update $block: $msg";
387 }
388 # nb: no need to return anything, since the CIDR block is the key
389}
390
391
392sub blockexists {
393 my $self = shift;
394 my $block = shift;
395 my $sth = $dbh->prepare("SELECT count(*) FROM blocks WHERE block=?");
396 $sth->execute($block);
397 my ($ret) = $sth->fetchrow_array();
398 return $ret;
399}
400
401
402# returns list (block,blockcomment,orgname) for the block that contains the passed IP.
403# accepts a level argument if you don't want the top-level registrar allocation block
404sub getcontainer {
405 my $self = shift;
406 my $ip = shift;
407 my $level = shift || 0;
408 my $sth = $dbh->prepare("SELECT b.block,b.comments,o.orgname FROM blocks b INNER JOIN orgs o ".
409 "ON b.orgid=o.orgid WHERE b.block >> ? AND b.level = ?");
410 $sth->execute($ip,$level);
411 return $sth->fetchrow_array();
412} # end getcontainer()
413
414
415# Get info about whether a block, IP or org is listed
416# Returns ?
417sub islisted {
418 my $self = shift;
419 my $entity = shift;
420
421 my $sth;
422
423 if ($entity =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
424 # looking for IP
425
426 $sth = $dbh->prepare("SELECT ip,s4list,exclude FROM iplist WHERE ip=?");
427 $sth->execute($entity);
428 my @ret = $sth->fetchrow_array;
429 return @ret if @ret;
430
431 } elsif ($entity =~ m|^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/(\d+)$|) {
432 # block
433
434 my $masklen = $1;
435
436 $sth = $dbh->prepare("SELECT block,listme,exclude,ipcount FROM blocks WHERE block = ?");
437 $sth->execute($entity);
438 my ($block, $listme, $exclude, $bcount) = $sth->fetchrow_array;
439
440 return if !$block;
441
442 my @ret = ( ($bcount >= $autolist{$masklen}), $listme, $exclude);
443 return @ret;
444
445 } else {
446 # org
447
448 $sth = $dbh->prepare("SELECT orgid,listme FROM orgs WHERE orgname=?");
449 $sth->execute($entity);
450 my ($orgid,$listme) = $sth->fetchrow_array;
451 return $listme if $orgid;
452
453 }
454
455 return undef;
456
457} # end islisted()
458
459
460# whee! Recursion is Fun!
461# Call ourself to dig down through the layers of blocks from registar-allocation
462# (level 0) to final block (level n, not to exceed $maxlvl)
463# Take a reference to a hash, and stuff it full of blacklisting goodness.
464# Optionally accept a level, block-container, and OOB block and org arguments for
465# the container to check and return
466# Returns no value directly
467# Calls itself to walk down the tree of containers
468sub export {
469 my $self = shift;
470 my $listhosts = shift;
471
472# Export data as CIDR netblocks or classful (A/B/C) blocks
473# Assume classful as it's more compatible with different DNS servers
474 my $mode = shift || 'class';
475
476# Assume we're checking the whole enchilada if we don't get told where to look.
477 my $level = shift || 0;
478 my $container = shift || '0.0.0.0/0';
479 my $bitmask = shift || 0;
480
481 if ($level == 0) {
482 $errstr = '';
483 }
484
485 return if ($errstr =~ /no connection to the server/);
486 if ($level > $maxlvl) {
487 warn "getting too deep, breaking off! ($container, $level)\n";
488 return;
489 }
490
491# fiddle $container into a sane state.
492 if ($container =~ m|^\d+\.\d+\.\d+/\d+$|) {
493 $container =~ s|/(\d+)$|.0/$1|;
494 } elsif ($container =~ m|^\d+\.\d+/\d+$|) {
495 $container =~ s|/(\d+)$|.0.0/$1|;
496 } elsif ($container =~ m|^\d+/(\d+)$|) {
497 $container =~ s|/(\d+)$|.0.0.0/$1|;
498 }
499
500
501 # catch database-went-away errors
502 local $dbh->{RaiseError} = 1;
503 eval {
504
505
506 my $sth = $dbh->prepare("SELECT count(*) FROM blocks WHERE parent = ?");
507 $sth->execute($container);
508 my ($nblocks) = $sth->fetchrow_array();
509
510 # need this for a bunch of things, may as well do it here
511 my ($masklen) = ($container =~ m|/(\d+)$|);
512
513# Update the bitmask variable with the current block info as needed.
514# Much faster than retrieving this data later (~3x faster!).
515 my $listme;
516 my $listorg;
517 my $bcount;
518 my $bexclude;
519 if ($container ne '0.0.0.0/0') {
520 $sth = $dbh->prepare("SELECT b.ipcount,b.listme,b.exclude,o.listme ".
521 "FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ".
522 "WHERE b.block = ?");
523 $sth->execute($container);
524 ($bcount,$listme,$bexclude,$listorg) = $sth->fetchrow_array();
525 $bitmask |= $bitfields{$level-1} if $bcount >= $autolist{$masklen};
526 $bitmask |= $bitfields{"block".($level-1)} if $listme;
527 $bitmask |= $bitfields{"org".($level-1)} if $listorg;
528 }
529
530# hm. can't seem to move this prepare elsewhere. :(
531 if ($nblocks > 0) {
532 my $sthsubblocks = $dbh->prepare("SELECT block,exclude FROM blocks ".
533 "WHERE level = ? AND parent = ?");
534 $sthsubblocks->execute($level, $container);
535 while (my ($cidr, $exclude) = $sthsubblocks->fetchrow_array()) {
536 if ($exclude) {
537 $listhosts->{$cidr} = -1;
538 } else { # don't check subtrees of an excluded block; rbldnsd doesn't support deep flip-flopping like that
539 $self->export($listhosts,$mode,$level+1,$cidr,$bitmask)
540 or die $errstr;
541 }
542 }
543 } # avoid checking content of subs if we don't have any
544
545 # don't check all 4.2 billion IPs individually if we're looking at all teh Intarwebs
546 return if $container eq '0.0.0.0/0';
547
548##fixme: need a way to dig out orphan IPs at all levels - IPs not found in a
549# subblock of the current container when the current container *has* subblocks
550# NB: this may be better handled as an out-of-band data-integrity-checker
551
552 # decrement level here so the right bitfield setting gets picked. this segment
553 # is inherently off-by-one from the block-recursion loop, and I can't see a
554 # better way to work around that. >:(
555 $level--;
556
557 if ($mode eq 'cidr') {
558 $listhosts->{$container} |= $bitmask if $bitmask && ($listme || $listorg || ($bcount >= $autolist{$masklen}));
559 } else {
560 # if $cidr->masklen is <= 24, iterate on /24 boundaries for bulk sublisting
561 # if $cidr->masklen is <= 16, iterate on /16 boundaries for bulk sublisting
562 # if $cidr->masklen is <= 8, iterate on /8 boundaries for bulk sublisting
563
564 if ($bitmask) {
565 my @blocksubs;
566 if ($masklen <= 30 && $masklen > 24) {
567 my ($net,$octet) = ($container =~ m|^(\d+\.\d+\.\d+\.)(\d+)/|);
568 for (my $entry = $octet; $entry < ($octet + $howmany[$masklen]); $entry++) {
569 my $host = "$net$entry";
570 $listhosts->{$host} = 0 if !defined($listhosts->{$host});
571 $listhosts->{$host} |= $bitmask;
572 }
573 } elsif ($masklen <= 24 && $masklen > 16) {
574 my ($net,$octet) = ($container =~ m|^(\d+\.\d+\.)(\d+)\.\d+/|);
575 for (my $entry = $octet; $entry < ($octet + $howmany[$masklen]); $entry++) {
576 my $twofour = "$net$entry.*";
577 $listhosts->{$twofour} |= $bitmask;
578 }
579 } elsif ($masklen <= 16 && $masklen > 8) {
580 my ($net,$octet) = ($container =~ m|^(\d+\.)(\d+)\.\d+\.\d+/|);
581 for (my $entry = $octet; $entry < ($octet + $howmany[$masklen]); $entry++) {
582 my $sixteen = "$net$entry.*";
583 $listhosts->{$sixteen} |= $bitmask;
584 }
585 } elsif ($masklen <= 8) {
586 my ($octet) = ($container =~ m|^(\d+)\.\d+\.\d+\.\d+/|);
587 for (my $entry = $octet; $entry < ($octet + $howmany[$masklen]); $entry++) {
588 my $eight = "$entry.*";
589 $listhosts->{$eight} |= $bitmask;
590 }
591 }
592
593 } # generate autolist entries for ips/octets not (yet) seen in reports
594
595 } # cidr vs classful mode
596
597 $sthmoron->execute($container);
598 while (my ($ip,$moron,$exclude) = $sthmoron->fetchrow_array()) {
599 if ($moron) {
600 $listhosts->{$ip} = $bitfields{slist};
601 } elsif ($exclude) {
602 $listhosts->{$ip} = -1;
603 } else {
604 $listhosts->{$ip} |= $bitmask;
605 $listhosts->{$ip} |= $bitfields{ip};
606 }
607 }
608
609
610 }; # db-went-away-catching eval
611 if ($@) {
612 $errstr = $@;
613 warn "export truncated: $errstr\n";
614 return;
615 }
616
617
618# get IPs which for reasons unknown are apparently allocated directly from the
619# parent registry (and so do not have containing netblocks in this system) O_o
620# select * from iplist where not (select count(*) from blocks where ip << block) > 0;
621
622 return 1;
623} # end export()
624
625
626sub export_alt {
627 my $self = shift;
628 my $listhosts = shift;
629 my $level = shift || 0;
630 my $container = shift || '0.0.0.0/0';
631 my $oobblock = shift || 0;
632 my $ooborg = shift || 0;
633
634#print "\nDEBUG: called with $level, $container, $oobblock, $ooborg\n";
635# if $level > 2 or $container =~ /^64\.76\./;
636# my %listhosts;
637
638# $level = 0 if !$level;
639 if ($level > 3) {
640 warn "getting too deep, breaking off!\n";
641 return;
642 }
643
644 my $sth = $dbh->prepare("select ip,s4list from iplist order by ip");
645 my $bsth = $dbh->prepare("select b.block,b.listme,b.level,o.listme ".
646 "from blocks b inner join orgs o on b.orgid=o.orgid ".
647 "where b.block >> ?");
648 while (my ($ip,$s4list) = $sth->fetchrow_array) {
649 $bsth->execute($ip);
650 while (my ($block,$blisted,$blevel,$olisted) = $bsth->fetchrow_array) {
651 $listhosts->{$ip} |= 0;
652 }
653 }
654
655} # end export_alt()
656
657
658## DNSBL::autolist_block()
659# check if a block should be autolisted
660sub autolist_block {
661 my $self = shift;
662 my $block = shift;
663
664 my $cidr = new NetAddr::IP "$block";
665 my $sth = $dbh->prepare("SELECT ipcount FROM blocks WHERE block = ?");
666 $sth->execute("$cidr");
667 my ($count) = $sth->fetchrow_array;
668
669 return 1 if $count >= $autolist{$cidr->masklen};
670 return 0;
671} # end autolist_block()
672
673
674# make Perl happy
6751;
Note: See TracBrowser for help on using the repository browser.