Ignore:
Timestamp:
05/14/13 18:10:22 (11 years ago)
Author:
Kris Deugau
Message:

/branches/stable

Merge /trunk r517 (merge /branches/htmlform)
Conflicts all resolved towards /trunk.
Fix a minor syntax error with "while (@data..." -> "while (my @data..."
(may cause merge conflicts later)

Location:
branches/stable
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/stable

  • branches/stable/cgi-bin/main.cgi

    r592 r593  
    1212use warnings;   
    1313use CGI::Carp qw(fatalsToBrowser);
     14use CGI::Simple;
     15use HTML::Template;
    1416use DBI;
    15 use CommonWeb qw(:ALL);
    1617use POSIX qw(ceil);
    1718use NetAddr::IP;
    … …  
    2627
    2728openlog "IPDB","pid","$IPDB::syslog_facility";
     29
     30## Environment.  Collect some things, process some things, set some things...
    2831
    2932# Collect the username from HTTP auth.  If undefined, we're in
    … …  
    3639}
    3740
     41# anyone got a better name?  :P
     42my $thingroot = $ENV{SCRIPT_FILENAME};
     43$thingroot =~ s|cgi-bin/main.cgi||;
     44
    3845syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}";
     46
     47##fixme there *must* be a better order to do things in so this can go back where it was
     48# CGI fiddling done here so we can declare %webvar so we can alter $webvar{action}
     49# to show the right page on DB errors.
     50# Set up the CGI object...
     51my $q = new CGI::Simple;
     52# ... and get query-string params as well as POST params if necessary
     53$q->parse_query_string;
     54
     55# Convenience;  saves changing all references to %webvar
     56##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     57my %webvar = $q->Vars;
    3958
    4059# Why not a global DB handle?  (And a global statement handle, as well...)
    … …  
    4564($ip_dbh,$errstr) = connectDB_My;
    4665if (!$ip_dbh) {
    47   exitError("Database error: $errstr\n");
    48 }
    49 initIPDBGlobals($ip_dbh);
    50 
    51 # Headerize!  Make sure we replace the $$EXTRA0$$ bit as needed.
    52 printHeader('', $IPDB::webpath, ($IPDBacl{$authuser} =~ /a/ ?
    53         '<td align=right><a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=assign">Add new assignment</a>' : ''
    54         ));
    55 
    56 
    57 # Global variables
    58 my %webvar = parse_post();
    59 cleanInput(\%webvar);
     66  $webvar{action} = "dberr";
     67} else {
     68  initIPDBGlobals($ip_dbh);
     69}
     70
     71# Set up some globals
     72$ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
     73
     74my $header = HTML::Template->new(filename => "header.tmpl");
     75my $footer = HTML::Template->new(filename => "footer.tmpl");
     76
     77$header->param(version => $IPDB::VERSION);
     78$header->param(addperm => $IPDBacl{$authuser} =~ /a/);
     79$header->param(webpath => $IPDB::webpath);
     80print "Content-type: text/html\n\n", $header->output;
    6081
    6182
    6283#main()
     84my $aclerr;
    6385
    6486if(!defined($webvar{action})) {
    65   $webvar{action} = "<NULL>";   #shuts up the warnings.
     87  $webvar{action} = "index";    #shuts up the warnings.
     88}
     89
     90my $page;
     91if (-e "$ENV{HTML_TEMPLATE_ROOT}/$webvar{action}.tmpl") {
     92  $page = HTML::Template->new(filename => "$webvar{action}.tmpl");
     93} else {
     94  $page = HTML::Template->new(filename => "dunno.tmpl");
    6695}
    6796
    … …  
    7099} elsif ($webvar{action} eq 'addmaster') {
    71100  if ($IPDBacl{$authuser} !~ /a/) {
    72     printError("You shouldn't have been able to get here.  Access denied.");
     101    $aclerr = 'addmaster';
     102  }
     103} elsif ($webvar{action} eq 'newmaster') {
     104
     105  if ($IPDBacl{$authuser} !~ /a/) {
     106    $aclerr = 'addmaster';
    73107  } else {
    74     open HTML, "<../addmaster.html";
    75     my $html = join('',<HTML>);
    76     close HTML;
    77     $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;
    78     print $html;
    79   }
    80 } elsif ($webvar{action} eq 'newmaster') {
    81 
    82   if ($IPDBacl{$authuser} !~ /a/) {
    83     printError("You shouldn't have been able to get here.  Access denied.");
    84   } else {
    85 
    86108    my $cidr = new NetAddr::IP $webvar{cidr};
    87 
    88     print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
     109    $page->param(cidr => "$cidr");
    89110
    90111    my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr});
    91112
    92113    if ($code eq 'FAIL') {
    93       carp "Transaction aborted because $msg";
    94114      syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
    95       printError("Could not add master block $webvar{cidr} to database: $msg");
     115      $page->param(err => $msg);
    96116    } else {
    97       print "<div type=heading align=center>Success!</div>\n";
    98117      syslog "info", "$authuser added master block $webvar{cidr}";
    99118    }
    … …  
    136155}
    137156elsif ($webvar{action} eq 'nodesearch') {
    138   open HTML, "<../nodesearch.html";
    139   my $html = join('',<HTML>);
    140   close HTML;
    141   $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;
    142 
    143157  $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    144   $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    145   my $nodes = '';
     158  $sth->execute() or $page->param(errmsg => $sth->errstr);
     159  my @nodelist;
    146160  while (my ($nid,$nname) = $sth->fetchrow_array()) {
    147     $nodes .= "<option value='$nid'>$nname</option>\n";
    148   }
    149   $html =~ s/\$\$NODELIST\$\$/$nodes/;
    150 
    151   print $html;
    152 }
    153 
    154 # Default is an error.  It shouldn't be possible to easily get here.
    155 # The only way I can think of offhand is to just call main.cgi bare-
    156 # which is not in any way guaranteed to provide anything useful.
     161    my %row = (nodeid => $nid, nodename => $nname);
     162    push @nodelist, \%row;
     163  }
     164  $page->param(nodelist => \@nodelist);
     165}
     166
     167# DB failure.  Can't do much here, really.
     168elsif ($webvar{action} eq 'dberr') {
     169  $page->param(errmsg => $errstr);
     170}
     171
     172# Default is an error.  It shouldn't be possible to get here unless you're
     173# randomly feeding in values for webvar{action}.
    157174else {
    158175  my $rnd = rand 500;
    159176  my $boing = sprintf("%.2f", rand 500);
    160   my @excuses = ("Aether cloudy.  Ask again later.","The gods are unhappy with your sacrifice.",
    161         "Because one of it's legs are both the same", "*wibble*",
    162         "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
    163         "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
    164   printAndExit("Error $boing:  ".$excuses[$rnd/30.0]);
     177  my @excuses = (
     178        "Aether cloudy.  Ask again later about $webvar{action}.",
     179        "The gods are unhappy with your sacrificial $webvar{action}.",
     180        "Because one of $webvar{action}'s legs are both the same",
     181        "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!",
     182        "Hey, man, you've had your free $webvar{action}.  Next one's gonna...  <i>cost</i>....",
     183        "I ain't done $webvar{action}",
     184        "Oooo, look!  A flying $webvar{action}!",
     185        "$webvar{action} too evil, avoiding.",
     186        "Rocks fall, $webvar{action} dies.",
     187        "Bit bucket must be emptied before I can $webvar{action}..."
     188        );
     189  $page->param(dunno => $excuses[$rnd/50.0]);
    165190}
    166191## Finally! Done with that NASTY "case" emulation!
    167192
     193
     194# Switch to a different template if we've tripped on an ACL error.
     195# Note that this should only be exercised in development, when
     196# deeplinked, or when being attacked;  normal ACL handling should
     197# remove the links a user is not allowed to click on.
     198if ($aclerr) {
     199  $page = HTML::Template->new(filename => "aclerror.tmpl");
     200  $page->param(ipdbfunc => $aclmsg{$aclerr});
     201}
    168202
    169203
    … …  
    171205finish($ip_dbh);
    172206
    173 print qq(<div align=right style="position: absolute; right: 30px;">).
    174         qq(<a href="$IPDB::webpath/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
    175         if $IPDBacl{$authuser} =~ /A/;
    176 
    177 # We print the footer here, so we don't have to do it elsewhere.
    178 printFooter;
     207## Do all our printing here so we can generate errors and stick them into the slots in the templates.
     208
     209# can't do this yet, too many blowups
     210#print "Content-type: text/html\n\n", $header->output;
     211$page->param(webpath => $IPDB::webpath);
     212print $page->output;
     213
     214# include the admin tools link in the output?
     215$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
     216$footer->param(webpath => $IPDB::webpath);
     217print $footer->output;
     218
    179219# Just in case something waaaayyy down isn't in place
    180220# properly... we exit explicitly.
    181 exit;
    182 
    183 
    184 
    185 # args are: a reference to an array with the row to be printed and the
    186 # class(stylesheet) to use for formatting.
    187 # if ommitting the class - call the sub as &printRow(\@array)
    188 sub printRow {
    189   my ($rowRef,$class) = @_;
    190 
    191   if (!$class) {
    192     print "<tr>\n";
    193   } else {
    194     print "<tr class=\"$class\">\n";
    195   }
    196 
    197 ELEMENT:  foreach my $element (@$rowRef) {
    198     if (!defined($element)) {
    199       print "<td></td>\n";
    200       next ELEMENT;
    201     }
    202     $element =~ s|\n|</br>|g;
    203     print "<td>$element</td>\n";
    204   }
    205   print "</tr>";
    206 } # printRow
    207 
    208 
    209 # Prints table headings.  Accepts any number of arguments;
    210 # each argument is a table heading.
    211 sub startTable {
    212   print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
    213 
    214   foreach(@_) {
    215     print qq(<td class="heading">$_</td>);
    216   }
    217   print "</tr>\n";
    218 } # startTable
     221exit 0;
    219222
    220223
    221224# Initial display:  Show master blocks with total allocated subnets, total free subnets
    222225sub showSummary {
    223 
    224   startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
    225         'Free netblocks', 'Largest free block');
    226 
    227226  my %allocated;
    228227  my %free;
    … …  
    264263  }
    265264
    266   # Print the data.
    267   my $count=0;
     265  # Assemble the data to stuff into the template.
     266  my @masterlist;
     267  my $rowclass=0;
    268268  foreach my $master (@masterblocks) {
    269     my @row = ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
    270         $routed{"$master"}, $allocated{"$master"}, $free{"$master"},
    271         ( ($bigfree{"$master"} eq '') ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
     269    my %row = (
     270        rowclass => $rowclass++ % 2,
     271        master => "$master",
     272        routed => $routed{"$master"},
     273        allocated => $allocated{"$master"},
     274        free => $free{"$master"},
     275        bigfree => ( ($bigfree{"$master"} eq '') ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
    272276        );
    273 
    274     printRow(\@row, 'color1' ) if($count%2==0);
    275     printRow(\@row, 'color2' ) if($count%2!=0);
    276     $count++;
    277   }
    278   print "</table>\n";
    279   if ($IPDBacl{$authuser} =~ /a/) {
    280     print qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n);
    281   }
    282   print "Note:  Free blocks noted here include both routed and unrouted blocks.\n";
     277    push (@masterlist, \%row);
     278  }
     279  $page->param(masterlist => \@masterlist);
     280
     281  $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) );
    283282
    284283} # showSummary
    … …  
    292291sub showMaster {
    293292
    294   print qq(<center><div class="heading">Summarizing routed blocks for ).
    295         qq($webvar{block}:</div></center><br>\n);
     293  $page->param(master => $webvar{block});
    296294
    297295  my %allocated;
    298296  my %free;
    299   my %routed;
     297  my %cities;
    300298  my %bigfree;
    301299
    … …  
    315313    $bigfree{"$cidr"} = 128;
    316314    # Retain the routing destination
    317     $routed{"$cidr"} = $data[1];
     315    $cities{"$cidr"} = $data[1];
    318316  }
    319317
    320318  # Check if there were actually any blocks routed from this master
    321319  if ($i > 0) {
    322     startTable('Routed block','Routed to','Allocated blocks',
    323         'Free blocks','Largest free block');
    324320
    325321    # Count the allocations
    … …  
    349345    }
    350346
    351     # Print the data.
    352     my $count=0;
     347    my @routed;
     348    my $rowclass = 0;
    353349    foreach my $master (@localmasters) {
    354       my @row = ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
    355         $routed{"$master"}, $allocated{"$master"},
    356         $free{"$master"},
    357         ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
    358       );
    359       printRow(\@row, 'color1' ) if($count%2==0);
    360       printRow(\@row, 'color2' ) if($count%2!=0);
    361       $count++;
    362     }
    363   } else {
    364     # If a master block has no routed blocks, then by definition it has no
    365     # allocations, and can be deleted.
    366     print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    367         qq($master.</div>\n).
    368         ($IPDBacl{$authuser} =~ /d/ ?
    369                 qq(<form action="$IPDB::webpath/cgi-bin/main.cgi" method=POST>\n).
    370                 qq(<input type=hidden name=action value="delete">\n).
    371                 qq(<input type=hidden name=block value="$master">\n).
    372                 qq(<input type=hidden name=alloctype value="mm">\n).
    373                 qq(<input type=submit value=" Remove this master ">\n).
    374                 qq(</form></center>\n) :
    375                 '');
     350      my %row = (
     351        rowclass => $rowclass++ % 2,
     352        block => "$master",
     353        city => $cities{"$master"},
     354        nsubs => $allocated{"$master"},
     355        nfree => $free{"$master"},
     356        lfree => ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
     357        );
     358      push @routed, \%row;
     359    }
     360    $page->param(routedlist => \@routed);
    376361
    377362  } # end check for existence of routed blocks in master
    378363
    379   print qq(</table>\n<hr width="60%">\n).
    380         qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
    381 
    382   startTable('Netblock','Range');
     364  $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/));
    383365
    384366  # Snag the free blocks.
    … …  
    387369        "routed='n' order by cidr");
    388370  $sth->execute();
     371  my @unrouted;
     372  my $rowclass = 0;
    389373  while (my @data = $sth->fetchrow_array()) {
    390374    my $cidr = new NetAddr::IP $data[0];
    391     my @row = (
    392         ($IPDBacl{$authuser} =~ /a/ ?
    393                 qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=n">$cidr</a>)
    394                 : $cidr),
    395         $cidr->range);
    396     printRow(\@row, 'color1' ) if($count%2==0);
    397     printRow(\@row, 'color2' ) if($count%2!=0);
    398     $count++;
    399   }
    400 
    401   print "</table>\n";
     375    my %row = (
     376        rowclass => $rowclass++ % 2,
     377        fblock => "$cidr",
     378        frange => $cidr->range
     379        );
     380    push @unrouted, \%row;
     381  }
     382  $page->param(unrouted => \@unrouted);
     383
    402384} # showMaster
    403385
    … …  
    416398  $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
    417399  $sth->execute;
    418   my @data = $sth->fetchrow_array;
    419 
    420   print qq(<center><div class="heading">Summarizing allocated blocks for ).
    421         qq($master ($data[0]):</div></center><br>\n);
    422 
    423   startTable('CIDR allocation','Customer Location','Type','CustID','SWIPed?','Description/Name');
     400  my ($rcity) = $sth->fetchrow_array;
     401
     402  $page->param(master => "$master");
     403  $page->param(rcity => $rcity);
    424404
    425405  # Snag the allocations for this block
    … …  
    432412  my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
    433413
    434   my $count=0;
    435   while (my @data = $sth->fetchrow_array()) {
    436     # cidr,city,type,custid,swip,description, as per the SELECT
    437     my $cidr = new NetAddr::IP $data[0];
    438 
    439     # Clean up extra spaces that are borking things.
    440 #    $data[2] =~ s/\s+//g;
    441 
    442     $custsth->execute($data[3]);
     414  my $rowclass = 0;
     415  my @blocklist;
     416  while (my ($cidr,$city,$type,$custid,$swip,$desc) = $sth->fetchrow_array()) {
     417    $custsth->execute($custid);
    443418    my ($ncust) = $custsth->fetchrow_array();
    444419
    445     # Prefix subblocks with "Sub "
    446     my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
    447         qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]&reallyblock=1">$data[0]</a>),
    448         $data[1], $disp_alloctypes{$data[2]}, $data[3],
    449         ($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), $data[5]);
    450     # If the allocation is a pool, allow listing of the IPs in the pool.
    451     if ($data[2] =~ /^.[pd]$/) {
    452       $row[0] .= qq( &nbsp; <a href="$IPDB::webpath/cgi-bin/main.cgi?action=listpool).
    453         "&pool=$data[0]\">List IPs</a>";
    454     }
    455 
    456     printRow(\@row, 'color1') if ($count%2 == 0);
    457     printRow(\@row, 'color2') if ($count%2 != 0);
    458     $count++;
    459   }
    460 
    461   print "</table>\n";
    462 
    463   # If the routed block has no allocations, by definition it only has
    464   # one free block, and therefore may be deleted.
    465   if ($count == 0) {
    466     print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    467         qq($master.</div></center>\n).
    468         ($IPDBacl{$authuser} =~ /d/ ?
    469                 qq(<form action="$IPDB::webpath/cgi-bin/main.cgi" method=POST>\n).
    470                 qq(<input type=hidden name=action value="delete">\n).
    471                 qq(<input type=hidden name=block value="$master">\n).
    472                 qq(<input type=hidden name=alloctype value="rm">\n).
    473                 qq(<input type=submit value=" Remove this block ">\n).
    474                 qq(</form>\n) :
    475                 '');
    476   }
    477 
    478   print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
    479         qq(submaster $master</div></center>\n);
    480 
    481   startTable('CIDR block','Range');
     420    my %row = (
     421        rowclass => $rowclass++ % 2,
     422        block => $cidr,
     423        city => $city,
     424        type => $disp_alloctypes{$type},
     425        custid => $custid,
     426        swip => ($swip eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'),
     427        desc => $desc
     428        );
     429    $row{subblock} = ($type =~ /^.r$/);         # hmf.  wonder why these won't work in the hash declaration...
     430    $row{listpool} = ($type =~ /^.[pd]$/);
     431    push (@blocklist, \%row);
     432  }
     433  $page->param(blocklist => \@blocklist);
     434
     435  $page->param(delrouted => $IPDBacl{$authuser} =~ /d/);
    482436
    483437  # Snag the free blocks.  We don't really *need* to be pedantic about avoiding
    484438  # unrouted free blocks, but it's better to let the database do the work if we can.
    485   $count = 0;
     439  $rowclass = 0;
     440  my @unassigned;
    486441  $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
    487442        " order by cidr");
    488443  $sth->execute();
    489   while (my @data = $sth->fetchrow_array()) {
    490     # cidr,routed
    491     my $cidr = new NetAddr::IP $data[0];
    492     # Include some HairyPerl(TM) to prefix subblocks with "Sub "
    493     my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
    494         ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
    495         $cidr->range);
    496     printRow(\@row, 'color1') if ($count%2 == 0);
    497     printRow(\@row, 'color2') if ($count%2 != 0);
    498     $count++;
    499   }
    500 
    501   print "</table>\n";
     444  while (my ($cidr_db,$routed) = $sth->fetchrow_array()) {
     445    my $cidr = new NetAddr::IP $cidr_db;
     446
     447    my %row = (
     448        rowclass => $rowclass++ % 2,
     449        subblock => ($routed ne 'y' && $routed ne 'n'),
     450        fblock => $cidr_db,
     451        fbtype => $routed,
     452        frange => $cidr->range,
     453        );
     454    push @unassigned, \%row;
     455  }
     456  $page->param(unassigned => \@unassigned);
     457
    502458} # showRBlock
    503459
    … …  
    508464  my $cidr = new NetAddr::IP $webvar{pool};
    509465
    510   my ($pooltype,$poolcity);
     466  $page->param(block => $webvar{pool});
     467  $page->param(netip => $cidr->addr);
     468  $cidr++;
     469  $page->param(gate => $cidr->addr);
     470  $cidr--;  $cidr--;
     471  $page->param(bcast => $cidr->addr);
     472  $page->param(mask => $cidr->mask);
    511473
    512474  # Snag pool info for heading
    513   $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
    514   $sth->execute;
    515   $sth->bind_columns(\$pooltype, \$poolcity);
    516   $sth->fetch() || carp $sth->errstr;
    517 
    518   print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
    519         qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n);
     475  $sth = $ip_dbh->prepare("select type,city from allocations where cidr=?");
     476  $sth->execute($webvar{pool});
     477  my ($pooltype, $poolcity) = $sth->fetchrow_array;
     478
     479  $page->param(disptype => $disp_alloctypes{$pooltype});
     480  $page->param(city => $poolcity);
     481
    520482  # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
    521   if ($pooltype =~ /^.d$/) {
    522     print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
    523     print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
    524         $cidr->addr."</td></tr>\n";
    525     $cidr++;
    526     print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
    527     $cidr--;  $cidr--;
    528     print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
    529         "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
    530         "</table></div></div>\n";
    531   }
     483  $page->param(realblock => $pooltype =~ /^.d$/);
    532484
    533485# probably have to add an "edit IP allocation" link here somewhere.
    534486
    535   startTable('IP','Customer ID','Available?','Description','');
    536487  $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
    537488        " from poolips where pool='$webvar{pool}' order by ip");
    538489  $sth->execute;
    539   my $count = 0;
    540   while (my @data = $sth->fetchrow_array) {
    541     # pool,ip,custid,city,ptype,available,notes,description,circuitid
    542     # ip,custid,available,description,type
    543     # If desc is "null", make it not null.  <g>
    544     if ($data[3] eq '') {
    545       $data[3] = '&nbsp;';
    546     }
    547     # Some nice hairy Perl to decide whether to allow unassigning each IP
    548     #   -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
    549     #      else we print a blank space
    550     my @row;
    551     if ($data[2] eq 'y' && $IPDBacl{$authuser} =~ /a/) {
    552       push @row, qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$data[0]&fbtype=i">$data[0]</a>);
    553     } else {
    554       push @row, qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>);
    555     }
    556     push @row, (
    557         $data[1],$data[2],$data[3],
    558         ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
    559           ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=delete&block=$data[0]&".
    560            "alloctype=$data[4]\">Unassign this IP</a>") :
    561           ("&nbsp;") )
     490  my @poolips;
     491  my $rowclass = 0;
     492  while (my ($ip,$custid,$available,$desc,$type) = $sth->fetchrow_array) {
     493    my %row = (
     494        rowclass => $rowclass++ % 2,
     495        ip => $ip,
     496        custid => $custid,
     497        available => $available,
     498        desc => $desc,
     499        maydel => $IPDBacl{$authuser} =~ /d/,
     500        delme => $available eq 'n'
    562501        );
    563     printRow(\@row, 'color1') if($count%2==0);
    564     printRow(\@row, 'color2') if($count%2!=0);
    565     $count++;
    566   }
    567   print "</table>\n";
     502    push @poolips, \%row;
     503  }
     504  $page->param(poolips => \@poolips);
    568505
    569506} # end listPool
    … …  
    575512
    576513  if ($IPDBacl{$authuser} !~ /a/) {
    577     printError("You shouldn't have been able to get here.  Access denied.");
     514    $aclerr = 'addblock';
    578515    return;
    579516  }
    580517
    581   my $html;
     518  # hack pthbttt eww
     519  $webvar{block} = '' if !$webvar{block};
     520
     521# hmm.  TMPL_IF block and TMPL_ELSE block on these instead?
     522  $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0));
     523  $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1));
     524  $page->param(block => $webvar{block});        # fb-assign flag, if block is set, we're in fb-assign
     525  $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y'));
    582526
    583527  # New special case- block to assign is specified
    584528  if ($webvar{block} ne '') {
    585     open HTML, "../fb-assign.html"
    586         or croak "Could not open fb-assign.html: $!";
    587     $html = join('',<HTML>);
    588     close HTML;
    589529    my $block = new NetAddr::IP $webvar{block};
    590530
    591     my $typelist = '';
    592 
    593     $html =~ s|\$\$WEBPATH\$\$|$IPDB::webpath|g;
    594     if ($IPDB::allowprivrange eq 'y' or $IPDB::allowprivrange eq 'on') {
    595       $html =~ s/\$\$ALLOWPRIV\$\$/checked=checked/;
    596     } else {
    597       $html =~ s/\$\$ALLOWPRIV\$\$//;
    598     }
    599 
     531    # Handle contained freeblock allocation.
    600532    # This is a little dangerous, as it's *theoretically* possible to
    601533    # get fbtype='n' (aka a non-routed freeblock).  However, should
    602534    # someone manage to get there, they get what they deserve.
    603 #    if ($webvar{fbtype} ne 'y') {
    604 #      # Snag the type of the block from the database.  We have no
    605 #      # convenient way to pass this in from the calling location.  :/
    606 #      $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
    607 #      $sth->execute;
    608 #      my @data = $sth->fetchrow_array;
    609 #      $data[0] =~ s/c$/r/;     # Munge the type into the correct form
    610 #      $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
    611 #    } else {
    612 if ($webvar{fbtype} eq 'n') {
    613   $typelist = "Routed netblock<input type=hidden name=alloctype value=rm>\n";
    614   $html =~ s|\$\$ALLOCBLOCK\$\$|<input name=block size=25 value="$block">|;
    615   $html =~ s|\$\$BLOCK\$\$|$block|g;
    616 } elsif ($webvar{fbtype} eq 'i') {
    617   my ($iptype,$pool) = $ip_dbh->selectrow_array("SELECT type,pool FROM poolips WHERE ip = ?", undef, ($block));
    618   $typelist = "$list_alloctypes{$iptype}<input type=hidden name=alloctype value=$iptype>\n";
    619   $html =~ s|\$\$ALLOCBLOCK\$\$|$block<input type=hidden name=block size=25 value="$block">|;
    620   $html =~ s|\$\$BLOCK\$\$|$pool|g;
    621 } else {
    622   $html =~ s|\$\$ALLOCBLOCK\$\$|<input name=block size=25 value="$block">|;
    623   $html =~ s|\$\$BLOCK\$\$|$block|g;
    624       $typelist .= qq(<select name="alloctype">\n);
     535    if ($webvar{fbtype} ne 'y') {
     536      # Snag the type of the container block from the database.
     537      $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
     538      $sth->execute;
     539      my @data = $sth->fetchrow_array;
     540      $data[0] =~ s/c$/r/;      # Munge the type into the correct form
     541      $page->param(fbdisptype => $list_alloctypes{$data[0]});
     542      $page->param(type => $data[0]);
     543    } else {
    625544      $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
    626545        "and type not like '_i' order by listorder");
    627546      $sth->execute;
    628       my @data = $sth->fetchrow_array;
    629       $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
    630       while (@data = $sth->fetchrow_array) {
    631         $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
     547      my @typelist;
     548      my $selflag = 0;
     549      while (my @data = $sth->fetchrow_array) {
     550        my %row = (tval => $data[0],
     551                type => $data[1],
     552                sel => ($selflag == 0 ? ' selected' : '')
     553                );
     554        push (@typelist, \%row);
     555        $selflag++;
    632556      }
    633       $typelist .= "</select>\n";
    634     }
    635     $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
     557      $page->param(typelist => \@typelist);
     558    }
    636559  } else {
    637     open HTML, "../assign.html"
    638         or croak "Could not open assign.html: $!";
    639     $html = join('',<HTML>);
    640     close HTML;
    641     $html =~ s|\$\$WEBPATH\$\$|$IPDB::webpath|g;
    642     if ($IPDB::allowprivrange eq 'y' or $IPDB::allowprivrange eq 'on') {
    643       $html =~ s/\$\$ALLOWPRIV\$\$/checked=checked/;
    644     } else {
    645       $html =~ s/\$\$ALLOWPRIV\$\$//;
    646     }
    647     my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
     560    my @masterlist;
    648561    foreach my $master (@masterblocks) {
    649       $masterlist .= "<option>$master</option>\n";
    650     }
    651     $masterlist .= "</select>\n";
    652     $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g;
    653     my $pops = '';
     562      my %row = (master => "$master");
     563      push (@masterlist, \%row);
     564    }
     565    $page->param(masterlist => \@masterlist);
     566
     567    my @pops;
    654568    foreach my $pop (@poplist) {
    655       $pops .= "<option>$pop</option>\n";
    656     }
    657     $html =~ s|\$\$POPLIST\$\$|$pops|g;
    658     my $typelist = '';
    659     $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
     569      my %row = (pop => $pop);
     570      push (@pops, \%row);
     571    }
     572    $page->param(pops => \@pops);
     573
     574    # could arguably include routing (500) in the list, but ATM it doesn't
     575    # make sense, and in any case that shouldn't be structurally possible here.
     576    $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder");
    660577    $sth->execute;
    661     my @data = $sth->fetchrow_array;
    662     $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
     578    my @typelist;
     579    my $selflag = 0;
    663580    while (my @data = $sth->fetchrow_array) {
    664       $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
    665     }
    666     $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
    667   }
    668   my $cities = '';
     581      my %row = (tval => $data[0],
     582        type => $data[1],
     583        sel => ($selflag == 0 ? ' selected' : '')
     584        );
     585      push (@typelist, \%row);
     586      $selflag++;
     587    }
     588    $page->param(typelist => \@typelist);
     589  }
     590
     591  my @cities;
    669592  foreach my $city (@citylist) {
    670     $cities .= "<option>$city</option>\n";
    671   }
    672   $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
     593    my %row = (city => $city);
     594    push (@cities, \%row);
     595  }
     596  $page->param(citylist => \@cities);
    673597
    674598## node hack
    675599  $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    676600  $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    677   my $nodes = '';
     601  my @nodes;
    678602  while (my ($nid,$nname) = $sth->fetchrow_array()) {
    679     $nodes .= "<option value='$nid'>$nname</option>\n";
    680   }
    681   $html =~ s/\$\$NODELIST\$\$/$nodes/;
     603    my %row = (nid => $nid, nname => $nname);
     604    push (@nodes, \%row);
     605  }
     606  $page->param(nodelist => \@nodes);
    682607## end node hack
    683608
    684   my $i = 0;
    685   $i++ if $webvar{fbtype} eq 'y';
    686   # Check to see if user is allowed to do anything with sensitive data
    687   my $privdata = '';
    688   if ($IPDBacl{$authuser} =~ /s/) {
    689     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    690         qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
    691         qq(</textarea></td></tr>\n);
    692     $i++;
    693   }
    694   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    695 
    696   $i = $i % 2;
    697   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    698 
    699   print $html;
     609  $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
    700610
    701611} # assignBlock
    … …  
    705615sub confirmAssign {
    706616  if ($IPDBacl{$authuser} !~ /a/) {
    707     printError("You shouldn't have been able to get here.  Access denied.");
     617    $aclerr = 'addblock';
    708618    return;
    709619  }
    … …  
    731641    $sth->execute;
    732642    my $optionlist;
    733     while (my @data = $sth->fetchrow_array) {
     643
     644    my @poollist;
     645    while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) {
    734646      # city,pool cidr,free IP count
    735       if ($data[2] > 0) {
    736         $optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n";
     647      if ($poolfree > 0) {
     648        my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree);
     649        push (@poollist, \%row);
    737650      }
    738651    }
     652    $page->param(staticip => 1);
     653    $page->param(poollist => \@poollist);
    739654    $cidr = "Single static IP";
    740     $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
     655##fixme:  need to handle "no available pools"
    741656
    742657  } else { # end show pool options
    … …  
    751666
    752667      if (!$webvar{maskbits}) {
    753         printError("Please specify a CIDR mask length.");
     668        $page->param(err => "Please specify a CIDR mask length.");
    754669        return;
    755670      }
    … …  
    789704            " block size for the pool.";
    790705        } else {
     706          if (!$webvar{pop}) {
     707            $page->param(err => 'Please select a POP to route the block from/through.');
     708            return;
     709          }
    791710          $city = $webvar{pop};
    792711          $failmsg = "No suitable free block found.<br>\nYou will have to route another".
    … …  
    810729      my @data = $sth->fetchrow_array();
    811730      if ($data[0] eq "") {
    812         printError($failmsg);
     731        $page->param(err => $failmsg);
    813732        return;
    814733      }
    … …  
    829748    } # check for freeblocks assignment or IPDB-controlled assignment
    830749
     750    $alloc_from = "$cidr";
    831751
    832752  } # if ($webvar{alloctype} =~ /^.i$/)
    833 
    834   open HTML, "../confirm.html"
    835         or croak "Could not open confirm.html: $!";
    836   my $html = join '', <HTML>;
    837   close HTML;
    838753
    839754## node hack
    … …  
    842757    $sth->execute($webvar{node});
    843758    my ($nodename) = $sth->fetchrow_array();
    844     $html =~ s/\$\$NODENAME\$\$/$nodename/;
    845     $html =~ s/\$\$NODEID\$\$/$webvar{node}/;
    846   } else {
    847     $html =~ s/\$\$NODENAME\$\$//;
    848     $html =~ s/\$\$NODEID\$\$//;
     759    $page->param(nodename => $nodename);
     760    $page->param(nodeid => $webvar{node});
    849761  }
    850762## end node hack
    851763
    852 ### gotta fix this in final
    853   # Stick in customer info as necessary - if it's blank, it just ends
    854   # up as blank lines ignored in the rendering of the page
    855         my $custbits;
    856   $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
    857 ###
    858 
    859764  # Stick in the allocation data
    860   $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
    861   $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
    862   $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
    863   $html =~ s|\$\$CIDR\$\$|$cidr|g;
    864   $webvar{city} = desanitize($webvar{city});
    865   $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
    866   $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
    867   $webvar{circid} = desanitize($webvar{circid});
    868   $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
    869   $webvar{desc} = desanitize($webvar{desc});
    870   $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
    871   $webvar{notes} = desanitize($webvar{notes});
    872   $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
    873   $html =~ s|\$\$ACTION\$\$|insert|g;
    874 
    875   my $i=1;
     765  $page->param(alloc_type => $webvar{alloctype});
     766  $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
     767  $page->param(alloc_from => $alloc_from);
     768  $page->param(cidr => $cidr);
     769  $page->param(city => $q->escapeHTML($webvar{city}));
     770  $page->param(custid => $webvar{custid});
     771  $page->param(circid => $q->escapeHTML($webvar{circid}));
     772  $page->param(desc => $q->escapeHTML($webvar{desc}));
     773
     774##fixme: find a way to have the displayed copy have <br> substitutions
     775# for newlines, and the <input> value have either encoded or bare newlines.
     776# Also applies to privdata.
     777  $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
     778
    876779  # Check to see if user is allowed to do anything with sensitive data
    877780  my $privdata = '';
    878   if ($IPDBacl{$authuser} =~ /s/) {
    879     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    880         qq(<td class=regular>$webvar{privdata}).
    881         qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
    882     $i++;
    883   }
    884 # We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
    885   $privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
     781  $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
     782        if $IPDBacl{$authuser} =~ /s/;
     783
     784  # Yay!  This now has it's very own little home.
     785  $page->param(billinguser => $webvar{userid})
    886786        if $webvar{userid};
    887   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    888 
    889   $i = $i % 2;
    890   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    891 
    892   print $html;
     787
     788##fixme:  this is only needed iff confirm.tmpl and
     789# confirmRemove.tmpl are merged (quite possible, just
     790# a little tedious)
     791  $page->param(action => "insert");
    893792
    894793} # end confirmAssign
    … …  
    898797sub insertAssign {
    899798  if ($IPDBacl{$authuser} !~ /a/) {
    900     printError("You shouldn't have been able to get here.  Access denied.");
     799    $aclerr = 'addblock';
    901800    return;
    902801  }
    … …  
    910809  # successful netblock allocation, the IP allocated for static
    911810  # IP, or the error message if an error occurred.
     811
    912812  my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
    913813        $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
    … …  
    917817    if ($webvar{alloctype} =~ /^.i$/) {
    918818      $msg =~ s|/32||;
    919       print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
    920         ( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
    921                 qq(<div><a href="https://billing.example.com/radius.pl?).
    922                 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
    923                 qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
    924         : "</div>");
     819      $page->param(staticip => $msg);
     820      $page->param(custid => $webvar{custid});
     821      $page->param(billinguser => $webvar{billinguser});
    925822      mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
    926823        "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
    … …  
    928825    } else {
    929826      my $netblock = new NetAddr::IP $webvar{fullcidr};
    930       if ($code eq 'OK') {
    931         print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
    932                 "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>";
    933       } else {
    934         print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
    935                 " added as $disp_alloctypes{$webvar{alloctype}} with a warning:<br>$msg</div>";
     827      $page->param(fullcidr => $webvar{fullcidr});
     828      $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
     829      $page->param(custid => $webvar{custid});
     830      if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
     831        $page->param(billinguser => $webvar{billinguser});
     832        $page->param(custid => $webvar{custid});
     833        $page->param(netaddr => $netblock->addr);
     834        $page->param(masklen => $netblock->masklen);
    936835      }
    937       print ( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
    938                 qq(<div><a href="https://billing.example.com/radius.pl?).
    939                 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
    940                 "&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
    941                 "&include_routed_subnet=1&ipdb=1".
    942                 qq(">Add this netblock to RADIUS user table</a></div>)
    943         : "</div>");
    944836      mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
    945837        "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
    … …  
    951843    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
    952844        "'$webvar{alloctype}' by $authuser failed: '$msg'";
    953     printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
     845    $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
    954846        " failed:<br>\n$msg\n");
    955847  }
    … …  
    963855sub validateInput {
    964856  if ($webvar{city} eq '-') {
    965     printError("Please choose a city.");
     857    $page->param(err => 'Please choose a city');
    966858    return;
    967859  }
    … …  
    972864    # Danger! Danger!  alloctype should ALWAYS be set by a dropdown.  Anyone
    973865    # managing to call things in such a way as to cause this deserves a cryptic error.
    974     printError("Invalid alloctype");
     866    $page->param(err => 'Invalid alloctype');
    975867    return;
    976868  }
    … …  
    980872  if ($def_custids{$webvar{alloctype}} eq '') {
    981873    if (!$webvar{custid}) {
    982       printError("Please enter a customer ID.");
     874      $page->param(err => 'Please enter a customer ID.');
    983875      return;
    984876    }
    … …  
    989881      my $status = CustIDCK->custid_exist($webvar{custid});
    990882      if ($CustIDCK::Error) {
    991         printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
     883        $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
    992884        return;
    993885      }
    994886      if (!$status) {
    995         printError("Customer ID not valid.  Make sure the Customer ID ".
     887        $page->param(err => "Customer ID not valid.  Make sure the Customer ID ".
    996888          "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
    997889          "non-customer assignments.");
    … …  
    1025917    }
    1026918  }
     919
     920  # if the alloctype has a restricted city/POP list as determined above,
     921  # and the reqested city/POP does not match that list, complain
    1027922  if ($flag ne 'n') {
    1028     printError("Please choose a valid POP location $flag.  Valid ".
     923    $page->param(err => "Please choose a valid POP location $flag.  Valid ".
    1029924        "POP locations are currently:<br>\n".join (" - ", @poplist));
    1030925    return;
    … …  
    1044939  # Two cases:  block is a netblock, or block is a static IP from a pool
    1045940  # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
    1046   if ($webvar{block} =~ /\/32$/ && !$webvar{reallyblock}) {
     941##fixme:  allow "SWIP" (publication to rWHOIS) of static IP data
     942  if ($webvar{block} =~ /\/32$/) {
    1047943    $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
    1048944  } else {
    … …  
    1057953  # Clean up extra whitespace on alloc type
    1058954  $data[2] =~ s/\s//;
    1059 
    1060   open (HTML, "../editDisplay.html")
    1061         or croak "Could not open editDisplay.html :$!";
    1062   my $html = join('', <HTML>);
    1063955
    1064956  # We can't let the city be changed here;  this block is a part of
    … …  
    1067959##fixme
    1068960# Needs thinking.  Have to allow changes to city to correct errors, no?
    1069   $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
    1070 
    1071   if ($IPDBacl{$authuser} =~ /c/) {
    1072     $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
    1073 
    1074 # Screw it.  Changing allocation types gets very ugly VERY quickly- especially
    1075 # with the much longer list of allocation types.
    1076 # We'll just show what type of block it is.
    1077 
    1078 # this has now been Requested, so here goes.
     961# Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads
     962
     963# @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip
     964
     965  $page->param(block => $webvar{block});
     966
     967  $page->param(custid => $data[1]);
     968  $page->param(city => $data[3]);
     969  $page->param(circid => $data[4]);
     970  $page->param(desc => $data[5]);
     971  $page->param(notes => $data[6]);
    1079972
    1080973##fixme The check here should be built from the database
    1081     if ($data[2] =~ /^.[ne]$/) {
    1082       # Block that can be changed
    1083       my $blockoptions = "<select name=alloctype><option".
    1084         (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
    1085         (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
    1086         (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
    1087         (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
    1088         (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
    1089         (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
    1090         (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
    1091         "</select>\n";
    1092       $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
    1093     } else {
    1094       $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
    1095     }
     974# Need to expand to support pool types too
     975  if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
     976    $page->param(changetype => 1);
     977    $page->param(alloctype => [
     978                { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" },
     979                { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
     980                { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
     981                { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
     982                { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" },
     983                { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" },
     984                { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" },
     985                ]
     986        );
     987  } else {
     988    $page->param(disptype => $disp_alloctypes{$data[2]});
     989    $page->param(type => $data[2]);
     990  }
     991
    1096992## node hack
    1097   $sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
     993  $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef".
     994        " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
    1098995  $sth->execute;
    1099   my ($nodeid) = $sth->fetchrow_array();
    1100   if ($nodeid) {
    1101     $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    1102     $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1103     my $nodes = "<select name=node>\n";
    1104     while (my ($nid,$nname) = $sth->fetchrow_array()) {
    1105       $nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
    1106     }
    1107     $nodes .= "</select>\n";
    1108     $html =~ s/\$\$NODE\$\$/$nodes/;
    1109   } else {
    1110     if ($data[2] eq 'fr' || $data[2] eq 'bi') {
     996  my ($nodeid,$nodename) = $sth->fetchrow_array();
     997  $page->param(havenodeid => $nodeid);
     998
     999  if ($data[2] eq 'fr' || $data[2] eq 'bi') {
     1000    $page->param(typesupportsnodes => 1);
     1001    $page->param(nodename => $nodename);
     1002
     1003##fixme:  this whole hack needs cleanup and generalization for all alloctypes
     1004##fixme:  arguably a bug that presence of a nodeid implies it can be changed..
     1005#  but except for manual database changes, only the two types fr and bi can
     1006#  (currently) have a nodeid set in the first place.
     1007    if ($IPDBacl{$authuser} =~ /c/) {
    11111008      $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    1112       $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1113       my $nodes = "<select name=node>\n<option value=>--</option>\n";
     1009      $sth->execute;
     1010      my @nodelist;
    11141011      while (my ($nid,$nname) = $sth->fetchrow_array()) {
    1115         $nodes .= "<option value='$nid'>$nname</option>\n";
     1012        my %row = (
     1013                selme => ($nodeid == $nid),
     1014                nodeid => $nid,
     1015                nodename => $nname,
     1016                );
     1017        push (@nodelist, \%row);
    11161018      }
    1117       $nodes .= "</select>\n";
    1118       $html =~ s/\$\$NODE\$\$/$nodes/;
    1119     } else {
    1120       $html =~ s|\$\$NODE\$\$|N/A|;
     1019      $page->param(nodelist => \@nodelist);
    11211020    }
    11221021  }
    11231022## end node hack
    1124     $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
    1125     $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
    1126     $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
    1127     $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
    1128   } else {
    1129 ## node hack
    1130     if ($data[2] eq 'fr' || $data[2] eq 'bi') {
    1131       $sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
    1132         " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
    1133       $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1134       my ($node) = $sth->fetchrow_array;
    1135       $html =~ s/\$\$NODE\$\$/$node/;
    1136     } else {
    1137       $html =~ s|\$\$NODE\$\$|N/A|;
    1138     }
    1139 ## end node hack
    1140     $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
    1141     $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
    1142     $html =~ s/\$\$CITY\$\$/$data[3]/g;
    1143     $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
    1144     $html =~ s/\$\$DESC\$\$/$data[5]/g;
    1145     $html =~ s/\$\$NOTES\$\$/$data[6]/g;
    1146   }
     1023
    11471024  my ($lastmod,undef) = split /\s+/, $data[7];
    1148   $html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
    1149 
    1150 ## Hack time!  SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
    1151 if ($data[2] =~ /.i/) {
    1152   $html =~ s/\$\$SWIP\$\$/N\/A/;
    1153 } else {
    1154   my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
    1155         '<input type=checkbox name=swip checked=yes>');
    1156   $html =~ s/\$\$SWIP\$\$/$tmp/;
    1157 }
    1158 
    1159   # Allows us to "correctly" colour backgrounds in table
    1160   my $i=1;
     1025  $page->param(lastmod => $lastmod);
     1026
     1027  # not happy with the upside-down logic, but...
     1028  $page->param(swipable => $data[2] !~ /.i/);
     1029  $page->param(swip => $data[10] ne 'n');
    11611030
    11621031  # Check to see if we can display sensitive data
    1163   my $privdata = '';
    1164   if ($IPDBacl{$authuser} =~ /s/) {
    1165     $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
    1166         qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
    1167         qq($data[8]</textarea></td></tr>\n);
    1168     $i++;
    1169   }
    1170   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1171 
    1172   # More ACL trickery - we can live with forms that don't submit,
    1173   # but we can't leave the extra table rows there, and we *really*
    1174   # can't leave the submit buttons there.
    1175   my $updok = '';
    1176   if ($IPDBacl{$authuser} =~ /c/) {
    1177     $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
    1178         qq(<input type="submit" value=" Update this block " class="regular">).
    1179         "</div></td></tr></form>\n";
    1180     $i++;
    1181   }
    1182   $html =~ s/\$\$UPDOK\$\$/$updok/g;
    1183 
    1184   my $delok = '';
    1185   if ($IPDBacl{$authuser} =~ /d/) {
    1186     $delok = qq(<form method="POST" action="main.cgi">
    1187         <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
    1188         <input type="hidden" name="action" value="delete">
    1189         <input type="hidden" name="block" value="$webvar{block}">
    1190         <input type="hidden" name="alloctype" value="$data[2]">
    1191         <input type=submit value=" Delete this block ">
    1192         </div></td></tr>);
    1193   }
    1194   $html =~ s/\$\$DELOK\$\$/$delok/;
    1195 
    1196   print $html;
     1032  $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
     1033  $page->param(privdata => $data[8]);
     1034
     1035  # ACL trickery - these two template booleans control the presence of all form/input tags
     1036  $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
     1037  $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
    11971038
    11981039} # edit()
    … …  
    12031044sub update {
    12041045  if ($IPDBacl{$authuser} !~ /c/) {
    1205     printError("You shouldn't have been able to get here.  Access denied.");
     1046    $aclerr = 'updateblock';
    12061047    return;
    12071048  }
    … …  
    12211062    my $sql;
    12221063    if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
    1223       $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
    1224         "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
     1064      $sql = "UPDATE poolips SET custid='$webvar{custid}',".
     1065        "city=?,description=?,notes=?,".
     1066        "circuitid='$webvar{circid}',".
    12251067        "$privdata where ip='$webvar{block}'";
    12261068    } else {
    1227       $sql = "update allocations set custid='$webvar{custid}',".
    1228         "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
    1229         "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
     1069      $sql = "UPDATE allocations SET custid='$webvar{custid}',".
     1070        "city=?,description=?,notes=?,".
     1071        "circuitid='$webvar{circid}'$privdata,".
     1072        "type='$webvar{alloctype}',".
    12301073        "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
    12311074        "where cidr='$webvar{block}'";
    … …  
    12341077    syslog "debug", $sql;
    12351078    $sth = $ip_dbh->prepare($sql);
    1236     $sth->execute;
     1079    $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes});
    12371080## node hack
    12381081    if ($webvar{node}) {
     1082      # done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there
    12391083      $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
    12401084      $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
    … …  
    12461090  if ($@) {
    12471091    my $msg = $@;
    1248     carp "Transaction aborted because $msg";
    12491092    eval { $ip_dbh->rollback; };
    12501093    syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
    1251     printError("Could not update block/IP $webvar{block}: $msg");
     1094    $page->param(err => "Could not update block/IP $webvar{block}: $msg");
    12521095    return;
    12531096  }
    … …  
    12591102mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
    12601103        "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
    1261   open (HTML, "../updated.html")
    1262         or croak "Could not open updated.html :$!";
    1263   my $html = join('', <HTML>);
     1104
     1105## node hack
     1106  if ($webvar{node} && $webvar{node} ne '-') {
     1107    $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
     1108    $sth->execute($webvar{node});
     1109    my ($nodename) = $sth->fetchrow_array();
     1110    $page->param(nodename => $nodename);
     1111  }
     1112## end node hack
    12641113
    12651114  # Link back to browse-routed or list-pool page on "Update complete" page.
    1266   my $backlink = "$IPDB::webpath/cgi-bin/main.cgi?action=";
    12671115  my $cblock;   # to contain the CIDR of the container block we're retrieving.
    12681116  my $sql;
    12691117  if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
     1118    $page->param(backpool => 1);
    12701119    $sql = "select pool from poolips where ip='$webvar{block}'";
    1271     $backlink .= "listpool&pool=";
    12721120  } else {
    12731121    $sql = "select cidr from routed where cidr >>= '$webvar{block}'";
    1274     $backlink .= "showrouted&block=";
    12751122  }
    12761123  # I define there to be no errors on this operation...  so we don't need to check for them.
    … …  
    12801127  $sth->fetch();
    12811128  $sth->finish;
    1282   $backlink .= $cblock;
    1283 
    1284 my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
    1285   $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
    1286   $webvar{city} = desanitize($webvar{city});
    1287   $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
    1288   $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
    1289   $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
    1290   $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
    1291   $html =~ s/\$\$SWIP\$\$/$swiptmp/g;
    1292   $webvar{circid} = desanitize($webvar{circid});
    1293   $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
    1294   $webvar{desc} = desanitize($webvar{desc});
    1295   $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
    1296   $webvar{notes} = desanitize($webvar{notes});
    1297   $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
    1298   $html =~ s/\$\$BACKLINK\$\$/$backlink/g;
    1299   $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
    1300 
    1301   if ($IPDBacl{$authuser} =~ /s/) {
    1302     $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
    1303         qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
    1304   }
    1305   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1306 
    1307   print $html;
     1129  $page->param(backblock => $cblock);
     1130
     1131  $page->param(cidr => $webvar{block});
     1132  $page->param(city => $webvar{city});
     1133  $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
     1134  $page->param(custid => $webvar{custid});
     1135  $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
     1136  $page->param(circid => $q->escapeHTML($webvar{circid}));
     1137  $page->param(desc => $q->escapeHTML($webvar{desc}));
     1138  $page->param(notes => $q->escapeHTML($webvar{notes}));
     1139  $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : "&nbsp;");
     1140  $page->param(privdata => $webvar{privdata})
     1141        if $IPDBacl{$authuser} =~ /s/;
    13081142
    13091143} # update()
    … …  
    13131147sub remove {
    13141148  if ($IPDBacl{$authuser} !~ /d/) {
    1315     printError("You shouldn't have been able to get here.  Access denied.");
     1149    $aclerr = 'delblock';
    13161150    return;
    13171151  }
    1318 
    1319   #show confirm screen.
    1320   open HTML, "../confirmRemove.html"
    1321         or croak "Could not open confirmRemove.html :$!";
    1322   my $html = join('', <HTML>);
    1323   close HTML;
    13241152
    13251153  # Serves'em right for getting here...
    13261154  if (!defined($webvar{block})) {
    1327     printError("Error 332");
     1155    $page->param(err => "Can't delete a block that doesn't exist");
    13281156    return;
    13291157  }
    … …  
    13461174    $desc = "N/A";
    13471175    $notes = "N/A";
     1176    $privdata = "N/A";
    13481177
    13491178  } elsif ($webvar{alloctype} eq 'mm') {
     1179
    13501180    $cidr = $webvar{block};
    13511181    $city = "N/A";
    … …  
    13551185    $desc = "N/A";
    13561186    $notes = "N/A";
     1187    $privdata = "N/A";
     1188
    13571189  } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
    13581190
    … …  
    13791211  } # end cases for different alloctypes
    13801212
    1381   # Munge everything into HTML
    1382   $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
    1383   $html =~ s|\$\$BLOCK\$\$|$cidr|g;
    1384   $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
    1385   $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
    1386   $html =~ s|\$\$CITY\$\$|$city|g;
    1387   $html =~ s|\$\$CUSTID\$\$|$custid|g;
    1388   $html =~ s|\$\$CIRCID\$\$|$circid|g;
    1389   $html =~ s|\$\$DESC\$\$|$desc|g;
    1390   $html =~ s|\$\$NOTES\$\$|$notes|g;
    1391 
    1392   $html =~ s|\$\$ACTION\$\$|finaldelete|g;
    1393 
    1394   # Set the warning text.
    1395   if ($alloctype =~ /^.[pd]$/) {
    1396     $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>|;
    1397   } else {
    1398     $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
    1399   }
    1400 
    1401   my $i = 1;
    1402   # Check to see if user is allowed to do anything with sensitive data
    1403   if ($IPDBacl{$authuser} =~ /s/) {
    1404     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    1405         qq(<td class=regular>$privdata</td></tr>\n);
    1406     $i++;
    1407   }
    1408   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1409 
    1410   $i = ++$i % 2;
    1411   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    1412 
    1413   print $html;
    1414 } # end edit()
     1213  $page->param(block => $cidr);
     1214  $page->param(disptype => $disp_alloctypes{$alloctype});
     1215  $page->param(type => $alloctype);
     1216  $page->param(city => $city);
     1217  $page->param(custid => $custid);
     1218  $page->param(circid => $circid);
     1219  $page->param(desc => $desc);
     1220  $page->param(notes => $notes);
     1221  $privdata = '&nbsp;' if $privdata eq '';
     1222  $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/;
     1223  $page->param(delpool => $alloctype =~ /^.[pd]$/);
     1224
     1225} # end remove()
    14151226
    14161227
    … …  
    14211232sub finalDelete {
    14221233  if ($IPDBacl{$authuser} !~ /d/) {
    1423     printError("You shouldn't have been able to get here.  Access denied.");
     1234    $aclerr = 'delblock';
    14241235    return;
    14251236  }
    … …  
    14301241  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
    14311242
     1243  $page->param(block => $webvar{block});
    14321244  if ($code eq 'OK') {
    1433     print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";
    14341245    syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
    14351246        " $custid, $city, desc='$description'";
    … …  
    14381249        "CustID: $custid\nCity: $city\nDescription: $description\n");
    14391250  } else {
     1251    $page->param(failmsg => $msg);
    14401252    if ($webvar{alloctype} =~ /^.i$/) {
    14411253      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
    1442       printError("Could not deallocate static IP $webvar{block}: $msg");
    14431254    } else {
    14441255      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
    1445       printError("Could not deallocate netblock $webvar{block}: $msg");
     1256      $page->param(netblock => 1);
    14461257    }
    14471258  }
    14481259
    14491260} # finalDelete
    1450 
    1451 
    1452 sub exitError {
    1453   my $errStr = $_[0];
    1454   printHeader('', $IPDB::webpath, '');
    1455   print qq(<center><p class="regular"> $errStr </p>
    1456 <input type="button" value="Back" onclick="history.go(-1)">
    1457 </center>
    1458 );
    1459   printFooter();
    1460   exit;
    1461 } # errorExit
    1462 
    1463 
    1464 # Just in case we manage to get here.
    1465 exit 0;
Note: See TracChangeset for help on using the changeset viewer.