Index: trunk/cgi-bin/CustIDCK.pm
===================================================================
--- trunk/cgi-bin/CustIDCK.pm	(revision 400)
+++ trunk/cgi-bin/CustIDCK.pm	(revision 400)
@@ -0,0 +1,87 @@
+# ipdb/cgi-bin/CustIDCK.pm
+# External Customer ID checker stub
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+
+package CustIDCK;
+
+use strict;
+use warnings;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use DBI;
+
+# Supposed to provide cross-Perl-version signal handling.
+# Not part of stock Debian Perl, use dh-make-perl or just
+#  install straight from CPAN.
+# Not part of stock RHEL/CentOS, use cpan2perl, cpanflute,
+#  or just install straight from CPAN.
+use Sys::SigAction;
+
+$VERSION        = 1.00;
+@ISA            = qw(Exporter);
+@EXPORT         = ();
+@EXPORT_OK      = qw ( &custid_exist );
+
+# this is really an example stub, and should be replaced by
+# the local admin on installation
+sub custid_exist {
+  my $custid = shift;
+
+  return 1 if $custid =~ /^STAFF$/;
+  return 1 if $custid =~ /^6750400$/;  # just in case some later change might block this
+  return 1 if $custid =~ /^\d{7}$/;
+  return 1 if $custid =~ /^\d{10}$/;
+
+# some example code for a database check
+  # Try to catch failures to connect.  If the remote server is up but
+  # not responding (this has HAPPENED) we need to break out rather than hanging.
+  my $dbh;
+  eval {
+    my $h = Sys::SigAction::set_sig_handler( 'ALRM',
+      sub { die "failed connection to apex!!"; } );
+
+    alarm 3;	# 3-second timeout.  This may be too aggressive.
+
+    eval {
+      $dbh = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
+      die "failed connection to billing!!" if !$dbh;
+# Not certain if this is needed here.  It doesn't seem to be.
+#      $dbh->ping;	# Gotta do this to "force" a "failure".  NRGH.
+    };
+    alarm 0;	# cancel the alarm
+    $dbh->ping;	# Gotta do this to "force" a "failure".  NRGH.
+  };
+  alarm 0;	# avoid race conditions.  May not be needed here.  (Hah!)
+  if ($@ && $@ !~ /failed connection to billing!!/) {
+    $CustIDCK::Error = 1;
+    $CustIDCK::ErrMsg = "Failed connection to billing DB host!  Unable to verify CustIDs.";
+    return 0;
+  }
+
+  # We should have a valid DB connection by now.
+  my $sth = $dbh->prepare("SELECT custid FROM custid WHERE custid = '$custid'");
+  $sth->execute;
+  if ($dbh->err) {
+    $CustIDCK::Error = 1;
+    $CustIDCK::ErrMsg = $dbh->errstr();
+    $sth->finish;
+    $dbh->disconnect;
+    return 0;
+  }
+  my $hr = $sth->fetchrow_hashref();
+  my $status = 0;
+  $status = 1 if ( $hr->{custid} );
+  $sth->finish;
+  $dbh->disconnect;
+  return $status;
+
+  return 0;
+  # Stubs for error messages
+  $CustIDCK::Error = 1 if 1 == 0;
+  $CustIDCK::ErrMsg = "bad foo-frob: 1 == 0";
+}
Index: trunk/cgi-bin/admin.cgi
===================================================================
--- trunk/cgi-bin/admin.cgi	(revision 399)
+++ trunk/cgi-bin/admin.cgi	(revision 400)
@@ -18,4 +18,5 @@
 use CommonWeb qw(:ALL);
 use MyIPDB;
+use CustIDCK;
 #use POSIX qw(ceil);
 use NetAddr::IP;
@@ -134,8 +135,23 @@
   my $custid = $data[0];
   if ($custid eq '') {
+    if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
+      # Force uppercase for now...
+      $webvar{custid} =~ tr/a-z/A-Z/;
+      # Crosscheck with billing.
+      my $status = CustIDCK->custid_exist($webvar{custid});
+      if ($CustIDCK::Error) {
+	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
+	return;
+      }
+      if (!$status) {
+	printError("Customer ID not valid.  Make sure the Customer ID ".
+	  "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
+	  "non-customer assignments.");
+	return;
+      }
+    }
     # Type that doesn't have a default custid
     $custid = $webvar{custid};
   }
-##fixme Check billing DB here
 
   my $cidr = new NetAddr::IP $webvar{cidr};
@@ -506,4 +522,5 @@
 #
 
+print qq(<hr><a href="/ip/">Back</a> to main interface</a>\n);
 
 printFooter;
