source: branches/stable/cgi-bin/main.cgi @ 286

Last change on this file since 286 was 286, checked in by Kris Deugau, 17 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: 43.8 KB
Line 
1#!/usr/bin/perl
2# ipdb/cgi-bin/main.cgi
3# Started munging from noc.vianet's old IPDB 04/22/2004
4###
5# SVN revision info
6# $Date: 2005-09-23 19:54:31 +0000 (Fri, 23 Sep 2005) $
7# SVN revision $Rev: 286 $
8# Last update by $Author: kdeugau $
9###
10
11use strict;             
12use warnings;   
13use CGI::Carp qw(fatalsToBrowser);
14use DBI;
15use CommonWeb qw(:ALL);
16use MyIPDB;
17use CustIDCK;
18use POSIX qw(ceil);
19use NetAddr::IP;
20
21use Sys::Syslog;
22
23openlog "IPDB","pid","local2";
24
25# Collect the username from HTTP auth.  If undefined, we're in
26# a test environment, or called without a username.
27my $authuser;
28if (!defined($ENV{'REMOTE_USER'})) {
29  $authuser = '__temptest';
30} else {
31  $authuser = $ENV{'REMOTE_USER'};
32}
33
34syslog "debug", "$authuser active";
35
36# Why not a global DB handle?  (And a global statement handle, as well...)
37# Use the connectDB function, otherwise we end up confusing ourselves
38my $ip_dbh;
39my $sth;
40my $errstr;
41($ip_dbh,$errstr) = connectDB_My;
42if (!$ip_dbh) {
43  exitError("Database error: $errstr\n");
44}
45initIPDBGlobals($ip_dbh);
46
47# Headerize!  Make sure we replace the $$EXTRA0$$ bit as needed.
48printHeader('', ($IPDBacl{$authuser} =~ /a/ ?
49        '<td align=right><a href="/ip/cgi-bin/main.cgi?action=assign">Add new assignment</a>' : ''
50        ));
51
52
53# Global variables
54my %webvar = parse_post();
55cleanInput(\%webvar);
56
57
58#main()
59
60if(!defined($webvar{action})) {
61  $webvar{action} = "<NULL>";   #shuts up the warnings.
62}
63
64if($webvar{action} eq 'index') {
65  showSummary();
66} elsif ($webvar{action} eq 'addmaster') {
67  if ($IPDBacl{$authuser} !~ /a/) {
68    printError("You shouldn't have been able to get here.  Access denied.");
69  } else {
70    open HTML, "<../addmaster.html";
71    print while <HTML>;
72  }
73} elsif ($webvar{action} eq 'newmaster') {
74
75  if ($IPDBacl{$authuser} !~ /a/) {
76    printError("You shouldn't have been able to get here.  Access denied.");
77  } else {
78
79    my $cidr = new NetAddr::IP $webvar{cidr};
80
81    print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
82
83    # Allow transactions, and raise an exception on errors so we can catch it later.
84    # Use local to make sure these get "reset" properly on exiting this block
85    local $ip_dbh->{AutoCommit} = 0;
86    local $ip_dbh->{RaiseError} = 1;
87
88    # Wrap the SQL in a transaction
89    eval {
90      $sth = $ip_dbh->prepare("insert into masterblocks values ('$webvar{cidr}')");
91      $sth->execute;
92
93# Unrouted blocks aren't associated with a city (yet).  We don't rely on this
94# elsewhere though;  legacy data may have traps and pitfalls in it to break this.
95# Thus the "routed" flag.
96
97      $sth = $ip_dbh->prepare("insert into freeblocks (cidr,maskbits,city,routed)".
98        " values ('$webvar{cidr}',".$cidr->masklen.",'<NULL>','n')");
99      $sth->execute;
100
101      # If we get here, everything is happy.  Commit changes.
102      $ip_dbh->commit;
103    }; # end eval
104
105    if ($@) {
106      my $msg = $@;
107      carp "Transaction aborted because $msg";
108      eval { $ip_dbh->rollback; };
109      syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
110      printError("Could not add master block $webvar{cidr} to database: $msg");
111    } else {
112      print "<div type=heading align=center>Success!</div>\n";
113      syslog "info", "$authuser added master block $webvar{cidr}";
114    }
115
116  } # ACL check
117
118} # end add new master
119
120elsif($webvar{action} eq 'showmaster') {
121  showMaster();
122}
123elsif($webvar{action} eq 'showrouted') {
124  showRBlock();
125}
126elsif($webvar{action} eq 'listpool') {
127  listPool();
128}
129
130# Not modified or added;  just shuffled
131elsif($webvar{action} eq 'assign') {
132  assignBlock();
133}
134elsif($webvar{action} eq 'confirm') {
135  confirmAssign();
136}
137elsif($webvar{action} eq 'insert') {
138  insertAssign();
139}
140elsif($webvar{action} eq 'edit') {
141  edit();
142}
143elsif($webvar{action} eq 'update') {
144  update();
145}
146elsif($webvar{action} eq 'delete') {
147  remove();
148}
149elsif($webvar{action} eq 'finaldelete') {
150  finalDelete();
151}
152
153# Default is an error.  It shouldn't be possible to easily get here.
154# The only way I can think of offhand is to just call main.cgi bare-
155# which is not in any way guaranteed to provide anything useful.
156else {
157  my $rnd = rand 500;
158  my $boing = sprintf("%.2f", rand 500);
159  my @excuses = ("Aether cloudy.  Ask again later.","The gods are unhappy with your sacrifice.",
160        "Because one of it's legs are both the same", "*wibble*",
161        "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
162        "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
163  printAndExit("Error $boing:  ".$excuses[$rnd/30.0]);
164}
165## Finally! Done with that NASTY "case" emulation!
166
167
168
169# Clean up IPDB globals, DB handle, etc.
170finish($ip_dbh);
171
172print qq(<div align=right style="position: absolute; right: 30px;">).
173        qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
174        if $IPDBacl{$authuser} =~ /A/;
175
176# We print the footer here, so we don't have to do it elsewhere.
177printFooter;
178# Just in case something waaaayyy down isn't in place
179# properly... we exit explicitly.
180exit;
181
182
183
184# args are: a reference to an array with the row to be printed and the
185# class(stylesheet) to use for formatting.
186# if ommitting the class - call the sub as &printRow(\@array)
187sub printRow {
188  my ($rowRef,$class) = @_;
189
190  if (!$class) {
191    print "<tr>\n";
192  } else {
193    print "<tr class=\"$class\">\n";
194  }
195
196ELEMENT:  foreach my $element (@$rowRef) {
197    if (!defined($element)) {
198      print "<td></td>\n";
199      next ELEMENT;
200    }
201    $element =~ s|\n|</br>|g;
202    print "<td>$element</td>\n";
203  }
204  print "</tr>";
205} # printRow
206
207
208# Prints table headings.  Accepts any number of arguments;
209# each argument is a table heading.
210sub startTable {
211  print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
212
213  foreach(@_) {
214    print qq(<td class="heading">$_</td>);
215  }
216  print "</tr>\n";
217} # startTable
218
219
220# Initial display:  Show master blocks with total allocated subnets, total free subnets
221sub showSummary {
222
223  startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
224        'Free netblocks', 'Largest free block');
225
226  my %allocated;
227  my %free;
228  my %routed;
229  my %bigfree;
230
231  # Count the allocations.
232  $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
233  foreach my $master (@masterblocks) {
234    $sth->execute("$master");
235    $sth->bind_columns(\$allocated{"$master"});
236    $sth->fetch();
237  }
238
239  # Count routed blocks
240  $sth = $ip_dbh->prepare("select count(*) from routed where cidr <<= ?");
241  foreach my $master (@masterblocks) {
242    $sth->execute("$master");
243    $sth->bind_columns(\$routed{"$master"});
244    $sth->fetch();
245  }
246
247  # Count the free blocks.
248  $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
249        "(routed='y' or routed='n')");
250  foreach my $master (@masterblocks) {
251    $sth->execute("$master");
252    $sth->bind_columns(\$free{"$master"});
253    $sth->fetch();
254  }
255
256  # Find the largest free block in each master
257  $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
258        "(routed='y' or routed='n') order by maskbits limit 1");
259  foreach my $master (@masterblocks) {
260    $sth->execute("$master");
261    $sth->bind_columns(\$bigfree{"$master"});
262    $sth->fetch();
263  }
264
265  # Print the data.
266  my $count=0;
267  foreach my $master (@masterblocks) {
268    my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
269        $routed{"$master"}, $allocated{"$master"}, $free{"$master"}, 
270        ( ($bigfree{"$master"} eq '') ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
271        );
272
273    printRow(\@row, 'color1' ) if($count%2==0);
274    printRow(\@row, 'color2' ) if($count%2!=0);
275    $count++;
276  }
277  print "</table>\n";
278  if ($IPDBacl{$authuser} =~ /a/) {
279    print qq(<a href="/ip/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n);
280  }
281  print "Note:  Free blocks noted here include both routed and unrouted blocks.\n";
282
283} # showSummary
284
285
286# Display detail on master
287# Alrighty then!  We're showing routed blocks within a single master this time.
288# We should be able to steal code from showSummary(), and if I'm really smart
289# I'll figger a way to munge the two together.  (Once I've done that, everything
290# else should follow.  YMMV.)
291sub showMaster {
292
293  print qq(<center><div class="heading">Summarizing routed blocks for ).
294        qq($webvar{block}:</div></center><br>\n);
295
296  my %allocated;
297  my %free;
298  my %routed;
299  my %bigfree;
300
301  my $master = new NetAddr::IP $webvar{block};
302  my @localmasters;
303
304  # Fetch only the blocks relevant to this master
305  $sth = $ip_dbh->prepare("select cidr,city from routed where cidr <<= '$master' order by cidr");
306  $sth->execute();
307
308  my $i=0;
309  while (my @data = $sth->fetchrow_array()) {
310    my $cidr = new NetAddr::IP $data[0];
311    $localmasters[$i++] = $cidr;
312    $free{"$cidr"} = 0;
313    $allocated{"$cidr"} = 0;
314    $bigfree{"$cidr"} = 128;
315    # Retain the routing destination
316    $routed{"$cidr"} = $data[1];
317  }
318
319  # Check if there were actually any blocks routed from this master
320  if ($i > 0) {
321    startTable('Routed block','Routed to','Allocated blocks',
322        'Free blocks','Largest free block');
323
324    # Count the allocations
325    $sth = $ip_dbh->prepare("select count(*) from allocations where cidr <<= ?");
326    foreach my $master (@localmasters) {
327      $sth->execute("$master");
328      $sth->bind_columns(\$allocated{"$master"});
329      $sth->fetch();
330    }
331
332    # Count the free blocks.
333    $sth = $ip_dbh->prepare("select count(*) from freeblocks where cidr <<= ? and ".
334        "(routed='y' or routed='n')");
335    foreach my $master (@localmasters) {
336      $sth->execute("$master");
337      $sth->bind_columns(\$free{"$master"});
338      $sth->fetch();
339    }
340
341    # Get the size of the largest free block
342    $sth = $ip_dbh->prepare("select maskbits from freeblocks where cidr <<= ? and ".
343        "(routed='y' or routed='n') order by maskbits limit 1");
344    foreach my $master (@localmasters) {
345      $sth->execute("$master");
346      $sth->bind_columns(\$bigfree{"$master"});
347      $sth->fetch();
348    }
349
350    # Print the data.
351    my $count=0;
352    foreach my $master (@localmasters) {
353      my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
354        $routed{"$master"}, $allocated{"$master"},
355        $free{"$master"},
356        ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
357      );
358      printRow(\@row, 'color1' ) if($count%2==0);
359      printRow(\@row, 'color2' ) if($count%2!=0);
360      $count++;
361    }
362  } else {
363    # If a master block has no routed blocks, then by definition it has no
364    # allocations, and can be deleted.
365    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
366        qq($master.</div>\n).
367        ($IPDBacl{$authuser} =~ /d/ ?
368                qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
369                qq(<input type=hidden name=action value="delete">\n).
370                qq(<input type=hidden name=block value="$master">\n).
371                qq(<input type=hidden name=alloctype value="mm">\n).
372                qq(<input type=submit value=" Remove this master ">\n).
373                qq(</form></center>\n) :
374                '');
375
376  } # end check for existence of routed blocks in master
377
378  print qq(</table>\n<hr width="60%">\n).
379        qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
380
381  startTable('Netblock','Range');
382
383  # Snag the free blocks.
384  my $count = 0;
385  $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr <<='$master' and ".
386        "routed='n' order by cidr");
387  $sth->execute();
388  while (my @data = $sth->fetchrow_array()) {
389    my $cidr = new NetAddr::IP $data[0];
390    my @row = ("$cidr", $cidr->range);
391    printRow(\@row, 'color1' ) if($count%2==0);
392    printRow(\@row, 'color2' ) if($count%2!=0);
393    $count++;
394  }
395
396  print "</table>\n";
397} # showMaster
398
399
400# Display details of a routed block
401# Alrighty then!  We're showing allocations within a routed block this time.
402# We should be able to steal code from showSummary() and showMaster(), and if
403# I'm really smart I'll figger a way to munge all three together.  (Once I've
404# done that, everything else should follow.  YMMV.
405# This time, we check the database before spewing, because we may
406# not have anything useful to spew.
407sub showRBlock {
408
409  my $master = new NetAddr::IP $webvar{block};
410
411  $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
412  $sth->execute;
413  my @data = $sth->fetchrow_array;
414
415  print qq(<center><div class="heading">Summarizing allocated blocks for ).
416        qq($master ($data[0]):</div></center><br>\n);
417
418  startTable('CIDR allocation','Customer Location','Type','CustID','SWIPed?','Description/Name');
419
420  # Snag the allocations for this block
421  $sth = $ip_dbh->prepare("select cidr,city,type,custid,swip,description".
422        " from allocations where cidr <<= '$master' order by cidr");
423  $sth->execute();
424
425  my $count=0;
426  while (my @data = $sth->fetchrow_array()) {
427    # cidr,city,type,custid,swip,description, as per the SELECT
428    my $cidr = new NetAddr::IP $data[0];
429
430    # Clean up extra spaces that are borking things.
431#    $data[2] =~ s/\s+//g;
432
433    # Prefix subblocks with "Sub "
434    my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
435        qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
436        $data[1], $disp_alloctypes{$data[2]}, $data[3], 
437        ($data[4] eq 'y' ? 'Yes' : 'No'), $data[5]);
438    # If the allocation is a pool, allow listing of the IPs in the pool.
439    if ($data[2] =~ /^.[pd]$/) {
440      $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
441        "&pool=$data[0]\">List IPs</a>";
442    }
443
444    printRow(\@row, 'color1') if ($count%2 == 0);
445    printRow(\@row, 'color2') if ($count%2 != 0);
446    $count++;
447  }
448
449  print "</table>\n";
450
451  # If the routed block has no allocations, by definition it only has
452  # one free block, and therefore may be deleted.
453  if ($count == 0) {
454    print qq(<hr width="60%"><center><div class="heading">No allocations in ).
455        qq($master.</div></center>\n).
456        ($IPDBacl{$authuser} =~ /d/ ?
457                qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
458                qq(<input type=hidden name=action value="delete">\n).
459                qq(<input type=hidden name=block value="$master">\n).
460                qq(<input type=hidden name=alloctype value="rm">\n).
461                qq(<input type=submit value=" Remove this block ">\n).
462                qq(</form>\n) :
463                '');
464  }
465
466  print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
467        qq(submaster $master</div></center>\n);
468
469  startTable('CIDR block','Range');
470
471  # Snag the free blocks.  We don't really *need* to be pedantic about avoiding
472  # unrouted free blocks, but it's better to let the database do the work if we can.
473  $count = 0;
474  $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
475        " order by cidr");
476  $sth->execute();
477  while (my @data = $sth->fetchrow_array()) {
478    # cidr,routed
479    my $cidr = new NetAddr::IP $data[0];
480    # Include some HairyPerl(TM) to prefix subblocks with "Sub "
481    my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
482        ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
483        $cidr->range);
484    printRow(\@row, 'color1') if ($count%2 == 0);
485    printRow(\@row, 'color2') if ($count%2 != 0);
486    $count++;
487  }
488
489  print "</table>\n";
490} # showRBlock
491
492
493# List the IPs used in a pool
494sub listPool {
495
496  my $cidr = new NetAddr::IP $webvar{pool};
497
498  my ($pooltype,$poolcity);
499
500  # Snag pool info for heading
501  $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
502  $sth->execute;
503  $sth->bind_columns(\$pooltype, \$poolcity);
504  $sth->fetch() || carp $sth->errstr;
505
506  print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
507        qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
508  # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
509  if ($pooltype =~ /^.d$/) {
510    print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
511    print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
512        $cidr->addr."</td></tr>\n";
513    $cidr++;
514    print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
515    $cidr--;  $cidr--;
516    print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
517        "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
518        "</table></div></div>\n";
519  }
520
521# probably have to add an "edit IP allocation" link here somewhere.
522
523  startTable('IP','Customer ID','Available?','Description','');
524  $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
525        " from poolips where pool='$webvar{pool}' order by ip");
526  $sth->execute;
527  my $count = 0;
528  while (my @data = $sth->fetchrow_array) {
529    # pool,ip,custid,city,ptype,available,notes,description,circuitid
530    # ip,custid,available,description,type
531    # If desc is "null", make it not null.  <g>
532    if ($data[3] eq '') {
533      $data[3] = '&nbsp;';
534    }
535    # Some nice hairy Perl to decide whether to allow unassigning each IP
536    #   -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
537    #      else we print a blank space
538    my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
539        $data[1],$data[2],$data[3],
540        ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
541          ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
542           "alloctype=$data[4]\">Unassign this IP</a>") :
543          ("&nbsp;") )
544        );
545    printRow(\@row, 'color1') if($count%2==0);
546    printRow(\@row, 'color2') if($count%2!=0);
547    $count++;
548  }
549  print "</table>\n";
550
551} # end listPool
552
553
554# Show "Add new allocation" page.  Note that the actual page may
555# be one of two templates, and the lists come from the database.
556sub assignBlock {
557
558  if ($IPDBacl{$authuser} !~ /a/) {
559    printError("You shouldn't have been able to get here.  Access denied.");
560    return;
561  }
562
563  my $html;
564
565  # New special case- block to assign is specified
566  if ($webvar{block} ne '') {
567    open HTML, "../fb-assign.html"
568        or croak "Could not open fb-assign.html: $!";
569    $html = join('',<HTML>);
570    close HTML;
571    my $block = new NetAddr::IP $webvar{block};
572    $html =~ s|\$\$BLOCK\$\$|$block|g;
573    $html =~ s|\$\$MASKBITS\$\$|$block->masklen|;
574    my $typelist = '';
575
576    # This is a little dangerous, as it's *theoretically* possible to
577    # get fbtype='n' (aka a non-routed freeblock).  However, should
578    # someone manage to get there, they get what they deserve.
579    if ($webvar{fbtype} ne 'y') {
580      # Snag the type of the block from the database.  We have no
581      # convenient way to pass this in from the calling location.  :/
582      $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
583      $sth->execute;
584      my @data = $sth->fetchrow_array;
585      $data[0] =~ s/c$/r/;      # Munge the type into the correct form
586      $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
587    } else {
588      $typelist .= qq(<select name="alloctype">\n);
589      $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
590        "and type not like '_i' and type not like '_r' order by listorder");
591      $sth->execute;
592      my @data = $sth->fetchrow_array;
593      $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
594      while (my @data = $sth->fetchrow_array) {
595        $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
596      }
597      $typelist .= "</select>\n";
598    }
599    $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
600  } else {
601    open HTML, "../assign.html"
602        or croak "Could not open assign.html: $!";
603    $html = join('',<HTML>);
604    close HTML;
605    my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
606    foreach my $master (@masterblocks) {
607      $masterlist .= "<option>$master</option>\n";
608    }
609    $masterlist .= "</select>\n";
610    $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g;
611    my $pops = '';
612    foreach my $pop (@poplist) {
613      $pops .= "<option>$pop</option>\n";
614    }
615    $html =~ s|\$\$POPLIST\$\$|$pops|g;
616    my $typelist = '';
617    $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
618    $sth->execute;
619    my @data = $sth->fetchrow_array;
620    $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
621    while (my @data = $sth->fetchrow_array) {
622      $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
623    }
624    $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
625  }
626  my $cities = '';
627  foreach my $city (@citylist) {
628    $cities .= "<option>$city</option>\n";
629  }
630  $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
631
632  my $i = 0;
633  $i++ if $webvar{fbtype} eq 'y';
634  # Check to see if user is allowed to do anything with sensitive data
635  my $privdata = '';
636  if ($IPDBacl{$authuser} =~ /s/) {
637    $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
638        qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
639        qq(</textarea></td></tr>\n);
640    $i++;
641  }
642  $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
643
644  $i = $i % 2;
645  $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
646
647  print $html;
648
649} # assignBlock
650
651
652# Take info on requested IP assignment and see what we can provide.
653sub confirmAssign {
654  if ($IPDBacl{$authuser} !~ /a/) {
655    printError("You shouldn't have been able to get here.  Access denied.");
656    return;
657  }
658
659  my $cidr;
660  my $alloc_from;
661
662  # Going to manually validate some items.
663  # custid and city are automagic.
664  return if !validateInput();
665
666# Several different cases here.
667# Static IP vs netblock
668#  + Different flavours of static IP
669#  + Different flavours of netblock
670
671  if ($webvar{alloctype} =~ /^.i$/) {
672    my ($base,undef) = split //, $webvar{alloctype};    # split into individual chars
673    my ($sql,$city);
674    # Check for pools in Subury, North Bay, or Toronto if DSL or server pool.
675    # Anywhere else is invalid and shouldn't be in the db in the first place.
676    # ... aside from #^%#$%#@#^%^^!!!! legacy data.  GRRR.
677    # Note that we want to retain the requested city to relate to customer info.
678    if ($base =~ /^[ds]$/) {
679      $city = "(allocations.city='Sudbury' or allocations.city='North Bay' or ".
680        "allocations.city='Toronto')";
681    } else {
682      $city = "allocations.city='$webvar{pop}'";
683    }
684
685# Ewww.  But it works.
686    $sth = $ip_dbh->prepare("SELECT (SELECT city FROM allocations WHERE cidr=poolips.pool), ".
687        "poolips.pool, COUNT(*) FROM poolips,allocations WHERE poolips.available='y' AND ".
688        "poolips.pool=allocations.cidr AND $city AND poolips.type LIKE '".$base."_' ".
689        "GROUP BY pool");
690    $sth->execute;
691    my $optionlist;
692    while (my @data = $sth->fetchrow_array) {
693      # city,pool cidr,free IP count
694      if ($data[2] > 0) {
695        $optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
696      }
697    }
698    $cidr = "Single static IP";
699    $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
700
701  } else { # end show pool options
702
703    if ($webvar{fbassign} eq 'y') {
704      $cidr = new NetAddr::IP $webvar{block};
705      $webvar{maskbits} = $cidr->masklen;
706    } else { # done with direct freeblocks assignment
707
708      if (!$webvar{maskbits}) {
709        printError("Please specify a CIDR mask length.");
710        return;
711      }
712      my $sql;
713      my $city;
714      my $failmsg;
715      my $extracond = '';
716      if ($webvar{allocfrom} eq '-') {
717        $extracond = ($webvar{allowpriv} eq 'on' ? '' : 
718                " and not (cidr <<= '192.168.0.0/16'".
719                        " or cidr <<= '10.0.0.0/8'".
720                        " or cidr <<= '172.16.0.0/12')");
721      }
722      my $sortorder;
723      if ($webvar{alloctype} eq 'rm') {
724        if ($webvar{allocfrom} ne '-') {
725          $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'".
726                " and cidr <<= '$webvar{allocfrom}'";
727          $sortorder = "maskbits desc";
728        } else {
729          $sql = "select * from freeblocks where maskbits<=$webvar{maskbits} and routed='n'";
730          $sortorder = "maskbits desc";
731        }
732        $failmsg = "No suitable free block found.<br>\nWe do not have a free".
733          " routeable block of that size.<br>\nYou will have to either route".
734          " a set of smaller netblocks or a single smaller netblock.";
735      } else {
736##fixme
737# This section needs serious Pondering.
738        # Pools of most types get assigned to the POP they're "routed from"
739        # This includes WAN blocks and other netblock "containers"
740        # This does NOT include cable pools.
741        if ($webvar{alloctype} =~ /^.[pc]$/) {
742          if (($webvar{city} !~ /^(Sudbury|North Bay|Toronto)$/) && ($webvar{alloctype} eq 'dp')) {
743            printError("You must chose Sudbury, North Bay, or Toronto for DSL pools.");
744            return;
745          }
746          $city = $webvar{city};
747          $failmsg = "No suitable free block found.<br>\nYou will have to route another".
748            " superblock from one of the<br>\nmaster blocks in Sudbury or chose a smaller".
749            " block size for the pool.";
750        } else {
751          $city = $webvar{pop};
752          $failmsg = "No suitable free block found.<br>\nYou will have to route another".
753            " superblock to $webvar{pop}<br>\nfrom one of the master blocks in Sudbury or".
754            " chose a smaller blocksize.";
755        }
756        if ($webvar{allocfrom} ne '-') {
757          $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
758                " and cidr <<= '$webvar{allocfrom}' and routed='".
759                (($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
760          $sortorder = "maskbits desc,cidr";
761        } else {
762          $sql = "select cidr from freeblocks where city='$city' and maskbits<=$webvar{maskbits}".
763                " and routed='".(($webvar{alloctype} =~ /^(.)r$/) ? "$1" : 'y')."'";
764          $sortorder = "maskbits desc,cidr";
765        }
766      }
767      $sql = $sql.$extracond." order by ".$sortorder;
768      $sth = $ip_dbh->prepare($sql);
769      $sth->execute;
770      my @data = $sth->fetchrow_array();
771      if ($data[0] eq "") {
772        printError($failmsg);
773        return;
774      }
775      $cidr = new NetAddr::IP $data[0];
776    } # check for freeblocks assignment or IPDB-controlled assignment
777
778    $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
779
780    # If the block to be allocated is smaller than the one we found,
781    # figure out the "real" block to be allocated.
782    if ($cidr->masklen() ne $webvar{maskbits}) {
783      my $maskbits = $cidr->masklen();
784      my @subblocks;
785      while ($maskbits++ < $webvar{maskbits}) {
786        @subblocks = $cidr->split($maskbits);
787      }
788      $cidr = $subblocks[0];
789    }
790  } # if ($webvar{alloctype} =~ /^.i$/)
791
792  open HTML, "../confirm.html"
793        or croak "Could not open confirm.html: $!";
794  my $html = join '', <HTML>;
795  close HTML;
796
797### gotta fix this in final
798  # Stick in customer info as necessary - if it's blank, it just ends
799  # up as blank lines ignored in the rendering of the page
800        my $custbits;
801  $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
802###
803
804  # Stick in the allocation data
805  $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
806  $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
807  $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
808  $html =~ s|\$\$CIDR\$\$|$cidr|g;
809  $webvar{city} = desanitize($webvar{city});
810  $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
811  $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
812  $webvar{circid} = desanitize($webvar{circid});
813  $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
814  $webvar{desc} = desanitize($webvar{desc});
815  $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
816  $webvar{notes} = desanitize($webvar{notes});
817  $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
818  $html =~ s|\$\$ACTION\$\$|insert|g;
819
820  my $i=1;
821  # Check to see if user is allowed to do anything with sensitive data
822  my $privdata = '';
823  if ($IPDBacl{$authuser} =~ /s/) {
824    $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
825        qq(<td class=regular>$webvar{privdata}).
826        qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
827    $i++;
828  }
829  $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
830
831  $i = $i % 2;
832  $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
833
834  print $html;
835
836} # end confirmAssign
837
838
839# Do the work of actually inserting a block in the database.
840sub insertAssign {
841  if ($IPDBacl{$authuser} !~ /a/) {
842    printError("You shouldn't have been able to get here.  Access denied.");
843    return;
844  }
845  # Some things are done more than once.
846  return if !validateInput();
847
848  if (!defined($webvar{privdata})) {
849    $webvar{privdata} = '';
850  }
851  # $code is "success" vs "failure", $msg contains OK for a
852  # successful netblock allocation, the IP allocated for static
853  # IP, or the error message if an error occurred.
854  my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
855        $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
856        $webvar{circid}, $webvar{privdata});
857
858  if ($code eq 'OK') {
859    if ($webvar{alloctype} =~ /^.i$/) {
860      print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div></div>);
861      # Notify tech@example.com
862      mailNotify('tech@example.com',"ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
863        "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
864        "Description: $webvar{desc}\n\nAllocated by: $authuser\n");
865    } else {
866      print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
867        "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div></div>";
868    }
869    syslog "notice", "$authuser allocated '$webvar{fullcidr}' to '$webvar{custid}' as ".
870        "'$webvar{alloctype}' ($msg)";
871  } else {
872    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
873        "'$webvar{alloctype}' by $authuser failed: '$msg'";
874    printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
875        " failed:<br>\n$msg\n");
876  }
877
878} # end insertAssign()
879
880
881# Does some basic checks on common input data to make sure nothing
882# *really* weird gets in to the database through this script.
883# Does NOT do complete input validation!!!
884sub validateInput {
885  if ($webvar{city} eq '-') {
886    printError("Please choose a city.");
887    return;
888  }
889
890  # Alloctype check.
891  chomp $webvar{alloctype};
892  if (!grep /$webvar{alloctype}/, keys %disp_alloctypes) {
893    # Danger! Danger!  alloctype should ALWAYS be set by a dropdown.  Anyone
894    # managing to call things in such a way as to cause this deserves a cryptic error.
895    printError("Invalid alloctype");
896    return;
897  }
898
899  # CustID check
900  # We have different handling for customer allocations and "internal" or "our" allocations
901  if ($def_custids{$webvar{alloctype}} eq '') {
902    if (!$webvar{custid}) {
903      printError("Please enter a customer ID.");
904      return;
905    }
906    if ($webvar{custid} !~ /^(?:\d{10}|\d{7}|STAFF)(?:-\d\d?)?$/) {
907      # Force uppercase for now...
908      $webvar{custid} =~ tr/a-z/A-Z/;
909      # Crosscheck with ... er...  something.
910      my $status = CustIDCK->custid_exist($webvar{custid});
911      if ($CustIDCK::Error) {
912        printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
913        return;
914      }
915      if (!$status) {
916        printError("Customer ID not valid.  Make sure the Customer ID ".
917          "is correct.<br>\nUse STAFF for staff static IPs, and 6750400 for any other ".
918          "non-customer assignments.");
919        return;
920      }
921#"Please enter a valid customer ID- this must be a 7- or 10-digit number, or STAFF for
922#static IPs for staff.");
923    }
924#    print "<!-- [ In validateInput().  Insert customer ID cross-check here. ] -->\n";
925  } else {
926    # New!  Improved!  And now Loaded From The Database!!
927    if ((!$webvar{custid}) || ($webvar{custid} ne 'STAFF')) {
928      $webvar{custid} = $def_custids{$webvar{alloctype}};
929    }
930  }
931
932  # Check POP location
933  my $flag;
934  if ($webvar{alloctype} eq 'rm') {
935    $flag = 'for a routed netblock';
936    foreach (@poplist) {
937      if (/^$webvar{city}$/) {
938        $flag = 'n';
939        last;
940      }
941    }
942  } else {
943    $flag = 'n';
944    if ($webvar{alloctype} =~ /w./) {
945      $webvar{pop} = "Sudbury";
946    } elsif ($webvar{pop} =~ /^-$/) {
947      $flag = 'to route the block from/through';
948    }
949  }
950  if ($flag ne 'n') {
951    printError("Please choose a valid POP location $flag.  Valid ".
952        "POP locations are currently:<br>\n".join (" - ", @poplist));
953    return;
954  }
955
956  return 'OK';
957} # end validateInput
958
959
960# Displays details of a specific allocation in a form
961# Allows update/delete
962# action=edit
963sub edit {
964
965  my $sql;
966
967  # Two cases:  block is a netblock, or block is a static IP from a pool
968  # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
969  if ($webvar{block} =~ /\/32$/) {
970    $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
971  } else {
972    $sql = "select cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip from allocations where cidr='$webvar{block}'"
973  }
974
975  # gotta snag block info from db
976  $sth = $ip_dbh->prepare($sql);
977  $sth->execute;
978  my @data = $sth->fetchrow_array;
979
980  # Clean up extra whitespace on alloc type
981  $data[2] =~ s/\s//;
982
983  open (HTML, "../editDisplay.html")
984        or croak "Could not open editDisplay.html :$!";
985  my $html = join('', <HTML>);
986
987  # We can't let the city be changed here;  this block is a part of
988  # a larger routed allocation and therefore by definition can't be moved.
989  # block and city are static.
990##fixme
991# Needs thinking.  Have to allow changes to city to correct errors, no?
992  $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
993
994  if ($IPDBacl{$authuser} =~ /c/) {
995    $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
996
997# Screw it.  Changing allocation types gets very ugly VERY quickly- especially
998# with the much longer list of allocation types.
999# We'll just show what type of block it is.
1000
1001# this has now been Requested, so here goes.
1002
1003##fixme The check here should be built from the database
1004    if ($data[2] =~ /^.[ne]$/) {
1005      # Block that can be changed
1006      my $blockoptions = "<select name=alloctype><option".
1007        (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
1008        (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
1009        (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
1010        (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
1011        (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
1012        (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
1013        (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
1014        "</select>\n";
1015      $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
1016    } else {
1017      $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
1018    }
1019    $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
1020    $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
1021    $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
1022    $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
1023  } else {
1024    $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
1025    $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
1026    $html =~ s/\$\$CITY\$\$/$data[3]/g;
1027    $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
1028    $html =~ s/\$\$DESC\$\$/$data[5]/g;
1029    $html =~ s/\$\$NOTES\$\$/$data[6]/g;
1030  }
1031  my ($lastmod,undef) = split /\s+/, $data[7];
1032  $html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
1033
1034## Hack time!  SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
1035if ($data[2] =~ /.i/) {
1036  $html =~ s/\$\$SWIP\$\$/N\/A/;
1037} else {
1038  my $tmp = (($data[8] eq 'n') ? '<input type=checkbox name=swip>' : 
1039        '<input type=checkbox name=swip checked=yes>');
1040  $html =~ s/\$\$SWIP\$\$/$tmp/;
1041}
1042
1043  # Allows us to "correctly" colour backgrounds in table
1044  my $i=1;
1045
1046  # Check to see if we can display sensitive data
1047  my $privdata = '';
1048  if ($IPDBacl{$authuser} =~ /s/) {
1049    $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
1050        qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
1051        qq($data[8]</textarea></td></tr>\n);
1052    $i++;
1053  }
1054  $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1055
1056  # More ACL trickery - we can live with forms that don't submit,
1057  # but we can't leave the extra table rows there, and we *really*
1058  # can't leave the submit buttons there.
1059  my $updok = '';
1060  if ($IPDBacl{$authuser} =~ /c/) {
1061    $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
1062        qq(<input type="submit" value=" Update this block " class="regular">).
1063        "</div></td></tr></form>\n";
1064    $i++;
1065  }
1066  $html =~ s/\$\$UPDOK\$\$/$updok/g;
1067
1068  my $delok = '';
1069  if ($IPDBacl{$authuser} =~ /d/) {
1070    $delok = qq(<form method="POST" action="main.cgi">
1071        <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
1072        <input type="hidden" name="action" value="delete">
1073        <input type="hidden" name="block" value="$webvar{block}">
1074        <input type="hidden" name="alloctype" value="$data[2]">
1075        <input type=submit value=" Delete this block ">
1076        </div></td></tr>);
1077  }
1078  $html =~ s/\$\$DELOK\$\$/$delok/;
1079
1080  print $html;
1081
1082} # edit()
1083
1084
1085# Stuff new info about a block into the db
1086# action=update
1087sub update {
1088  if ($IPDBacl{$authuser} !~ /c/) {
1089    printError("You shouldn't have been able to get here.  Access denied.");
1090    return;
1091  }
1092
1093  # Check to see if we can update restricted data
1094  my $privdata = '';
1095  if ($IPDBacl{$authuser} =~ /s/) {
1096    $privdata = ",privdata='$webvar{privdata}'";
1097  }
1098
1099  # Make sure incoming data is in correct format - custID among other things.
1100  return if !validateInput;
1101
1102  # SQL transaction wrapper
1103  eval {
1104    # Relatively simple SQL transaction here.
1105    my $sql;
1106    if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
1107      $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
1108        "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
1109        "$privdata where ip='$webvar{block}'";
1110    } else {
1111      $sql = "update allocations set custid='$webvar{custid}',".
1112        "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
1113        "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata ".
1114        "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
1115        "where cidr='$webvar{block}'";
1116    }
1117    # Log the details of the change.
1118    syslog "debug", $sql;
1119    $sth = $ip_dbh->prepare($sql);
1120    $sth->execute;
1121    $ip_dbh->commit;
1122  };
1123  if ($@) {
1124    my $msg = $@;
1125    carp "Transaction aborted because $msg";
1126    eval { $ip_dbh->rollback; };
1127    syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
1128    printError("Could not update block/IP $webvar{block}: $msg");
1129    return;
1130  }
1131
1132  # If we get here, the operation succeeded.
1133  syslog "notice", "$authuser updated $webvar{block}";
1134  open (HTML, "../updated.html")
1135        or croak "Could not open updated.html :$!";
1136  my $html = join('', <HTML>);
1137
1138my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
1139  $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
1140  $webvar{city} = desanitize($webvar{city});
1141  $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
1142  $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
1143  $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
1144  $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
1145  $html =~ s/\$\$SWIP\$\$/$swiptmp/g;
1146  $webvar{circid} = desanitize($webvar{circid});
1147  $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
1148  $webvar{desc} = desanitize($webvar{desc});
1149  $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
1150  $webvar{notes} = desanitize($webvar{notes});
1151  $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
1152
1153  if ($IPDBacl{$authuser} =~ /s/) {
1154    $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
1155        qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
1156  }
1157  $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1158
1159  print $html;
1160
1161} # update()
1162
1163
1164# Delete an allocation.
1165sub remove {
1166  if ($IPDBacl{$authuser} !~ /d/) {
1167    printError("You shouldn't have been able to get here.  Access denied.");
1168    return;
1169  }
1170
1171  #show confirm screen.
1172  open HTML, "../confirmRemove.html"
1173        or croak "Could not open confirmRemove.html :$!";
1174  my $html = join('', <HTML>);
1175  close HTML;
1176
1177  # Serves'em right for getting here...
1178  if (!defined($webvar{block})) {
1179    printError("Error 332");
1180    return;
1181  }
1182
1183  my ($cidr, $custid, $type, $city, $circid, $desc, $notes, $alloctype, $privdata);
1184
1185  if ($webvar{alloctype} eq 'rm') {
1186    $sth = $ip_dbh->prepare("select cidr,city from routed where cidr='$webvar{block}'");
1187    $sth->execute();
1188
1189# This feels...  extreme.
1190    croak $sth->errstr() if($sth->errstr());
1191
1192    $sth->bind_columns(\$cidr,\$city);
1193    $sth->execute();
1194    $sth->fetch || croak $sth->errstr();
1195    $custid = "N/A";
1196    $alloctype = $webvar{alloctype};
1197    $circid = "N/A";
1198    $desc = "N/A";
1199    $notes = "N/A";
1200
1201  } elsif ($webvar{alloctype} eq 'mm') {
1202    $cidr = $webvar{block};
1203    $city = "N/A";
1204    $custid = "N/A";
1205    $alloctype = $webvar{alloctype};
1206    $circid = "N/A";
1207    $desc = "N/A";
1208    $notes = "N/A";
1209  } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
1210
1211    # Unassigning a static IP
1212    my $sth = $ip_dbh->prepare("select ip,custid,city,type,notes,circuitid,privdata".
1213        " from poolips where ip='$webvar{block}'");
1214    $sth->execute();
1215#  croak $sth->errstr() if($sth->errstr());
1216
1217    $sth->bind_columns(\$cidr, \$custid, \$city, \$alloctype, \$notes, \$circid,
1218        \$privdata);
1219    $sth->fetch() || croak $sth->errstr;
1220
1221  } else { # done with alloctype=~ /^.i$/
1222
1223    my $sth = $ip_dbh->prepare("select cidr,custid,type,city,circuitid,description,notes,privdata".
1224        " from allocations where cidr='$webvar{block}'");
1225    $sth->execute();
1226#       croak $sth->errstr() if($sth->errstr());
1227
1228    $sth->bind_columns(\$cidr, \$custid, \$alloctype, \$city, \$circid, \$desc,
1229        \$notes, \$privdata);
1230    $sth->fetch() || carp $sth->errstr;
1231  } # end cases for different alloctypes
1232
1233  # Munge everything into HTML
1234  $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
1235  $html =~ s|\$\$BLOCK\$\$|$cidr|g;
1236  $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
1237  $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
1238  $html =~ s|\$\$CITY\$\$|$city|g;
1239  $html =~ s|\$\$CUSTID\$\$|$custid|g;
1240  $html =~ s|\$\$CIRCID\$\$|$circid|g;
1241  $html =~ s|\$\$DESC\$\$|$desc|g;
1242  $html =~ s|\$\$NOTES\$\$|$notes|g;
1243
1244  $html =~ s|\$\$ACTION\$\$|finaldelete|g;
1245
1246  # Set the warning text.
1247  if ($alloctype =~ /^.[pd]$/) {
1248    $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>|;
1249  } else {
1250    $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
1251  }
1252
1253  my $i = 1;
1254  # Check to see if user is allowed to do anything with sensitive data
1255  if ($IPDBacl{$authuser} =~ /s/) {
1256    $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
1257        qq(<td class=regular>$privdata</td></tr>\n);
1258    $i++;
1259  }
1260  $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
1261
1262  $i = ++$i % 2;
1263  $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
1264
1265  print $html;
1266} # end edit()
1267
1268
1269# Delete an allocation.  Return it to the freeblocks table;  munge
1270# data as necessary to keep as few records as possible in freeblocks
1271# to prevent weirdness when allocating blocks later.
1272# Remove IPs from pool listing if necessary
1273sub finalDelete {
1274  if ($IPDBacl{$authuser} !~ /d/) {
1275    printError("You shouldn't have been able to get here.  Access denied.");
1276    return;
1277  }
1278
1279  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
1280
1281  if ($code eq 'OK') {
1282    print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";
1283    syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}";
1284    # Notify tech@ when a block/IP is deallocated
1285    mailNotify('tech@example.com',"REMOVED: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
1286        "$disp_alloctypes{$webvar{alloctype}} $webvar{block} deallocated by $authuser\n");
1287  } else {
1288    if ($webvar{alloctype} =~ /^.i$/) {
1289      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
1290      printError("Could not deallocate static IP $webvar{block}: $msg");
1291    } else {
1292      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
1293      printError("Could not deallocate netblock $webvar{block}: $msg");
1294    }
1295  }
1296
1297} # finalDelete
1298
1299
1300sub exitError {
1301  my $errStr = $_[0];
1302  printHeader('','');
1303  print qq(<center><p class="regular"> $errStr </p>
1304<input type="button" value="Back" onclick="history.go(-1)">
1305</center>
1306);
1307  printFooter();
1308  exit;
1309} # errorExit
1310
1311
1312# Just in case we manage to get here.
1313exit 0;
Note: See TracBrowser for help on using the repository browser.