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

Last change on this file since 290 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 19.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: 2005-09-23 19:54:31 +0000 (Fri, 23 Sep 2005) $
9# SVN revision $Rev: 286 $
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;
20use CustIDCK;
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
36syslog "debug", "$authuser active";
37
38# Why not a global DB handle? (And a global statement handle, as well...)
39# Use the connectDB function, otherwise we end up confusing ourselves
40my $ip_dbh;
41my $sth;
42my $errstr;
43($ip_dbh,$errstr) = connectDB_My;
44if (!$ip_dbh) {
45 printAndExit("Database error: $errstr\n");
46}
47initIPDBGlobals($ip_dbh);
48
49if ($IPDBacl{$authuser} !~ /A/) {
50 print "Content-Type: text/html\n\n".
51 "<html><head><title>Access denied</title></head><body>\n".
52 'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
53 "for more information.</body></html>\n";
54 exit;
55}
56
57my %webvar = parse_post();
58cleanInput(\%webvar);
59
60print "Content-type: text/html\n\n".
61 "<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n".
62 qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n).
63 "</head>\n<body>\n".
64 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
65
66if(!defined($webvar{action})) {
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
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>
81<a href="admin.cgi?action=newalloc">Add allocation</a>
82<hr>
83<form action="admin.cgi" method="POST">
84<input type=hidden name=action value=alloc>
85Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid>
86<input type=submit value=" GIMME!! "></form>
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">
91</form>
92<hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
93<hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users; change
94internal access controls - note that this does NOT include IP-based limits)
95);
96} else {
97 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
98}
99
100
101## Possible actions.
102if ($webvar{action} eq 'alloc') {
103 # OK, we know what we're allocating.
104
105 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) {
106 printAndExit("Can't allocate something that's not a netblock/ip");
107 }
108
109 $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'");
110 $sth->execute;
111 my @data = $sth->fetchrow_array;
112 my $custid = $data[0];
113 if ($custid eq '') {
114 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
115 # Force uppercase for now...
116 $webvar{custid} =~ tr/a-z/A-Z/;
117 # Crosscheck with ... er... something.
118 my $status = CustIDCK->custid_exist($webvar{custid});
119 if ($CustIDCK::Error) {
120 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
121 return;
122 }
123 if (!$status) {
124 printError("Customer ID not valid. Make sure the Customer ID ".
125 "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
126 "non-customer assignments.");
127 return;
128 }
129 }
130 # Type that doesn't have a default custid
131 $custid = $webvar{custid};
132 }
133
134 my $cidr = new NetAddr::IP $webvar{cidr};
135 my @data;
136 if ($webvar{alloctype} eq 'rm') {
137 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and routed='n'");
138 $sth->execute;
139 @data = $sth->fetchrow_array;
140# User deserves errors if user can't be bothered to find the free block first.
141 printAndExit("Can't allocate from outside a free block!!\n")
142 if !$data[0];
143 } elsif ($webvar{alloctype} =~ /^(.)i$/) {
144 $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')");
145 $sth->execute;
146 @data = $sth->fetchrow_array;
147# User deserves errors if user can't be bothered to find the pool and a free IP first.
148 printAndExit("Can't allocate static IP from outside a pool!!\n")
149 if !$data[0];
150 } else {
151 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')");
152 $sth->execute;
153 @data = $sth->fetchrow_array;
154# User deserves errors if user can't be bothered to find the free block first.
155 printAndExit("Can't allocate from outside a routed block!!\n")
156 if !$data[0];
157 }
158
159 my $alloc_from = new NetAddr::IP $data[0];
160 $sth->finish;
161
162 my $cities = '';
163 foreach my $city (@citylist) {
164 $cities .= "<option>$city</option>\n";
165 }
166
167 print qq(<table class=regular>
168<form method=POST action=admin.cgi>
169<tr class=color1>
170<td>Allocating:</td>
171<td>$cidr<input type=hidden name=cidr value="$cidr"></td>
172</tr><tr class=color2>
173<td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}}
174<input type=hidden name=alloctype value="$webvar{alloctype}"></td>
175</tr><tr class=color1>
176<td>Allocated from:</td>
177<td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td>
178</tr><tr class="color2">
179<td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td>
180</tr><tr class=color1>
181<td>Customer location:</td><td>
182<select name="city"><option selected>-</option>
183$cities
184</select>
185&nbsp;<a href="javascript:popNotes('/ip/newcity.html')">Add new location</a>
186</td>
187</tr>
188<tr class="color2">
189<td>Circuit ID:</td><td><input name=circid size=40></td>
190</tr><tr class="color1">
191<td>Description/Name:</td><td><input name="desc" size=40></td>
192</tr><tr class="color2">
193<td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td>
194</tr><tr class="warning">
195<td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td>
196</tr><tr class="color2">
197<td class="center" colspan="2"><input type="submit" value=" Assign "></td>
198<input type="hidden" name="action" value="confirm">
199</tr>
200</table>
201);
202
203
204} elsif ($webvar{action} eq 'confirm') {
205
206 print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ".
207 "$disp_alloctypes{$webvar{alloctype}}...<br>\n";
208 # Only need to check city here.
209 if ($webvar{city} eq '-') {
210 printError("Invalid customer location! Go back and select customer's location.");
211 } else {
212 my ($retcode,$msg) = allocateBlock($ip_dbh, $webvar{cidr}, $webvar{alloc_from},
213 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
214 $webvar{circid});
215 if ($retcode eq 'OK') {
216 print "Allocation OK!\n";
217
218 if ($webvar{alloctype} =~ /^.i$/) {
219 # Notify tech@example.com
220 mailNotify('tech@example.com',"$disp_alloctypes{$webvar{alloctype}} allocation",
221 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
222 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
223 }
224 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
225 "'$webvar{alloctype}'";
226 } else {
227 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";
228 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
229 "'$webvar{alloctype}' failed: '$msg'";
230 }
231 } # done city check
232
233} elsif ($webvar{action} eq 'alloctweak') {
234 fix_allocfrom();
235 showAllocs($webvar{allocfrom});
236} elsif ($webvar{action} eq 'update') {
237 update();
238} elsif ($webvar{action} eq 'assign') {
239 # Display a list of possible blocks within the requested block.
240 open (HTML, "../admin_alloc.html")
241 or croak "Could not open admin_alloc.html :$!";
242 my $html = join('', <HTML>);
243 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
244 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
245
246 my $from = new NetAddr::IP $webvar{allocfrom};
247 my @blocklist = $from->split($webvar{masklen});
248 my $availblocks;
249 foreach (@blocklist) {
250 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
251 }
252 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
253
254 print $html;
255} elsif ($webvar{action} eq 'showpools') {
256 print "IP Pools currently allocated:\n".
257 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n";
258 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr");
259 $sth->execute;
260 my %poolfree;
261 while (my @data = $sth->fetchrow_array) {
262 $poolfree{$data[0]} = 0;
263 }
264 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
265 $sth->execute;
266 while (my @data = $sth->fetchrow_array) {
267 $poolfree{$data[0]}++;
268 }
269 foreach my $key (keys %poolfree) {
270 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>).
271 "<td>$poolfree{$key}</td></tr>\n";
272 }
273 print "</table>\n";
274} elsif ($webvar{action} eq 'tweakpool') {
275 showPool($webvar{pool});
276} elsif ($webvar{action} eq 'updatepool') {
277
278 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
279 "city='$webvar{city}', type='$webvar{type}', available='".
280 (($webvar{available} eq 'y') ? 'y' : 'n').
281 "', notes='$webvar{notes}', description='$webvar{desc}' ".
282 "where ip='$webvar{ip}'");
283 $sth->execute;
284 if ($sth->err) {
285 print "Error updating pool IP $webvar{ip}: $@<hr>\n";
286 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
287 } else {
288 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
289 $sth->execute;
290 my @data = $sth->fetchrow_array;
291 print "$webvar{ip} in $data[0] updated\n<hr>\n";
292 syslog "notice", "$authuser updated pool IP $webvar{ip}";
293 }
294} elsif ($webvar{action} eq 'showusers') {
295 print "Notes:<br>\n".
296 "<li>Admin users automatically get all other priviledges.\n".
297 "<hr>Add new user:<form action=admin.cgi method=POST>\n".
298 "Username: <input name=username><br>\n".
299 "Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n".
300 "<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n";
301
302 print "<hr>Users with access:\n<table border=1>\n";
303 print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n";
304 print "<tr><td>Username</td><td>Add new</td><td>Change</td>".
305 "<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n".
306 "<form action=admin.cgi method=POST>\n";
307 $sth = $ip_dbh->prepare("select username,acl from users order by username");
308 $sth->execute;
309 while (my @data = $sth->fetchrow_array) {
310 print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>".
311 qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>).
312 # Now for the fun bit. We have to pull apart the ACL field and
313 # output a bunch of checkboxes.
314 "<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : '').
315 "></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : '').
316 "></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : '').
317 "></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : '').
318 "></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : '').
319 qq(></td><td><input type=submit value="Update"></td></form>\n).
320 "<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>".
321 "<input type=hidden name=username value=$data[0]>".
322 qq(<input type=submit value="Delete user"></tr></form>\n);
323
324 }
325 print "</table>\n";
326} elsif ($webvar{action} eq 'updacl') {
327 print "Updating ACL for $webvar{username}:<br>\n";
328 my $acl = 'b';
329 if ($webvar{admin} eq 'on') {
330 $acl .= "acdsA";
331 } else {
332 $acl .= ($webvar{add} eq 'on' ? 'a' : '').
333 ($webvar{change} eq 'on' ? 'c' : '').
334 ($webvar{del} eq 'on' ? 'd' : '').
335 ($webvar{sysnet} eq 'on' ? 's' : '');
336 }
337 print "New ACL: $acl<br>\n";
338
339 $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'");
340 $sth->execute;
341 print "OK\n" if !$sth->err;
342
343 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
344
345} elsif ($webvar{action} eq 'newuser') {
346 print "Adding user $webvar{username}...\n";
347 my $cr_pass = ($webvar{preenc} ? $webvar{password} :
348 crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]));
349 $sth = $ip_dbh->prepare("insert into users (username,password,acl) values ".
350 "('$webvar{username}','$cr_pass','b')");
351 $sth->execute;
352 if ($sth->err) {
353 print "<br>Error adding user: ".$sth->errstr;
354 } else {
355 print "OK\n";
356 }
357
358 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
359
360} elsif ($webvar{action} eq 'deluser') {
361 print "Deleting user $webvar{username}.<br>\n";
362 $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'");
363 $sth->execute;
364 print "OK\n" if !$sth->err;
365
366 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
367
368} elsif ($webvar{action} ne '<NULL>') {
369 print "webvar{action} check failed: Don't know how to $webvar{action}";
370}
371
372# Hokay. This is a little different. We have a few specific functions here:
373# -> Assign arbitrary subnet from arbitrary free space
374# -> Tweak individual DB fields
375#
376
377
378printFooter;
379
380$ip_dbh->disconnect;
381
382exit;
383
384
385# Tweak allocfrom into shape.
386sub fix_allocfrom {
387 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
388 # 3-octet class C specified
389 $webvar{allocfrom} .= ".0/24";
390 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
391 # 4-octet IP specified;
392 $webvar{allocfrom} .= "/24";
393 }
394}
395
396
397# List free blocks in a /24 for arbitrary manual allocation
398sub showfree($) {
399 my $cidr = new NetAddr::IP $_[0];
400 print "Showing free blocks in $cidr<br>\n".
401 "<table border=1>\n";
402 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
403 $sth->execute;
404 while (my @data = $sth->fetchrow_array) {
405 my $temp = new NetAddr::IP $data[0];
406 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
407 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
408 "<td>".
409 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
410 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
411 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
412 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
413 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
414 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
415 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
416 "</td>".
417 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
418 "\n</form></tr>\n";
419 }
420 print "</table>\n";
421}
422
423
424# Show allocations to allow editing.
425sub showAllocs($) {
426 my $cidr = new NetAddr::IP $_[0];
427 print "Edit custID, allocation type, city for allocations in ".
428 "$cidr:\n<table border=1>";
429 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
430 $sth->execute;
431 while (my @data = $sth->fetchrow_array) {
432 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
433 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
434 qq(<td><input name=custid value="$data[1]"></td>\n).
435 "<td><select name=alloctype>";
436
437 my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes".
438 " where listorder < 500 and not (type like '_i') order by listorder");
439 $sth2->execute;
440 while (my @types = $sth2->fetchrow_array) {
441 print "<option". (($data[2] eq $types[0]) ? ' selected' : '') .
442 " value='$types[0]'>$types[1]</option>\n";
443 }
444 print "<option". (($data[2] eq 'in') ? ' selected' : '') .
445 " value='in'>Internal netblock</option>\n</select></td>\n";
446
447 print qq(<td><input name=city value="$data[3]"></td>\n).
448 "<td>$data[4]</td><td>$data[5]</td>".
449 qq(<td><input type=submit value="Update"></td></form></tr>\n);
450 }
451 print "</table>\n";
452
453 # notes
454 print "<hr><b>Notes:</b>\n".
455 "<ul>\n<li>Use the main interface to update description and notes fields\n".
456 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
457 "</ul>\n";
458}
459
460
461# Stuff updates into DB
462sub update {
463 eval {
464 # Relatively simple SQL transaction here. Note that we're deliberately NOT
465 # updating notes/desc here as it's available through the main interface.
466 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
467 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
468 $sth->execute;
469 $ip_dbh->commit;
470 };
471 if ($@) {
472 carp "Transaction aborted because $@";
473 eval { $ip_dbh->rollback; };
474 syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
475 } else {
476 # If we get here, the operation succeeded.
477 syslog "notice", "$authuser updated $webvar{block}";
478 print "Allocation $webvar{block} updated<hr>\n";
479 }
480 # need to get /24 that block is part of
481 my @bits = split /\./, $webvar{block};
482 $bits[3] = "0/24";
483 showAllocs((join ".", @bits));
484}
485
486
487# showPool()
488# List all IPs in a pool, and allow arbitrary admin changes to each
489# Allow changes to ALL fields
490sub showPool($) {
491 my $pool = new NetAddr::IP $_[0];
492 print qq(Listing pool $pool:\n<table border=1>
493<form action=admin.cgi method=POST>
494<input type=hidden name=action value=updatepool>
495<tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>
496<tr><td align=right>Customer location:</td><td><input name=city></td></tr>
497<tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n);
498
499 $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder");
500 $sth->execute;
501 while (my @data = $sth->fetchrow_array) {
502 print "<option value='$data[0]'>$data[1]</option>\n";
503 }
504
505 print qq(</select></td></tr>
506<tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr>
507<tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr>
508<tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr>
509<tr><td colspan=2 align=center><input type=submit value="Update"></td></tr>
510).
511 "</table>Update the following record:<table border=1>\n";
512 $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
513 $sth->execute;
514 while (my @data = $sth->fetchrow_array) {
515 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>).
516 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>".
517 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n";
518 }
519 print "</form></table>\n";
520}
Note: See TracBrowser for help on using the repository browser.