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

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

/branches/stable

Merge all changes from /trunk r141-144 and r146
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 10.8 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.
5###
6# SVN revision info
7# $Date: 2005-02-09 20:53:56 +0000 (Wed, 09 Feb 2005) $
8# SVN revision $Rev: 158 $
9# Last update by $Author: kdeugau $
10###
[158]11# Copyright (C) 2004,2005 - Kris Deugau
[54]12
13use strict;
14use warnings;
15use CGI::Carp qw(fatalsToBrowser);
16use DBI;
17use CommonWeb qw(:ALL);
18use IPDB qw(:ALL);
19#use POSIX qw(ceil);
20use NetAddr::IP;
21
22use Sys::Syslog;
23
24openlog "IPDB-admin","pid","local2";
25
26# Collect the username from HTTP auth. If undefined, we're in a test environment.
27my $authuser;
28if (!defined($ENV{'REMOTE_USER'})) {
29 $authuser = '__temptest';
30} else {
31 $authuser = $ENV{'REMOTE_USER'};
32}
33
34if ($authuser !~ /^(kdeugau|jodyh|__temptest)$/) {
35 print "Content-Type: text/html\n\n".
36 "<html><head><title>Access denied</title></head><body>\n".
37 'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
38 "for more information.</body></html>\n";
39 exit;
40}
41
42syslog "debug", "$authuser active";
43
44my %webvar = parse_post();
45cleanInput(\%webvar);
[58]46
47my %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
[54]68my $ip_dbh = connectDB;
69my $sth;
70
71print "Content-type: text/html\n\n".
[58]72 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n</head>\n<body>\n".
[54]73 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
74
75if(!defined($webvar{action})) {
76 $webvar{action} = "<NULL>"; #shuts up the warnings.
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><form action="admin.cgi" method="POST">
80<input type=hidden name=action value=alloc>
81Allocate block from this /24: <input name=allocfrom>
82<input type=submit value="List available free blocks">
83</form>
84<hr><form action="admin.cgi" method="POST">
85<input type=hidden name=action value=alloctweak>
86Manually update allocation data in this /24: <input name=allocfrom>
87<input type=submit value="Show allocations">
88);
89} else {
90 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
91}
92
93if ($webvar{action} eq 'alloc') {
94 fix_allocfrom();
95 showfree($webvar{allocfrom});
96} elsif ($webvar{action} eq 'alloctweak') {
97 fix_allocfrom();
98 showAllocs($webvar{allocfrom});
99} elsif ($webvar{action} eq 'update') {
100 update();
[58]101} elsif ($webvar{action} eq 'assign') {
102 # Display a list of possible blocks within the requested block.
103 open (HTML, "../admin_alloc.html")
104 or croak "Could not open admin_alloc.html :$!";
105 my $html = join('', <HTML>);
106 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
107 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
108
109 my $from = new NetAddr::IP $webvar{allocfrom};
110 my @blocklist = $from->split($webvar{masklen});
111 my $availblocks;
112 foreach (@blocklist) {
113 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
114 }
115 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
116
117 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";
[54]125}
126
127# Hokay. This is a little different. We have a few specific functions here:
128# -> Assign arbitrary subnet from arbitrary free space
129# -> Tweak individual DB fields
130#
131
132
133printFooter;
134
135$ip_dbh->disconnect;
136
137exit;
138
139
140# Tweak allocfrom into shape.
141sub fix_allocfrom {
142 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
143 # 3-octet class C specified
144 $webvar{allocfrom} .= ".0/24";
145 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
146 # 4-octet IP specified;
147 $webvar{allocfrom} .= "/24";
148 }
149}
150
151
[58]152# Do the gruntwork of allocating a block. This should really be in IPDB.pm.
153sub 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 block
161 } 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 $from
172 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 } # while
177
178# insert the data here. Woo.
179 # Begin SQL transaction block
180 eval {
181 # Delete old freeblocks entry
182 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$from'");
183 $sth->execute();
184
185 # Insert the new freeblocks entries
186 $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 entry
192 $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 eval
198 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 of
212 my @bits = split /\./, $webvar{block};
213 $bits[3] = "0/24";
214 showAllocs((join ".", @bits));
215}
216
217# List free blocks in a /24 for arbitrary manual allocation
218sub showfree($) {
219 my $cidr = new NetAddr::IP $_[0];
220 print "Showing free blocks in $cidr<br>\n".
221 "<table border=1>\n";
222 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
223 $sth->execute;
224 while (my @data = $sth->fetchrow_array) {
225 my $temp = new NetAddr::IP $data[0];
226 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
227 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
228 "<td>".
229 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
230 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
231 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
232 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
233 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
234 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
235 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
236 "</td>".
237 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
238 "\n</form></tr>\n";
239 }
240 print "</table>\n";
241}
242
243
[54]244# Show allocations to allow editing.
245sub showAllocs($) {
246 my $cidr = new NetAddr::IP $_[0];
247 print "Edit custID, allocation type, city for allocations in ".
248 "$cidr:\n<table border=1>";
249 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
250 $sth->execute;
251 while (my @data = $sth->fetchrow_array) {
252 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
253 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
254 qq(<td><input name=custid value="$data[1]"></td>\n);
255
256 print "<td><select name=alloctype><option".
257 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
258 (($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
259 (($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
260 (($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
261 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
262 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
263 (($data[2] eq 'sp') ? ' selected' : '') ." value='sp'>Static Pool - Server pool</option>\n<option".
264 (($data[2] eq 'cp') ? ' selected' : '') ." value='cp'>Static Pool - Cable</option>\n<option".
265 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
266 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
267 (($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".
273 "</select></td>\n";
274 print qq(<td><input name=city value="$data[3]"></td>\n).
275 "<td>$data[4]</td><td>$data[5]</td>".
276 qq(<td><input type=submit value="Update"></td></form></tr>\n);
277 }
278 print "</table>\n";
279
280 # notes
281 print "<hr><b>Notes:</b>\n".
282 "<ul>\n<li>Use the main interface to update description and notes fields\n".
283 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
284 "</ul>\n";
285}
286
287
288# Stuff updates into DB
289sub update {
290 eval {
291 # Relatively simple SQL transaction here. Note that we're deliberately NOT
292 # updating notes/desc here as it's available through the main interface.
293 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
294 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
295 $sth->execute;
296 $ip_dbh->commit;
297 };
298 if ($@) {
299 carp "Transaction aborted because $@";
300 eval { $ip_dbh->rollback; };
301 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
302 } else {
303 # If we get here, the operation succeeded.
304 syslog "notice", "$authuser updated $webvar{block}";
305 print "Allocation $webvar{block} updated<hr>\n";
306 }
307 # need to get /24 that block is part of
308 my @bits = split /\./, $webvar{block};
309 $bits[3] = "0/24";
310 showAllocs((join ".", @bits));
311}
Note: See TracBrowser for help on using the repository browser.