Changeset 517 for trunk/cgi-bin/main.cgi


Ignore:
Timestamp:
10/18/12 16:53:10 (12 years ago)
Author:
Kris Deugau
Message:

/trunk

Finally merge conversion to HTML::Template from /branches/htmlform

  • Node "hack" showed conflict due to having been added to all branches in parallel
  • editDisplay.html was apparently changed enough that the merged delete caused an irrelevant conflict

Closes #3.

Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk

  • trunk/cgi-bin/main.cgi

    r515 r517  
    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('', ($IPDBacl{$authuser} =~ /a/ ?
    53         '<td align=right><a href="/ip/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     print while <HTML>;
    76   }
    77 } elsif ($webvar{action} eq 'newmaster') {
    78 
    79   if ($IPDBacl{$authuser} !~ /a/) {
    80     printError("You shouldn't have been able to get here.  Access denied.");
    81   } else {
    82 
    83108    my $cidr = new NetAddr::IP $webvar{cidr};
    84 
    85     print "<div type=heading align=center>Adding $cidr as master block....</div>\n";
     109    $page->param(cidr => "$cidr");
    86110
    87111    my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr});
    88112
    89113    if ($code eq 'FAIL') {
    90       carp "Transaction aborted because $msg";
    91114      syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'";
    92       printError("Could not add master block $webvar{cidr} to database: $msg");
     115      $page->param(err => $msg);
    93116    } else {
    94       print "<div type=heading align=center>Success!</div>\n";
    95117      syslog "info", "$authuser added master block $webvar{cidr}";
    96118    }
    … …  
    133155}
    134156elsif ($webvar{action} eq 'nodesearch') {
    135   open HTML, "<../nodesearch.html";
    136   my $html = join('',<HTML>);
    137   close HTML;
    138 
    139157  $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    140   $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    141   my $nodes = '';
     158  $sth->execute() or $page->param(errmsg => $sth->errstr);
     159  my @nodelist;
    142160  while (my ($nid,$nname) = $sth->fetchrow_array()) {
    143     $nodes .= "<option value='$nid'>$nname</option>\n";
    144   }
    145   $html =~ s/\$\$NODELIST\$\$/$nodes/;
    146 
    147   print $html;
    148 }
    149 
    150 # Default is an error.  It shouldn't be possible to easily get here.
    151 # The only way I can think of offhand is to just call main.cgi bare-
    152 # 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}.
    153174else {
    154175  my $rnd = rand 500;
    155176  my $boing = sprintf("%.2f", rand 500);
    156   my @excuses = ("Aether cloudy.  Ask again later.","The gods are unhappy with your sacrifice.",
    157         "Because one of it's legs are both the same", "*wibble*",
    158         "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9",
    159         "8", "9", "10", "11", "12", "13", "14", "15", "16", "17");
    160   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]);
    161190}
    162191## Finally! Done with that NASTY "case" emulation!
    163192
     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}
    164202
    165203
    … …  
    167205finish($ip_dbh);
    168206
    169 print qq(<div align=right style="position: absolute; right: 30px;">).
    170         qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n)
    171         if $IPDBacl{$authuser} =~ /A/;
    172 
    173 # We print the footer here, so we don't have to do it elsewhere.
    174 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
    175219# Just in case something waaaayyy down isn't in place
    176220# properly... we exit explicitly.
    177 exit;
    178 
    179 
    180 
    181 # args are: a reference to an array with the row to be printed and the
    182 # class(stylesheet) to use for formatting.
    183 # if ommitting the class - call the sub as &printRow(\@array)
    184 sub printRow {
    185   my ($rowRef,$class) = @_;
    186 
    187   if (!$class) {
    188     print "<tr>\n";
    189   } else {
    190     print "<tr class=\"$class\">\n";
    191   }
    192 
    193 ELEMENT:  foreach my $element (@$rowRef) {
    194     if (!defined($element)) {
    195       print "<td></td>\n";
    196       next ELEMENT;
    197     }
    198     $element =~ s|\n|</br>|g;
    199     print "<td>$element</td>\n";
    200   }
    201   print "</tr>";
    202 } # printRow
    203 
    204 
    205 # Prints table headings.  Accepts any number of arguments;
    206 # each argument is a table heading.
    207 sub startTable {
    208   print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
    209 
    210   foreach(@_) {
    211     print qq(<td class="heading">$_</td>);
    212   }
    213   print "</tr>\n";
    214 } # startTable
     221exit 0;
    215222
    216223
    217224# Initial display:  Show master blocks with total allocated subnets, total free subnets
    218225sub showSummary {
    219 
    220   startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',
    221         'Free netblocks', 'Largest free block');
    222 
    223226  my %allocated;
    224227  my %free;
    … …  
    260263  }
    261264
    262   # Print the data.
    263   my $count=0;
     265  # Assemble the data to stuff into the template.
     266  my @masterlist;
     267  my $rowclass=0;
    264268  foreach my $master (@masterblocks) {
    265     my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>",
    266         $routed{"$master"}, $allocated{"$master"}, $free{"$master"},
    267         ( ($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"}) )
    268276        );
    269 
    270     printRow(\@row, 'color1' ) if($count%2==0);
    271     printRow(\@row, 'color2' ) if($count%2!=0);
    272     $count++;
    273   }
    274   print "</table>\n";
    275   if ($IPDBacl{$authuser} =~ /a/) {
    276     print qq(<a href="/ip/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n);
    277   }
    278   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/) );
    279282
    280283} # showSummary
    … …  
    288291sub showMaster {
    289292
    290   print qq(<center><div class="heading">Summarizing routed blocks for ).
    291         qq($webvar{block}:</div></center><br>\n);
     293  $page->param(master => $webvar{block});
    292294
    293295  my %allocated;
    294296  my %free;
    295   my %routed;
     297  my %cities;
    296298  my %bigfree;
    297299
    … …  
    311313    $bigfree{"$cidr"} = 128;
    312314    # Retain the routing destination
    313     $routed{"$cidr"} = $data[1];
     315    $cities{"$cidr"} = $data[1];
    314316  }
    315317
    316318  # Check if there were actually any blocks routed from this master
    317319  if ($i > 0) {
    318     startTable('Routed block','Routed to','Allocated blocks',
    319         'Free blocks','Largest free block');
    320320
    321321    # Count the allocations
    … …  
    345345    }
    346346
    347     # Print the data.
    348     my $count=0;
     347    my @routed;
     348    my $rowclass = 0;
    349349    foreach my $master (@localmasters) {
    350       my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>",
    351         $routed{"$master"}, $allocated{"$master"},
    352         $free{"$master"},
    353         ( ($bigfree{"$master"} eq 128) ? ("&lt;NONE&gt;") : ("/".$bigfree{"$master"}) )
    354       );
    355       printRow(\@row, 'color1' ) if($count%2==0);
    356       printRow(\@row, 'color2' ) if($count%2!=0);
    357       $count++;
    358     }
    359   } else {
    360     # If a master block has no routed blocks, then by definition it has no
    361     # allocations, and can be deleted.
    362     print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    363         qq($master.</div>\n).
    364         ($IPDBacl{$authuser} =~ /d/ ?
    365                 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
    366                 qq(<input type=hidden name=action value="delete">\n).
    367                 qq(<input type=hidden name=block value="$master">\n).
    368                 qq(<input type=hidden name=alloctype value="mm">\n).
    369                 qq(<input type=submit value=" Remove this master ">\n).
    370                 qq(</form></center>\n) :
    371                 '');
     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);
    372361
    373362  } # end check for existence of routed blocks in master
    374363
    375   print qq(</table>\n<hr width="60%">\n).
    376         qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n);
    377 
    378   startTable('Netblock','Range');
     364  $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/));
    379365
    380366  # Snag the free blocks.
    … …  
    383369        "routed='n' order by cidr");
    384370  $sth->execute();
     371  my @unrouted;
     372  my $rowclass = 0;
    385373  while (my @data = $sth->fetchrow_array()) {
    386374    my $cidr = new NetAddr::IP $data[0];
    387     my @row = ("$cidr", $cidr->range);
    388     printRow(\@row, 'color1' ) if($count%2==0);
    389     printRow(\@row, 'color2' ) if($count%2!=0);
    390     $count++;
    391   }
    392 
    393   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
    394384} # showMaster
    395385
    … …  
    408398  $sth = $ip_dbh->prepare("select city from routed where cidr='$master'");
    409399  $sth->execute;
    410   my @data = $sth->fetchrow_array;
    411 
    412   print qq(<center><div class="heading">Summarizing allocated blocks for ).
    413         qq($master ($data[0]):</div></center><br>\n);
    414 
    415   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);
    416404
    417405  # Snag the allocations for this block
    … …  
    424412  my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?");
    425413
    426   my $count=0;
    427   while (my @data = $sth->fetchrow_array()) {
    428     # cidr,city,type,custid,swip,description, as per the SELECT
    429     my $cidr = new NetAddr::IP $data[0];
    430 
    431     # Clean up extra spaces that are borking things.
    432 #    $data[2] =~ s/\s+//g;
    433 
    434     $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);
    435418    my ($ncust) = $custsth->fetchrow_array();
    436419
    437     # Prefix subblocks with "Sub "
    438     my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : '').
    439         qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    440         $data[1], $disp_alloctypes{$data[2]}, $data[3],
    441         ($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), $data[5]);
    442     # If the allocation is a pool, allow listing of the IPs in the pool.
    443     if ($data[2] =~ /^.[pd]$/) {
    444       $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
    445         "&pool=$data[0]\">List IPs</a>";
    446     }
    447 
    448     printRow(\@row, 'color1') if ($count%2 == 0);
    449     printRow(\@row, 'color2') if ($count%2 != 0);
    450     $count++;
    451   }
    452 
    453   print "</table>\n";
    454 
    455   # If the routed block has no allocations, by definition it only has
    456   # one free block, and therefore may be deleted.
    457   if ($count == 0) {
    458     print qq(<hr width="60%"><center><div class="heading">No allocations in ).
    459         qq($master.</div></center>\n).
    460         ($IPDBacl{$authuser} =~ /d/ ?
    461                 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n).
    462                 qq(<input type=hidden name=action value="delete">\n).
    463                 qq(<input type=hidden name=block value="$master">\n).
    464                 qq(<input type=hidden name=alloctype value="rm">\n).
    465                 qq(<input type=submit value=" Remove this block ">\n).
    466                 qq(</form>\n) :
    467                 '');
    468   }
    469 
    470   print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ).
    471         qq(submaster $master</div></center>\n);
    472 
    473   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/);
    474436
    475437  # Snag the free blocks.  We don't really *need* to be pedantic about avoiding
    476438  # unrouted free blocks, but it's better to let the database do the work if we can.
    477   $count = 0;
     439  $rowclass = 0;
     440  my @unassigned;
    478441  $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'".
    479442        " order by cidr");
    480443  $sth->execute();
    481   while (my @data = $sth->fetchrow_array()) {
    482     # cidr,routed
    483     my $cidr = new NetAddr::IP $data[0];
    484     # Include some HairyPerl(TM) to prefix subblocks with "Sub "
    485     my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : '').
    486         ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr),
    487         $cidr->range);
    488     printRow(\@row, 'color1') if ($count%2 == 0);
    489     printRow(\@row, 'color2') if ($count%2 != 0);
    490     $count++;
    491   }
    492 
    493   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
    494458} # showRBlock
    495459
    … …  
    500464  my $cidr = new NetAddr::IP $webvar{pool};
    501465
    502   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);
    503473
    504474  # Snag pool info for heading
    505   $sth = $ip_dbh->prepare("select type,city from allocations where cidr='$cidr'");
    506   $sth->execute;
    507   $sth->bind_columns(\$pooltype, \$poolcity);
    508   $sth->fetch() || carp $sth->errstr;
    509 
    510   print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).
    511         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
    512482  # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy
    513   if ($pooltype =~ /^.d$/) {
    514     print qq(<div class="indent"><b>Reserved IPs:</b><br>\n);
    515     print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>).
    516         $cidr->addr."</td></tr>\n";
    517     $cidr++;
    518     print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n";
    519     $cidr--;  $cidr--;
    520     print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n".
    521         "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n".
    522         "</table></div></div>\n";
    523   }
     483  $page->param(realblock => $pooltype =~ /^.d$/);
    524484
    525485# probably have to add an "edit IP allocation" link here somewhere.
    526486
    527   startTable('IP','Customer ID','Available?','Description','');
    528487  $sth = $ip_dbh->prepare("select ip,custid,available,description,type".
    529488        " from poolips where pool='$webvar{pool}' order by ip");
    530489  $sth->execute;
    531   my $count = 0;
    532   while (my @data = $sth->fetchrow_array) {
    533     # pool,ip,custid,city,ptype,available,notes,description,circuitid
    534     # ip,custid,available,description,type
    535     # If desc is "null", make it not null.  <g>
    536     if ($data[3] eq '') {
    537       $data[3] = '&nbsp;';
    538     }
    539     # Some nice hairy Perl to decide whether to allow unassigning each IP
    540     #   -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link
    541     #      else we print a blank space
    542     my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    543         $data[1],$data[2],$data[3],
    544         ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ?
    545           ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&".
    546            "alloctype=$data[4]\">Unassign this IP</a>") :
    547           ("&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'
    548501        );
    549     printRow(\@row, 'color1') if($count%2==0);
    550     printRow(\@row, 'color2') if($count%2!=0);
    551     $count++;
    552   }
    553   print "</table>\n";
     502    push @poolips, \%row;
     503  }
     504  $page->param(poolips => \@poolips);
    554505
    555506} # end listPool
    … …  
    561512
    562513  if ($IPDBacl{$authuser} !~ /a/) {
    563     printError("You shouldn't have been able to get here.  Access denied.");
     514    $aclerr = 'addblock';
    564515    return;
    565516  }
    566517
    567   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'));
    568526
    569527  # New special case- block to assign is specified
    570528  if ($webvar{block} ne '') {
    571     open HTML, "../fb-assign.html"
    572         or croak "Could not open fb-assign.html: $!";
    573     $html = join('',<HTML>);
    574     close HTML;
    575529    my $block = new NetAddr::IP $webvar{block};
    576     $html =~ s|\$\$BLOCK\$\$|$block|g;
    577     $html =~ s|\$\$MASKBITS\$\$|$block->masklen|;
    578     my $typelist = '';
    579 
     530
     531    # Handle contained freeblock allocation.
    580532    # This is a little dangerous, as it's *theoretically* possible to
    581533    # get fbtype='n' (aka a non-routed freeblock).  However, should
    582534    # someone manage to get there, they get what they deserve.
    583535    if ($webvar{fbtype} ne 'y') {
    584       # Snag the type of the block from the database.  We have no
    585       # convenient way to pass this in from the calling location.  :/
     536      # Snag the type of the container block from the database.
    586537      $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'");
    587538      $sth->execute;
    588539      my @data = $sth->fetchrow_array;
    589540      $data[0] =~ s/c$/r/;      # Munge the type into the correct form
    590       $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n";
     541      $page->param(fbdisptype => $list_alloctypes{$data[0]});
     542      $page->param(type => $data[0]);
    591543    } else {
    592       $typelist .= qq(<select name="alloctype">\n);
    593544      $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ".
    594545        "and type not like '_i' and type not like '_r' order by listorder");
    595546      $sth->execute;
    596       my @data = $sth->fetchrow_array;
    597       $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
     547      my @typelist;
     548      my $selflag = 0;
    598549      while (my @data = $sth->fetchrow_array) {
    599         $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
     550        my %row = (tval => $data[0],
     551                type => $data[1],
     552                sel => ($selflag == 0 ? ' selected' : '')
     553                );
     554        push (@typelist, \%row);
     555        $selflag++;
    600556      }
    601       $typelist .= "</select>\n";
    602     }
    603     $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
     557      $page->param(typelist => \@typelist);
     558    }
    604559  } else {
    605     open HTML, "../assign.html"
    606         or croak "Could not open assign.html: $!";
    607     $html = join('',<HTML>);
    608     close HTML;
    609     my $masterlist = "<select name=allocfrom><option selected>-</option>\n";
     560    my @masterlist;
    610561    foreach my $master (@masterblocks) {
    611       $masterlist .= "<option>$master</option>\n";
    612     }
    613     $masterlist .= "</select>\n";
    614     $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g;
    615     my $pops = '';
     562      my %row = (master => "$master");
     563      push (@masterlist, \%row);
     564    }
     565    $page->param(masterlist => \@masterlist);
     566
     567    my @pops;
    616568    foreach my $pop (@poplist) {
    617       $pops .= "<option>$pop</option>\n";
    618     }
    619     $html =~ s|\$\$POPLIST\$\$|$pops|g;
    620     my $typelist = '';
    621     $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");
    622577    $sth->execute;
    623     my @data = $sth->fetchrow_array;
    624     $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
     578    my @typelist;
     579    my $selflag = 0;
    625580    while (my @data = $sth->fetchrow_array) {
    626       $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
    627     }
    628     $html =~ s|\$\$TYPELIST\$\$|$typelist|g;
    629   }
    630   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;
    631592  foreach my $city (@citylist) {
    632     $cities .= "<option>$city</option>\n";
    633   }
    634   $html =~ s|\$\$ALLCITIES\$\$|$cities|g;
     593    my %row = (city => $city);
     594    push (@cities, \%row);
     595  }
     596  $page->param(citylist => \@cities);
    635597
    636598## node hack
    637599  $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    638600  $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    639   my $nodes = '';
     601  my @nodes;
    640602  while (my ($nid,$nname) = $sth->fetchrow_array()) {
    641     $nodes .= "<option value='$nid'>$nname</option>\n";
    642   }
    643   $html =~ s/\$\$NODELIST\$\$/$nodes/;
     603    my %row = (nid => $nid, nname => $nname);
     604    push (@nodes, \%row);
     605  }
     606  $page->param(nodelist => \@nodes);
    644607## end node hack
    645608
    646   my $i = 0;
    647   $i++ if $webvar{fbtype} eq 'y';
    648   # Check to see if user is allowed to do anything with sensitive data
    649   my $privdata = '';
    650   if ($IPDBacl{$authuser} =~ /s/) {
    651     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    652         qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
    653         qq(</textarea></td></tr>\n);
    654     $i++;
    655   }
    656   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    657 
    658   $i = $i % 2;
    659   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    660 
    661   print $html;
     609  $page->param(privdata => $IPDBacl{$authuser} =~ /s/);
    662610
    663611} # assignBlock
    … …  
    667615sub confirmAssign {
    668616  if ($IPDBacl{$authuser} !~ /a/) {
    669     printError("You shouldn't have been able to get here.  Access denied.");
     617    $aclerr = 'addblock';
    670618    return;
    671619  }
    … …  
    693641    $sth->execute;
    694642    my $optionlist;
    695     while (my @data = $sth->fetchrow_array) {
     643
     644    my @poollist;
     645    while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) {
    696646      # city,pool cidr,free IP count
    697       if ($data[2] > 0) {
    698         $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);
    699650      }
    700651    }
     652    $page->param(staticip => 1);
     653    $page->param(poollist => \@poollist);
    701654    $cidr = "Single static IP";
    702     $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n";
     655##fixme:  need to handle "no available pools"
    703656
    704657  } else { # end show pool options
    … …  
    710663
    711664      if (!$webvar{maskbits}) {
    712         printError("Please specify a CIDR mask length.");
     665        $page->param(err => "Please specify a CIDR mask length.");
    713666        return;
    714667      }
    … …  
    748701            " block size for the pool.";
    749702        } else {
     703          if (!$webvar{pop}) {
     704            $page->param(err => 'Please select a POP to route the block from/through.');
     705            return;
     706          }
    750707          $city = $webvar{pop};
    751708          $failmsg = "No suitable free block found.<br>\nYou will have to route another".
    … …  
    769726      my @data = $sth->fetchrow_array();
    770727      if ($data[0] eq "") {
    771         printError($failmsg);
     728        $page->param(err => $failmsg);
    772729        return;
    773730      }
    … …  
    775732    } # check for freeblocks assignment or IPDB-controlled assignment
    776733
    777     $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);
     734    $alloc_from = "$cidr";
    778735
    779736    # If the block to be allocated is smaller than the one we found,
    … …  
    789746  } # if ($webvar{alloctype} =~ /^.i$/)
    790747
    791   open HTML, "../confirm.html"
    792         or croak "Could not open confirm.html: $!";
    793   my $html = join '', <HTML>;
    794   close HTML;
    795 
    796748## node hack
    797749  if ($webvar{node} && $webvar{node} ne '-') {
    … …  
    799751    $sth->execute($webvar{node});
    800752    my ($nodename) = $sth->fetchrow_array();
    801     $html =~ s/\$\$NODENAME\$\$/$nodename/;
    802     $html =~ s/\$\$NODEID\$\$/$webvar{node}/;
    803   } else {
    804     $html =~ s/\$\$NODENAME\$\$//;
    805     $html =~ s/\$\$NODEID\$\$//;
     753    $page->param(nodename => $nodename);
     754    $page->param(nodeid => $webvar{node});
    806755  }
    807756## end node hack
    808757
    809 ### gotta fix this in final
    810   # Stick in customer info as necessary - if it's blank, it just ends
    811   # up as blank lines ignored in the rendering of the page
    812         my $custbits;
    813   $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;
    814 ###
    815 
    816758  # Stick in the allocation data
    817   $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g;
    818   $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g;
    819   $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g;
    820   $html =~ s|\$\$CIDR\$\$|$cidr|g;
    821   $webvar{city} = desanitize($webvar{city});
    822   $html =~ s|\$\$CITY\$\$|$webvar{city}|g;
    823   $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g;
    824   $webvar{circid} = desanitize($webvar{circid});
    825   $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g;
    826   $webvar{desc} = desanitize($webvar{desc});
    827   $html =~ s|\$\$DESC\$\$|$webvar{desc}|g;
    828   $webvar{notes} = desanitize($webvar{notes});
    829   $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g;
    830   $html =~ s|\$\$ACTION\$\$|insert|g;
    831 
    832   my $i=1;
     759  $page->param(alloc_type => $webvar{alloctype});
     760  $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}}));
     761  $page->param(alloc_from => $alloc_from);
     762  $page->param(cidr => $cidr);
     763  $page->param(city => $q->escapeHTML($webvar{city}));
     764  $page->param(custid => $webvar{custid});
     765  $page->param(circid => $q->escapeHTML($webvar{circid}));
     766  $page->param(desc => $q->escapeHTML($webvar{desc}));
     767
     768##fixme: find a way to have the displayed copy have <br> substitutions
     769# for newlines, and the <input> value have either encoded or bare newlines.
     770# Also applies to privdata.
     771  $page->param(notes => $q->escapeHTML($webvar{notes},'y'));
     772
    833773  # Check to see if user is allowed to do anything with sensitive data
    834774  my $privdata = '';
    835   if ($IPDBacl{$authuser} =~ /s/) {
    836     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    837         qq(<td class=regular>$webvar{privdata}).
    838         qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n);
    839     $i++;
    840   }
    841 # We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing.
    842   $privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n"
     775  $page->param(privdata => $q->escapeHTML($webvar{privdata},'y'))
     776        if $IPDBacl{$authuser} =~ /s/;
     777
     778  # Yay!  This now has it's very own little home.
     779  $page->param(billinguser => $webvar{userid})
    843780        if $webvar{userid};
    844   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    845 
    846   $i = $i % 2;
    847   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    848 
    849   print $html;
     781
     782##fixme:  this is only needed iff confirm.tmpl and
     783# confirmRemove.tmpl are merged (quite possible, just
     784# a little tedious)
     785  $page->param(action => "insert");
    850786
    851787} # end confirmAssign
    … …  
    855791sub insertAssign {
    856792  if ($IPDBacl{$authuser} !~ /a/) {
    857     printError("You shouldn't have been able to get here.  Access denied.");
     793    $aclerr = 'addblock';
    858794    return;
    859795  }
    … …  
    867803  # successful netblock allocation, the IP allocated for static
    868804  # IP, or the error message if an error occurred.
     805
    869806  my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from},
    870807        $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes},
    … …  
    874811    if ($webvar{alloctype} =~ /^.i$/) {
    875812      $msg =~ s|/32||;
    876       print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>).
    877         ( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ?
    878                 qq(<div><a href="https://billing.example.com/radius.pl?).
    879                 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
    880                 qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>)
    881         : "</div>");
     813      $page->param(staticip => $msg);
     814      $page->param(custid => $webvar{custid});
     815      $page->param(billinguser => $webvar{billinguser});
    882816      mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
    883817        "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n".
    … …  
    885819    } else {
    886820      my $netblock = new NetAddr::IP $webvar{fullcidr};
    887       print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).
    888         "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>".
    889         ( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?
    890                 qq(<div><a href="https://billing.example.com/radius.pl?).
    891                 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".
    892                 "&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.
    893                 "&include_routed_subnet=1&ipdb=1".
    894                 qq(">Add this netblock to RADIUS user table</a></div>)
    895         : "</div>");
     821      $page->param(fullcidr => $webvar{fullcidr});
     822      $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}});
     823      $page->param(custid => $webvar{custid});
     824      if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) {
     825        $page->param(billinguser => $webvar{billinguser});
     826        $page->param(custid => $webvar{custid});
     827        $page->param(netaddr => $netblock->addr);
     828        $page->param(masklen => $netblock->masklen);
     829      }
    896830      mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation",
    897831        "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n".
    … …  
    903837    syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ".
    904838        "'$webvar{alloctype}' by $authuser failed: '$msg'";
    905     printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
     839    $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".
    906840        " failed:<br>\n$msg\n");
    907841  }
    … …  
    915849sub validateInput {
    916850  if ($webvar{city} eq '-') {
    917     printError("Please choose a city.");
     851    $page->param(err => 'Please choose a city');
    918852    return;
    919853  }
    … …  
    924858    # Danger! Danger!  alloctype should ALWAYS be set by a dropdown.  Anyone
    925859    # managing to call things in such a way as to cause this deserves a cryptic error.
    926     printError("Invalid alloctype");
     860    $page->param(err => 'Invalid alloctype');
    927861    return;
    928862  }
    … …  
    932866  if ($def_custids{$webvar{alloctype}} eq '') {
    933867    if (!$webvar{custid}) {
    934       printError("Please enter a customer ID.");
     868      $page->param(err => 'Please enter a customer ID.');
    935869      return;
    936870    }
    … …  
    941875      my $status = CustIDCK->custid_exist($webvar{custid});
    942876      if ($CustIDCK::Error) {
    943         printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
     877        $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
    944878        return;
    945879      }
    946880      if (!$status) {
    947         printError("Customer ID not valid.  Make sure the Customer ID ".
     881        $page->param(err => "Customer ID not valid.  Make sure the Customer ID ".
    948882          "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
    949883          "non-customer assignments.");
    … …  
    977911    }
    978912  }
     913
     914  # if the alloctype has a restricted city/POP list as determined above,
     915  # and the reqested city/POP does not match that list, complain
    979916  if ($flag ne 'n') {
    980     printError("Please choose a valid POP location $flag.  Valid ".
     917    $page->param(err => "Please choose a valid POP location $flag.  Valid ".
    981918        "POP locations are currently:<br>\n".join (" - ", @poplist));
    982919    return;
    … …  
    996933  # Two cases:  block is a netblock, or block is a static IP from a pool
    997934  # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data
     935##fixme:  allow "SWIP" (publication to rWHOIS) of static IP data
    998936  if ($webvar{block} =~ /\/32$/) {
    999937    $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'";
    … …  
    1009947  # Clean up extra whitespace on alloc type
    1010948  $data[2] =~ s/\s//;
    1011 
    1012   open (HTML, "../editDisplay.html")
    1013         or croak "Could not open editDisplay.html :$!";
    1014   my $html = join('', <HTML>);
    1015949
    1016950  # We can't let the city be changed here;  this block is a part of
    … …  
    1019953##fixme
    1020954# Needs thinking.  Have to allow changes to city to correct errors, no?
    1021   $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
    1022 
    1023   if ($IPDBacl{$authuser} =~ /c/) {
    1024     $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/;
    1025 
    1026 # Screw it.  Changing allocation types gets very ugly VERY quickly- especially
    1027 # with the much longer list of allocation types.
    1028 # We'll just show what type of block it is.
    1029 
    1030 # this has now been Requested, so here goes.
     955# Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads
     956
     957# @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip
     958
     959  $page->param(block => $webvar{block});
     960
     961  $page->param(custid => $data[1]);
     962  $page->param(city => $data[3]);
     963  $page->param(circid => $data[4]);
     964  $page->param(desc => $data[5]);
     965  $page->param(notes => $data[6]);
    1031966
    1032967##fixme The check here should be built from the database
    1033     if ($data[2] =~ /^.[ne]$/) {
    1034       # Block that can be changed
    1035       my $blockoptions = "<select name=alloctype><option".
    1036         (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option".
    1037         (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option".
    1038         (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option".
    1039         (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option".
    1040         (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option".
    1041         (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option".
    1042         (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n".
    1043         "</select>\n";
    1044       $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g;
    1045     } else {
    1046       $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g;
    1047     }
     968# Need to expand to support pool types too
     969  if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) {
     970    $page->param(changetype => 1);
     971    $page->param(alloctype => [
     972                { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" },
     973                { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" },
     974                { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" },
     975                { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" },
     976                { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" },
     977                { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" },
     978                { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" },
     979                ]
     980        );
     981  } else {
     982    $page->param(disptype => $disp_alloctypes{$data[2]});
     983    $page->param(type => $data[2]);
     984  }
     985
    1048986## node hack
    1049   $sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'");
     987  $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef".
     988        " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
    1050989  $sth->execute;
    1051   my ($nodeid) = $sth->fetchrow_array();
    1052   if ($nodeid) {
    1053     $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    1054     $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1055     my $nodes = "<select name=node>\n";
    1056     while (my ($nid,$nname) = $sth->fetchrow_array()) {
    1057       $nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n";
    1058     }
    1059     $nodes .= "</select>\n";
    1060     $html =~ s/\$\$NODE\$\$/$nodes/;
    1061   } else {
    1062     if ($data[2] eq 'fr' || $data[2] eq 'bi') {
     990  my ($nodeid,$nodename) = $sth->fetchrow_array();
     991  $page->param(havenodeid => $nodeid);
     992
     993  if ($data[2] eq 'fr' || $data[2] eq 'bi') {
     994    $page->param(typesupportsnodes => 1);
     995    $page->param(nodename => $nodename);
     996
     997##fixme:  this whole hack needs cleanup and generalization for all alloctypes
     998##fixme:  arguably a bug that presence of a nodeid implies it can be changed..
     999#  but except for manual database changes, only the two types fr and bi can
     1000#  (currently) have a nodeid set in the first place.
     1001    if ($IPDBacl{$authuser} =~ /c/) {
    10631002      $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id");
    1064       $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1065       my $nodes = "<select name=node>\n<option value=>--</option>\n";
     1003      $sth->execute;
     1004      my @nodelist;
    10661005      while (my ($nid,$nname) = $sth->fetchrow_array()) {
    1067         $nodes .= "<option value='$nid'>$nname</option>\n";
     1006        my %row = (
     1007                selme => ($nodeid == $nid),
     1008                nodeid => $nid,
     1009                nodename => $nname,
     1010                );
     1011        push (@nodelist, \%row);
    10681012      }
    1069       $nodes .= "</select>\n";
    1070       $html =~ s/\$\$NODE\$\$/$nodes/;
    1071     } else {
    1072       $html =~ s|\$\$NODE\$\$|N/A|;
     1013      $page->param(nodelist => \@nodelist);
    10731014    }
    10741015  }
    10751016## end node hack
    1076     $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g;
    1077     $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g;
    1078     $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g;
    1079     $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g;
    1080   } else {
    1081 ## node hack
    1082     if ($data[2] eq 'fr' || $data[2] eq 'bi') {
    1083       $sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef".
    1084         " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'");
    1085       $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";
    1086       my ($node) = $sth->fetchrow_array;
    1087       $html =~ s/\$\$NODE\$\$/$node/;
    1088     } else {
    1089       $html =~ s|\$\$NODE\$\$|N/A|;
    1090     }
    1091 ## end node hack
    1092     $html =~ s/\$\$CUSTID\$\$/$data[1]/g;
    1093     $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g;
    1094     $html =~ s/\$\$CITY\$\$/$data[3]/g;
    1095     $html =~ s/\$\$CIRCID\$\$/$data[4]/g;
    1096     $html =~ s/\$\$DESC\$\$/$data[5]/g;
    1097     $html =~ s/\$\$NOTES\$\$/$data[6]/g;
    1098   }
     1017
    10991018  my ($lastmod,undef) = split /\s+/, $data[7];
    1100   $html =~ s/\$\$LASTMOD\$\$/$lastmod/g;
    1101 
    1102 ## Hack time!  SWIP isn't going to stay, so I'm not going to integrate it with ACLs.
    1103 if ($data[2] =~ /.i/) {
    1104   $html =~ s/\$\$SWIP\$\$/N\/A/;
    1105 } else {
    1106   my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' :
    1107         '<input type=checkbox name=swip checked=yes>');
    1108   $html =~ s/\$\$SWIP\$\$/$tmp/;
    1109 }
    1110 
    1111   # Allows us to "correctly" colour backgrounds in table
    1112   my $i=1;
     1019  $page->param(lastmod => $lastmod);
     1020
     1021  # not happy with the upside-down logic, but...
     1022  $page->param(swipable => $data[2] !~ /.i/);
     1023  $page->param(swip => $data[10] ne 'n');
    11131024
    11141025  # Check to see if we can display sensitive data
    1115   my $privdata = '';
    1116   if ($IPDBacl{$authuser} =~ /s/) {
    1117     $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>).
    1118         qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">).
    1119         qq($data[8]</textarea></td></tr>\n);
    1120     $i++;
    1121   }
    1122   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1123 
    1124   # More ACL trickery - we can live with forms that don't submit,
    1125   # but we can't leave the extra table rows there, and we *really*
    1126   # can't leave the submit buttons there.
    1127   my $updok = '';
    1128   if ($IPDBacl{$authuser} =~ /c/) {
    1129     $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">).
    1130         qq(<input type="submit" value=" Update this block " class="regular">).
    1131         "</div></td></tr></form>\n";
    1132     $i++;
    1133   }
    1134   $html =~ s/\$\$UPDOK\$\$/$updok/g;
    1135 
    1136   my $delok = '';
    1137   if ($IPDBacl{$authuser} =~ /d/) {
    1138     $delok = qq(<form method="POST" action="main.cgi">
    1139         <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center>
    1140         <input type="hidden" name="action" value="delete">
    1141         <input type="hidden" name="block" value="$webvar{block}">
    1142         <input type="hidden" name="alloctype" value="$data[2]">
    1143         <input type=submit value=" Delete this block ">
    1144         </div></td></tr>);
    1145   }
    1146   $html =~ s/\$\$DELOK\$\$/$delok/;
    1147 
    1148   print $html;
     1026  $page->param(nocling => $IPDBacl{$authuser} =~ /s/);
     1027  $page->param(privdata => $data[8]);
     1028
     1029  # ACL trickery - these two template booleans control the presence of all form/input tags
     1030  $page->param(maychange => $IPDBacl{$authuser} =~ /c/);
     1031  $page->param(maydel => $IPDBacl{$authuser} =~ /d/);
    11491032
    11501033} # edit()
    … …  
    11551038sub update {
    11561039  if ($IPDBacl{$authuser} !~ /c/) {
    1157     printError("You shouldn't have been able to get here.  Access denied.");
     1040    $aclerr = 'updateblock';
    11581041    return;
    11591042  }
    … …  
    11731056    my $sql;
    11741057    if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
    1175       $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',".
    1176         "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'".
     1058      $sql = "UPDATE poolips SET custid='$webvar{custid}',".
     1059        "city=?,description=?,notes=?,".
     1060        "circuitid='$webvar{circid}',".
    11771061        "$privdata where ip='$webvar{block}'";
    11781062    } else {
    1179       $sql = "update allocations set custid='$webvar{custid}',".
    1180         "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',".
    1181         "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,".
     1063      $sql = "UPDATE allocations SET custid='$webvar{custid}',".
     1064        "city=?,description=?,notes=?,".
     1065        "circuitid='$webvar{circid}'$privdata,".
     1066        "type='$webvar{alloctype}',".
    11821067        "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ".
    11831068        "where cidr='$webvar{block}'";
    … …  
    11861071    syslog "debug", $sql;
    11871072    $sth = $ip_dbh->prepare($sql);
    1188     $sth->execute;
     1073    $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes});
    11891074## node hack
    11901075    if ($webvar{node}) {
     1076      # done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there
    11911077      $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'");
    11921078      $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)");
    … …  
    11981084  if ($@) {
    11991085    my $msg = $@;
    1200     carp "Transaction aborted because $msg";
    12011086    eval { $ip_dbh->rollback; };
    12021087    syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'";
    1203     printError("Could not update block/IP $webvar{block}: $msg");
     1088    $page->param(err => "Could not update block/IP $webvar{block}: $msg");
    12041089    return;
    12051090  }
    … …  
    12111096mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}",
    12121097        "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on';
    1213   open (HTML, "../updated.html")
    1214         or croak "Could not open updated.html :$!";
    1215   my $html = join('', <HTML>);
     1098
     1099## node hack
     1100  if ($webvar{node} && $webvar{node} ne '-') {
     1101    $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?");
     1102    $sth->execute($webvar{node});
     1103    my ($nodename) = $sth->fetchrow_array();
     1104    $page->param(nodename => $nodename);
     1105  }
     1106## end node hack
    12161107
    12171108  # Link back to browse-routed or list-pool page on "Update complete" page.
    1218   my $backlink = "/ip/cgi-bin/main.cgi?action=";
    12191109  my $cblock;   # to contain the CIDR of the container block we're retrieving.
    12201110  my $sql;
    12211111  if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) {
     1112    $page->param(backpool => 1);
    12221113    $sql = "select pool from poolips where ip='$webvar{block}'";
    1223     $backlink .= "listpool&pool=";
    12241114  } else {
    12251115    $sql = "select cidr from routed where cidr >>= '$webvar{block}'";
    1226     $backlink .= "showrouted&block=";
    12271116  }
    12281117  # I define there to be no errors on this operation...  so we don't need to check for them.
    … …  
    12321121  $sth->fetch();
    12331122  $sth->finish;
    1234   $backlink .= $cblock;
    1235 
    1236 my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No');
    1237   $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g;
    1238   $webvar{city} = desanitize($webvar{city});
    1239   $html =~ s/\$\$CITY\$\$/$webvar{city}/g;
    1240   $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g;
    1241   $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g;
    1242   $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g;
    1243   $html =~ s/\$\$SWIP\$\$/$swiptmp/g;
    1244   $webvar{circid} = desanitize($webvar{circid});
    1245   $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g;
    1246   $webvar{desc} = desanitize($webvar{desc});
    1247   $html =~ s/\$\$DESC\$\$/$webvar{desc}/g;
    1248   $webvar{notes} = desanitize($webvar{notes});
    1249   $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g;
    1250   $html =~ s/\$\$BACKLINK\$\$/$backlink/g;
    1251   $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g;
    1252 
    1253   if ($IPDBacl{$authuser} =~ /s/) {
    1254     $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>).
    1255         qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n);
    1256   }
    1257   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1258 
    1259   print $html;
     1123  $page->param(backblock => $cblock);
     1124
     1125  $page->param(cidr => $webvar{block});
     1126  $page->param(city => $webvar{city});
     1127  $page->param(disptype => $disp_alloctypes{$webvar{alloctype}});
     1128  $page->param(custid => $webvar{custid});
     1129  $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No');
     1130  $page->param(circid => $q->escapeHTML($webvar{circid}));
     1131  $page->param(desc => $q->escapeHTML($webvar{desc}));
     1132  $page->param(notes => $q->escapeHTML($webvar{notes}));
     1133  $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : "&nbsp;");
     1134  $page->param(privdata => $webvar{privdata})
     1135        if $IPDBacl{$authuser} =~ /s/;
    12601136
    12611137} # update()
    … …  
    12651141sub remove {
    12661142  if ($IPDBacl{$authuser} !~ /d/) {
    1267     printError("You shouldn't have been able to get here.  Access denied.");
     1143    $aclerr = 'delblock';
    12681144    return;
    12691145  }
    1270 
    1271   #show confirm screen.
    1272   open HTML, "../confirmRemove.html"
    1273         or croak "Could not open confirmRemove.html :$!";
    1274   my $html = join('', <HTML>);
    1275   close HTML;
    12761146
    12771147  # Serves'em right for getting here...
    12781148  if (!defined($webvar{block})) {
    1279     printError("Error 332");
     1149    $page->param(err => "Can't delete a block that doesn't exist");
    12801150    return;
    12811151  }
    … …  
    12981168    $desc = "N/A";
    12991169    $notes = "N/A";
     1170    $privdata = "N/A";
    13001171
    13011172  } elsif ($webvar{alloctype} eq 'mm') {
     1173
    13021174    $cidr = $webvar{block};
    13031175    $city = "N/A";
    … …  
    13071179    $desc = "N/A";
    13081180    $notes = "N/A";
     1181    $privdata = "N/A";
     1182
    13091183  } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m
    13101184
    … …  
    13311205  } # end cases for different alloctypes
    13321206
    1333   # Munge everything into HTML
    1334   $html =~ s|Please confirm|Please confirm <b>removal</b> of|;
    1335   $html =~ s|\$\$BLOCK\$\$|$cidr|g;
    1336   $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g;
    1337   $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g;
    1338   $html =~ s|\$\$CITY\$\$|$city|g;
    1339   $html =~ s|\$\$CUSTID\$\$|$custid|g;
    1340   $html =~ s|\$\$CIRCID\$\$|$circid|g;
    1341   $html =~ s|\$\$DESC\$\$|$desc|g;
    1342   $html =~ s|\$\$NOTES\$\$|$notes|g;
    1343 
    1344   $html =~ s|\$\$ACTION\$\$|finaldelete|g;
    1345 
    1346   # Set the warning text.
    1347   if ($alloctype =~ /^.[pd]$/) {
    1348     $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>|;
    1349   } else {
    1350     $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|;
    1351   }
    1352 
    1353   my $i = 1;
    1354   # Check to see if user is allowed to do anything with sensitive data
    1355   if ($IPDBacl{$authuser} =~ /s/) {
    1356     $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>).
    1357         qq(<td class=regular>$privdata</td></tr>\n);
    1358     $i++;
    1359   }
    1360   $html =~ s/\$\$PRIVDATA\$\$/$privdata/g;
    1361 
    1362   $i = ++$i % 2;
    1363   $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/;
    1364 
    1365   print $html;
    1366 } # end edit()
     1207  $page->param(block => $cidr);
     1208  $page->param(disptype => $disp_alloctypes{$alloctype});
     1209  $page->param(type => $alloctype);
     1210  $page->param(city => $city);
     1211  $page->param(custid => $custid);
     1212  $page->param(circid => $circid);
     1213  $page->param(desc => $desc);
     1214  $page->param(notes => $notes);
     1215  $privdata = '&nbsp;' if $privdata eq '';
     1216  $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/;
     1217  $page->param(delpool => $alloctype =~ /^.[pd]$/);
     1218
     1219} # end remove()
    13671220
    13681221
    … …  
    13731226sub finalDelete {
    13741227  if ($IPDBacl{$authuser} !~ /d/) {
    1375     printError("You shouldn't have been able to get here.  Access denied.");
     1228    $aclerr = 'delblock';
    13761229    return;
    13771230  }
    … …  
    13821235  my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype});
    13831236
     1237  $page->param(block => $webvar{block});
    13841238  if ($code eq 'OK') {
    1385     print "<div class=heading align=center>Success!  $webvar{block} deallocated.</div>\n";
    13861239    syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}".
    13871240        " $custid, $city, desc='$description'";
    … …  
    13901243        "CustID: $custid\nCity: $city\nDescription: $description\n");
    13911244  } else {
     1245    $page->param(failmsg => $msg);
    13921246    if ($webvar{alloctype} =~ /^.i$/) {
    13931247      syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'";
    1394       printError("Could not deallocate static IP $webvar{block}: $msg");
    13951248    } else {
    13961249      syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'";
    1397       printError("Could not deallocate netblock $webvar{block}: $msg");
     1250      $page->param(netblock => 1);
    13981251    }
    13991252  }
    14001253
    14011254} # finalDelete
    1402 
    1403 
    1404 sub exitError {
    1405   my $errStr = $_[0];
    1406   printHeader('','');
    1407   print qq(<center><p class="regular"> $errStr </p>
    1408 <input type="button" value="Back" onclick="history.go(-1)">
    1409 </center>
    1410 );
    1411   printFooter();
    1412   exit;
    1413 } # errorExit
    1414 
    1415 
    1416 # Just in case we manage to get here.
    1417 exit 0;
Note: See TracChangeset for help on using the changeset viewer.