source: trunk/cgi-bin/admin.cgi@ 215

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

/trunk

Port bugfixes from /branches/stable r203-206 and r209-213 forward.
Clean merge.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 15.8 KB
Line 
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.
5#
6###
7# SVN revision info
8# $Date: 2005-04-05 18:24:52 +0000 (Tue, 05 Apr 2005) $
9# SVN revision $Rev: 214 $
10# Last update by $Author: kdeugau $
11###
12# Copyright (C) 2004,2005 - Kris Deugau
13
14use strict;
15use warnings;
16use CGI::Carp qw(fatalsToBrowser);
17use DBI;
18use CommonWeb qw(:ALL);
19use MyIPDB;
20#use POSIX qw(ceil);
21use NetAddr::IP;
22
23use Sys::Syslog;
24
25openlog "IPDB-admin","pid","local2";
26
27# Collect the username from HTTP auth. If undefined, we're in a test environment.
28my $authuser;
29if (!defined($ENV{'REMOTE_USER'})) {
30 $authuser = '__temptest';
31} else {
32 $authuser = $ENV{'REMOTE_USER'};
33}
34
35if ($authuser !~ /^(kdeugau|jodyh|jipp)$/) {
36 print "Content-Type: text/html\n\n".
37 "<html><head><title>Access denied</title></head><body>\n".
38 'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
39 "for more information.</body></html>\n";
40 exit;
41}
42
43syslog "debug", "$authuser active";
44
45# Why not a global DB handle? (And a global statement handle, as well...)
46# Use the connectDB function, otherwise we end up confusing ourselves
47my $ip_dbh;
48my $sth;
49my $errstr;
50($ip_dbh,$errstr) = connectDB_My;
51if (!$ip_dbh) {
52 printAndExit("Database error: $errstr\n");
53}
54initIPDBGlobals($ip_dbh);
55
56my %webvar = parse_post();
57cleanInput(\%webvar);
58
59print "Content-type: text/html\n\n".
60 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n".
61 qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n).
62 "</head>\n<body>\n".
63 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
64
65if(!defined($webvar{action})) {
66 $webvar{action} = "<NULL>"; #shuts up the warnings.
67
68 my $typelist = '';
69 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
70 $sth->execute;
71 my @data = $sth->fetchrow_array;
72 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
73 while (my @data = $sth->fetchrow_array) {
74 $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
75 }
76
77 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
78main interface if at all possible.
79<hr>
80<a href="admin.cgi?action=newalloc">Add allocation</a>
81<hr>
82<form action="admin.cgi" method="POST">
83<input type=hidden name=action value=alloc>
84Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid>
85<input type=submit value=" GIMME!! "></form>
86<hr><form action="admin.cgi" method="POST">
87<input type=hidden name=action value=alloctweak>
88Manually update allocation data in this /24: <input name=allocfrom>
89<input type=submit value="Show allocations">
90</form>
91<hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
92);
93} else {
94 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
95}
96
97
98## Possible actions.
99if ($webvar{action} eq 'alloc') {
100 # OK, we know what we're allocating.
101
102 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) {
103 printAndExit("Can't allocate something that's not a netblock/ip");
104 }
105
106 $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'");
107 $sth->execute;
108 my @data = $sth->fetchrow_array;
109 my $custid = $data[0];
110 if ($custid eq '') {
111 # Type that doesn't have a default custid
112 $custid = $webvar{custid};
113 }
114##fixme Check billing DB here
115
116 my $cidr = new NetAddr::IP $webvar{cidr};
117 my @data;
118 if ($webvar{alloctype} eq 'rm') {
119 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'");
120 $sth->execute;
121 @data = $sth->fetchrow_array;
122# User deserves errors if user can't be bothered to find the free block first.
123 printAndExit("Can't allocate from outside a free block!!\n")
124 if !$data[0];
125 } else {
126 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')");
127 $sth->execute;
128 @data = $sth->fetchrow_array;
129# User deserves errors if user can't be bothered to find the free block first.
130 printAndExit("Can't allocate from outside a routed block!!\n")
131 if !$data[0];
132 }
133
134 my $alloc_from = new NetAddr::IP $data[0];
135 $sth->finish;
136
137 my $cities = '';
138 foreach my $city (@citylist) {
139 $cities .= "<option>$city</option>\n";
140 }
141
142 print qq(<table class=regular>
143<form method=POST action=admin.cgi>
144<tr class=color1>
145<td>Allocating:</td>
146<td>$cidr<input type=hidden name=cidr value="$cidr"></td>
147</tr><tr class=color2>
148<td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}}
149<input type=hidden name=alloctype value="$webvar{alloctype}"></td>
150</tr><tr class=color1>
151<td>Allocated from:</td>
152<td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td>
153</tr><tr class="color2">
154<td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td>
155</tr><tr class=color1>
156<td>Customer location:</td><td>
157<select name="city"><option selected>-</option>
158$cities
159</select>
160&nbsp;<a href="javascript:popNotes('/ip/newcity.html')">Add new location</a>
161</td>
162</tr>
163<tr class="color2">
164<td>Circuit ID:</td><td><input name=circid size=40></td>
165</tr><tr class="color1">
166<td>Description/Name:</td><td><input name="desc" size=40></td>
167</tr><tr class="color2">
168<td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td>
169</tr><tr class="warning">
170<td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td>
171</tr><tr class="color2">
172<td class="center" colspan="2"><input type="submit" value=" Assign "></td>
173<input type="hidden" name="action" value="confirm">
174</tr>
175</table>
176);
177
178
179} elsif ($webvar{action} eq 'confirm') {
180
181 print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ".
182 "$disp_alloctypes{$webvar{alloctype}}...<br>\n";
183 # Only need to check city here.
184 if ($webvar{city} eq '-') {
185 printError("Invalid customer location! Go back and select customer's location.");
186 } else {
187 my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from},
188 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
189 $webvar{circid});
190 if ($retcode eq 'OK') {
191 print "Allocation OK!\n";
192
193 if ($webvar{alloctype} =~ /^.i$/) {
194 # Notify tech@example.com
195 mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
196 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
197 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
198 }
199 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
200 "'$webvar{alloctype}'";
201 } else {
202 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";
203 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
204 "'$webvar{type}' failed: '$msg'";
205 }
206 } # done city check
207
208} elsif ($webvar{action} eq 'alloctweak') {
209 fix_allocfrom();
210 showAllocs($webvar{allocfrom});
211} elsif ($webvar{action} eq 'update') {
212 update();
213} elsif ($webvar{action} eq 'assign') {
214 # Display a list of possible blocks within the requested block.
215 open (HTML, "../admin_alloc.html")
216 or croak "Could not open admin_alloc.html :$!";
217 my $html = join('', <HTML>);
218 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
219 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
220
221 my $from = new NetAddr::IP $webvar{allocfrom};
222 my @blocklist = $from->split($webvar{masklen});
223 my $availblocks;
224 foreach (@blocklist) {
225 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
226 }
227 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
228
229 print $html;
230} elsif ($webvar{action} eq 'showpools') {
231 print "IP Pools currently allocated:\n".
232 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n";
233 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr");
234 $sth->execute;
235 my %poolfree;
236 while (my @data = $sth->fetchrow_array) {
237 $poolfree{$data[0]} = 0;
238 }
239 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
240 $sth->execute;
241 while (my @data = $sth->fetchrow_array) {
242 $poolfree{$data[0]}++;
243 }
244 foreach my $key (keys %poolfree) {
245 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>).
246 "<td>$poolfree{$key}</td></tr>\n";
247 }
248 print "</table>\n";
249} elsif ($webvar{action} eq 'tweakpool') {
250 showPool($webvar{pool});
251} elsif ($webvar{action} eq 'updatepool') {
252
253 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
254 "city='$webvar{city}', type='$webvar{type}', available='".
255 (($webvar{available} eq 'y') ? 'y' : 'n').
256 "', notes='$webvar{notes}', description='$webvar{desc}' ".
257 "where ip='$webvar{ip}'");
258 $sth->execute;
259 if ($sth->err) {
260 print "Error updating pool IP $webvar{ip}: $@<hr>\n";
261 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
262 } else {
263 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
264 $sth->execute;
265 my @data = $sth->fetchrow_array;
266 print "$webvar{ip} in $data[0] updated\n<hr>\n";
267 syslog "notice", "$authuser updated pool IP $webvar{ip}";
268 }
269# showPool("$data[0]");
270#} else {
271# print "webvar{action} check failed: $webvar{action}";
272}
273
274# Hokay. This is a little different. We have a few specific functions here:
275# -> Assign arbitrary subnet from arbitrary free space
276# -> Tweak individual DB fields
277#
278
279
280printFooter;
281
282$ip_dbh->disconnect;
283
284exit;
285
286
287# Tweak allocfrom into shape.
288sub fix_allocfrom {
289 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
290 # 3-octet class C specified
291 $webvar{allocfrom} .= ".0/24";
292 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
293 # 4-octet IP specified;
294 $webvar{allocfrom} .= "/24";
295 }
296}
297
298
299# List free blocks in a /24 for arbitrary manual allocation
300sub showfree($) {
301 my $cidr = new NetAddr::IP $_[0];
302 print "Showing free blocks in $cidr<br>\n".
303 "<table border=1>\n";
304 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
305 $sth->execute;
306 while (my @data = $sth->fetchrow_array) {
307 my $temp = new NetAddr::IP $data[0];
308 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
309 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
310 "<td>".
311 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
312 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
313 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
314 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
315 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
316 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
317 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
318 "</td>".
319 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
320 "\n</form></tr>\n";
321 }
322 print "</table>\n";
323}
324
325
326# Show allocations to allow editing.
327sub showAllocs($) {
328 my $cidr = new NetAddr::IP $_[0];
329 print "Edit custID, allocation type, city for allocations in ".
330 "$cidr:\n<table border=1>";
331 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
332 $sth->execute;
333 while (my @data = $sth->fetchrow_array) {
334 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
335 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
336 qq(<td><input name=custid value="$data[1]"></td>\n);
337
338 print "<td><select name=alloctype><option".
339 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
340 (($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
341 (($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
342 (($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
343 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
344 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
345 (($data[2] eq 'sd') ? ' selected' : '') ." value='sd'>Static Pool - Server pool</option>\n<option".
346 (($data[2] eq 'cd') ? ' selected' : '') ." value='cd'>Static Pool - Cable</option>\n<option".
347 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
348 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
349 (($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option".
350 (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
351 (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
352 (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
353 (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
354 (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic WiFi netblock</option>\n<option".
355 (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
356 "</select></td>\n";
357 print qq(<td><input name=city value="$data[3]"></td>\n).
358 "<td>$data[4]</td><td>$data[5]</td>".
359 qq(<td><input type=submit value="Update"></td></form></tr>\n);
360 }
361 print "</table>\n";
362
363 # notes
364 print "<hr><b>Notes:</b>\n".
365 "<ul>\n<li>Use the main interface to update description and notes fields\n".
366 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
367 "</ul>\n";
368}
369
370
371# Stuff updates into DB
372sub update {
373 eval {
374 # Relatively simple SQL transaction here. Note that we're deliberately NOT
375 # updating notes/desc here as it's available through the main interface.
376 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
377 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
378 $sth->execute;
379 $ip_dbh->commit;
380 };
381 if ($@) {
382 carp "Transaction aborted because $@";
383 eval { $ip_dbh->rollback; };
384 syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
385 } else {
386 # If we get here, the operation succeeded.
387 syslog "notice", "$authuser updated $webvar{block}";
388 print "Allocation $webvar{block} updated<hr>\n";
389 }
390 # need to get /24 that block is part of
391 my @bits = split /\./, $webvar{block};
392 $bits[3] = "0/24";
393 showAllocs((join ".", @bits));
394}
395
396
397# showPool()
398# List all IPs in a pool, and allow arbitrary admin changes to each
399# Allow changes to ALL fields
400sub showPool($) {
401 my $pool = new NetAddr::IP $_[0];
402 print qq(Listing pool $pool:\n<table border=1>
403<form action=admin.cgi method=POST>
404<input type=hidden name=action value=updatepool>
405<tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>
406<tr><td align=right>Customer location:</td><td><input name=city></td></tr>
407<tr><td align=right>Type:</td><td><select name=type><option selected>-</option>
408<option value="si">Static IP - Server pool</option>
409<option value="ci">Static IP - Cable</option>
410<option value="di">Static IP - DSL</option>
411<option value="mi">Static IP - Dialup</option>
412<option value="wi">Static IP - Wireless</option>
413</select></td></tr>
414<tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr>
415<tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr>
416<tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr>
417<tr><td colspan=2 align=center><input type=submit value="Update"></td></tr>
418).
419 "</table>Update the following record:<table border=1>\n";
420 $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
421 $sth->execute;
422 while (my @data = $sth->fetchrow_array) {
423 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>).
424 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>".
425 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n";
426 }
427 print "</form></table>\n";
428}
Note: See TracBrowser for help on using the repository browser.