Changeset 106


Ignore:
Timestamp:
12/22/04 16:25:59 (20 years ago)
Author:
Kris Deugau
Message:

/trunk

IPDB rewrite, first stable iteration.

-> uses allocateBlock(), deleteBlock() from IPDB module rather

than hardcoding that in the web script

-> uses global variables from IPDB module for "static" data such

as allocation types and ities (which are loaded from the
database in much the same way that master blocks have been loaded)

-> IPDB.pm contains NO locally-exiting code, nor calls to any code

which exits before returning. This allows returning status codes
to the caller, so that things like database handles can be
properly cleaned up.

There are probably also a long list of minor bugfixes that I've forgotten.

Location:
trunk/cgi-bin
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/cgi-bin/IPDB.pm

    r96 r106  
    2121$VERSION        = 2.0;
    2222@ISA            = qw(Exporter);
    23 @EXPORT_OK      = qw(&initIPDBGlocals &connectDB &finish &checkDBSanity &allocateBlock
    24                         &deleteBlock &mailNotify);
     23@EXPORT_OK    = qw(
     24        %disp_alloctypes %list_alloctypes @citylist @poplist @masterblocks
     25        &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &deleteBlock
     26        &mailNotify
     27        );
    2528
    2629@EXPORT         = (); # Export nothing by default.
    27 %EXPORT_TAGS    = ( ALL => [qw( &initIPDBGlocals &connectDB &finish &checkDBSanity
    28                                 &allocateBlock &deleteBlock &mailNotify)]
    29                   );
     30%EXPORT_TAGS    = ( ALL => [qw(
     31                %disp_alloctypes %list_alloctypes @citylist @poplist @masterblocks
     32                &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
     33                &deleteBlock &mailNotify
     34                )]
     35        );
    3036
    3137##
    … …  
    3642our @citylist;
    3743our @poplist;
     44our @masterblocks;
    3845
    3946# Let's initialize the globals.
    … …  
    4451  my $sth;
    4552
    46   # Initialize alloctypes list
    47   $sth = $dbh->prepare("select type,dispname from alloctypes");
     53  # Initialize alloctypes hashes
     54  $sth = $dbh->prepare("select * from alloctypes order by listorder");
    4855  $sth->execute;
    49   return (undef,$sth->errstr) if $sth->err;
    5056  while (my @data = $sth->fetchrow_array) {
    51     $disp_alloctypes{$data[0]} = $data[1];
     57    $disp_alloctypes{$data[0]} = $data[2];
     58    if ($data[3] < 900) {
     59      $list_alloctypes{$data[0]} = $data[1];
     60    }
    5261  }
    5362
    … …  
    5665  $sth->execute;
    5766  return (undef,$sth->errstr) if $sth->err;
    58   my $i = 0;
    59   my $j = 0;
    6067  while (my @data = $sth->fetchrow_array) {
    61     $citylist[$i++] = $data[0];
     68    push @citylist, $data[0];
    6269    if ($data[1] eq 'y') {
    63       $poplist[$j++] = $data[0];
     70      push @poplist, $data[0];
    6471    }
    6572  }
     73
     74  # Master block list
     75  $sth = $dbh->prepare("select * from masterblocks order by cidr");
     76  $sth->execute;
     77  for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
     78    $masterblocks[$i] = new NetAddr::IP $data[0];
     79  }
     80  return (undef,$sth->errstr) if $sth->err;
    6681
    6782  return (1,"OK");
    … …  
    117132
    118133
     134## IPDB::checkDBSanity()
    119135# Quick check to see if the db is responding.  A full integrity
    120136# check will have to be a separate tool to walk the IP allocation trees.
    121137sub checkDBSanity {
    122   my $dbh = connectDB();
     138  my ($dbh) = $_[0];
    123139
    124140  if (!$dbh) {
    125     print "Cannot connect to the database!";
     141    print "No database handle, or connection has been closed.";
     142    return -1;
    126143  } else {
    127144    # it connects, try a stmt.
    … …  
    134151    } else {
    135152      print "Connected to the database, but could not execute test statement.  ".$sth->errstr();
     153      return -1;
    136154    }
    137155  }
    138156  # Clean up after ourselves.
    139   $dbh->disconnect;
     157#  $dbh->disconnect;
    140158} # end checkDBSanity
    141159
    … …  
    187205      return ('FAIL',$msg);
    188206    } else {
    189       return ('OK',"OK");
     207      return ('OK',"$cidr");
    190208    }
    191209

  • trunk/cgi-bin/consistency-check.pl

    r95 r106  
    1111
    1212use DBI;
    13 use IPDB qw(:ALL);
     13use IPDB 2.0 qw(:ALL);
    1414use NetAddr::IP;
    1515
    16 $dbh = connectDB;
     16($dbh,$errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
    1717
    1818# Schlep up the masters

  • trunk/cgi-bin/main.cgi

    r95 r106  
    1414use DBI;
    1515use CommonWeb qw(:ALL);
    16 use IPDB qw(:ALL);
     16use IPDB 2.0 qw(:ALL);
    1717use POSIX qw(ceil);
    1818use NetAddr::IP;
    … …  
    3232syslog "debug", "$authuser active";
    3333
    34 checkDBSanity();
     34# Why not a global DB handle?  (And a global statement handle, as well...)
     35# Use the connectDB function, otherwise we end up confusing ourselves
     36my $ip_dbh;
     37my $sth;
     38my $errstr;
     39($ip_dbh,$errstr) = connectDB("ipdb", "ipdb", "ipdbpwd");
     40if (!$ip_dbh) {
     41  printAndExit("Failed to connect to database: $errstr\n");
     42}
     43checkDBSanity($ip_dbh);
     44initIPDBGlobals($ip_dbh);
    3545
    3646#prototypes
    … …  
    4151                        # Only usage passes "select count(*) ..."
    4252
     53# Global variables
    4354my $RESULTS_PER_PAGE = 50;
    4455my %webvar = parse_post();
    4556cleanInput(\%webvar);
    4657
    47 my %full_alloc_types = (
    48         "ci","Static cable IP",
    49         "di","Static DSL IP",
    50         "si","Server pool IP",
    51         "mi","Static dialup IP",
    52         "wi","Static wireless IP",
    53         "cp","Cable pool",
    54         "dp","DSL pool",
    55         "sp","Server pool",
    56         "mp","Static dialup pool",
    57         "wp","Static wireless pool",
    58         "dn","Dialup netblock",
    59         "dy","Dynamic DSL netblock",
    60         "dc","Dynamic cable netblock",
    61         "cn","Customer netblock",
    62         "ee","End-use netblock",
    63         "rr","Routed netblock",
    64         "ii","Internal netblock",
    65         "mm","Master block"
    66 );
    67 
    68 # Other global variables
    69 my @masterblocks;
    70 my @citylist;
    71 my @poplist;
    72 my %allocated;  # Count for allocated blocks in a master block
    73 my %free;       # Count for free blocks (routed and unrouted) in a master block
    74 my %bigfree;    # Tracking largest free block in a master block
    75 my %routed;     # Number of routed blocks in a master block
    76 
    77 # Why not a global DB handle?  (And a global statement handle, as well...)
    78 # We already know the DB is happy, (checkDBSanity) otherwise we wouldn't be here.
    79 # Use the connectDB function, otherwise we end up confusing ourselves
    80 my $ip_dbh = connectDB;
    81 my $sth;
     58# Stuff that gets loaded from the database
     59#my @citylist;
     60#my @poplist;
     61#my %allocated; # Count for allocated blocks in a master block
     62#my %free;      # Count for free blocks (routed and unrouted) in a master block
     63#my %bigfree;   # Tracking largest free block in a master block
     64#my %routed;    # Number of routed blocks in a master block
    8265
    8366# Slurp up the master block list - we need this several places
    8467# While we're at it, initialize the related hashes.
    85 $sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
    86 $sth->execute;
    87 for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
    88   $masterblocks[$i] = new NetAddr::IP $data[0];
    89   $allocated{"$masterblocks[$i]"} = 0;
    90   $free{"$masterblocks[$i]"} = 0;
    91   $bigfree{"$masterblocks[$i]"} = 128;  # Larger number means smaller block.
    92                                         # Set to 128 to prepare for IPv6
    93   $routed{"$masterblocks[$i]"} = 0;
    94 }
    95 
    96 # Initialize the city and poplist arrays
    97 $sth = $ip_dbh->prepare("select * from cities order by city");
    98 $sth->execute;
    99 my $i = 0;
    100 my $j = 0;
    101 while (my @data = $sth->fetchrow_array) {
    102   $citylist[$i++] = $data[0];
    103   if ($data[1] eq 'y') {
    104     $poplist[$j++] = $data[0];
    105   }
    106 }
     68#$sth = $ip_dbh->prepare("select * from masterblocks order by cidr");
     69#$sth->execute;
     70#for (my $i=0; my @data = $sth->fetchrow_array(); $i++) {
     71#  $masterblocks[$i] = new NetAddr::IP $data[0];
     72#  $allocated{"$masterblocks[$i]"} = 0;
     73#  $free{"$masterblocks[$i]"} = 0;
     74#  $bigfree{"$masterblocks[$i]"} = 128; # Larger number means smaller block.
     75#                                       # Set to 128 to prepare for IPv6
     76#  $routed{"$masterblocks[$i]"} = 0;
     77#}
     78
    10779
    10880
    … …  
    149121    eval { $ip_dbh->rollback; };
    150122    syslog "err", "Could not add master block '$webvar{cidr}' to database: '$@'";
    151     printAndExit("Could not add master block $webvar{cidr} to database: $@");
    152   }
    153 
    154   print "Success!</div>\n";
     123    printError("Could not add master block $webvar{cidr} to database: $@");
     124  } else {
     125    print "Success!</div>\n";
     126    syslog "info", "$authuser added master block $webvar{cidr}";
     127  }
    155128
    156129  printFooter;
    … …  
    217190
    218191
    219 #end main()
    220 
    221 # Shut up error log warning about not disconnecting.  Maybe.
    222 $ip_dbh->disconnect;
    223 # Just in case something waaaayyy down isn't in place properly...
    224 exit 0;
     192
     193# Clean up IPDB globals, DB handle, etc.
     194finish;
     195# Just in case something waaaayyy down isn't in place
     196# properly... we exit explicitly.
     197exit;
    225198
    226199
    … …  
    374347    }
    375348    my @row = (qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    376         $data[1], $full_alloc_types{$data[2]}, $data[3], $data[4]);
     349        $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
    377350    # Allow listing of pool if desired/required.
    378351    if ($data[2] =~ /^[cdsmw]p$/) {
    … …  
    438411  startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
    439412        'Free netblocks', 'Largest free block');
     413
     414  my %allocated;
     415  my %free;
     416  my %routed;
     417  my %bigfree;
    440418
    441419# Snag the allocations.
    … …  
    516494  print qq(<center><div class="heading">Summarizing routed blocks for ).
    517495        qq($webvar{block}:</div></center><br>\n);
     496
     497  my %allocated;
     498  my %free;
     499  my %routed;
     500  my %bigfree;
    518501
    519502  my $master = new NetAddr::IP $webvar{block};
    … …  
    663646
    664647    my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=edit&block=$data[0]\">$data[0]</a>",
    665         $data[3], $full_alloc_types{$data[2]}, $data[1], $data[4]);
     648        $data[3], $disp_alloctypes{$data[2]}, $data[1], $data[4]);
    666649    # If the allocation is a pool, allow listing of the IPs in the pool.
    667650    if ($data[2] =~ /^[cdsmw]p$/) {
    … …  
    730713
    731714  print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
    732         qq(($full_alloc_types{$type} in $data[3])</div></center><br>\n);
     715        qq(($disp_alloctypes{$type} in $data[3])</div></center><br>\n);
    733716  print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
    734717  print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
    … …  
    773756
    774757
    775 # Should this maybe just be a full static page?  It just spews out some predefined HTML.
     758# Show "Add new allocation" page.  Note that the actual page may
     759# be one of two templates, and the lists come from the database.
    776760sub assignBlock {
    777761  printHeader('');
    … …  
    788772    $html =~ s|\$\$BLOCK\$\$|$block|g;
    789773    $html =~ s|\$\$MASKBITS\$\$|$block->masklen|;
     774    my $typelist = '';
     775    $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 and type not like '_i' order by listorder");
     776    $sth->execute;
     777    my @data = $sth->fetchrow_array;
     778    $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
     779    while (my @data = $sth->fetchrow_array) {
     780      $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
     781    }
     782    $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
    790783  } else {
    791784    open HTML, "../assign.html"
    … …  
    804797    }
    805798    $html =~ s|\$\$POPLIST\$\$|$pops|g;
     799    my $typelist = '';
     800    $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
     801    $sth->execute;
     802    my @data = $sth->fetchrow_array;
     803    $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
     804    while (my @data = $sth->fetchrow_array) {
     805      $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
     806    }
     807    $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
    806808  }
    807809  my $cities = '';
    … …  
    907909          $city = $webvar{pop};
    908910          $failmsg = "No suitable free block found.<br>\nYou will have to route another".
    909             " superblock to $webvar{city}<br>\nfrom one of the master blocks in Sudbury or".
     911            " superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
    910912            " chose a smaller blocksize.";
    911913        }
    … …  
    955957  # Stick in the allocation data
    956958  $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
    957   $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$webvar{alloctype}}|g;
     959  $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
    958960  $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
    959961  $html =~ s|\$\$CIDR\$\$|$cidr|g;
    … …  
    981983  validateInput();
    982984
    983   # Set some things that may be needed
    984   # Don't set $cidr here as it may not even be a valid IP address.
    985   my $alloc_from = new NetAddr::IP $webvar{alloc_from};
    986 
    987 # dynDSL (dy), sIP DSL(dp), and server pools (sp) are nominally allocated to Sudbury
    988 # no matter what else happens.
    989 #  if ($webvar{alloctype} =~ /^([sd]p|dy)$/) { $webvar{city} = "Sudbury"; }
    990 # OOPS.  forgot about North Bay DSL.
    991 #### Gotta make this cleaner and more accurate
    992 #  if ($webvar{alloctype} eq "sp") { $webvar{city} = "Sudbury"; }
    993 
    994 # Same ordering as confirmation page
    995 
    996   if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
    997     my ($base,$tmp) = split //, $webvar{alloctype};     # split into individual chars
    998 
    999     # We'll just have to put up with the oddities caused by SQL (un)sort order
    1000     $sth = $ip_dbh->prepare("select * from poolips where pool='$webvar{alloc_from}'".
    1001         " and available='y' order by ip");
    1002     $sth->execute;
    1003 
    1004     my @data = $sth->fetchrow_array;
    1005     my $cidr = $data[1];
    1006 
    1007     $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}',".
    1008         "city='$webvar{city}',available='n',description='$webvar{desc}',".
    1009         "circuitid='$webvar{circid}'".
    1010         " where ip='$cidr'");
    1011     $sth->execute;
    1012     if ($sth->err) {
    1013       syslog "err", "Allocation of $cidr to $webvar{custid} by $authuser failed: ".
    1014         "'".$sth->errstr."'";
    1015       printAndExit("Allocation of $cidr to $webvar{custid} failed: '".$sth->errstr."'");
    1016     }
    1017     print qq(<div class="center"><div class="heading">The IP $cidr has been allocated to customer $webvar{custid}</div></div>);
    1018     syslog "notice", "$authuser allocated $cidr to $webvar{custid}";
    1019 # Notify tech@example.com
    1020     mailNotify('tech@example.com','$full_alloc_types{$webvar{alloctype}} allocation',
    1021         "$full_alloc_types{$webvar{alloctype}} $cidr allocated to customer $webvar{custid}");
    1022 
    1023   } else { # end IP-from-pool allocation
    1024 
    1025     # Set $cidr here as it may not be a valid IP address elsewhere.
    1026     my $cidr = new NetAddr::IP $webvar{fullcidr};
    1027 
    1028 # Allow transactions, and make errors much easier to catch.
    1029 # Much as I would like to error-track specifically on each ->execute,
    1030 # that's a LOT of code, and some SQL blocks MUST be atomic at a
    1031 # multi-statement level.  :/
    1032     local $ip_dbh->{AutoCommit} = 0;    # These need to be local so we don't
    1033     local $ip_dbh->{RaiseError} = 1;    # step on our toes by accident.
    1034 
    1035     if ($webvar{fullcidr} eq $webvar{alloc_from}) {
    1036       # Easiest case- insert in one table, delete in the other, and go home.  More or less.
    1037       # insert into allocations values (cidr,custid,type,city,desc) and
    1038       # delete from freeblocks where cidr='cidr'
    1039       # For data safety on non-transaction DBs, we delete first.
    1040 
    1041       eval {
    1042         if ($webvar{alloctype} eq 'rr') {
    1043           $sth = $ip_dbh->prepare("update freeblocks set routed='y',city='$webvar{city}'".
    1044             " where cidr='$webvar{fullcidr}'");
    1045           $sth->execute;
    1046           $sth = $ip_dbh->prepare("insert into routed values ('$webvar{fullcidr}',".
    1047             $cidr->masklen.",'$webvar{city}')");
    1048           $sth->execute;
    1049         } else {
    1050           # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
    1051 
    1052           # city has to be reset for DSL/server pools;  nominally to Sudbury.
    1053           ## Gotta rethink this;  DSL pools can be in North Bay as well.  :/
    1054           #if ($webvar{alloctype} =~ /^[sd]p$/) { $webvar{city} = 'Sudbury'; }
    1055 
    1056           $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{fullcidr}'");
    1057           $sth->execute;
    1058 
    1059           $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
    1060             "'$webvar{custid}','$webvar{alloctype}','$webvar{city}','$webvar{desc}',".
    1061             "'$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
    1062           $sth->execute;
    1063         } # routing vs non-routing netblock
    1064         $ip_dbh->commit;
    1065       };  # end of eval
    1066       if ($@) {
    1067         carp "Transaction aborted because $@";
    1068         eval { $ip_dbh->rollback; };
    1069         syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
    1070                 "'$webvar{alloctype}' by $authuser failed: '$@'";
    1071         printAndExit("Allocation of $cidr as $full_alloc_types{$webvar{alloctype}} failed.\n");
    1072       }
    1073 
    1074       # If we get here, the DB transaction has succeeded.
    1075       syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
    1076 
    1077 # How to log SQL without munging too many error-checking wrappers in?
    1078 #      syslog "info", "
    1079 # We don't.  GRRR.
    1080 
    1081     } else { # webvar{fullcidr} != webvar{alloc_from}
    1082       # Hard case.  Allocation is smaller than free block.
    1083       my $wantmaskbits = $cidr->masklen;
    1084       my $maskbits = $alloc_from->masklen;
    1085 
    1086       my @newfreeblocks;        # Holds free blocks generated from splitting the source freeblock.
    1087 
    1088       my $i=0;
    1089       while ($maskbits++ < $wantmaskbits) {
    1090         my @subblocks = $alloc_from->split($maskbits);
    1091         $newfreeblocks[$i++] = $subblocks[1];
    1092       } # while
    1093 
    1094       # Begin SQL transaction block
    1095       eval {
    1096         # Delete old freeblocks entry
    1097         $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{alloc_from}'");
    1098         $sth->execute();
    1099 
    1100         # now we have to do some magic for routing blocks
    1101         if ($webvar{alloctype} eq 'rr') {
    1102           # Insert the new freeblocks entries
    1103           # Note that non-routed blocks are assigned to <NULL>
    1104           $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
    1105           foreach my $block (@newfreeblocks) {
    1106             $sth->execute("$block", $block->masklen);
    1107           }
    1108           # Insert the entry in the routed table
    1109           $sth = $ip_dbh->prepare("insert into routed values ('$cidr',".
    1110             $cidr->masklen.",'$webvar{city}')");
    1111           $sth->execute;
    1112           # Insert the (almost) same entry in the freeblocks table
    1113           $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".
    1114             $cidr->masklen.",'$webvar{city}','y')");
    1115           $sth->execute;
    1116 
    1117         } else { # done with alloctype == rr
    1118 
    1119           # Insert the new freeblocks entries
    1120           $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ?,'y')");
    1121           foreach my $block (@newfreeblocks) {
    1122             $sth->execute("$block", $block->masklen, $webvar{city});
    1123           }
    1124           # Insert the allocations entry
    1125           $sth = $ip_dbh->prepare("insert into allocations values ('$webvar{fullcidr}',".
    1126             "'$webvar{custid}','$webvar{alloctype}','$webvar{city}',".
    1127             "'$webvar{desc}','$webvar{notes}',".$cidr->masklen.",'$webvar{circid}')");
    1128           $sth->execute;
    1129         } # done with netblock alloctype != rr
    1130         $ip_dbh->commit;
    1131       }; # end eval
    1132       if ($@) {
    1133         carp "Transaction aborted because $@";
    1134         eval { $ip_dbh->rollback; };
    1135         syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
    1136                 "'$webvar{alloctype}' by $authuser failed: '$@'";
    1137         printAndExit("Allocation of $cidr as $full_alloc_types{$webvar{alloctype}} failed.\n");
    1138       }
    1139       syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as '$webvar{alloctype}'";
    1140 
    1141     } # end fullcidr != alloc_from
    1142 
    1143     # Begin SQL transaction block
    1144     eval {
    1145       # special extra handling for pools.
    1146       # Note that this must be done for ANY pool allocation!
    1147       if ( my ($pooltype) = ($webvar{alloctype} =~ /^([cdsmw])p$/) ) {
    1148         # have to insert all pool IPs into poolips table as "unallocated".
    1149         $sth = $ip_dbh->prepare("insert into poolips values ('$webvar{fullcidr}',".
    1150           " ?, '6750400', '$webvar{city}', '$pooltype', 'y', '', '', '')");
    1151         my @poolip_list = $cidr->hostenum;
    1152         for (my $i=1; $i<=$#poolip_list; $i++) {
    1153           $sth->execute($poolip_list[$i]->addr);
    1154         }
    1155       } # end pool special
    1156       $ip_dbh->commit;
    1157     }; # end eval
    1158     if ($@) {
    1159       carp "Transaction aborted because $@";
    1160       eval { $ip_dbh->rollback; };
    1161       syslog "err", "Initialization of pool '$webvar{fullcidr}' by $authuser failed: '$@'";
    1162       printAndExit("$full_alloc_types{$webvar{alloctype}} $webvar{fullcidr} not completely initialized.");
    1163     }
    1164     syslog "notice", "$full_alloc_types{$webvar{alloctype}} '$webvar{fullcidr}' successfully initialized by $authuser";
    1165 
    1166     print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was sucessfully added as type '$webvar{alloctype}' ($full_alloc_types{$webvar{alloctype}})</div></div>);
    1167 
    1168   } # end static-IP vs netblock allocation
     985  # $code is "success" vs "failure", $msg contains OK for a
     986  # successful netblock allocation, the IP allocated for static
     987  # IP, or the error message if an error occurred.
     988  my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
     989        $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
     990        $webvar{circid});
     991
     992  if ($code) {
     993    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
     994        "'$webvar{alloctype}' by $authuser failed: '$msg'";
     995    printAndExit("Allocation of $webvar{fullcidr} as $disp_alloctypes{$webvar{alloctype}}".
     996        " failed: $msg\n");
     997  } else {
     998    if ($webvar{alloctype} =~ /^.i$/) {
     999      print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
     1000      # Notify tech@example.com
     1001      mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
     1002        "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}");
     1003    } else {
     1004      print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
     1005        "sucessfully added as type '$webvar{alloctype}' ".
     1006        "($disp_alloctypes{$webvar{alloctype}})</div></div>";
     1007    }
     1008    syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
     1009        "'$webvar{alloctype}'";
     1010  }
    11691011
    11701012  printFooter();
    … …  
    11811023  chomp $webvar{alloctype};
    11821024  # We have different handling for customer allocations and "internal" or "our" allocations
    1183   if ($webvar{alloctype} =~ /^(ci|di|cn|mi)$/) {
     1025  if ($webvar{alloctype} =~ /^(ci|di|cn|mi|wi)$/) {
    11841026    if (!$webvar{custid}) {
    11851027      printAndExit("Please enter a customer ID.");
    … …  
    11941036    $webvar{custid} = "6750400";
    11951037    if ($webvar{alloctype} eq 'rr') {
    1196       if ($webvar{city} !~ /^(?:Huntsville|North Bay|Ottawa|Pembroke|Sault Ste. Marie|Sudbury|Timmins|Thunder Bay|Toronto)$/) {
     1038      my $flag;
     1039      foreach (@poplist) {
     1040        if (/^$webvar{city}$/) {
     1041          $flag = 'y'; last;
     1042        }
     1043      }
     1044      if (!$flag) {
    11971045        printAndExit("Please choose a valid POP location for a routed netblock.  Valid ".
    1198                 "POP locations are currently:<br>\n Elliot Lake - Huntsville - North Bay -".
    1199                 " Ottawa -".
    1200                 " Pembroke - Sault Ste. Marie - Sudbury - Timmins - Thunder Bay - Toronto");
     1046                "POP locations are currently:<br>\n".join (" - ", @poplist));
    12011047      }
    12021048    }
    12031049  } else {
     1050print "$webvar{alloctype}";
    12041051    # Danger! Danger!  alloctype should ALWAYS be set by a dropdown.  Anyone
    12051052    # managing to call things in such a way as to cause this deserves a cryptic error.
    … …  
    12691116    $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
    12701117  } else {
    1271     $html =~ s/\$\$TYPESELECT\$\$/$full_alloc_types{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
     1118    $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
    12721119  }
    12731120
    … …  
    13301177  $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
    13311178  $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
    1332   $html =~ s/\$\$TYPEFULL\$\$/$full_alloc_types{$webvar{alloctype}}/g;
     1179  $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
    13331180  $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
    13341181  $webvar{circid} = desanitize($webvar{circid});
    … …  
    13461193
    13471194# Delete an allocation.
    1348 sub remove
    1349 {
     1195sub remove {
    13501196  printHeader('');
    13511197  #show confirm screen.
    … …  
    14131259  $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
    14141260  $html =~ s|\$\$BLOCK\$\$|$cidr|g;
    1415   $html =~ s|\$\$TYPEFULL\$\$|$full_alloc_types{$alloctype}|g;
     1261  $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
    14161262  $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
    14171263  $html =~ s|\$\$CITY\$\$|$city|g;
    … …  
    14421288  printHeader('');
    14431289
    1444   # Enable transactions and exception-on-errors... but only for this sub
    1445   local $ip_dbh->{AutoCommit} = 0;
    1446   local $ip_dbh->{RaiseError} = 1;
    1447 
    1448   if ($webvar{alloctype} =~ /^[cdsmw]i$/) {
    1449 
    1450     eval {
    1451       $sth = $ip_dbh->prepare("select * from poolips where ip='$webvar{block}'");
    1452       $sth->execute;
    1453       my @data = $sth->fetchrow_array;
    1454       $sth = $ip_dbh->prepare("select city from allocations where cidr='$data[0]'");
    1455       $sth->execute;
    1456       @data = $sth->fetchrow_array;
    1457       $sth = $ip_dbh->prepare("update poolips set custid='6750400', available='y',".
    1458         " city='$data[0]', description='' where ip='$webvar{block}'");
    1459       $sth->execute;
    1460       $ip_dbh->commit;
    1461     };
    1462     if ($@) {
    1463       carp "Transaction aborted because $@";
    1464       eval { $ip_dbh->rollback; };
    1465       syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$@'";
    1466       printAndExit("Could not deallocate static IP $webvar{block}: $@");
    1467     }
     1290  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
     1291
     1292  if ($code eq 'OK') {
    14681293    print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";
    1469     syslog "notice", "$authuser deallocated static IP $webvar{block}";
    1470 
    1471   } elsif ($webvar{alloctype} eq 'mm') { # end alloctype = [cdsmw]i
    1472 
    1473     eval {
    1474       $sth = $ip_dbh->prepare("delete from masterblocks where cidr='$webvar{block}'");
    1475       $sth->execute;
    1476       $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$webvar{block}'");
    1477       $sth->execute;
    1478       $ip_dbh->commit;
    1479     };
    1480     if ($@) {
    1481       carp "Transaction aborted because $@";
    1482       eval { $ip_dbh->rollback; };
    1483       syslog "err", "$authuser could not remove master block '$webvar{block}': '$@'";
    1484       printAndExit("Could not remove master block $webvar{block}: $@");
    1485     }
    1486     print "<div class=heading align=center>Success!  Master $webvar{block} removed.</div>\n";
    1487     syslog "notice", "$authuser removed master block $webvar{block}";
    1488 
    1489   } else { # end alloctype master block case
    1490 
    1491     ## This is a big block; but it HAS to be done in a chunk.  Any removal
    1492     ## of a netblock allocation may result in a larger chunk of free
    1493     ## contiguous IP space - which may in turn be combined into a single
    1494     ## netblock rather than a number of smaller netblocks.
    1495 
    1496     eval {
    1497 
    1498       my $cidr = new NetAddr::IP $webvar{block};
    1499       if ($webvar{alloctype} eq 'rr') {
    1500 
    1501         $sth = $ip_dbh->prepare("delete from routed where cidr='$webvar{block}'");
    1502         $sth->execute;
    1503         # Make sure block getting deleted is properly accounted for.
    1504         $sth = $ip_dbh->prepare("update freeblocks set routed='n',city='<NULL>'".
    1505                 " where cidr='$webvar{block}'");
    1506         $sth->execute;
    1507         # Set up query to start compacting free blocks.
    1508         $sth = $ip_dbh->prepare("select * from freeblocks where ".
    1509                 "maskbits<=".$cidr->masklen." and routed='n' order by maskbits desc");
    1510 
    1511       } else { # end alloctype routing case
    1512 
    1513         $sth = $ip_dbh->prepare("delete from allocations where cidr='$webvar{block}'");
    1514         $sth->execute;
    1515         # Special case - delete pool IPs
    1516         if ($webvar{alloctype} =~ /^[cdsmw]p$/) {
    1517           # We have to delete the IPs from the pool listing.
    1518           $sth = $ip_dbh->prepare("delete from poolips where pool='$webvar{block}'");
    1519           $sth->execute;
    1520         }
    1521 
    1522         # Set up query for compacting free blocks.
    1523         $sth = $ip_dbh->prepare("select * from freeblocks where cidr << ".
    1524                 "(select cidr from routed where cidr >> '$cidr') ".
    1525                 " and maskbits<=".$cidr->masklen." and routed='y' order by maskbits desc");
    1526 
    1527       } # end alloctype general case
    1528 
    1529       # Now we look for larger-or-equal-sized free blocks in the same master (routed)
    1530       # (super)block. If there aren't any, we can't combine blocks anyway.  If there
    1531       # are, we check to see if we can combine blocks.
    1532       # Execute the statement prepared in the if-else above.
    1533 
    1534       $sth->execute;
    1535 
    1536 # NetAddr::IP->compact() attempts to produce the smallest inclusive block
    1537 # from the caller and the passed terms.
    1538 # EG:  if you call $cidr->compact($ip1,$ip2,$ip3) when $cidr, $ip1, $ip2,
    1539 #       and $ip3 are consecutive /27's starting on .0 (.0-.31, .32-.63,
    1540 #       .64-.95, and .96-.128), you will get an array containing a single
    1541 #       /25 as element 0 (.0-.127).  Order is not important;  you could have
    1542 #       $cidr=.32/27, $ip1=.96/27, $ip2=.0/27, and $ip3=.64/27.
    1543 
    1544       my (@together, @combinelist);
    1545       my $i=0;
    1546       while (my @data = $sth->fetchrow_array) {
    1547         my $testIP = new NetAddr::IP $data[0];
    1548         @together = $testIP->compact($cidr);
    1549         my $num = @together;
    1550         if ($num == 1) {
    1551           $cidr = $together[0];
    1552           $combinelist[$i++] = $testIP;
    1553         }
    1554       }
    1555 
    1556       # Clear old freeblocks entries - if any.  $i==0 if not.
    1557       if ($i>0) {
    1558         $sth = $ip_dbh->prepare("delete from freeblocks where cidr=?");
    1559         foreach my $block (@combinelist) {
    1560           $sth->execute("$block");
    1561         }
    1562       }
    1563 
    1564       # insert "new" freeblocks entry
    1565       if ($webvar{alloctype} eq 'rr') {
    1566         $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
    1567                 ",'<NULL>','n')");
    1568       } else {
    1569         $sth = $ip_dbh->prepare("insert into freeblocks values ('$cidr',".$cidr->masklen.
    1570                 ",(select city from routed where cidr >>= '$cidr'),'y')");
    1571       }
    1572       $sth->execute;
    1573 
    1574       # If we got here, we've succeeded.  Whew!
    1575       $ip_dbh->commit;
    1576     }; # end eval
    1577     if ($@) {
    1578       carp "Transaction aborted because $@";
    1579       eval { $ip_dbh->rollback; };
    1580       syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$@'";
    1581       printAndExit("Could not deallocate netblock $webvar{block}: $@");
    1582     }
    1583     print "<div class=heading align=center>Success!  $webvar{block} deleted.</div>\n";
    15841294    syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
    1585 
    1586   } # end alloctype != netblock
     1295  } else {
     1296    if ($webvar{alloctype} =~ /^.i$/) {
     1297      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
     1298      printAndExit("Could not deallocate static IP $webvar{block}: $msg");
     1299    } else {
     1300      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
     1301      printAndExit("Could not deallocate netblock $webvar{block}: $msg");
     1302    }
     1303  }
    15871304
    15881305  printFooter;
Note: See TracChangeset for help on using the changeset viewer.