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

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

/trunk

Corrected incorrect or missing svn:* properties on
Perl scripts and modules

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 15.0 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: 2004-12-01 20:46:46 +0000 (Wed, 01 Dec 2004) $
9# SVN revision $Rev: 95 $
10# Last update by $Author: kdeugau $
11###
12# Copyright (C) 2004 - Kris Deugau
13
14use strict;
15use warnings;
16use CGI::Carp qw(fatalsToBrowser);
17use DBI;
18use CommonWeb qw(:ALL);
19use IPDB qw(:ALL);
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|__temptest)$/) {
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
45my %webvar = parse_post();
46cleanInput(\%webvar);
47
48my %full_alloc_types = (
49 "ci","Cable pool IP",
50 "di","DSL pool IP",
51 "si","Server pool IP",
52 "mi","Static dialup IP",
53 "wi","Static wireless IP",
54 "cp","Cable pool",
55 "dp","DSL pool",
56 "sp","Server pool",
57 "mp","Static dialup pool",
58 "wp","Static wireless pool",
59 "dn","Dialup netblock",
60 "dy","Dynamic DSL netblock",
61 "dc","Dynamic cable netblock",
62 "cn","Customer netblock",
63 "ee","End-use netblock",
64 "rr","Routed netblock",
65 "ii","Internal netblock",
66 "mm","Master block"
67);
68
69my $ip_dbh = connectDB;
70my $sth;
71
72print "Content-type: text/html\n\n".
73 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n</head>\n<body>\n".
74 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
75
76if(!defined($webvar{action})) {
77 $webvar{action} = "<NULL>"; #shuts up the warnings.
78 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
79main interface if at all possible.
80<hr><form action="admin.cgi" method="POST">
81<input type=hidden name=action value=alloc>
82Allocate block from this /24: <input name=allocfrom>
83<input type=submit value="List available free blocks">
84</form>
85<hr><form action="admin.cgi" method="POST">
86<input type=hidden name=action value=alloctweak>
87Manually update allocation data in this /24: <input name=allocfrom>
88<input type=submit value="Show allocations">
89</form>
90<hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
91);
92} else {
93 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
94}
95
96if ($webvar{action} eq 'alloc') {
97 fix_allocfrom();
98 showfree($webvar{allocfrom});
99} elsif ($webvar{action} eq 'alloctweak') {
100 fix_allocfrom();
101 showAllocs($webvar{allocfrom});
102} elsif ($webvar{action} eq 'update') {
103 update();
104} elsif ($webvar{action} eq 'assign') {
105 # Display a list of possible blocks within the requested block.
106 open (HTML, "../admin_alloc.html")
107 or croak "Could not open admin_alloc.html :$!";
108 my $html = join('', <HTML>);
109 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
110 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
111
112 my $from = new NetAddr::IP $webvar{allocfrom};
113 my @blocklist = $from->split($webvar{masklen});
114 my $availblocks;
115 foreach (@blocklist) {
116 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
117 }
118 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
119
120 print $html;
121} elsif ($webvar{action} eq 'confirm') {
122 print "Assigning $webvar{block} to $webvar{custid} (\"$webvar{desc}\")...\n";
123 allocBlock($ip_dbh, $webvar{allocfrom}, $webvar{block}, $webvar{alloctype},
124 $webvar{custid}, $webvar{city}, $webvar{desc}, $webvar{notes});
125 #my ($dbh,from,block,$type,$custid,$city,$desc,$notes) = @_;
126} elsif ($webvar{action} eq 'showpools') {
127 print "IP Pools currently allocated:\n".
128 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n";
129 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' order by cidr");
130 $sth->execute;
131 my %poolfree;
132 while (my @data = $sth->fetchrow_array) {
133 $poolfree{$data[0]} = 0;
134 }
135 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
136 $sth->execute;
137 while (my @data = $sth->fetchrow_array) {
138 $poolfree{$data[0]}++;
139 }
140 foreach my $key (keys %poolfree) {
141 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>).
142 "<td>$poolfree{$key}</td></tr>\n";
143 }
144 print "</table>\n";
145} elsif ($webvar{action} eq 'tweakpool') {
146 showPool($webvar{pool});
147} elsif ($webvar{action} eq 'updatepool') {
148 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
149 "city='$webvar{city}', ptype='$webvar{ptype}', available='".
150 (($webvar{available} eq 'y') ? 'y' : 'n').
151 "', notes='$webvar{notes}', description='$webvar{desc}' ".
152 "where ip='$webvar{ip}'");
153 $sth->execute;
154 if ($sth->err) {
155 print "Error updating pool IP $webvar{ip}: $@<hr>\n";
156 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
157 } else {
158 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
159 $sth->execute;
160 my @data = $sth->fetchrow_array;
161 print "$webvar{ip} in $data[0] updated\n<hr>\n";
162 syslog "notice", "$authuser updated pool IP $webvar{ip}";
163 }
164 showPool("$data[0]");
165#} else {
166# print "webvar{action} check failed: $webvar{action}";
167}
168
169# Hokay. This is a little different. We have a few specific functions here:
170# -> Assign arbitrary subnet from arbitrary free space
171# -> Tweak individual DB fields
172#
173
174
175printFooter;
176
177$ip_dbh->disconnect;
178
179exit;
180
181
182# Tweak allocfrom into shape.
183sub fix_allocfrom {
184 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
185 # 3-octet class C specified
186 $webvar{allocfrom} .= ".0/24";
187 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
188 # 4-octet IP specified;
189 $webvar{allocfrom} .= "/24";
190 }
191}
192
193
194# Do the gruntwork of allocating a block. This should really be in IPDB.pm.
195sub allocBlock($$$$$$$$) {
196 my ($dbh,undef,undef,$type,$custid,$city,$desc,$notes) = @_;
197 my $from = new NetAddr::IP $_[1];
198 my $block = new NetAddr::IP $_[2];
199
200 local $ip_dbh->{AutoCommit} = 0; # enable transactions, if possible
201 local $ip_dbh->{RaiseError} = 1; # Use local to limit to this sub
202
203 if ($from eq $block) {
204 eval {
205 # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
206
207 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$block'");
208 $sth->execute;
209
210 # Insert the allocations entry
211 $sth = $ip_dbh->prepare("insert into allocations values ('$block',".
212 "'$custid','$type','$city','$desc','$notes',".$block->masklen.")");
213 $sth->execute;
214
215 $ip_dbh->commit;
216 }; # end of eval
217 if ($@) {
218 carp "Transaction aborted because $@";
219 eval { $ip_dbh->rollback; };
220 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
221 "'$webvar{alloctype}' by $authuser failed: '$@'";
222 printAndExit("Allocation of $cidr as $full_alloc_types{$webvar{alloctype}} failed.\n");
223 } else {
224 syslog "notice", "$authuser allocated '$block' to '$custid'".
225 " as '$webvar{alloctype}'";
226 print "Block $block allocated to $custid.<br>\n";
227 }
228 } else {
229 # The complex case. An allocation from a larger block.
230
231 # Gotta snag the free blocks left over.
232 my $wantmaskbits = $block->masklen;
233 my $maskbits = $from->masklen;
234
235 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
236
237 my $i=0;
238 my $tmp_from = $from; # So we don't munge $from
239 while ($maskbits++ < $wantmaskbits) {
240 my @subblocks = $tmp_from->split($maskbits);
241 $newfreeblocks[$i++] = (($block->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
242 $tmp_from = ( ($block->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
243 } # while
244
245# insert the data here. Woo.
246 # Begin SQL transaction block
247 eval {
248 # Delete old freeblocks entry
249 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$from'");
250 $sth->execute();
251
252 # Insert the new freeblocks entries
253 $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ".
254 "(select city from routed where cidr >>= '$block'),'y')");
255 foreach my $block (@newfreeblocks) {
256 $sth->execute("$block", $block->masklen);
257 }
258 # Insert the allocations entry
259 $sth = $ip_dbh->prepare("insert into allocations values ('$block',".
260 "'$custid','$type','$city','$desc','$notes',".$block->masklen.")");
261 $sth->execute;
262
263 $ip_dbh->commit;
264 }; # end eval
265 if ($@) {
266 carp "Transaction aborted because $@";
267 eval { $ip_dbh->rollback; };
268 syslog "err", "Allocation of '$block' to '$custid' as ".
269 "'$type' by $authuser failed: '$@'";
270 print "Allocation of $block as $full_alloc_types{$type} failed.\n";
271 } else {
272 syslog "notice", "$authuser allocated '$block' to '$custid'".
273 " as '$type'";
274 print "Block $block allocated to $custid.<br>\n";
275 } # done OK?/NOK! check after DB changes
276
277 } # done "hard" allocation case.
278
279 # need to get /24 that block is part of
280 my @bits = split /\./, $webvar{block};
281 $bits[3] = "0/24";
282 showAllocs((join ".", @bits));
283}
284
285
286# List free blocks in a /24 for arbitrary manual allocation
287sub showfree($) {
288 my $cidr = new NetAddr::IP $_[0];
289 print "Showing free blocks in $cidr<br>\n".
290 "<table border=1>\n";
291 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
292 $sth->execute;
293 while (my @data = $sth->fetchrow_array) {
294 my $temp = new NetAddr::IP $data[0];
295 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
296 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
297 "<td>".
298 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
299 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
300 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
301 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
302 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
303 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
304 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
305 "</td>".
306 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
307 "\n</form></tr>\n";
308 }
309 print "</table>\n";
310}
311
312
313# Show allocations to allow editing.
314sub showAllocs($) {
315 my $cidr = new NetAddr::IP $_[0];
316 print "Edit custID, allocation type, city for allocations in ".
317 "$cidr:\n<table border=1>";
318 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
319 $sth->execute;
320 while (my @data = $sth->fetchrow_array) {
321 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
322 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
323 qq(<td><input name=custid value="$data[1]"></td>\n);
324
325 print "<td><select name=alloctype><option".
326 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
327 (($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
328 (($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
329 (($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
330 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
331 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
332 (($data[2] eq 'sp') ? ' selected' : '') ." value='sp'>Static Pool - Server pool</option>\n<option".
333 (($data[2] eq 'cp') ? ' selected' : '') ." value='cp'>Static Pool - Cable</option>\n<option".
334 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
335 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
336 (($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option".
337 (($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option".
338 (($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option".
339 (($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option".
340 (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
341 (($data[2] eq 'ii') ? ' selected' : '') ." value='ii'>Internal netblock</option>\n".
342 "</select></td>\n";
343 print qq(<td><input name=city value="$data[3]"></td>\n).
344 "<td>$data[4]</td><td>$data[5]</td>".
345 qq(<td><input type=submit value="Update"></td></form></tr>\n);
346 }
347 print "</table>\n";
348
349 # notes
350 print "<hr><b>Notes:</b>\n".
351 "<ul>\n<li>Use the main interface to update description and notes fields\n".
352 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
353 "</ul>\n";
354}
355
356
357# Stuff updates into DB
358sub update {
359 eval {
360 # Relatively simple SQL transaction here. Note that we're deliberately NOT
361 # updating notes/desc here as it's available through the main interface.
362 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
363 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
364 $sth->execute;
365 $ip_dbh->commit;
366 };
367 if ($@) {
368 carp "Transaction aborted because $@";
369 eval { $ip_dbh->rollback; };
370 syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
371 } else {
372 # If we get here, the operation succeeded.
373 syslog "notice", "$authuser updated $webvar{block}";
374 print "Allocation $webvar{block} updated<hr>\n";
375 }
376 # need to get /24 that block is part of
377 my @bits = split /\./, $webvar{block};
378 $bits[3] = "0/24";
379 showAllocs((join ".", @bits));
380}
381
382
383# showPool()
384# List all IPs in a pool, and allow arbitrary admin changes to each
385# Allow changes to ALL fields
386sub showPool($) {
387 my $pool = new NetAddr::IP $_[0];
388 print qq(Listing pool $pool:\n<table border=1>
389<form action=admin.cgi method=POST>
390<input type=hidden name=action value=updatepool>
391<tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>
392<tr><td align=right>Customer location:</td><td><input name=city></td></tr>
393<tr><td align=right>Type:</td><td><select name=ptype><option selected>-</option>
394<option value="s">Static IP - Server pool</option>
395<option value="c">Static IP - Cable</option>
396<option value="d">Static IP - DSL</option>
397<option value="m">Static IP - Dialup</option>
398<option value="w">Static IP - Wireless</option>
399</select></td></tr>
400<tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr>
401<tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr>
402<tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr>
403<tr><td colspan=2 align=center><input type=submit value="Update"></td></tr>
404).
405 "</table>Update the following record:<table border=1>\n";
406 $sth = $ip_dbh->prepare("select * from poolips where pool='$pool' order by ip");
407 $sth->execute;
408 while (my @data = $sth->fetchrow_array) {
409 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>).
410 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>".
411 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n";
412 }
413 print "</form></table>\n";
414}
Note: See TracBrowser for help on using the repository browser.