Index: trunk/cgi-bin/checkcusts.pl
===================================================================
--- trunk/cgi-bin/checkcusts.pl	(revision 400)
+++ trunk/cgi-bin/checkcusts.pl	(revision 400)
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+# Check all customer IDs to see which are invalid
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+# Copyright (C) 2004-2006 Kris Deugau
+
+use DBI;
+use IPDB 2.0 qw(:ALL);
+
+# We'll be hosing the server with several thousand queries.  We
+# REALLY don't want the overhead and load of opening a new connection
+# for each query.
+#use CustIDCK;
+
+use NetAddr::IP;
+
+$priv1 = new NetAddr::IP '10.0.0.0/8';
+$priv2 = new NetAddr::IP '172.16.0.0/12';
+$priv3 = new NetAddr::IP '192.168.0.0/16';
+
+print "Content-type: text/plain\n\n";
+
+($dbh,$errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
+$IDH = DBI->connect ("DBI:Pg:host=billing;dbname=custids", "cidcheck", "c1dch4ck");
+
+$sth = $dbh->prepare("select distinct def_custid from alloctypes where listorder >=40");
+$sth->execute;
+while (@data = $sth->fetchrow_array) {
+  push @def_custids, $data[0];
+}
+$sth = $dbh->prepare("select cidr,custid from searchme where not (custid='6750400') ".
+	"and not (custid='STAFF') order by cidr");
+#$sth = $dbh->prepare("select cidr,custid from searchme order by cidr");
+$sth->execute;
+
+$IDS = $IDH->prepare("select custid from custid where custid=?");
+
+$count = $bad = 0;
+while (@data = $sth->fetchrow_array) {
+  $cidr = new NetAddr::IP $data[0];
+  if ($cidr->within($priv1) or $cidr->within($priv2) or $cidr->within($priv3) or
+	(grep /$data[1]/, @def_custids)) {
+    # no-op.  we ignore these.
+  } else {
+    $count++;
+    $IDS->execute($data[1]);
+    $hr = $IDS->fetchrow_hashref();
+    if (!$hr->{custid}) {
+      print "  $data[0]\thas invalid CustID '$data[1]'\n";
+      $bad++;
+    }
+    $IDS->finish;
+  }
+}
+
+$IDH->disconnect;
+$dbh->disconnect;
+
+print "$count customer blocks, $bad bad.\n";
+exit 0;
+
+
+### Ported subs of sorts from CustIDCK.pm
Index: trunk/cgi-bin/main.cgi
===================================================================
--- trunk/cgi-bin/main.cgi	(revision 399)
+++ trunk/cgi-bin/main.cgi	(revision 400)
@@ -15,4 +15,5 @@
 use CommonWeb qw(:ALL);
 use MyIPDB;
+use CustIDCK;
 use POSIX qw(ceil);
 use NetAddr::IP;
@@ -943,9 +944,23 @@
       return;
     }
-    if ($webvar{custid} !~ /^(?:\d{5,10}|STAFF|TEMP)(?:-\d\d?)?$/) {
-      printError("Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for static IPs for staff.");
-      return;
-    }
-    print "<!-- [ In validateInput().  Insert customer ID cross-check here. ] -->\n";
+    if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
+      # Force uppercase for now...
+      $webvar{custid} =~ tr/a-z/A-Z/;
+      # Crosscheck with billing.
+      my $status = CustIDCK->custid_exist($webvar{custid});
+      if ($CustIDCK::Error) {
+	printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
+	return;
+      }
+      if (!$status) {
+	printError("Customer ID not valid.  Make sure the Customer ID ".
+	  "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
+	  "non-customer assignments.");
+	return;
+      }
+#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
+#static IPs for staff.");
+    }
+#    print "<!-- [ In validateInput().  Insert customer ID cross-check here. ] -->\n";
   } else {
     # New!  Improved!  And now Loaded From The Database!!
@@ -967,9 +982,9 @@
   } else {
     $flag = 'n';
-    if ($webvar{alloctype} =~ /[wp][cr]|d[pi]/) {
+    if ($webvar{alloctype} =~ /[wp][cr]|[ds][pi]/) {
       # Set this forcibly rather than messing around elsewhere.  Yes, this *is* a hack.  PTHBTT!!
-      # Match CORE/WAN types (wc, wr, pc, pr), DSL pool and IP (dp, di).
-      $webvar{pop} = "Sudbury";
-    } elsif ($webvar{pop} =~ /^-$/) {
+      $webvar{pop} = 'Sudbury';
+    }
+    if ($webvar{pop} =~ /^-$/) {
       $flag = 'to route the block from/through';
     }
