source: branches/htmlform/cgi-bin/main.cgi@ 493

Last change on this file since 493 was 493, checked in by Kris Deugau, 14 years ago

/branches/htmlform

Convert dangling direct error print to template parameter (can't load node list for
search). See #3.
Remove dangling obsolete commented code fragments and subs (printRow and startTable).
See #3, #26.
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 39.3 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3###
4# SVN revision info
5# $Date: 2010-09-24 00:58:52 +0000 (Fri, 24 Sep 2010) $
6# SVN revision $Rev: 493 $
7# Last update by $Author: kdeugau $
8###
9# Copyright (C) 2004-2010 - Kris Deugau
10
11use strict;
12use warnings;
13use CGI::Carp qw(fatalsToBrowser);
14use CGI::Simple;
15use HTML::Template;
16use DBI;
17use CommonWeb qw(:ALL);
18use CustIDCK;
19use POSIX qw(ceil);
20use NetAddr::IP;
21
22use Sys::Syslog;
23
24# don't remove! required for GNU/FHS-ish install from tarball
25##uselib##
26
27use MyIPDB;
28
29openlog "IPDB","pid","$IPDB::syslog_facility";
30
31## Environment. Collect some things, process some things, set some things...
32
33# Collect the username from HTTP auth. If undefined, we're in
34# a test environment, or called without a username.
35my $authuser;
36if (!defined($ENV{'REMOTE_USER'})) {
37 $authuser = '__temptest';
38} else {
39 $authuser = $ENV{'REMOTE_USER'};
40}
41
42# anyone got a better name? :P
43my $thingroot = $ENV{SCRIPT_FILENAME};
44$thingroot =~ s|cgi-bin/main.cgi||;
45
46syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
47
48##fixme there *must* be a better order to do things in so this can go back where it was
49# CGI fiddling done here so we can declare %webvar so we can alter $webvar{action}
50# to show the right page on DB errors.
51# Set up the CGI object...
52my $q = new CGI::Simple;
53# ... and get query-string params as well as POST params if necessary
54$q->parse_query_string;
55
56# Convenience; saves changing all references to %webvar
57##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection)
58my %webvar = $q->Vars;
59
60# Why not a global DB handle? (And a global statement handle, as well...)
61# Use the connectDB function, otherwise we end up confusing ourselves
62my $ip_dbh;
63my $sth;
64my $errstr;
65($ip_dbh,$errstr) = connectDB_My;
66if (!$ip_dbh) {
67 $webvar{action} = "dberr";
68} else {
69 initIPDBGlobals($ip_dbh);
70}
71
72# Set up some globals
73$ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
74
75my $header = HTML::Template->new(filename => "header.tmpl");
76my $footer = HTML::Template->new(filename => "footer.tmpl");
77
78$header->param(version => $IPDB::VERSION);
79$header->param(addperm => $IPDBacl{$authuser} =~ /a/);
80print "Content-type: text/html\n\n", $header->output;
81
82
83#main()
84
85if(!defined($webvar{action})) {
86 $webvar{action} = "index"; #shuts up the warnings.
87}
88
89my $page = HTML::Template->new(filename => "$webvar{action}.tmpl");
90
91if($webvar{action} eq 'index') {
92 showSummary();
93} elsif ($webvar{action} eq 'addmaster') {
94 if ($IPDBacl{$authuser} !~ /a/) {
95 printError("You shouldn't have been able to get here. Access denied.");
96 }
97} elsif ($webvar{action} eq 'newmaster') {
98
99 if ($IPDBacl{$authuser} !~ /a/) {
100 printError("You shouldn't have been able to get here. Access denied.");
101 } else {
102 my $cidr = new NetAddr::IP $webvar{cidr};
103 $page->param(cidr => "$cidr");
104
105 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr});
106
107 if ($code eq 'FAIL') {
108 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
109 $page->param(err => $msg);
110 } else {
111 syslog "info", "$authuser added master block $webvar{cidr}";
112 }
113
114 } # ACL check
115
116} # end add new master
117
118elsif($webvar{action} eq 'showmaster') {
119 showMaster();
120}
121elsif($webvar{action} eq 'showrouted') {
122 showRBlock();
123}
124elsif($webvar{action} eq 'listpool') {
125 listPool();
126}
127
128# Not modified or added; just shuffled
129elsif($webvar{action} eq 'assign') {
130 assignBlock();
131}
132elsif($webvar{action} eq 'confirm') {
133 confirmAssign();
134}
135elsif($webvar{action} eq 'insert') {
136 insertAssign();
137}
138elsif($webvar{action} eq 'edit') {
139 edit();
140}
141elsif($webvar{action} eq 'update') {
142 update();
143}
144elsif($webvar{action} eq 'delete') {
145 remove();
146}
147elsif($webvar{action} eq 'finaldelete') {
148 finalDelete();
149}
150elsif ($webvar{action} eq 'nodesearch') {
151 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
152 $sth->execute() or $page->param(errmsg => $sth->errstr);
153 my @nodelist;
154 while (my ($nid,$nname) = $sth->fetchrow_array()) {
155 my %row = (nodeid => $nid, nodename => $nname);
156 push @nodelist, \%row;
157 }
158 $page->param(nodelist => \@nodelist);
159}
160
161# DB failure. Can't do much here, really.
162elsif ($webvar{action} eq 'dberr') {
163 $page->param(errmsg => $errstr);
164}
165
166# Default is an error. It shouldn't be possible to easily get here.
167# The only way I can think of offhand is to just call main.cgi bare-
168# which is not in any way guaranteed to provide anything useful.
169else {
170 my $rnd = rand 500;
171 my $boing = sprintf("%.2f", rand 500);
172 my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.",
173 "Because one of it's legs are both the same", "*wibble*",
174 "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
175 "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
176 printAndExit("Error $boing: ".$excuses[$rnd/30.0]);
177}
178## Finally! Done with that NASTY "case" emulation!
179
180
181
182# Clean up IPDB globals, DB handle, etc.
183finish($ip_dbh);
184
185## Do all our printing here so we can generate errors and stick them into the slots in the templates.
186
187# can't do this yet, too many blowups
188#print "Content-type: text/html\n\n", $header->output;
189
190print $page->output;
191
192# include the admin tools link in the output?
193$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
194
195print $footer->output;
196
197# Just in case something waaaayyy down isn't in place
198# properly... we exit explicitly.
199exit 0;
200
201
202# Initial display: Show master blocks with total allocated subnets, total free subnets
203sub showSummary {
204 my %allocated;
205 my %free;
206 my %routed;
207 my %bigfree;
208
209 # Count the allocations.
210 $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
211 foreach my $master (@masterblocks) {
212 $sth->execute("$master");
213 $sth->bind_columns(\$allocated{"$master"});
214 $sth->fetch();
215 }
216
217 # Count routed blocks
218 $sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
219 foreach my $master (@masterblocks) {
220 $sth->execute("$master");
221 $sth->bind_columns(\$routed{"$master"});
222 $sth->fetch();
223 }
224
225 # Count the free blocks.
226 $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
227 "(routed='y' or routed='n')");
228 foreach my $master (@masterblocks) {
229 $sth->execute("$master");
230 $sth->bind_columns(\$free{"$master"});
231 $sth->fetch();
232 }
233
234 # Find the largest free block in each master
235 $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
236 "(routed='y' or routed='n') order by maskbits limit 1");
237 foreach my $master (@masterblocks) {
238 $sth->execute("$master");
239 $sth->bind_columns(\$bigfree{"$master"});
240 $sth->fetch();
241 }
242
243 # Assemble the data to stuff into the template.
244 my @masterlist;
245 my $rowclass=0;
246 foreach my $master (@masterblocks) {
247 my %row = (
248 rowclass => $rowclass++ % 2,
249 master => "$master",
250 routed => $routed{"$master"},
251 allocated => $allocated{"$master"},
252 free => $free{"$master"},
253 bigfree => ( ($bigfree{"$master"} eq '') ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
254 );
255 push (@masterlist, \%row);
256 }
257 $page->param(masterlist => \@masterlist);
258
259 $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
260
261} # showSummary
262
263
264# Display detail on master
265# Alrighty then! We're showing routed blocks within a single master this time.
266# We should be able to steal code from showSummary(), and if I'm really smart
267# I'll figger a way to munge the two together. (Once I've done that, everything
268# else should follow. YMMV.)
269sub showMaster {
270
271 $page->param(master => $webvar{block});
272
273 my %allocated;
274 my %free;
275 my %cities;
276 my %bigfree;
277
278 my $master = new NetAddr::IP $webvar{block};
279 my @localmasters;
280
281 # Fetch only the blocks relevant to this master
282 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr <<= '$master' order by cidr");
283 $sth->execute();
284
285 my $i=0;
286 while (my @data = $sth->fetchrow_array()) {
287 my $cidr = new NetAddr::IP $data[0];
288 $localmasters[$i++] = $cidr;
289 $free{"$cidr"} = 0;
290 $allocated{"$cidr"} = 0;
291 $bigfree{"$cidr"} = 128;
292 # Retain the routing destination
293 $cities{"$cidr"} = $data[1];
294 }
295
296 # Check if there were actually any blocks routed from this master
297 if ($i > 0) {
298
299 # Count the allocations
300 $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
301 foreach my $master (@localmasters) {
302 $sth->execute("$master");
303 $sth->bind_columns(\$allocated{"$master"});
304 $sth->fetch();
305 }
306
307 # Count the free blocks.
308 $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
309 "(routed='y' or routed='n')");
310 foreach my $master (@localmasters) {
311 $sth->execute("$master");
312 $sth->bind_columns(\$free{"$master"});
313 $sth->fetch();
314 }
315
316 # Get the size of the largest free block
317 $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
318 "(routed='y' or routed='n') order by maskbits limit 1");
319 foreach my $master (@localmasters) {
320 $sth->execute("$master");
321 $sth->bind_columns(\$bigfree{"$master"});
322 $sth->fetch();
323 }
324
325 my @routed;
326 my $rowclass = 0;
327 foreach my $master (@localmasters) {
328 my %row = (
329 rowclass => $rowclass++ % 2,
330 block => "$master",
331 city => $cities{"$master"},
332 nsubs => $allocated{"$master"},
333 nfree => $free{"$master"},
334 lfree => ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
335 );
336 push @routed, \%row;
337 }
338 $page->param(routedlist => \@routed);
339
340 } # end check for existence of routed blocks in master
341
342 $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/));
343
344 # Snag the free blocks.
345 my $count = 0;
346 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
347 "routed='n' order by cidr");
348 $sth->execute();
349 my @unrouted;
350 my $rowclass = 0;
351 while (my @data = $sth->fetchrow_array()) {
352 my $cidr = new NetAddr::IP $data[0];
353 my %row = (
354 rowclass => $rowclass++ % 2,
355 fblock => "$cidr",
356 frange => $cidr->range
357 );
358 push @unrouted, \%row;
359 }
360 $page->param(unrouted => \@unrouted);
361
362} # showMaster
363
364
365# Display details of a routed block
366# Alrighty then! We're showing allocations within a routed block this time.
367# We should be able to steal code from showSummary() and showMaster(), and if
368# I'm really smart I'll figger a way to munge all three together. (Once I've
369# done that, everything else should follow. YMMV.
370# This time, we check the database before spewing, because we may
371# not have anything useful to spew.
372sub showRBlock {
373
374 my $master = new NetAddr::IP $webvar{block};
375
376 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
377 $sth->execute;
378 my ($rcity) = $sth->fetchrow_array;
379
380 $page->param(master => "$master");
381 $page->param(rcity => $rcity);
382
383 # Snag the allocations for this block
384 $sth = $ip_dbh->prepare("select cidr,city,type,custid,swip,description".
385 " from allocations where cidr <<= '$master' order by cidr");
386 $sth->execute();
387
388 # hack hack hack
389 # set up to flag swip=y records if they don't actually have supporting data in the customers table
390 my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
391
392 my $rowclass = 0;
393 my @blocklist;
394 while (my ($cidr,$city,$type,$custid,$swip,$desc) = $sth->fetchrow_array()) {
395 $custsth->execute($custid);
396 my ($ncust) = $custsth->fetchrow_array();
397
398 my %row = (
399 rowclass => $rowclass++ % 2,
400 block => $cidr,
401 city => $city,
402 type => $disp_alloctypes{$type},
403 custid => $custid,
404 swip => ($swip eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'),
405 desc => $desc
406 );
407 $row{subblock} = ($type =~ /^.r$/); # hmf. wonder why these won't work in the hash declaration...
408 $row{listpool} = ($type =~ /^.[pd]$/);
409 push (@blocklist, \%row);
410 }
411 $page->param(blocklist => \@blocklist);
412
413 $page->param(delrouted => $IPDBacl{$authuser} =~ /d/);
414
415 # Snag the free blocks. We don't really *need* to be pedantic about avoiding
416 # unrouted free blocks, but it's better to let the database do the work if we can.
417 $rowclass = 0;
418 my @unassigned;
419 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
420 " order by cidr");
421 $sth->execute();
422 while (my ($cidr_db,$routed) = $sth->fetchrow_array()) {
423 my $cidr = new NetAddr::IP $cidr_db;
424
425 my %row = (
426 rowclass => $rowclass++ % 2,
427 subblock => ($routed ne 'y' && $routed ne 'n'),
428 fblock => $cidr_db,
429 fbtype => $routed,
430 frange => $cidr->range,
431 );
432 push @unassigned, \%row;
433 }
434 $page->param(unassigned => \@unassigned);
435
436} # showRBlock
437
438
439# List the IPs used in a pool
440sub listPool {
441
442 my $cidr = new NetAddr::IP $webvar{pool};
443
444 $page->param(block => $webvar{pool});
445 $page->param(netip => $cidr->addr);
446 $cidr++;
447 $page->param(gate => $cidr->addr);
448 $cidr--; $cidr--;
449 $page->param(bcast => $cidr->addr);
450 $page->param(mask => $cidr->mask);
451
452 # Snag pool info for heading
453 $sth = $ip_dbh->prepare("select type,city from allocations where cidr=?");
454 $sth->execute($webvar{pool});
455 my ($pooltype, $poolcity) = $sth->fetchrow_array;
456
457 $page->param(disptype => $disp_alloctypes{$pooltype});
458 $page->param(city => $poolcity);
459
460 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
461 $page->param(realblock => $pooltype =~ /^.d$/);
462
463# probably have to add an "edit IP allocation" link here somewhere.
464
465 $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
466 " from poolips where pool='$webvar{pool}' order by ip");
467 $sth->execute;
468 my @poolips;
469 my $rowclass = 0;
470 while (my ($ip,$custid,$available,$desc,$type) = $sth->fetchrow_array) {
471 my %row = (
472 rowclass => $rowclass++ % 2,
473 ip => $ip,
474 custid => $custid,
475 available => $available,
476 desc => $desc,
477 maydel => $IPDBacl{$authuser} =~ /d/,
478 delme => $available eq 'n'
479 );
480 push @poolips, \%row;
481 }
482 $page->param(poolips => \@poolips);
483
484} # end listPool
485
486
487# Show "Add new allocation" page. Note that the actual page may
488# be one of two templates, and the lists come from the database.
489sub assignBlock {
490
491 if ($IPDBacl{$authuser} !~ /a/) {
492 printError("You shouldn't have been able to get here. Access denied.");
493 return;
494 }
495
496 # hack pthbttt eww
497 $webvar{block} = '' if !$webvar{block};
498
499# hmm. TMPL_IF block and TMPL_ELSE block on these instead?
500 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
501 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
502 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign
503 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y'));
504
505 # New special case- block to assign is specified
506 if ($webvar{block} ne '') {
507 my $block = new NetAddr::IP $webvar{block};
508
509 # Handle contained freeblock allocation.
510 # This is a little dangerous, as it's *theoretically* possible to
511 # get fbtype='n' (aka a non-routed freeblock). However, should
512 # someone manage to get there, they get what they deserve.
513 if ($webvar{fbtype} ne 'y') {
514 # Snag the type of the container block from the database.
515 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
516 $sth->execute;
517 my @data = $sth->fetchrow_array;
518 $data[0] =~ s/c$/r/; # Munge the type into the correct form
519 $page->param(fbdisptype => $list_alloctypes{$data[0]});
520 $page->param(type => $data[0]);
521 } else {
522 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
523 "and type not like '_i' and type not like '_r' order by listorder");
524 $sth->execute;
525 my @typelist;
526 my $selflag = 0;
527 while (my @data = $sth->fetchrow_array) {
528 my %row = (tval => $data[0],
529 type => $data[1],
530 sel => ($selflag == 0 ? ' selected' : '')
531 );
532 push (@typelist, \%row);
533 $selflag++;
534 }
535 $page->param(typelist => \@typelist);
536 }
537 } else {
538 my @masterlist;
539 foreach my $master (@masterblocks) {
540 my %row = (master => "$master");
541 push (@masterlist, \%row);
542 }
543 $page->param(masterlist => \@masterlist);
544
545 my @pops;
546 foreach my $pop (@poplist) {
547 my %row = (pop => $pop);
548 push (@pops, \%row);
549 }
550 $page->param(pops => \@pops);
551
552 # could arguably include routing (500) in the list, but ATM it doesn't
553 # make sense, and in any case that shouldn't be structurally possible here.
554 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder");
555 $sth->execute;
556 my @typelist;
557 my $selflag = 0;
558 while (my @data = $sth->fetchrow_array) {
559 my %row = (tval => $data[0],
560 type => $data[1],
561 sel => ($selflag == 0 ? ' selected' : '')
562 );
563 push (@typelist, \%row);
564 $selflag++;
565 }
566 $page->param(typelist => \@typelist);
567 }
568
569 my @cities;
570 foreach my $city (@citylist) {
571 my %row = (city => $city);
572 push (@cities, \%row);
573 }
574 $page->param(citylist => \@cities);
575
576## node hack
577 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
578 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
579 my @nodes;
580 while (my ($nid,$nname) = $sth->fetchrow_array()) {
581 my %row = (nid => $nid, nname => $nname);
582 push (@nodes, \%row);
583 }
584 $page->param(nodelist => \@nodes);
585## end node hack
586
587 $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
588
589} # assignBlock
590
591
592# Take info on requested IP assignment and see what we can provide.
593sub confirmAssign {
594 if ($IPDBacl{$authuser} !~ /a/) {
595 printError("You shouldn't have been able to get here. Access denied.");
596 return;
597 }
598
599 my $cidr;
600 my $alloc_from;
601
602 # Going to manually validate some items.
603 # custid and city are automagic.
604 return if !validateInput();
605
606# Several different cases here.
607# Static IP vs netblock
608# + Different flavours of static IP
609# + Different flavours of netblock
610
611 if ($webvar{alloctype} =~ /^.i$/) {
612 my ($base,undef) = split //, $webvar{alloctype}; # split into individual chars
613
614# Ewww. But it works.
615 $sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
616 "poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
617 "poolips.pool=allocations.cidr AND allocations.city='$webvar{pop}' AND poolips.type LIKE '".$base."_' ".
618 "GROUP BY pool");
619 $sth->execute;
620 my $optionlist;
621
622 my @poollist;
623 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) {
624 # city,pool cidr,free IP count
625 if ($poolfree > 0) {
626 my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree);
627 push (@poollist, \%row);
628 }
629 }
630 $page->param(staticip => 1);
631 $page->param(poollist => \@poollist);
632 $cidr = "Single static IP";
633##fixme: need to handle "no available pools"
634
635 } else { # end show pool options
636
637 if ($webvar{fbassign} eq 'y') {
638 $cidr = new NetAddr::IP $webvar{block};
639 $webvar{maskbits} = $cidr->masklen;
640 } else { # done with direct freeblocks assignment
641
642 if (!$webvar{maskbits}) {
643 $page->param(err => "Please specify a CIDR mask length.");
644 return;
645 }
646 my $sql;
647 my $city;
648 my $failmsg;
649 my $extracond = '';
650 if ($webvar{allocfrom} eq '-') {
651 $extracond = ($webvar{allowpriv} eq 'on' ? '' :
652 " and not (cidr <<= '192.168.0.0/16'".
653 " or cidr <<= '10.0.0.0/8'".
654 " or cidr <<= '172.16.0.0/12')");
655 }
656 my $sortorder;
657 if ($webvar{alloctype} eq 'rm') {
658 if ($webvar{allocfrom} ne '-') {
659 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
660 " and cidr <<= '$webvar{allocfrom}'";
661 $sortorder = "maskbits desc";
662 } else {
663 $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
664 $sortorder = "maskbits desc";
665 }
666 $failmsg = "No suitable free block found.<br>\nWe do not have a free".
667 " routeable block of that size.<br>\nYou will have to either route".
668 " a set of smaller netblocks or a single smaller netblock.";
669 } else {
670##fixme
671# This section needs serious Pondering.
672 # Pools of most types get assigned to the POP they're "routed from"
673 # This includes WAN blocks and other netblock "containers"
674 # This does NOT include cable pools.
675 if ($webvar{alloctype} =~ /^.[pc]$/) {
676 $city = $webvar{city};
677 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
678 " superblock from one of the<br>\nmaster blocks or chose a smaller".
679 " block size for the pool.";
680 } else {
681 $city = $webvar{pop};
682 $failmsg = "No suitable free block found.<br>\nYou will have to route another".
683 " superblock to $webvar{pop}<br>\nfrom one of the master blocks or".
684 " chose a smaller blocksize.";
685 }
686 if (defined $webvar{allocfrom} && $webvar{allocfrom} ne '-') {
687 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
688 " and cidr <<= '$webvar{allocfrom}' and routed='".
689 (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
690 $sortorder = "maskbits desc,cidr";
691 } else {
692 $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
693 " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
694 $sortorder = "maskbits desc,cidr";
695 }
696 }
697 $sql = $sql.$extracond." order by ".$sortorder;
698 $sth = $ip_dbh->prepare($sql);
699 $sth->execute;
700 my @data = $sth->fetchrow_array();
701 if ($data[0] eq "") {
702 $page->param(err => $failmsg);
703 return;
704 }
705 $cidr = new NetAddr::IP $data[0];
706 } # check for freeblocks assignment or IPDB-controlled assignment
707
708 $alloc_from = "$cidr";
709
710 # If the block to be allocated is smaller than the one we found,
711 # figure out the "real" block to be allocated.
712 if ($cidr->masklen() ne $webvar{maskbits}) {
713 my $maskbits = $cidr->masklen();
714 my @subblocks;
715 while ($maskbits++ < $webvar{maskbits}) {
716 @subblocks = $cidr->split($maskbits);
717 }
718 $cidr = $subblocks[0];
719 }
720 } # if ($webvar{alloctype} =~ /^.i$/)
721
722## node hack
723 if ($webvar{node} && $webvar{node} ne '-') {
724 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
725 $sth->execute($webvar{node});
726 my ($nodename) = $sth->fetchrow_array();
727 $page->param(nodename => $nodename);
728 $page->param(nodeid => $webvar{node});
729 }
730## end node hack
731
732 # Stick in the allocation data
733 $page->param(alloc_type => $webvar{alloctype});
734 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
735 $page->param(alloc_from => $alloc_from);
736 $page->param(cidr => $cidr);
737 $page->param(city => $q->escapeHTML($webvar{city}));
738 $page->param(custid => $webvar{custid});
739 $page->param(circid => $q->escapeHTML($webvar{circid}));
740 $page->param(desc => $q->escapeHTML($webvar{desc}));
741
742##fixme: find a way to have the displayed copy have <br> substitutions
743# for newlines, and the <input> value have either encoded or bare newlines.
744# Also applies to privdata.
745 $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
746
747 # Check to see if user is allowed to do anything with sensitive data
748 my $privdata = '';
749 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
750 if $IPDBacl{$authuser} =~ /s/;
751
752 # Yay! This now has it's very own little home.
753 $page->param(billinguser => $webvar{userid})
754 if $webvar{userid};
755
756##fixme: this is only needed iff confirm.tmpl/confirm.html and
757# confirmRemove.html/confirmRemove.tmpl are merged (quite possible, just
758# a little tedious)
759 $page->param(action => "insert");
760
761} # end confirmAssign
762
763
764# Do the work of actually inserting a block in the database.
765sub insertAssign {
766 if ($IPDBacl{$authuser} !~ /a/) {
767 printError("You shouldn't have been able to get here. Access denied.");
768 return;
769 }
770 # Some things are done more than once.
771 return if !validateInput();
772
773 if (!defined($webvar{privdata})) {
774 $webvar{privdata} = '';
775 }
776 # $code is "success" vs "failure", $msg contains OK for a
777 # successful netblock allocation, the IP allocated for static
778 # IP, or the error message if an error occurred.
779
780 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
781 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
782 $webvar{circid}, $webvar{privdata}, $webvar{node});
783
784 if ($code eq 'OK') {
785 if ($webvar{alloctype} =~ /^.i$/) {
786 $msg =~ s|/32||;
787 $page->param(staticip => $msg);
788 $page->param(custid => $webvar{custid});
789 $page->param(billinguser => $webvar{billinguser});
790 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
791 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
792 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
793 } else {
794 my $netblock = new NetAddr::IP $webvar{fullcidr};
795 $page->param(fullcidr => $webvar{fullcidr});
796 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
797 $page->param(custid => $webvar{custid});
798 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
799 $page->param(billinguser => $webvar{billinguser});
800 $page->param(custid => $webvar{custid});
801 $page->param(netaddr => $netblock->addr);
802 $page->param(masklen => $netblock->masklen);
803 }
804 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
805 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
806 "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
807 }
808 syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
809 "'$webvar{alloctype}' ($msg)";
810 } else {
811 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
812 "'$webvar{alloctype}' by $authuser failed: '$msg'";
813 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
814 " failed:<br>\n$msg\n");
815 }
816
817} # end insertAssign()
818
819
820# Does some basic checks on common input data to make sure nothing
821# *really* weird gets in to the database through this script.
822# Does NOT do complete input validation!!!
823sub validateInput {
824 if ($webvar{city} eq '-') {
825 printError("Please choose a city.");
826 return;
827 }
828
829 # Alloctype check.
830 chomp $webvar{alloctype};
831 if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
832 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone
833 # managing to call things in such a way as to cause this deserves a cryptic error.
834 printError("Invalid alloctype");
835 return;
836 }
837
838 # CustID check
839 # We have different handling for customer allocations and "internal" or "our" allocations
840 if ($def_custids{$webvar{alloctype}} eq '') {
841 if (!$webvar{custid}) {
842 printError("Please enter a customer ID.");
843 return;
844 }
845 if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
846 # Force uppercase for now...
847 $webvar{custid} =~ tr/a-z/A-Z/;
848 # Crosscheck with billing.
849 my $status = CustIDCK->custid_exist($webvar{custid});
850 if ($CustIDCK::Error) {
851 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
852 return;
853 }
854 if (!$status) {
855 printError("Customer ID not valid. Make sure the Customer ID ".
856 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
857 "non-customer assignments.");
858 return;
859 }
860 }
861# print "<!-- [ In validateInput(). Insert customer ID cross-check here. ] -->\n";
862 } else {
863 # New! Improved! And now Loaded From The Database!!
864 if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
865 $webvar{custid} = $def_custids{$webvar{alloctype}};
866 }
867 }
868
869 # Check POP location
870 my $flag;
871 if ($webvar{alloctype} eq 'rm') {
872 $flag = 'for a routed netblock';
873 foreach (@poplist) {
874 if (/^$webvar{city}$/) {
875 $flag = 'n';
876 last;
877 }
878 }
879 } else {
880 $flag = 'n';
881##fixme: hook to force-set POP or city on certain alloctypes
882# if ($webvar{alloctype =~ /foo,bar,bz/ { $webvar{pop} = 'blah'; }
883 if ($webvar{pop} =~ /^-$/) {
884 $flag = 'to route the block from/through';
885 }
886 }
887 if ($flag ne 'n') {
888 printError("Please choose a valid POP location $flag. Valid ".
889 "POP locations are currently:<br>\n".join (" - ", @poplist));
890 return;
891 }
892
893 return 'OK';
894} # end validateInput
895
896
897# Displays details of a specific allocation in a form
898# Allows update/delete
899# action=edit
900sub edit {
901
902 my $sql;
903
904 # Two cases: block is a netblock, or block is a static IP from a pool
905 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
906##fixme: allow "SWIP" (publication to rWHOIS) of static IP data
907 if ($webvar{block} =~ /\/32$/) {
908 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
909 } else {
910 $sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip from allocations where cidr='$webvar{block}'"
911 }
912
913 # gotta snag block info from db
914 $sth = $ip_dbh->prepare($sql);
915 $sth->execute;
916 my @data = $sth->fetchrow_array;
917
918 # Clean up extra whitespace on alloc type
919 $data[2] =~ s/\s//;
920
921 # We can't let the city be changed here; this block is a part of
922 # a larger routed allocation and therefore by definition can't be moved.
923 # block and city are static.
924##fixme
925# Needs thinking. Have to allow changes to city to correct errors, no?
926# Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads
927
928# @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip
929
930 $page->param(block => $webvar{block});
931
932 $page->param(custid => $data[1]);
933 $page->param(city => $data[3]);
934 $page->param(circid => $data[4]);
935 $page->param(desc => $data[5]);
936 $page->param(notes => $data[6]);
937
938##fixme The check here should be built from the database
939# Need to expand to support pool types too
940 if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
941 $page->param(changetype => 1);
942 $page->param(alloctype => [
943 { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" },
944 { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
945 { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
946 { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
947 { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" },
948 { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" },
949 { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" },
950 ]
951 );
952 } else {
953 $page->param(disptype => $disp_alloctypes{$data[2]});
954 $page->param(type => $data[2]);
955 }
956
957## node hack
958 $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef".
959 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
960 $sth->execute;
961 my ($nodeid,$nodename) = $sth->fetchrow_array();
962 $page->param(havenodeid => $nodeid);
963
964 if ($data[2] eq 'fr' || $data[2] eq 'bi') {
965 $page->param(typesupportsnodes => 1);
966 $page->param(nodename => $nodename);
967
968##fixme: this whole hack needs cleanup and generalization for all alloctypes
969##fixme: arguably a bug that presence of a nodeid implies it can be changed..
970# but except for manual database changes, only the two types fr and bi can
971# (currently) have a nodeid set in the first place.
972 if ($IPDBacl{$authuser} =~ /c/) {
973 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
974 $sth->execute;
975 my @nodelist;
976 while (my ($nid,$nname) = $sth->fetchrow_array()) {
977 my %row = (
978 selme => ($nodeid == $nid),
979 nodeid => $nid,
980 nodename => $nname,
981 );
982 push (@nodelist, \%row);
983 }
984 $page->param(nodelist => \@nodelist);
985 }
986 }
987## end node hack
988
989 my ($lastmod,undef) = split /\s+/, $data[7];
990 $page->param(lastmod => $lastmod);
991
992 # not happy with the upside-down logic, but...
993 $page->param(swipable => $data[2] !~ /.i/);
994 $page->param(swip => $data[10] ne 'n');
995
996 # Check to see if we can display sensitive data
997 $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
998 $page->param(privdata => $data[8]);
999
1000 # ACL trickery - these two template booleans control the presence of all form/input tags
1001 $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
1002 $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
1003
1004} # edit()
1005
1006
1007# Stuff new info about a block into the db
1008# action=update
1009sub update {
1010 if ($IPDBacl{$authuser} !~ /c/) {
1011 printError("You shouldn't have been able to get here. Access denied.");
1012 return;
1013 }
1014
1015 # Check to see if we can update restricted data
1016 my $privdata = '';
1017 if ($IPDBacl{$authuser} =~ /s/) {
1018 $privdata = ",privdata='$webvar{privdata}'";
1019 }
1020
1021 # Make sure incoming data is in correct format - custID among other things.
1022 return if !validateInput;
1023
1024 # SQL transaction wrapper
1025 eval {
1026 # Relatively simple SQL transaction here.
1027 my $sql;
1028 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1029 $sql = "UPDATE poolips SET custid='$webvar{custid}',".
1030 "city=?,description=?,notes=?,".
1031 "circuitid='$webvar{circid}',".
1032 "$privdata where ip='$webvar{block}'";
1033 } else {
1034 $sql = "UPDATE allocations SET custid='$webvar{custid}',".
1035 "city=?,description=?,notes=?,".
1036 "circuitid='$webvar{circid}'$privdata,".
1037 "type='$webvar{alloctype}',".
1038 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
1039 "where cidr='$webvar{block}'";
1040 }
1041 # Log the details of the change.
1042 syslog "debug", $sql;
1043 $sth = $ip_dbh->prepare($sql);
1044 $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes});
1045## node hack
1046 if ($webvar{node}) {
1047 # done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there
1048 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
1049 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
1050 $sth->execute($webvar{block},$webvar{node});
1051 }
1052## end node hack
1053 $ip_dbh->commit;
1054 };
1055 if ($@) {
1056 my $msg = $@;
1057 carp "Transaction aborted because $msg";
1058 eval { $ip_dbh->rollback; };
1059 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
1060 printError("Could not update block/IP $webvar{block}: $msg");
1061 return;
1062 }
1063
1064 # If we get here, the operation succeeded.
1065 syslog "notice", "$authuser updated $webvar{block}";
1066##fixme: need to wedge something in to allow "update:field" notifications
1067## hmm. how to tell what changed? O_o
1068mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1069 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
1070
1071## node hack
1072 if ($webvar{node} && $webvar{node} ne '-') {
1073 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
1074 $sth->execute($webvar{node});
1075 my ($nodename) = $sth->fetchrow_array();
1076 $page->param(nodename => $nodename);
1077 }
1078## end node hack
1079
1080 # Link back to browse-routed or list-pool page on "Update complete" page.
1081 my $cblock; # to contain the CIDR of the container block we're retrieving.
1082 my $sql;
1083 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1084 $page->param(backpool => 1);
1085 $sql = "select pool from poolips where ip='$webvar{block}'";
1086 } else {
1087 $sql = "select cidr from routed where cidr >>= '$webvar{block}'";
1088 }
1089 # I define there to be no errors on this operation... so we don't need to check for them.
1090 $sth = $ip_dbh->prepare($sql);
1091 $sth->execute;
1092 $sth->bind_columns(\$cblock);
1093 $sth->fetch();
1094 $sth->finish;
1095 $page->param(backblock => $cblock);
1096
1097 $page->param(cidr => $webvar{block});
1098 $page->param(city => $webvar{city});
1099 $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
1100 $page->param(custid => $webvar{custid});
1101 $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
1102 $page->param(circid => $q->escapeHTML($webvar{circid}));
1103 $page->param(desc => $q->escapeHTML($webvar{desc}));
1104 $page->param(notes => $q->escapeHTML($webvar{notes}));
1105 $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : "&nbsp;");
1106 $page->param(privdata => $webvar{privdata})
1107 if $IPDBacl{$authuser} =~ /s/;
1108
1109} # update()
1110
1111
1112# Delete an allocation.
1113sub remove {
1114 if ($IPDBacl{$authuser} !~ /d/) {
1115 printError("You shouldn't have been able to get here. Access denied.");
1116 return;
1117 }
1118
1119 # Serves'em right for getting here...
1120 if (!defined($webvar{block})) {
1121 printError("Error 332");
1122 return;
1123 }
1124
1125 my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
1126
1127 if ($webvar{alloctype} eq 'rm') {
1128 $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1129 $sth->execute();
1130
1131# This feels... extreme.
1132 croak $sth->errstr() if($sth->errstr());
1133
1134 $sth->bind_columns(\$cidr,\$city);
1135 $sth->execute();
1136 $sth->fetch || croak $sth->errstr();
1137 $custid = "N/A";
1138 $alloctype = $webvar{alloctype};
1139 $circid = "N/A";
1140 $desc = "N/A";
1141 $notes = "N/A";
1142 $privdata = "N/A";
1143
1144 } elsif ($webvar{alloctype} eq 'mm') {
1145
1146 $cidr = $webvar{block};
1147 $city = "N/A";
1148 $custid = "N/A";
1149 $alloctype = $webvar{alloctype};
1150 $circid = "N/A";
1151 $desc = "N/A";
1152 $notes = "N/A";
1153 $privdata = "N/A";
1154
1155 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
1156
1157 # Unassigning a static IP
1158 my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
1159 " from poolips where ip='$webvar{block}'");
1160 $sth->execute();
1161# croak $sth->errstr() if($sth->errstr());
1162
1163 $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
1164 \$privdata);
1165 $sth->fetch() || croak $sth->errstr;
1166
1167 } else { # done with alloctype=~ /^.i$/
1168
1169 my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
1170 " from allocations where cidr='$webvar{block}'");
1171 $sth->execute();
1172# croak $sth->errstr() if($sth->errstr());
1173
1174 $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
1175 \$notes, \$privdata);
1176 $sth->fetch() || carp $sth->errstr;
1177 } # end cases for different alloctypes
1178
1179 $page->param(block => $cidr);
1180 $page->param(disptype => $disp_alloctypes{$alloctype});
1181 $page->param(type => $alloctype);
1182 $page->param(city => $city);
1183 $page->param(custid => $custid);
1184 $page->param(circid => $circid);
1185 $page->param(desc => $desc);
1186 $page->param(notes => $notes);
1187 $privdata = '&nbsp;' if $privdata eq '';
1188 $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/;
1189 $page->param(delpool => $alloctype =~ /^.[pd]$/);
1190
1191} # end remove()
1192
1193
1194# Delete an allocation. Return it to the freeblocks table; munge
1195# data as necessary to keep as few records as possible in freeblocks
1196# to prevent weirdness when allocating blocks later.
1197# Remove IPs from pool listing if necessary
1198sub finalDelete {
1199 if ($IPDBacl{$authuser} !~ /d/) {
1200 $page->param(aclerr => 1);
1201 return;
1202 }
1203
1204 # need to retrieve block data before deleting so we can notify on that
1205 my ($cidr,$custid,$type,$city,$description) = getBlockData($ip_dbh, $webvar{block});
1206
1207 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
1208
1209 $page->param(block => $webvar{block});
1210 if ($code eq 'OK') {
1211 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
1212 " $custid, $city, desc='$description'";
1213 mailNotify($ip_dbh, 'da', "REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1214 "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n".
1215 "CustID: $custid\nCity: $city\nDescription: $description\n");
1216 } else {
1217 $page->param(failmsg => $msg);
1218 if ($webvar{alloctype} =~ /^.i$/) {
1219 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
1220 } else {
1221 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
1222 $page->param(netblock => 1);
1223 }
1224 }
1225
1226} # finalDelete
Note: See TracBrowser for help on using the repository browser.