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

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

/branches/stable

Add admin interface script to stable tree from /trunk r58
  • Property svn:executable set to *
File size: 10.7 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$
8# SVN revision $Rev$
9# Last update by $Author$
10###
11
12use strict;
13use warnings;
14use CGI::Carp qw(fatalsToBrowser);
15use DBI;
16use CommonWeb qw(:ALL);
17use IPDB qw(:ALL);
18#use POSIX qw(ceil);
19use NetAddr::IP;
20
21use Sys::Syslog;
22
23openlog "IPDB-admin","pid","local2";
24
25# Collect the username from HTTP auth. If undefined, we're in a test environment.
26my $authuser;
27if (!defined($ENV{'REMOTE_USER'})) {
28 $authuser = '__temptest';
29} else {
30 $authuser = $ENV{'REMOTE_USER'};
31}
32
33if ($authuser !~ /^(kdeugau|jodyh|__temptest)$/) {
34 print "Content-Type: text/html\n\n".
35 "<html><head><title>Access denied</title></head><body>\n".
36 'Access to this tool is restricted. Contact <a href="mailto:kdeugau@vianet.ca">Kris</a> '.
37 "for more information.</body></html>\n";
38 exit;
39}
40
41syslog "debug", "$authuser active";
42
43my %webvar = parse_post();
44cleanInput(\%webvar);
[58]45
46my %full_alloc_types = (
47 "ci","Cable pool IP",
48 "di","DSL pool IP",
49 "si","Server pool IP",
50 "mi","Static dialup IP",
51 "wi","Static wireless IP",
52 "cp","Cable pool",
53 "dp","DSL pool",
54 "sp","Server pool",
55 "mp","Static dialup pool",
56 "wp","Static wireless pool",
57 "dn","Dialup netblock",
58 "dy","Dynamic DSL netblock",
59 "dc","Dynamic cable netblock",
60 "cn","Customer netblock",
61 "ee","End-use netblock",
62 "rr","Routed netblock",
63 "ii","Internal netblock",
64 "mm","Master block"
65);
66
[54]67my $ip_dbh = connectDB;
68my $sth;
69
70print "Content-type: text/html\n\n".
[58]71 "<html>\n<head>\n\t<title>TEST [IPDB admin tools] TEST</title>\n</head>\n<body>\n".
[54]72 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
73
74if(!defined($webvar{action})) {
75 $webvar{action} = "<NULL>"; #shuts up the warnings.
76 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the
77main interface if at all possible.
78<hr><form action="admin.cgi" method="POST">
79<input type=hidden name=action value=alloc>
80Allocate block from this /24: <input name=allocfrom>
81<input type=submit value="List available free blocks">
82</form>
83<hr><form action="admin.cgi" method="POST">
84<input type=hidden name=action value=alloctweak>
85Manually update allocation data in this /24: <input name=allocfrom>
86<input type=submit value="Show allocations">
87);
88} else {
89 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>';
90}
91
92if ($webvar{action} eq 'alloc') {
93 fix_allocfrom();
94 showfree($webvar{allocfrom});
95} elsif ($webvar{action} eq 'alloctweak') {
96 fix_allocfrom();
97 showAllocs($webvar{allocfrom});
98} elsif ($webvar{action} eq 'update') {
99 update();
[58]100} elsif ($webvar{action} eq 'assign') {
101 # Display a list of possible blocks within the requested block.
102 open (HTML, "../admin_alloc.html")
103 or croak "Could not open admin_alloc.html :$!";
104 my $html = join('', <HTML>);
105 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
106 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
107
108 my $from = new NetAddr::IP $webvar{allocfrom};
109 my @blocklist = $from->split($webvar{masklen});
110 my $availblocks;
111 foreach (@blocklist) {
112 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
113 }
114 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
115
116 print $html;
117} elsif ($webvar{action} eq 'confirm') {
118 print "Assigning $webvar{block} to $webvar{custid} (\"$webvar{desc}\")...\n";
119 allocBlock($ip_dbh, $webvar{allocfrom}, $webvar{block}, $webvar{alloctype},
120 $webvar{custid}, $webvar{city}, $webvar{desc}, $webvar{notes});
121 #my ($dbh,from,block,$type,$custid,$city,$desc,$notes) = @_;
122} else {
123 print "webvar{action} check failed";
[54]124}
125
126# Hokay. This is a little different. We have a few specific functions here:
127# -> Assign arbitrary subnet from arbitrary free space
128# -> Tweak individual DB fields
129#
130
131
132printFooter;
133
134$ip_dbh->disconnect;
135
136exit;
137
138
139# Tweak allocfrom into shape.
140sub fix_allocfrom {
141 if ($webvar{allocfrom} =~ /^(\d+\.){2}\d+$/) {
142 # 3-octet class C specified
143 $webvar{allocfrom} .= ".0/24";
144 } elsif ($webvar{allocfrom} =~ /^(\d+\.){3}\d+$/) {
145 # 4-octet IP specified;
146 $webvar{allocfrom} .= "/24";
147 }
148}
149
150
[58]151# Do the gruntwork of allocating a block. This should really be in IPDB.pm.
152sub allocBlock($$$$$$$$) {
153 my ($dbh,undef,undef,$type,$custid,$city,$desc,$notes) = @_;
154 my $from = new NetAddr::IP $_[1];
155 my $block = new NetAddr::IP $_[2];
156
157 # First, figure out what free blocks will get mangled.
158 if ($from eq $block) {
159 # Whee! Easy. Just allocate the block
160 } else {
161 # The complex case. An allocation from a larger block.
162
163 # Gotta snag the free blocks left over.
164 my $wantmaskbits = $block->masklen;
165 my $maskbits = $from->masklen;
166
167 my @newfreeblocks; # Holds free blocks generated from splitting the source freeblock.
168
169 my $i=0;
170 my $tmp_from = $from; # So we don't munge $from
171 while ($maskbits++ < $wantmaskbits) {
172 my @subblocks = $tmp_from->split($maskbits);
173 $newfreeblocks[$i++] = (($block->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
174 $tmp_from = ( ($block->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
175 } # while
176
177# insert the data here. Woo.
178 # Begin SQL transaction block
179 eval {
180 # Delete old freeblocks entry
181 $sth = $ip_dbh->prepare("delete from freeblocks where cidr='$from'");
182 $sth->execute();
183
184 # Insert the new freeblocks entries
185 $sth = $ip_dbh->prepare("insert into freeblocks values (?, ?, ".
186 "(select city from routed where cidr >>= '$block'),'y')");
187 foreach my $block (@newfreeblocks) {
188 $sth->execute("$block", $block->masklen);
189 }
190 # Insert the allocations entry
191 $sth = $ip_dbh->prepare("insert into allocations values ('$block',".
192 "'$custid','$type','$city','$desc','$notes',".$block->masklen.")");
193 $sth->execute;
194
195 $ip_dbh->commit;
196 }; # end eval
197 if ($@) {
198 carp "Transaction aborted because $@";
199 eval { $ip_dbh->rollback; };
200 syslog "err", "Allocation of '$block' to '$custid' as ".
201 "'$type' by $authuser failed: '$@'";
202 print "Allocation of $block as $full_alloc_types{$type} failed.\n";
203 } else {
204 syslog "notice", "$authuser allocated '$block' to '$custid'".
205 " as '$type'";
206 print "OK!<br>\n";
207 }
208
209 }
210 # need to get /24 that block is part of
211 my @bits = split /\./, $webvar{block};
212 $bits[3] = "0/24";
213 showAllocs((join ".", @bits));
214}
215
216# List free blocks in a /24 for arbitrary manual allocation
217sub showfree($) {
218 my $cidr = new NetAddr::IP $_[0];
219 print "Showing free blocks in $cidr<br>\n".
220 "<table border=1>\n";
221 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
222 $sth->execute;
223 while (my @data = $sth->fetchrow_array) {
224 my $temp = new NetAddr::IP $data[0];
225 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
226 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
227 "<td>".
228 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
229 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
230 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
231 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
232 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
233 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
234 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
235 "</td>".
236 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
237 "\n</form></tr>\n";
238 }
239 print "</table>\n";
240}
241
242
[54]243# Show allocations to allow editing.
244sub showAllocs($) {
245 my $cidr = new NetAddr::IP $_[0];
246 print "Edit custID, allocation type, city for allocations in ".
247 "$cidr:\n<table border=1>";
248 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
249 $sth->execute;
250 while (my @data = $sth->fetchrow_array) {
251 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
252 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
253 qq(<td><input name=custid value="$data[1]"></td>\n);
254
255 print "<td><select name=alloctype><option".
256 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
257 (($data[2] eq 'si') ? ' selected' : '') ." value='si'>Static IP - Server pool</option>\n<option".
258 (($data[2] eq 'ci') ? ' selected' : '') ." value='ci'>Static IP - Cable</option>\n<option".
259 (($data[2] eq 'di') ? ' selected' : '') ." value='di'>Static IP - DSL</option>\n<option".
260 (($data[2] eq 'mi') ? ' selected' : '') ." value='mi'>Static IP - Dialup</option>\n<option".
261 (($data[2] eq 'wi') ? ' selected' : '') ." value='wi'>Static IP - Wireless</option>\n<option".
262 (($data[2] eq 'sp') ? ' selected' : '') ." value='sp'>Static Pool - Server pool</option>\n<option".
263 (($data[2] eq 'cp') ? ' selected' : '') ." value='cp'>Static Pool - Cable</option>\n<option".
264 (($data[2] eq 'dp') ? ' selected' : '') ." value='dp'>Static Pool - DSL</option>\n<option".
265 (($data[2] eq 'mp') ? ' selected' : '') ." value='mp'>Static Pool - Dialup</option>\n<option".
266 (($data[2] eq 'wp') ? ' selected' : '') ." value='wp'>Static Pool - Wireless</option>\n<option".
267 (($data[2] eq 'ee') ? ' selected' : '') ." value='ee'>End-use netblock</option>\n<option".
268 (($data[2] eq 'dn') ? ' selected' : '') ." value='dn'>Dialup netblock</option>\n<option".
269 (($data[2] eq 'dy') ? ' selected' : '') ." value='dy'>Dynamic DSL netblock</option>\n<option".
270 (($data[2] eq 'dc') ? ' selected' : '') ." value='dc'>Dynamic cable netblock</option>\n<option".
271 (($data[2] eq 'ii') ? ' selected' : '') ." value='ii'>Internal netblock</option>\n".
272 "</select></td>\n";
273 print qq(<td><input name=city value="$data[3]"></td>\n).
274 "<td>$data[4]</td><td>$data[5]</td>".
275 qq(<td><input type=submit value="Update"></td></form></tr>\n);
276 }
277 print "</table>\n";
278
279 # notes
280 print "<hr><b>Notes:</b>\n".
281 "<ul>\n<li>Use the main interface to update description and notes fields\n".
282 "<li>Changing the allocation type here will NOT affect IP pool data.\n".
283 "</ul>\n";
284}
285
286
287# Stuff updates into DB
288sub update {
289 eval {
290 # Relatively simple SQL transaction here. Note that we're deliberately NOT
291 # updating notes/desc here as it's available through the main interface.
292 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
293 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
294 $sth->execute;
295 $ip_dbh->commit;
296 };
297 if ($@) {
298 carp "Transaction aborted because $@";
299 eval { $ip_dbh->rollback; };
300 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$@'";
301 } else {
302 # If we get here, the operation succeeded.
303 syslog "notice", "$authuser updated $webvar{block}";
304 print "Allocation $webvar{block} updated<hr>\n";
305 }
306 # need to get /24 that block is part of
307 my @bits = split /\./, $webvar{block};
308 $bits[3] = "0/24";
309 showAllocs((join ".", @bits));
310}
Note: See TracBrowser for help on using the repository browser.