Index: branches/stable/cgi-bin/allocate.pl
===================================================================
--- branches/stable/cgi-bin/allocate.pl	(revision 188)
+++ branches/stable/cgi-bin/allocate.pl	(revision 188)
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+# Shell-based script to allocate arbitrary block
+###
+# SVN revision info
+# $Date$
+# SVN revision $Rev$
+# Last update by $Author$
+###
+
+use strict;
+use warnings;
+#use CGI::Carp qw(fatalsToBrowser);
+use Carp;
+use DBI;
+use CommonWeb qw(:ALL);
+use MyIPDB;
+use IBLink;
+use POSIX qw(ceil);
+use NetAddr::IP;
+
+use Sys::Syslog;
+
+openlog "IPDBshell","pid","local2";
+
+# Collect the username from the environment.  If undefined, something
+# is Officially Hosed.
+my $authuser;
+if (!defined($ENV{'USER'})) {
+  die "Bad environment!  USER not defined.\n";
+} else {
+  $authuser = $ENV{'USER'};
+}
+
+# Why not a global DB handle?  (And a global statement handle, as well...)
+# Use the connectDB function, otherwise we end up confusing ourselves
+my $ip_dbh;
+my $sth;
+my $errstr;
+($ip_dbh,$errstr) = connectDB_My;
+if (!$ip_dbh) {
+  printAndExit("Failed to connect to database: $errstr\n");
+}
+checkDBSanity($ip_dbh);
+initIPDBGlobals($ip_dbh);
+
+# Hokay, now we can start to handle the allocation.
+
+my ($cidr, $type, $custid, $city, $desc, $alloc_from);
+# Check ARGV.  We need some information to determine what to allocate.
+if (!$ARGV[1]) {
+  # Usage message
+  print "Usage:  allocate.pl [IP/subnet] [Type] [CustID] [City] [\"Description\"]\n".
+	"	Further information can be entered via the web interface\n";
+  exit;
+} else {
+  $cidr = new NetAddr::IP "$ARGV[0]";
+  $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr'");
+  $sth->execute;
+  my @data = $sth->fetchrow_array;
+# User deserves errors if user can't be bothered to find the free block first.
+  die "Can't allocate from outside a free block!!\n"
+	if !$data[0];
+  $alloc_from = new NetAddr::IP $data[0];
+  $sth->finish;
+  $type = $ARGV[1];
+  if (!$ARGV[4]) {
+    # Default desc
+    $desc = "DEFAULT: $disp_alloctypes{$type}";
+  } else {
+    $desc = $ARGV[4];
+  }
+  if (!$ARGV[3]) {
+    # Default city
+    $sth = $ip_dbh->prepare("select city from routed where cidr >>='$cidr'");
+    $sth->execute;
+    my @data = $sth->fetchrow_array;
+    $city = $data[0];
+    $sth->finish;
+  } else {
+    $city = $ARGV[3];
+  }
+  if (!$ARGV[2]) {
+    # Default custid - make it REAL obvious.
+    $custid = "FIXME";
+  } else {
+    $custid = $ARGV[2];
+  }
+}
+
+print "Allocating $cidr as $type to $custid in $city: '$desc'\n";
+
+my ($code,$msg) = allocateBlock($ip_dbh, $cidr, $alloc_from, $custid, $type, $city,
+	$desc, '', '');
+
+if ($code eq 'OK') {
+  print "Allocation OK!\n";
+  syslog "notice", "($authuser) Allocated '$cidr' to '$custid' as '$type'";
+} else {
+  print "Allocation failed!  IPDB::allocateBlock said:\n$msg\n";
+  syslog "err", "($authuser) Allocation of '$cidr' to '$custid' as '$type' failed: '$msg'";
+}
+
+# Close it down.
+finish($ip_dbh);