Index: trunk/dnsbl/DNSBL.pm
===================================================================
--- trunk/dnsbl/DNSBL.pm	(revision 54)
+++ trunk/dnsbl/DNSBL.pm	(revision 66)
@@ -130,5 +130,5 @@
 
 our $err;
-our $errstr;
+our $errstr = '';
 
 # basic object subs
@@ -184,5 +184,5 @@
 	"WHERE b.block >>= ? ".
 	"GROUP BY b.block,b.level,b.listme,o.listme ORDER BY b.block");
-  $sthmoron = $dbh->prepare("SELECT ip,s4list FROM iplist WHERE parent = ?");
+  $sthmoron = $dbh->prepare("SELECT ip,s4list,white FROM iplist WHERE parent = ?");
 }
 
@@ -193,7 +193,7 @@
   my $self = shift;
   my $ip = shift;
-  my $sth = $dbh->prepare("SELECT count FROM iplist WHERE ip=?");
+  my $sth = $dbh->prepare("SELECT count, exclude FROM iplist WHERE ip=?");
   $sth->execute($ip);
-  my ($ret) = $sth->fetchrow_array();
+  my $ret = $sth->fetchrow_arrayref();
   return $ret;
 } # end ipexists()
@@ -205,4 +205,5 @@
   my $self = shift;
   my $rep = shift;
+  my $exclude = shift;
   my $sth;
   my $rows = 0;
