source: branches/stable/cgi-bin/admin.cgi@ 200

Last change on this file since 200 was 200, checked in by Kris Deugau, 20 years ago

/branches/stable

Backport admin.cgi update from /trunk r199
Add Billing Gateway check for customer IDs
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 16.3 KB
RevLine 
[54]1#!/usr/bin/perl
2# ipdb/cgi-bin/admin.cgi
3# Hack interface to make specific changes to IPDB that (for one reason
4# or another) can't be made through the main interface.
[200]5#
[54]6###
7# SVN revision info
8# $Date: 2005-03-17 18:28:03 +0000 (Thu, 17 Mar 2005) $
9# SVN revision $Rev: 200 $
10# Last update by $Author: kdeugau $
11###
[158]12# Copyright (C) 2004,2005 - Kris Deugau
[54]13
14use strict;
15use warnings;
16use CGI::Carp qw(fatalsToBrowser);
17use DBI;
18use CommonWeb qw(:ALL);
[200]19use MyIPDB;
20use CustIDCK;
[54]21#use POSIX qw(ceil);
22use NetAddr::IP;
23
24use Sys::Syslog;
25
26openlog "IPDB-admin","pid","local2";
27
28# Collect the username from HTTP auth. If undefined, we're in a test environment.
29my $authuser;
30if (!defined($ENV{'REMOTE_USER'})) {
31 $authuser = '__temptest';
32} else {
33 $authuser = $ENV{'REMOTE_USER'};
34}
35
36if ($authuser !~ /^(kdeugau|jodyh|__temptest)$/) {
37 print "Content-Type: text/html\n\n".
38 "<html><head><title>Access denied</title></head><body>\n".
39 'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
40 "for more information.</body></html>\n";
41 exit;
42}
43
44syslog "debug", "$authuser active";
45
[200]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
48my $ip_dbh;
49my $sth;
50my $errstr;
51($ip_dbh,$errstr) = connectDB_My;
52if (!$ip_dbh) {
53 printAndExit("Database error: $errstr\n");
54}
55initIPDBGlobals($ip_dbh);
56
[54]57my %webvar = parse_post();
58cleanInput(\%webvar);
[58]59
[54]60print "Content-type: text/html\n\n".
[200]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".
[54]64 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
65
66if(!defined($webvar{action})) {
67 $webvar{action} = "<NULL>"; #shuts up the warnings.
[200]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
[54]78 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
79main interface if at all possible.
[200]80<hr>
81<a href="admin.cgi?action=newalloc">Add allocation</a>
82<hr>
83<form action="admin.cgi" method="POST">
[54]84<input type=hidden name=action value=alloc>
[200]85Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid>
86<input type=submit value=" GIMME!! "></form>
[54]87<hr><form action="admin.cgi" method="POST">
88<input type=hidden name=action value=alloctweak>
89Manually update allocation data in this /24: <input name=allocfrom>
90<input type=submit value="Show allocations">
[200]91</form>
92<hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
[54]93);
94} else {
95 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
96}
97
[200]98
99## Possible actions.
[54]100if ($webvar{action} eq 'alloc') {
[200]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&nbsp;<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
[54]224} elsif ($webvar{action} eq 'alloctweak') {
225 fix_allocfrom();
226 showAllocs($webvar{allocfrom});
227} elsif ($webvar{action} eq 'update') {
228 update();
[58]229} elsif ($webvar{action} eq 'assign') {
230 # Display a list of possible blocks within the requested block.
231 open (HTML, "../admin_alloc.html")
232 or croak "Could not open admin_alloc.html :$!";
233 my $html = join('', <HTML>);
234 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
235 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
236
237 my $from = new NetAddr::IP $webvar{allocfrom};
238 my @blocklist = $from->split($webvar{masklen});
239 my $availblocks;
240 foreach (@blocklist) {
241 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
242 }
243 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
244
245 print $html;
[200]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}";
[54]288}
289
290# Hokay. This is a little different. We have a few specific functions here:
291# -> Assign arbitrary subnet from arbitrary free space
292# -> Tweak individual DB fields
293#
294
295
296printFooter;
297
298$ip_dbh->disconnect;
299
300exit;
301
302
303# Tweak allocfrom into shape.
304sub fix_allocfrom {
305 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
306 # 3-octet class C specified
307 $webvar{allocfrom} .= ".0/24";
308 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
309 # 4-octet IP specified;
310 $webvar{allocfrom} .= "/24";
311 }
312}
313
314
[58]315# List free blocks in a /24 for arbitrary manual allocation
316sub showfree($) {
317 my $cidr = new NetAddr::IP $_[0];
318 print "Showing free blocks in $cidr<br>\n".
319 "<table border=1>\n";
320 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
321 $sth->execute;
322 while (my @data = $sth->fetchrow_array) {
323 my $temp = new NetAddr::IP $data[0];
324 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
325 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
326 "<td>".
327 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
328 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
329 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
330 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
331 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
332 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
333 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
334 "</td>".
335 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
336 "\n</form></tr>\n";
337 }
338 print "</table>\n";
339}
340
341
[54]342# Show allocations to allow editing.
343sub showAllocs($) {
344 my $cidr = new NetAddr::IP $_[0];
345 print "Edit custID, allocation type, city for allocations in ".
346 "$cidr:\n<table border=1>";
347 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
348 $sth->execute;
349 while (my @data = $sth->fetchrow_array) {
350 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
351 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
352 qq(<td><input name=custid value="$data[1]"></td>\n);
353
354 print "<td><select name=alloctype><option".
355 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
356 (($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
357 (($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
358 (($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
359 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
360 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
[200]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".
[54]363 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
364 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
365 (($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option".
[200]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".
[54]372 "</select></td>\n";
373 print qq(<td><input name=city value="$data[3]"></td>\n).
374 "<td>$data[4]</td><td>$data[5]</td>".
375 qq(<td><input type=submit value="Update"></td></form></tr>\n);
376 }
377 print "</table>\n";
378
379 # notes
380 print "<hr><b>Notes:</b>\n".
381 "<ul>\n<li>Use the main interface to update description and notes fields\n".
382 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
383 "</ul>\n";
384}
385
386
387# Stuff updates into DB
388sub update {
389 eval {
390 # Relatively simple SQL transaction here. Note that we're deliberately NOT
391 # updating notes/desc here as it's available through the main interface.
392 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
393 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
394 $sth->execute;
395 $ip_dbh->commit;
396 };
397 if ($@) {
398 carp "Transaction aborted because $@";
399 eval { $ip_dbh->rollback; };
[200]400 syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
[54]401 } else {
402 # If we get here, the operation succeeded.
403 syslog "notice", "$authuser updated $webvar{block}";
404 print "Allocation $webvar{block} updated<hr>\n";
405 }
406 # need to get /24 that block is part of
407 my @bits = split /\./, $webvar{block};
408 $bits[3] = "0/24";
409 showAllocs((join ".", @bits));
410}
[200]411
412
413# showPool()
414# List all IPs in a pool, and allow arbitrary admin changes to each
415# Allow changes to ALL fields
416sub 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 TracBrowser for help on using the repository browser.