Changeset 66 for trunk/dnsbl/DNSBL.pm


Ignore:
Timestamp:
01/05/18 18:06:47 (6 years ago)
Author:
Kris Deugau
Message:

/trunk/dnsbl

Add exclusion flagging and block-comment handling to IP list tools. Exclusion
flags can be set or unset on each submit; netblock comments can be added,
updated, or removed (or at least "set empty") on each submit.

Note this is focused on the CIDR (rbldnsd) export format, and may produce
excitingly weird results with the default "classful"/tinydns mode.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/dnsbl/DNSBL.pm

    r54 r66  
    130130
    131131our $err;
    132 our $errstr;
     132our $errstr = '';
    133133
    134134# basic object subs
    … …  
    184184        "WHERE b.block >>= ? ".
    185185        "GROUP BY b.block,b.level,b.listme,o.listme ORDER BY b.block");
    186   $sthmoron = $dbh->prepare("SELECT ip,s4list FROM iplist WHERE parent = ?");
     186  $sthmoron = $dbh->prepare("SELECT ip,s4list,white FROM iplist WHERE parent = ?");
    187187}
    188188
    … …  
    193193  my $self = shift;
    194194  my $ip = shift;
    195   my $sth = $dbh->prepare("SELECT count FROM iplist WHERE ip=?");
     195  my $sth = $dbh->prepare("SELECT count, exclude FROM iplist WHERE ip=?");
    196196  $sth->execute($ip);
    197   my ($ret) = $sth->fetchrow_array();
     197  my $ret = $sth->fetchrow_arrayref();
    198198  return $ret;
    199199} # end ipexists()
    … …  
    205205  my $self = shift;
    206206  my $rep = shift;
     207  my $exclude = shift;
    207208  my $sth;
    208209  my $rows = 0;
    … …  
    214215      $rows = $sth->rows;
    215216      if ($rows == 0) {
    216         $sth = $dbh->prepare("INSERT INTO iplist (ip,parent) VALUES ".
    217                 "(?,(SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1))");
    218         $sth->execute($rep,$rep) or die "couldn't add entry for $rep: ".$dbh->errstr."\n";
     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) or die "couldn't add entry for $rep: ".$dbh->errstr."\n";
    219220      } elsif ($rows == 1) {
    220         $sth = $dbh->prepare("UPDATE iplist SET count=count+1 WHERE ip=?");
     221        $sth = $dbh->prepare("UPDATE iplist SET count=count+1,".
     222                " exclude=".($exclude ? "'y'" : "'n'"). " WHERE ip=?");
    221223        $sth->execute($rep) or die "couldn't update listing for $rep: ".$dbh->errstr."\n";
    222224      } else {
    … …  
    225227      $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ?");
    226228      $sth->execute($rep);
    227       my $updsth = $dbh->prepare("UPDATE blocks SET ipcount=(SELECT count(*) FROM iplist WHERE ip << ?) WHERE block=?");
     229      my $updsth = $dbh->prepare("UPDATE blocks SET ipcount=(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n') WHERE block=?");
    228230      while (my ($block) = $sth->fetchrow_array) {
    229231        $updsth->execute($block,$block);
    … …  
    309311  my $orgid = shift;
    310312  my $level = shift;
     313  my $exclude = shift;
     314  my $comment = shift;
    311315  $blockin =~ s/^\s+//;
    312316  $blockin =~ s/\s+$//;
    … …  
    325329      ($parent) = $sth->fetchrow_array;
    326330    }
    327     $sth = $dbh->prepare("INSERT INTO blocks (block,orgid,level,parent,ipcount) VALUES (?,?,?,?,".
    328         "(SELECT count(*) FROM iplist WHERE ip << ?))");
    329     $sth->execute("$block",$orgid,$level,$parent,"$block");
     331    $sth = $dbh->prepare("INSERT INTO blocks (block,orgid,level,parent,exclude,comments,ipcount) VALUES (?,?,?,?,?,?,".
     332        "(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n'))");
     333    $sth->execute("$block",$orgid,$level,$parent,$exclude,$comment,"$block");
    330334    $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
    331335    $sth->execute("$block",$parent,"$block");
    … …  
    341345
    342346
     347# Update a netblock entry.  Supports (un)setting the exclude flag and the comment.
     348# Does NOT do any magic around leftover IPs within the block
     349sub updateblock {
     350  my $self = shift;
     351  my $blockin = shift;
     352  my $orgid = shift;
     353  my $level = shift;
     354  my $exclude = shift;
     355  my $comment = shift;
     356  $blockin =~ s/^\s+//;
     357  $blockin =~ s/\s+$//;
     358  my $block = new NetAddr::IP "$blockin";       # need this to clean up messes like ranges.  sigh.
     359
     360  return "$blockin not a single CIDR range" if !$block;
     361
     362  local $dbh->{AutoCommit} = 0;
     363  local $dbh->{RaiseError} = 1;
     364
     365  my $sth;
     366  eval {
     367    my $parent = '0/0';
     368    if ($level > 0) {
     369      $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1");
     370      $sth->execute("$block");
     371      ($parent) = $sth->fetchrow_array;
     372    }
     373    $sth = $dbh->prepare("UPDATE blocks SET exclude = ?, comments = ?, ipcount = ".
     374        "(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n')".
     375        " WHERE block = ?");
     376    $sth->execute($exclude, $comment, "$block", "$block");
     377    $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
     378    $sth->execute("$block", $parent, "$block");
     379    $dbh->commit;
     380  };
     381  if ($@) {
     382    my $msg = $@;
     383    eval { dbh->rollback; };
     384    return "failed to update $block: $msg";
     385  }
     386  # nb: no need to return anything, since the CIDR block is the key
     387}
     388
     389
    343390sub blockexists {
    344391  my $self = shift;
    … …  
    351398
    352399
    353 # returns list (block,orgname) for the block that contains the passed IP.
     400# returns list (block,blockcomment,orgname) for the block that contains the passed IP.
    354401# accepts a level argument if you don't want the top-level registrar allocation block
    355402sub getcontainer {
    … …  
    357404  my $ip = shift;
    358405  my $level = shift || 0;
    359   my $sth = $dbh->prepare("SELECT b.block,o.orgname FROM blocks b INNER JOIN orgs o ".
     406  my $sth = $dbh->prepare("SELECT b.block,b.comments,o.orgname FROM blocks b INNER JOIN orgs o ".
    360407        "ON b.orgid=o.orgid WHERE b.block >> ? AND b.level = ?");
    361408  $sth->execute($ip,$level);
    … …  
    375422    # looking for IP
    376423
    377     $sth = $dbh->prepare("SELECT ip,s4list FROM iplist WHERE ip=?");
     424    $sth = $dbh->prepare("SELECT ip,s4list,exclude FROM iplist WHERE ip=?");
    378425    $sth->execute($entity);
    379426    my @ret = $sth->fetchrow_array;
    … …  
    385432    my $masklen = $1;
    386433
    387     $sth = $dbh->prepare("SELECT block,listme FROM blocks WHERE block=?");
     434    $sth = $dbh->prepare("SELECT block,listme,exclude,ipcount FROM blocks WHERE block = ?");
    388435    $sth->execute($entity);
    389     my ($block,$listme) = $sth->fetchrow_array;
     436    my ($block, $listme, $exclude, $bcount) = $sth->fetchrow_array;
    390437
    391438    return if !$block;
    392439
    393     $sth = $dbh->prepare("SELECT ipcount FROM blocks WHERE block = ?");
    394     $sth->execute($entity);
    395     my ($bcount) = $sth->fetchrow_array;
    396     my @ret = ( ($bcount >= $autolist{$masklen}), $listme);
     440    my @ret = ( ($bcount >= $autolist{$masklen}), $listme, $exclude);
    397441    return @ret;
    398442
    … …  
    433477  my $bitmask = shift || 0;
    434478
     479  if ($level == 0) {
     480    $errstr = '';
     481  }
     482
     483  return if ($errstr =~ /no connection to the server/);
    435484  if ($level > $maxlvl) {
    436485    warn "getting too deep, breaking off! ($container, $level)\n";
    … …  
    447496  }
    448497
     498
     499  # catch database-went-away errors
     500  local $dbh->{RaiseError} = 1;
     501  eval {
     502
     503
    449504  my $sth = $dbh->prepare("SELECT count(*) FROM blocks WHERE parent = ?");
    450505  $sth->execute($container);
    … …  
    459514  my $listorg;
    460515  my $bcount;
     516  my $bexclude;
    461517  if ($container ne '0.0.0.0/0') {
    462     $sth = $dbh->prepare("SELECT b.ipcount,b.listme,o.listme ".
     518    $sth = $dbh->prepare("SELECT b.ipcount,b.listme,b.exclude,o.listme ".
    463519        "FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ".
    464520        "WHERE b.block = ?");
    465521    $sth->execute($container);
    466     ($bcount,$listme,$listorg) = $sth->fetchrow_array();
    467 
     522    ($bcount,$listme,$bexclude,$listorg) = $sth->fetchrow_array();
    468523    $bitmask |= $bitfields{$level-1} if $bcount >= $autolist{$masklen};
    469524    $bitmask |= $bitfields{"block".($level-1)} if $listme;
    … …  
    473528# hm.  can't seem to move this prepare elsewhere.  :(
    474529  if ($nblocks > 0) {
    475     my $sthsubblocks = $dbh->prepare("SELECT block FROM blocks ".
     530    my $sthsubblocks = $dbh->prepare("SELECT block,exclude FROM blocks ".
    476531        "WHERE level = ? AND parent = ?");
    477532    $sthsubblocks->execute($level, $container);
    478     while (my ($cidr) = $sthsubblocks->fetchrow_array()) {
    479       $self->export($listhosts,$mode,$level+1,$cidr,$bitmask);
     533    while (my ($cidr, $exclude) = $sthsubblocks->fetchrow_array()) {
     534      if ($exclude) {
     535        $listhosts->{$cidr} = -1;
     536      } else { # don't check subtrees of an excluded block;  rbldnsd doesn't support deep flip-flopping like that
     537        $self->export($listhosts,$mode,$level+1,$cidr,$bitmask)
     538          or die $errstr;
     539      }
    480540    }
    481541  } # avoid checking content of subs if we don't have any
    … …  
    534594
    535595  $sthmoron->execute($container);
    536   while (my ($ip,$moron) = $sthmoron->fetchrow_array()) {
    537     $listhosts->{$ip} |= $bitmask;
     596  while (my ($ip,$moron,$exclude) = $sthmoron->fetchrow_array()) {
    538597    if ($moron) {
    539598      $listhosts->{$ip} = $bitfields{slist};
     599    } elsif ($exclude) {
     600      $listhosts->{$ip} = -1;
    540601    } else {
     602      $listhosts->{$ip} |= $bitmask;
    541603      $listhosts->{$ip} |= $bitfields{ip};
    542604    }
    543605  }
     606
     607
     608  }; # db-went-away-catching eval
     609  if ($@) {
     610    $errstr = $@;
     611    warn "export truncated: $errstr\n";
     612    return;
     613  }
     614
    544615
    545616# get IPs which for reasons unknown are apparently allocated directly from the
    … …  
    547618#  select * from iplist where not (select count(*) from blocks where ip << block) > 0;
    548619
    549   return;
     620  return 1;
    550621} # end export()
    551622
Note: See TracChangeset for help on using the changeset viewer.