Changeset 200 for branches/stable/cgi-bin/admin.cgi
- Timestamp:
- 03/17/05 13:28:03 (20 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/stable/cgi-bin/admin.cgi
r158 r200 3 3 # Hack interface to make specific changes to IPDB that (for one reason 4 4 # or another) can't be made through the main interface. 5 # 5 6 ### 6 7 # SVN revision info … … 16 17 use DBI; 17 18 use CommonWeb qw(:ALL); 18 use IPDB qw(:ALL); 19 use MyIPDB; 20 use CustIDCK; 19 21 #use POSIX qw(ceil); 20 22 use NetAddr::IP; … … 42 44 syslog "debug", "$authuser active"; 43 45 46 # Why not a global DB handle? (And a global statement handle, as well...) 47 # Use the connectDB function, otherwise we end up confusing ourselves 48 my $ip_dbh; 49 my $sth; 50 my $errstr; 51 ($ip_dbh,$errstr) = connectDB_My; 52 if (!$ip_dbh) { 53 printAndExit("Database error: $errstr\n"); 54 } 55 initIPDBGlobals($ip_dbh); 56 44 57 my %webvar = parse_post(); 45 58 cleanInput(\%webvar); 46 59 47 my %full_alloc_types = (48 "ci","Cable pool IP",49 "di","DSL pool 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 my $ip_dbh = connectDB;69 my $sth;70 71 60 print "Content-type: text/html\n\n". 72 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n</head>\n<body>\n". 61 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n". 62 qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n). 63 "</head>\n<body>\n". 73 64 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n"; 74 65 75 66 if(!defined($webvar{action})) { 76 67 $webvar{action} = "<NULL>"; #shuts up the warnings. 68 69 my $typelist = ''; 70 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 71 $sth->execute; 72 my @data = $sth->fetchrow_array; 73 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n"; 74 while (my @data = $sth->fetchrow_array) { 75 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 76 } 77 77 78 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the 78 79 main interface if at all possible. 79 <hr><form action="admin.cgi" method="POST"> 80 <hr> 81 <a href="admin.cgi?action=newalloc">Add allocation</a> 82 <hr> 83 <form action="admin.cgi" method="POST"> 80 84 <input type=hidden name=action value=alloc> 81 Allocate block from this /24: <input name=allocfrom> 82 <input type=submit value="List available free blocks"> 83 </form> 85 Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid> 86 <input type=submit value=" GIMME!! "></form> 84 87 <hr><form action="admin.cgi" method="POST"> 85 88 <input type=hidden name=action value=alloctweak> 86 89 Manually update allocation data in this /24: <input name=allocfrom> 87 90 <input type=submit value="Show allocations"> 91 </form> 92 <hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates 88 93 ); 89 94 } else { … … 91 96 } 92 97 98 99 ## Possible actions. 93 100 if ($webvar{action} eq 'alloc') { 94 fix_allocfrom(); 95 showfree($webvar{allocfrom}); 101 # OK, we know what we're allocating. 102 103 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 104 printAndExit("Can't allocate something that's not a netblock/ip"); 105 } 106 107 $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'"); 108 $sth->execute; 109 my @data = $sth->fetchrow_array; 110 my $custid = $data[0]; 111 if ($custid eq '') { 112 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) { 113 # Force uppercase for now... 114 $webvar{custid} =~ tr/a-z/A-Z/; 115 # Crosscheck with ... er... something. 116 my $status = CustIDCK->custid_exist($webvar{custid}); 117 if ($CustIDCK::Error) { 118 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg); 119 return; 120 } 121 if (!$status) { 122 printError("Customer ID not valid. Make sure the Customer ID ". 123 "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ". 124 "non-customer assignments."); 125 return; 126 } 127 } 128 # Type that doesn't have a default custid 129 $custid = $webvar{custid}; 130 } 131 132 my $cidr = new NetAddr::IP $webvar{cidr}; 133 my @data; 134 if ($webvar{alloctype} eq 'rm') { 135 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'"); 136 $sth->execute; 137 @data = $sth->fetchrow_array; 138 # User deserves errors if user can't be bothered to find the free block first. 139 printAndExit("Can't allocate from outside a free block!!\n") 140 if !$data[0]; 141 } else { 142 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')"); 143 $sth->execute; 144 @data = $sth->fetchrow_array; 145 # User deserves errors if user can't be bothered to find the free block first. 146 printAndExit("Can't allocate from outside a routed block!!\n") 147 if !$data[0]; 148 } 149 150 my $alloc_from = new NetAddr::IP $data[0]; 151 $sth->finish; 152 153 my $cities = ''; 154 foreach my $city (@citylist) { 155 $cities .= "<option>$city</option>\n"; 156 } 157 158 print qq(<table class=regular> 159 <form method=POST action=admin.cgi> 160 <tr class=color1> 161 <td>Allocating:</td> 162 <td>$cidr<input type=hidden name=cidr value="$cidr"></td> 163 </tr><tr class=color2> 164 <td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}} 165 <input type=hidden name=alloctype value="$webvar{alloctype}"></td> 166 </tr><tr class=color1> 167 <td>Allocated from:</td> 168 <td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td> 169 </tr><tr class="color2"> 170 <td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td> 171 </tr><tr class=color1> 172 <td>Customer location:</td><td> 173 <select name="city"><option selected>-</option> 174 $cities 175 </select> 176 <a href="javascript:popNotes('/ip/newcity.html')">Add new location</a> 177 </td> 178 </tr> 179 <tr class="color2"> 180 <td>Circuit ID:</td><td><input name=circid size=40></td> 181 </tr><tr class="color1"> 182 <td>Description/Name:</td><td><input name="desc" size=40></td> 183 </tr><tr class="color2"> 184 <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td> 185 </tr><tr class="warning"> 186 <td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td> 187 </tr><tr class="color2"> 188 <td class="center" colspan="2"><input type="submit" value=" Assign "></td> 189 <input type="hidden" name="action" value="confirm"> 190 </tr> 191 </table> 192 ); 193 194 195 } elsif ($webvar{action} eq 'confirm') { 196 197 print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ". 198 "$disp_alloctypes{$webvar{alloctype}}...<br>\n"; 199 # Only need to check city here. 200 if ($webvar{city} eq '-') { 201 printError("Invalid customer location! Go back and select customer's location."); 202 } else { 203 my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from}, 204 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes}, 205 $webvar{circid}); 206 if ($retcode eq 'OK') { 207 print "Allocation OK!\n"; 208 209 if ($webvar{alloctype} =~ /^.i$/) { 210 # Notify tech@example.com 211 mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation", 212 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n". 213 "Description: $webvar{desc}\n\nAllocated by: $authuser\n"); 214 } 215 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 216 "'$webvar{alloctype}'"; 217 } else { 218 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n"; 219 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 220 "'$webvar{type}' failed: '$msg'"; 221 } 222 } # done city check 223 96 224 } elsif ($webvar{action} eq 'alloctweak') { 97 225 fix_allocfrom(); … … 116 244 117 245 print $html; 118 } elsif ($webvar{action} eq 'confirm') { 119 print "Assigning $webvar{block} to $webvar{custid} (\"$webvar{desc}\")...\n"; 120 allocBlock($ip_dbh, $webvar{allocfrom}, $webvar{block}, $webvar{alloctype}, 121 $webvar{custid}, $webvar{city}, $webvar{desc}, $webvar{notes}); 122 #my ($dbh,from,block,$type,$custid,$city,$desc,$notes) = @_; 123 } else { 124 print "webvar{action} check failed"; 246 } elsif ($webvar{action} eq 'showpools') { 247 print "IP Pools currently allocated:\n". 248 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n"; 249 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr"); 250 $sth->execute; 251 my %poolfree; 252 while (my @data = $sth->fetchrow_array) { 253 $poolfree{$data[0]} = 0; 254 } 255 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip"); 256 $sth->execute; 257 while (my @data = $sth->fetchrow_array) { 258 $poolfree{$data[0]}++; 259 } 260 foreach my $key (keys %poolfree) { 261 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>). 262 "<td>$poolfree{$key}</td></tr>\n"; 263 } 264 print "</table>\n"; 265 } elsif ($webvar{action} eq 'tweakpool') { 266 showPool($webvar{pool}); 267 } elsif ($webvar{action} eq 'updatepool') { 268 269 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ". 270 "city='$webvar{city}', type='$webvar{type}', available='". 271 (($webvar{available} eq 'y') ? 'y' : 'n'). 272 "', notes='$webvar{notes}', description='$webvar{desc}' ". 273 "where ip='$webvar{ip}'"); 274 $sth->execute; 275 if ($sth->err) { 276 print "Error updating pool IP $webvar{ip}: $@<hr>\n"; 277 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@"; 278 } else { 279 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); 280 $sth->execute; 281 my @data = $sth->fetchrow_array; 282 print "$webvar{ip} in $data[0] updated\n<hr>\n"; 283 syslog "notice", "$authuser updated pool IP $webvar{ip}"; 284 } 285 # showPool("$data[0]"); 286 #} else { 287 # print "webvar{action} check failed: $webvar{action}"; 125 288 } 126 289 … … 149 312 } 150 313 151 152 # Do the gruntwork of allocating a block. This should really be in IPDB.pm.153 sub allocBlock($$$$$$$$) {154 my ($dbh,undef,undef,$type,$custid,$city,$desc,$notes) = @_;155 my $from = new NetAddr::IP $_[1];156 my $block = new NetAddr::IP $_[2];157 158 # First, figure out what free blocks will get mangled.159 if ($from eq $block) {160 # Whee! Easy. Just allocate the block161 } else {162 # The complex case. An allocation from a larger block.163 164 # Gotta snag the free blocks left over.165 my $wantmaskbits = $block->masklen;166 my $maskbits = $from->masklen;167 168 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.169 170 my $i=0;171 my $tmp_from = $from; # So we don't munge $from172 while ($maskbits++ < $wantmaskbits) {173 my @subblocks = $tmp_from->split($maskbits);174 $newfreeblocks[$i++] = (($block->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);175 $tmp_from = ( ($block->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );176 } # while177 178 # insert the data here. Woo.179 # Begin SQL transaction block180 eval {181 # Delete old freeblocks entry182 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$from'");183 $sth->execute();184 185 # Insert the new freeblocks entries186 $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ".187 "(select city from routed where cidr >>= '$block'),'y')");188 foreach my $block (@newfreeblocks) {189 $sth->execute("$block", $block->masklen);190 }191 # Insert the allocations entry192 $sth = $ip_dbh->prepare("insert into allocations values ('$block',".193 "'$custid','$type','$city','$desc','$notes',".$block->masklen.")");194 $sth->execute;195 196 $ip_dbh->commit;197 }; # end eval198 if ($@) {199 carp "Transaction aborted because $@";200 eval { $ip_dbh->rollback; };201 syslog "err", "Allocation of '$block' to '$custid' as ".202 "'$type' by $authuser failed: '$@'";203 print "Allocation of $block as $full_alloc_types{$type} failed.\n";204 } else {205 syslog "notice", "$authuser allocated '$block' to '$custid'".206 " as '$type'";207 print "OK!<br>\n";208 }209 210 }211 # need to get /24 that block is part of212 my @bits = split /\./, $webvar{block};213 $bits[3] = "0/24";214 showAllocs((join ".", @bits));215 }216 314 217 315 # List free blocks in a /24 for arbitrary manual allocation … … 261 359 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option". 262 360 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option". 263 (($data[2] eq 's p') ? ' selected' : '') ." value='sp'>Static Pool - Server pool</option>\n<option".264 (($data[2] eq 'c p') ? ' selected' : '') ." value='cp'>Static Pool - Cable</option>\n<option".361 (($data[2] eq 'sd') ? ' selected' : '') ." value='sd'>Static Pool - Server pool</option>\n<option". 362 (($data[2] eq 'cd') ? ' selected' : '') ." value='cd'>Static Pool - Cable</option>\n<option". 265 363 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option". 266 364 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option". 267 365 (($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option". 268 (($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option". 269 (($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option". 270 (($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option". 271 (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option". 272 (($data[2] eq 'ii') ? ' selected' : '') ." value='ii'>Internal netblock</option>\n". 366 (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option". 367 (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option". 368 (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option". 369 (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option". 370 (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic WiFi netblock</option>\n<option". 371 (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n". 273 372 "</select></td>\n"; 274 373 print qq(<td><input name=city value="$data[3]"></td>\n). … … 299 398 carp "Transaction aborted because $@"; 300 399 eval { $ip_dbh->rollback; }; 301 syslog "err", "$authuser could not update block /IP'$webvar{block}': '$@'";400 syslog "err", "$authuser could not update block '$webvar{block}': '$@'"; 302 401 } else { 303 402 # If we get here, the operation succeeded. … … 310 409 showAllocs((join ".", @bits)); 311 410 } 411 412 413 # showPool() 414 # List all IPs in a pool, and allow arbitrary admin changes to each 415 # Allow changes to ALL fields 416 sub showPool($) { 417 my $pool = new NetAddr::IP $_[0]; 418 print qq(Listing pool $pool:\n<table border=1> 419 <form action=admin.cgi method=POST> 420 <input type=hidden name=action value=updatepool> 421 <tr><td align=right>Customer ID:</td><td><input name=custid></td></tr> 422 <tr><td align=right>Customer location:</td><td><input name=city></td></tr> 423 <tr><td align=right>Type:</td><td><select name=type><option selected>-</option> 424 <option value="si">Static IP - Server pool</option> 425 <option value="ci">Static IP - Cable</option> 426 <option value="di">Static IP - DSL</option> 427 <option value="mi">Static IP - Dialup</option> 428 <option value="wi">Static IP - Wireless</option> 429 </select></td></tr> 430 <tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr> 431 <tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr> 432 <tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr> 433 <tr><td colspan=2 align=center><input type=submit value="Update"></td></tr> 434 ). 435 "</table>Update the following record:<table border=1>\n"; 436 $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); 437 $sth->execute; 438 while (my @data = $sth->fetchrow_array) { 439 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>). 440 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>". 441 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n"; 442 } 443 print "</form></table>\n"; 444 }
Note:
See TracChangeset
for help on using the changeset viewer.