@@ -214,9 +215,10 @@
       $rows = $sth->rows;
       if ($rows == 0) {
-        $sth = $dbh->prepare("INSERT INTO iplist (ip,parent) VALUES ".
-		"(?,(SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1))");
-        $sth->execute($rep,$rep) or die "couldn't add entry for $rep: ".$dbh->errstr."\n";
+        $sth = $dbh->prepare("INSERT INTO iplist (ip,parent,exclude) VALUES ".
+		"(?,(SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1),?)");
+        $sth->execute($rep,$rep,$exclude) or die "couldn't add entry for $rep: ".$dbh->errstr."\n";
       } elsif ($rows == 1) {
-        $sth = $dbh->prepare("UPDATE iplist SET count=count+1 WHERE ip=?");
+        $sth = $dbh->prepare("UPDATE iplist SET count=count+1,".
+		" exclude=".($exclude ? "'y'" : "'n'"). " WHERE ip=?");
         $sth->execute($rep) or die "couldn't update listing for $rep: ".$dbh->errstr."\n";
       } else {
@@ -225,5 +227,5 @@
       $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ?");
       $sth->execute($rep);
-      my $updsth = $dbh->prepare("UPDATE blocks SET ipcount=(SELECT count(*) FROM iplist WHERE ip << ?) WHERE block=?");
+      my $updsth = $dbh->prepare("UPDATE blocks SET ipcount=(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n') WHERE block=?");
       while (my ($block) = $sth->fetchrow_array) {
 	$updsth->execute($block,$block);
@@ -309,4 +311,6 @@
   my $orgid = shift;
   my $level = shift;
+  my $exclude = shift;
+  my $comment = shift;
   $blockin =~ s/^\s+//;
   $blockin =~ s/\s+$//;
@@ -325,7 +329,7 @@
       ($parent) = $sth->fetchrow_array;
     }
-    $sth = $dbh->prepare("INSERT INTO blocks (block,orgid,level,parent,ipcount) VALUES (?,?,?,?,".
-	"(SELECT count(*) FROM iplist WHERE ip << ?))");
-    $sth->execute("$block",$orgid,$level,$parent,"$block");
+    $sth = $dbh->prepare("INSERT INTO blocks (block,orgid,level,parent,exclude,comments,ipcount) VALUES (?,?,?,?,?,?,".
+	"(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n'))");
+    $sth->execute("$block",$orgid,$level,$parent,$exclude,$comment,"$block");
     $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
     $sth->execute("$block",$parent,"$block");
@@ -341,4 +345,47 @@
 
 
+# Update a netblock entry.  Supports (un)setting the exclude flag and the comment.
+# Does NOT do any magic around leftover IPs within the block
+sub updateblock {
+  my $self = shift;
+  my $blockin = shift;
+  my $orgid = shift;
+  my $level = shift;
+  my $exclude = shift;
+  my $comment = shift;
+  $blockin =~ s/^\s+//;
+  $blockin =~ s/\s+$//;
+  my $block = new NetAddr::IP "$blockin";	# need this to clean up messes like ranges.  sigh.
+
+  return "$blockin not a single CIDR range" if !$block;
+
+  local $dbh->{AutoCommit} = 0;
+  local $dbh->{RaiseError} = 1;
+
+  my $sth;
+  eval {
+    my $parent = '0/0';
+    if ($level > 0) {
+      $sth = $dbh->prepare("SELECT block FROM blocks WHERE block >> ? ORDER BY level DESC LIMIT 1");
+      $sth->execute("$block");
+      ($parent) = $sth->fetchrow_array;
+    }
+    $sth = $dbh->prepare("UPDATE blocks SET exclude = ?, comments = ?, ipcount = ".
+	"(SELECT count(*) FROM iplist WHERE ip << ? AND exclude='n')".
+        " WHERE block = ?");
+    $sth->execute($exclude, $comment, "$block", "$block");
+    $sth = $dbh->prepare("UPDATE iplist SET parent=? WHERE parent=? AND ip << ?");
+    $sth->execute("$block", $parent, "$block");
+    $dbh->commit;
+  };
+  if ($@) {
+    my $msg = $@;
+    eval { dbh->rollback; };
+    return "failed to update $block: $msg";
+  }
+  # nb: no need to return anything, since the CIDR block is the key
+}
+
+
 sub blockexists {
   my $self = shift;
@@ -351,5 +398,5 @@
 
 
-# returns list (block,orgname) for the block that contains the passed IP.
+# returns list (block,blockcomment,orgname) for the block that contains the passed IP.
 # accepts a level argument if you don't want the top-level registrar allocation block
 sub getcontainer {
@@ -357,5 +404,5 @@
   my $ip = shift;
   my $level = shift || 0;
-  my $sth = $dbh->prepare("SELECT b.block,o.orgname FROM blocks b INNER JOIN orgs o ".
+  my $sth = $dbh->prepare("SELECT b.block,b.comments,o.orgname FROM blocks b INNER JOIN orgs o ".
 	"ON b.orgid=o.orgid WHERE b.block >> ? AND b.level = ?");
   $sth->execute($ip,$level);
@@ -375,5 +422,5 @@
     # looking for IP
 
-    $sth = $dbh->prepare("SELECT ip,s4list FROM iplist WHERE ip=?");
+    $sth = $dbh->prepare("SELECT ip,s4list,exclude FROM iplist WHERE ip=?");
     $sth->execute($entity);
     my @ret = $sth->fetchrow_array;
@@ -385,14 +432,11 @@
     my $masklen = $1;
 
-    $sth = $dbh->prepare("SELECT block,listme FROM blocks WHERE block=?");
+    $sth = $dbh->prepare("SELECT block,listme,exclude,ipcount FROM blocks WHERE block = ?");
     $sth->execute($entity);
-    my ($block,$listme) = $sth->fetchrow_array;
+    my ($block, $listme, $exclude, $bcount) = $sth->fetchrow_array;
 
     return if !$block;
 
-    $sth = $dbh->prepare("SELECT ipcount FROM blocks WHERE block = ?");
-    $sth->execute($entity);
-    my ($bcount) = $sth->fetchrow_array;
-    my @ret = ( ($bcount >= $autolist{$masklen}), $listme);
+    my @ret = ( ($bcount >= $autolist{$masklen}), $listme, $exclude);
     return @ret;
 
@@ -433,4 +477,9 @@
   my $bitmask = shift || 0;
 
+  if ($level == 0) {
+    $errstr = '';
+  }
+
+  return if ($errstr =~ /no connection to the server/);
   if ($level > $maxlvl) {
     warn "getting too deep, breaking off! ($container, $level)\n";
@@ -447,4 +496,10 @@
   }
 
+
+  # catch database-went-away errors
+  local $dbh->{RaiseError} = 1;
+  eval {
+
+
   my $sth = $dbh->prepare("SELECT count(*) FROM blocks WHERE parent = ?");
   $sth->execute($container);
@@ -459,11 +514,11 @@
   my $listorg;
   my $bcount;
+  my $bexclude;
   if ($container ne '0.0.0.0/0') {
-    $sth = $dbh->prepare("SELECT b.ipcount,b.listme,o.listme ".
+    $sth = $dbh->prepare("SELECT b.ipcount,b.listme,b.exclude,o.listme ".
 	"FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ".
 	"WHERE b.block = ?");
     $sth->execute($container);
-    ($bcount,$listme,$listorg) = $sth->fetchrow_array();
-
+    ($bcount,$listme,$bexclude,$listorg) = $sth->fetchrow_array();
     $bitmask |= $bitfields{$level-1} if $bcount >= $autolist{$masklen};
     $bitmask |= $bitfields{"block".($level-1)} if $listme;
@@ -473,9 +528,14 @@
 # hm.  can't seem to move this prepare elsewhere.  :(
   if ($nblocks > 0) {
-    my $sthsubblocks = $dbh->prepare("SELECT block FROM blocks ".
+    my $sthsubblocks = $dbh->prepare("SELECT block,exclude FROM blocks ".
 	"WHERE level = ? AND parent = ?");
     $sthsubblocks->execute($level, $container);
-    while (my ($cidr) = $sthsubblocks->fetchrow_array()) {
-      $self->export($listhosts,$mode,$level+1,$cidr,$bitmask);
+    while (my ($cidr, $exclude) = $sthsubblocks->fetchrow_array()) {
+      if ($exclude) {
+        $listhosts->{$cidr} = -1;
+      } else { # don't check subtrees of an excluded block;  rbldnsd doesn't support deep flip-flopping like that
+        $self->export($listhosts,$mode,$level+1,$cidr,$bitmask)
+          or die $errstr;
+      }
     }
   } # avoid checking content of subs if we don't have any
@@ -534,12 +594,23 @@
 
   $sthmoron->execute($container);
-  while (my ($ip,$moron) = $sthmoron->fetchrow_array()) {
-    $listhosts->{$ip} |= $bitmask;
+  while (my ($ip,$moron,$exclude) = $sthmoron->fetchrow_array()) {
     if ($moron) {
       $listhosts->{$ip} = $bitfields{slist};
+    } elsif ($exclude) {
+      $listhosts->{$ip} = -1;
     } else {
+      $listhosts->{$ip} |= $bitmask;
       $listhosts->{$ip} |= $bitfields{ip};
     }
   }
+
+
+  }; # db-went-away-catching eval
+  if ($@) {
+    $errstr = $@;
+    warn "export truncated: $errstr\n";
+    return;
+  }
+
 
 # get IPs which for reasons unknown are apparently allocated directly from the
@@ -547,5 +618,5 @@
 #  select * from iplist where not (select count(*) from blocks where ip << block) > 0;
 
-  return;
+  return 1;
 } # end export()
 
