Ignore:
Timestamp:
05/14/13 18:10:22 (12 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:
1 deleted
12 edited

Legend:

Unmodified
Added
Removed
  • branches/stable

  • branches/stable/cgi-bin/CustIDCK.pm

    r445 r593  
    3131# the local admin on installation
    3232sub custid_exist {
     33  my $self = shift;
    3334  my $custid = shift;
    3435
  • branches/stable/cgi-bin/IPDB.pm

    r592 r593  
    2424@EXPORT_OK    = qw(
    2525        %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks
    26         %allocated %free %routed %bigfree %IPDBacl
     26        %allocated %free %routed %bigfree %IPDBacl %aclmsg
    2727        &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &addMaster
    2828        &deleteBlock &getBlockData &mailNotify
     
    3232%EXPORT_TAGS    = ( ALL => [qw(
    3333                %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist
    34                 @masterblocks %allocated %free %routed %bigfree %IPDBacl
     34                @masterblocks %allocated %free %routed %bigfree %IPDBacl %aclmsg
    3535                &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock
    3636                &addMaster &deleteBlock &getBlockData &mailNotify
     
    5252our %bigfree;
    5353our %IPDBacl;
     54
     55# mapping table for functional-area => error message
     56our %aclmsg = (
     57        addmaster       => 'add a master block',
     58        addblock        => 'add an allocation',
     59        updateblock     => 'update a block',
     60        delblock        => 'delete an allocation',
     61        );
    5462
    5563our $org_name = 'Example Corp';
     
    126134  }
    127135
     136##fixme:  initialize HTML::Template env var for template path
     137# something like $self->path().'/templates' ?
     138#  $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar';
     139
    128140  return (1,"OK");
    129141} # end initIPDBGlobals
     
    174186sub finish {
    175187  my $dbh = $_[0];
    176   $dbh->disconnect;
     188  $dbh->disconnect if $dbh;
    177189} # end finish
    178190
     
    360372      }
    361373
    362       $sth = $dbh->prepare("update poolips set custid='$custid',".
    363         "city='$city',available='n',description='$desc',notes='$notes',".
    364         "circuitid='$circid',privdata='$privdata'".
    365         " where ip='$cidr'");
    366       $sth->execute;
     374      $sth = $dbh->prepare("update poolips set custid=?,city=?,".
     375        "available='n',description=?,notes=?,circuitid=?,privdata=?".
     376        " where ip=?");
     377      $sth->execute($custid, $city, $desc, $notes, $circid, $privdata, "$cidr");
    367378# node hack
    368379      if ($nodeid && $nodeid ne '') {
     
    413424          $sth = $dbh->prepare("insert into allocations".
    414425                " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
    415                 " values ('$cidr','$custid','$type','$city',?,?,".
    416                 $cidr->masklen.",?,?)");
    417           $sth->execute($desc,$notes,$circid,$privdata);
     426                " values (?,?,?,?,?,?,?,?,?)");
     427          $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
    418428
    419429          # And initialize the pool, if necessary
     
    527537          $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
    528538                "description,notes,maskbits,circuitid,privdata)".
    529                 " values ('$cidr','$custid','$type','$city',?,?,".
    530                 $cidr->masklen.",?,?)");
    531           $sth->execute($desc,$notes,$circid,$privdata);
     539                " values (?,?,?,?,?,?,?,?,?)");
     540          $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
    532541
    533542          # And initialize the pool, if necessary
     
    653662    eval {
    654663      $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
    655       $sth = $dbh->prepare("update poolips set custid='$defcustid',available='y',".
    656         "city=(select city from allocations where cidr >>= '$cidr'".
     664      $sth = $dbh->prepare("update poolips set custid=?,available='y',".
     665        "city=(select city from allocations where cidr >>= ?".
    657666        " order by masklen(cidr) desc limit 1),".
    658         "description='',notes='',circuitid='' where ip='$cidr'");
    659       $sth->execute;
     667        "description='',notes='',circuitid='' where ip=?");
     668      $sth->execute($defcustid, "$cidr", "$cidr");
    660669      $dbh->commit;
    661670    };
  • branches/stable/cgi-bin/MyIPDB.pm

    r509 r593  
    2323my $dbhost = 'ipdb-db';
    2424
    25 # Quick workaround for fixed web path.  Set this to the absolute web path to
    26 # your IPDB install, or leave blank for installation at the webroot.
    27 $IPDB::webpath = '';
     25# Quick workaround for fixed web path.  Set this to the absolute web path to 
     26# your IPDB install, or leave blank for installation at the webroot. 
     27$IPDB::webpath = ''; 
    2828
    2929# Set some globals declared in IPDB.pm.  Most of these only affect mailNotify().
  • branches/stable/cgi-bin/admin.cgi

    r592 r593  
    1515use warnings;
    1616use CGI::Carp qw(fatalsToBrowser);
     17use CGI::Simple;
     18use HTML::Template;
    1719use DBI;
    18 use CommonWeb qw(:ALL);
    1920#use POSIX qw(ceil);
    2021use NetAddr::IP;
     
    3940
    4041syslog "debug", "$authuser active";
     42
     43# Set up the CGI object...
     44my $q = new CGI::Simple;
     45# ... and get query-string params as well as POST params if necessary
     46$q->parse_query_string;
     47
     48# Convenience;  saves changing all references to %webvar
     49##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     50my %webvar = $q->Vars;
     51
     52# anyone got a better name?  :P
     53my $thingroot = $ENV{SCRIPT_FILENAME};
     54$thingroot =~ s|cgi-bin/admin.cgi||;
     55
     56# Set up some globals
     57$ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
    4158
    4259# Why not a global DB handle?  (And a global statement handle, as well...)
     
    4764($ip_dbh,$errstr) = connectDB_My;
    4865if (!$ip_dbh) {
    49   printAndExit("Database error: $errstr\n");
    50 }
    51 initIPDBGlobals($ip_dbh);
     66  $webvar{action} = "dberr";
     67} else {
     68  initIPDBGlobals($ip_dbh);
     69}
     70
     71# handle DB error output
     72if ($webvar{action} eq 'dberr') {
     73  my $page = HTML::Template->new(filename => "admin/dberr.tmpl");
     74  $page->param(errmsg => $errstr);
     75  print "Content-Type: text/html\n\n".$page->output;
     76  exit;
     77}
    5278
    5379if ($IPDBacl{$authuser} !~ /A/) {
    54   print "Content-Type: text/html\n\n".
    55         "<html>\n<head>\n\t<title>Access denied</title>\n".
    56         qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/ipdb.css">\n).
    57         qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n).
    58         "</head>\n<body>\n".
    59         qq(Access to this tool is restricted.  Contact the <a href="mailto:ipdbadmin\@example.com">IPDB administrator</a> \n).
    60         "for more information.\n</body>\n</html>\n";
     80  my $page = HTML::Template->new(filename => "admin/aclerr.tmpl");
     81##fixme:  need params for IPDB admin email and name
     82  $page->param(ipdbadmin_email => 'ipdbadmin@example.com');
     83  $page->param(ipdbadmin_name => 'the IPDB administrator');
     84  print "Content-Type: text/html\n\n".$page->output;
    6185  exit;
    6286}
    6387
    64 my %webvar = parse_post();
    65 cleanInput(\%webvar);
    66 
    67 print "Content-type: text/html\n\n".
    68         "<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n".
    69         qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/ipdb.css">\n).
    70         qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n).
    71         "</head>\n<body>\n".
    72         "<h2>IPDB - Administrative Tools</h2>\n<hr>\n";
     88my $header = HTML::Template->new(filename => "admin/header.tmpl");
    7389
    7490if(!defined($webvar{action})) {
    75   $webvar{action} = "<NULL>";   #shuts up the warnings.
    76 
    77   my $typelist = '';
     91  $webvar{action} = "main";   #shuts up the warnings.
     92}
     93
     94my $page;
     95if (-e "$ENV{HTML_TEMPLATE_ROOT}/admin/$webvar{action}.tmpl") {
     96  $page = HTML::Template->new(filename => "admin/$webvar{action}.tmpl");
     97} else {
     98  $page = HTML::Template->new(filename => "admin/dunno.tmpl");
     99}
     100
     101# handle index page
     102if ($webvar{action} eq 'main') {
     103  $header->param(mainpage => 1);
     104
    78105  $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder");
    79106  $sth->execute;
    80   my @data = $sth->fetchrow_array;
    81   $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";
    82   while (my @data = $sth->fetchrow_array) {
    83     $typelist .= "<option value='$data[0]'>$data[1]</option>\n";
    84   }
    85 
    86   my $masterlist = '';
     107
     108  my @typelist;
     109  my $count = 0;
     110  while (my ($type,$listname) = $sth->fetchrow_array) {
     111    my %row = (
     112        selected => $count++,
     113        type => $type,
     114        dispname => $listname
     115        );
     116    push @typelist, \%row;
     117  }
     118  $page->param(typelist => \@typelist);
     119
     120  my @masterlist;
    87121  $sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr");
    88122  $sth->execute;
    89   while (my @data = $sth->fetchrow_array) {
    90     $masterlist .= "<option value='$data[0]'>$data[0] ($data[1])</option>\n";
    91   }
    92 
    93   print qq(WARNING:  There are FAR fewer controls on what you can do here.  Use the
    94 main interface if at all possible.
    95 <hr>
    96 <form action="admin.cgi" method="POST">
    97 <input type=hidden name=action value=alloc>
    98 Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid>
    99 <input type=submit value=" GIMME!! "></form>
    100 <hr><form action="admin.cgi" method="POST">
    101 <input type=hidden name=action value=alloctweak>
    102 Manually update allocation data in this /24: <input name=allocfrom>
    103 <input type=submit value="Show allocations">
    104 </form>
    105 
    106 <hr>rWHOIS tools:
    107 <form action="admin.cgi" method="POST">
    108 <input type=hidden name=action value=touch>
    109 Bump "last updated" timestamp on this master: <select name=whichmaster>$masterlist</select>
    110 <input type=submit value="Update timestamp"> (Sets timestamp to "now")</form>
    111 <a href="admin.cgi?action=listcust">Edit customer data for rWHOIS</a> - data used for
    112 blocks with the SWIP box checkmarked.  Links to edit/add data are on this page.
    113 
    114 <hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates
    115 
    116 <hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users;  change
    117 internal access controls - note that this does NOT include IP-based limits)<br>
    118 <a href="admin.cgi?action=emailnotice">Manage email notice options</a> (pick which events
    119 and allocation types cause notifications;  configure recipient lists for notices)
    120 
    121 <hr>Consistency check tools<br>
    122 <a href="consistency-check.pl">General</a>:  Check general netblock consistency.<br>
    123 <a href="freespace.pl">Free space</a>:  List total and aggregate free space.  Does not
    124 include private networks (192.168.0.0/16, 172.16.0.0/12, 10.0.0.0/8)
    125 );
    126 } else {
    127   print qq(<a href="$IPDB::webpath/cgi-bin/admin.cgi">Back</a> to main<hr>);
    128 }
    129 
    130 
    131 ## Possible actions.
    132 if ($webvar{action} eq 'alloc') {
    133   # OK, we know what we're allocating.
    134 
    135 #  if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) {
    136 #    printAndExit("Can't allocate something that's not a netblock/ip");
    137 #  }
     123  while (my ($cidr,$mtime) = $sth->fetchrow_array) {
     124    my %row = (
     125        master => $cidr,
     126        masterdate => $mtime
     127        );
     128    push @masterlist, \%row;
     129  }
     130  $page->param(masterlist => \@masterlist);
     131
     132}
     133
     134## Non-default actions.
     135
     136elsif ($webvar{action} eq 'alloc') {
     137
     138  if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) {
     139    $page->param(errmsg => "Can't allocate something that's not a netblock/ip");
     140    goto ERRJUMP;
     141  }
    138142
    139143  $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'");
     
    148152      my $status = CustIDCK->custid_exist($webvar{custid});
    149153      if ($CustIDCK::Error) {
    150         printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);
    151         return;
     154        $page->param(errmsg => "Error verifying customer ID: ".$CustIDCK::ErrMsg);
     155        goto ERRJUMP;
    152156      }
    153157      if (!$status) {
    154         printError("Customer ID not valid.  Make sure the Customer ID ".
     158        $page->param(errmsg => "Customer ID not valid.  Make sure the Customer ID ".
    155159          "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ".
    156160          "non-customer assignments.");
    157         return;
     161        goto ERRJUMP;
    158162      }
    159163    }
     
    169173    @data = $sth->fetchrow_array;
    170174# User deserves errors if user can't be bothered to find the free block first.
    171     printAndExit("Can't allocate from outside a free block!!\n")
    172         if !$data[0];
     175    if (!$data[0]) {
     176      $page->param(errmsg => "Can't allocate from outside a free block!!");
     177      goto ERRJUMP;
     178    }
    173179  } elsif ($webvar{alloctype} =~ /^(.)i$/) {
    174180    $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')");
     
    176182    @data = $sth->fetchrow_array;
    177183# User deserves errors if user can't be bothered to find the pool and a free IP first.
    178     printAndExit("Can't allocate static IP from outside a pool!!\n")
    179         if !$data[0];
     184    if (!$data[0]) {
     185      $page->param(errmsg => "Can't allocate static IP from outside a pool!!");
     186      goto ERRJUMP;
     187    }
    180188  } else {
    181189    $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')");
     
    183191    @data = $sth->fetchrow_array;
    184192# User deserves errors if user can't be bothered to find the free block first.
    185     printAndExit("Can't allocate from outside a routed block!!\n")
    186         if !$data[0];
     193    if (!$data[0]) {
     194      $page->param(errmsg => "Can't allocate from outside a routed block!!");
     195      goto ERRJUMP;
     196    }
    187197  }
    188198
     
    190200  $sth->finish;
    191201
    192   my $cities = '';
     202  my @cities;
    193203  foreach my $city (@citylist) {
    194     $cities .= "<option>$city</option>\n";
    195   }
    196 
    197   print qq(<table class=regular>
    198 <form method=POST action=admin.cgi>
    199 <tr class=color1>
    200 <td>Allocating:</td>
    201 <td>$cidr<input type=hidden name=cidr value="$cidr"></td>
    202 </tr><tr class=color2>
    203 <td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}}
    204 <input type=hidden name=alloctype value="$webvar{alloctype}"></td>
    205 </tr><tr class=color1>
    206 <td>Allocated from:</td>
    207 <td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td>
    208 </tr><tr class="color2">
    209 <td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td>
    210 </tr><tr class=color1>
    211 <td>Customer location:</td><td>
    212 <select name="city"><option selected>-</option>
    213 $cities
    214 </select>
    215 &nbsp;<a href="javascript:popNotes('$IPDB::webpath/newcity.html')">Add new location</a>
    216 </td>
    217 </tr>
    218 <tr class="color2">
    219 <td>Circuit ID:</td><td><input name=circid size=40></td>
    220 </tr><tr class="color1">
    221 <td>Description/Name:</td><td><input name="desc" size=40></td>
    222 </tr><tr class="color2">
    223 <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td>
    224 </tr><tr class="warning">
    225 <td colspan=2><center>WARNING:  This will IMMEDIATELY assign this block!!</center></td>
    226 </tr><tr class="color2">
    227 <td class="center" colspan="2"><input type="submit" value="  Assign  "></td>
    228 <input type="hidden" name="action" value="confirm">
    229 </form>
    230 </tr>
    231 </table>
    232 );
    233 
     204     my %row = (city => $city);
     205     push @cities, \%row;
     206  }
     207  $page->param(
     208        cidr => $cidr,
     209        disptype => $disp_alloctypes{$webvar{alloctype}},
     210        type => $webvar{alloctype},
     211        alloc_from => $alloc_from,
     212        custid => $custid,
     213        citylist => \@cities
     214        );
    234215
    235216} elsif ($webvar{action} eq 'confirm') {
    236217
    237   print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ".
    238         "$disp_alloctypes{$webvar{alloctype}}...<br>\n";
     218  $page->param(
     219        cidr => $webvar{cidr},
     220        custid => $webvar{custid},
     221        desc => $webvar{desc},
     222        disptype => $disp_alloctypes{$webvar{alloctype}}
     223        );
    239224  # Only need to check city here.
    240225  if ($webvar{city} eq '-') {
    241     printError("Invalid customer location!  Go back and select customer's location.");
     226    $page->param(locerr => "Invalid customer location!  Go back and select customer's location.");
     227    goto ERRJUMP;
    242228  } else {
    243229    if ($webvar{alloctype} =~ /^.i$/) {
     
    247233      $sth->execute;
    248234      if ($sth->err) {
    249         print "Allocation failed!  DBI said:\n".$sth->errstr."\n";
     235        $page->param(errmsg => $sth->errstr);
    250236        syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
    251237                "'$webvar{alloctype}' failed: '".$sth->errstr."'";
    252238      } else {
    253         print "Allocation OK!\n";
    254239        syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
    255240                "'$webvar{alloctype}'";
     
    263248        $webvar{circid});
    264249      if ($retcode eq 'OK') {
    265         print "Allocation OK!\n";
    266250        syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ".
    267251                "'$webvar{alloctype}'";
    268252      } else {
    269         print "Allocation failed!  IPDB::allocateBlock said:\n$msg\n";
     253        $page->param(errmsg => $msg);
    270254        syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ".
    271255                "'$webvar{alloctype}' failed: '$msg'";
     
    276260
    277261} elsif ($webvar{action} eq 'alloctweak') {
     262
    278263  fix_allocfrom();
    279264  showAllocs($webvar{allocfrom});
     265
    280266} elsif ($webvar{action} eq 'update') {
     267
    281268  update();
    282 } elsif ($webvar{action} eq 'assign') {
    283   # Display a list of possible blocks within the requested block.
    284   open (HTML, "../admin_alloc.html")
    285         or croak "Could not open admin_alloc.html :$!";
    286   my $html = join('', <HTML>);
    287   $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g;
    288   $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g;
    289 
    290   my $from = new NetAddr::IP $webvar{allocfrom};
    291   my @blocklist = $from->split($webvar{masklen});
    292   my $availblocks;
    293   foreach (@blocklist) {
    294     $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n);
    295   }
    296   $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g;
    297 
    298   print $html;
     269
    299270} elsif ($webvar{action} eq 'touch') {
    300   print "Touching master $webvar{whichmaster}\n";
     271
     272  $page->param(master => $webvar{whichmaster});
    301273  $sth = $ip_dbh->prepare("update masterblocks set mtime=now() where cidr='$webvar{whichmaster}'");
    302274  $sth->execute;
    303275  if ($sth->err) {
    304     print "<p>Error updating modified timestamp on master $webvar{whichmaster}: ".$sth->errstr."\n";
    305   }
     276    $page->param(errmsg => $sth->errstr);
     277  }
     278
    306279} elsif ($webvar{action} eq 'listcust') {
    307   print qq(Add new entry:\n
    308 <form action=admin.cgi method=POST>
    309 <table border=1><tr>
    310 <input type=hidden name=action value=edcust>
    311 <input type=hidden name=newcust value=1>
    312 <td>CustID:</td><td><input name=custid></td>
    313 <td align=center><input type=submit value="Go to edit page for this custid"></td></tr>
    314 </form></table>
    315 );
    316   print "<p>Click CustID to edit existing customer contact data:\n".
    317         "<table border=1>\n<tr><td>CustID</td><td>Name</td><td>Tech handle</td></tr>\n";
     280
    318281  $sth = $ip_dbh->prepare("select custid,name,tech_handle from customers order by custid");
    319282  $sth->execute;
     283  my @custlist;
    320284  while (my @data = $sth->fetchrow_array) {
    321     print qq(<tr><td><a href="admin.cgi?action=edcust&custid=$data[0]">$data[0]</td>).
    322         "<td>$data[1]</td><td>$data[2]</td></tr>\n";
    323   }
    324   print "</table>\n";
     285    my %row = (
     286        custid => $data[0],
     287        custname => $data[1],
     288        tech => $data[2]
     289        );
     290    push @custlist, \%row;
     291  }
     292  $page->param(custlist => \@custlist);
     293
    325294} elsif ($webvar{action} eq 'edcust') {
     295
    326296  if ($webvar{newcust}) {
    327     print "got here?\n";
    328297    $sth = $ip_dbh->prepare("INSERT INTO customers (custid) VALUES (?)");
    329298    $sth->execute($webvar{custid});
     
    335304  my ($custid, $name, $street, $city, $prov, $country, $pocode, $phone, $tech, $abuse, $admin, $special) =
    336305        $sth->fetchrow_array;
    337   print qq(<form action=admin.cgi method=POST>
    338 <table border=1><tr>
    339 <input type=hidden name=action value=updcust>
    340 <td>CustID:</td><td>$custid<input type=hidden name=custid value=$custid></td>
    341 <td>Name:</td><td><input name=name value="$name"></td></tr>
    342 <tr><td>Street:</td><td><input name=street value="$street"></td>
    343 <!-- <td>Street2:</td><td><input name=street2></td> -->
    344 <td>City:</td><td><input name=city value="$city"></td></tr>
    345 <tr><td>Province/State: (2-letter code)</td><td><input name=province value="$prov" length=2 size=2></td>
    346 <td>Country: (2-letter code)</td><td><input name=country value="$country" length=2 size=2></td></tr>
    347 <tr><td>Postal/ZIP Code:</td><td><input name=pocode value="$pocode"></td>
    348 <td>Phone:</td><td><input name=phone value="$pocode"></td></tr>
    349 <!-- <td>Default rDNS:</td><td><input name=def_rdns></td></tr>
    350 <td>Description:</td><td><input name=description></td> -->
    351 <tr><td>Contacts/ARIN Handles:</td><td>
    352  Tech: <input name=tech_handle value="$tech"><br>
    353  Abuse: <input name=abuse_handle value="$abuse"><br>
    354  Admin: <input name=admin_handle value="$admin"><br>
    355 Note:  Only tech is required at the moment.
    356 </td>
    357 <td>"Special":</td><td><textarea name=special rows=4 cols=50>$special</textarea></td>
    358 </tr>
    359 <tr><td colspan=4 align=center><input type=submit value="Update"></td></tr>
    360 </form></table>
    361 <div style="margin-left:5px">
    362 <h3>Explanation for "Special" field:</h3>
    363 This is a temporary place to define the WHOIS "net name" for a block.
    364 It may be removed later, more likely migrated elsewhere.
    365 <p>It's formatted like this, one line for each custom net name:
    366 <pre>NetName[CIDR block]: NET-NAME</pre>
    367 Example:
    368 <pre>NetName192.168.236.0/24: MEGAWIDGET-1</pre>
    369 Note:
    370 <ul style="margin-top: 0px;">
    371 <li>Spacing is important - there should only be ONE space, in between the colon and the net name.
    372 <li>The CIDR block name nust include all four octets - no short forms are accepted.
    373 <li>Net names must be all uppercase, and consist only of A-Z, 0-9, and - (same as for SWIPed net names).
    374 </ul>
    375 </div>
    376 );
     306
     307  $page->param(
     308        custid => $custid,
     309        name => $name,
     310        street => $street,
     311        city => $city,
     312        prov => $prov,
     313        country => $country,
     314        pocode => $pocode,
     315        phone => $phone,
     316        tech => $tech,
     317        abuse => $abuse,
     318        admin => $admin,
     319        special => $special
     320        );
    377321
    378322} elsif ($webvar{action} eq 'updcust') {
     323
    379324  $sth = $ip_dbh->prepare("UPDATE customers SET".
    380325        " name=?, street=?, city=?, province=?, country=?, pocode=?,".
     
    384329        $webvar{country}, $webvar{pocode}, $webvar{phone}, $webvar{tech_handle},
    385330        $webvar{abuse_handle}, $webvar{admin_handle}, $webvar{special}, $webvar{custid});
    386   print "Updated $webvar{custid}<br>\n".
    387         qq(<table border=1>
    388 <tr><td>CustID:</td><td>$webvar{custid}</td></tr>
    389 <tr><td>Name:</td><td>$webvar{name}</td></tr>
    390 <tr><td>Street:</td><td>$webvar{street}</td></tr>
    391 <tr><td>City:</td><td>$webvar{city}</td></tr>
    392 <tr><td>Province/State:</td><td>$webvar{province}</td></tr>
    393 <tr><td>Country:</td><td>$webvar{country}</td></tr>
    394 <tr><td>Postal/ZIP Code:</td><td>$webvar{pocode}</td></tr>
    395 <tr><td>Phone:</td><td>$webvar{phone}</td></tr>
    396 <!-- <td>Default rDNS:</td><td>$webvar{def_rdns}</td></tr> -->
    397 <tr><td>Contacts/ARIN Handles:</td><td>
    398  Tech: $webvar{tech_handle}<br>
    399  Abuse: $webvar{abuse_handle}<br>
    400  Admin: $webvar{admin_handle}<br>
    401 </td></tr>
    402 <tr><td>"Special":</td><td><pre>$webvar{special}</pre></td></tr>
    403 </table>
    404 <a href="admin.cgi?action=listcust">Back</a> to rWHOIS customer list<br>\n);
     331  $page->param(
     332        custid => $webvar{custid},
     333        name => $webvar{name},
     334        street => $webvar{street},
     335        city => $webvar{city},
     336        prov => $webvar{province},
     337        country => $webvar{country},
     338        pocode => $webvar{pocode},
     339        phone => $webvar{phone},
     340        tech => $webvar{tech_handle},
     341        abuse => $webvar{abuse_handle},
     342        admin => $webvar{admin_handle},
     343        special => $webvar{special}
     344        );
    405345
    406346} elsif ($webvar{action} eq 'showpools') {
    407   print "IP Pools currently allocated:\n".
    408         "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n";
    409   $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr");
    410   $sth->execute;
    411   my %poolfree;
    412   while (my @data = $sth->fetchrow_array) {
    413     $poolfree{$data[0]} = 0;
    414   }
    415   $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip");
    416   $sth->execute;
    417   while (my @data = $sth->fetchrow_array) {
    418     $poolfree{$data[0]}++;
    419   }
    420   foreach my $key (keys %poolfree) {
    421     print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>).
    422         "<td>$poolfree{$key}</td></tr>\n";
    423   }
    424   print "</table>\n";
     347
     348  $sth = $ip_dbh->prepare("select pool, count(*) from poolips where available='y' group by pool order by pool");
     349  $sth->execute;
     350  my @poollist;
     351  while (my ($pool,$free) = $sth->fetchrow_array) {
     352    my %row = (
     353        pool => $pool,
     354        free => $free
     355        );
     356    push @poollist, \%row;
     357  }
     358  $page->param(poollist => \@poollist);
     359
    425360} elsif ($webvar{action} eq 'tweakpool') {
     361
    426362  showPool($webvar{pool});
     363
    427364} elsif ($webvar{action} eq 'updatepool') {
    428365
    429366  $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ".
    430         "city='$webvar{city}', type='$webvar{type}', available='".
     367        "city=?, type='$webvar{type}', available='".
    431368        (($webvar{available} eq 'y') ? 'y' : 'n').
    432         "', notes='$webvar{notes}', description='$webvar{desc}' ".
     369        "', notes=?, description=? ".
    433370        "where ip='$webvar{ip}'");
    434   $sth->execute;
     371  $sth->execute($webvar{city},$webvar{notes},$webvar{desc});
     372  $page->param(ip => $webvar{ip});
    435373  if ($sth->err) {
    436     print "Error updating pool IP $webvar{ip}: $@<hr>\n";
    437     syslog "err", "$authuser could not update pool IP $webvar{ip}: $@";
    438   } else { 
    439     $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
    440     $sth->execute;
    441     my @data = $sth->fetchrow_array;
    442     print "$webvar{ip} in $data[0] updated\n<hr>\n";
     374    $page->param(errmsg => $sth->errstr);
     375    syslog "err", "$authuser could not update pool IP $webvar{ip}: ".$sth->errstr;
     376  } else {
    443377    syslog "notice", "$authuser updated pool IP $webvar{ip}";
    444378  }
     379  $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'");
     380  $sth->execute;
     381  my @data = $sth->fetchrow_array;
     382  $page->param(pool => $data[0]);
     383
    445384} elsif ($webvar{action} eq 'showusers') {
    446   print "Notes:<br>\n".
    447         "<li>Admin users automatically get all other priviledges.\n".
    448         "<li>Everyone has basic read access.\n".
    449         "<hr>Add new user:<form action=admin.cgi method=POST>\n".
    450         "Username: <input name=username><br>\n".
    451         "Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n".
    452         "<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n";
    453 
    454   print "<hr>Users with access:\n<table border=1>\n";
    455   print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n";
    456   print "<tr><td>Username</td><td>Add new</td><td>Change</td>".
    457         "<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n".
    458         "<form action=admin.cgi method=POST>\n";
     385
    459386  $sth = $ip_dbh->prepare("select username,acl from users order by username");
    460387  $sth->execute;
    461   while (my @data = $sth->fetchrow_array) {
    462     print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>".
    463         qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>).
    464     # Now for the fun bit.  We have to pull apart the ACL field and
    465     # output a bunch of checkboxes.
    466         "<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : '').
    467         "></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : '').
    468         "></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : '').
    469         "></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : '').
    470         "></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : '').
    471         qq(></td><td><input type=submit value="Update"></td></form>\n).
    472         "<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>".
    473         "<input type=hidden name=username value=$data[0]>".
    474         qq(<input type=submit value="Delete user"></tr></form>\n);
    475 
    476   }
    477   print "</table>\n";
     388  my @userlist;
     389  while (my ($username,$acl) = $sth->fetchrow_array) {
     390##fixme: funky things happening with HTML::Template here;  shouldn't need the "logic ? iftrue : iffalse" structure
     391    my %row = (
     392        username => $username,
     393        can_add => ($acl =~ /a/ ? 1 : 0),
     394        can_change => ($acl =~ /c/ ? 1 : 0),
     395        can_del => ($acl =~ /d/ ? 1 : 0),
     396        sysnet => ($acl =~ /s/ ? 1 : 0),
     397        is_admin => ($acl =~ /A/ ? 1 : 0),
     398        acl => $acl
     399        );
     400    push @userlist, \%row;
     401  }
     402  $page->param(userlist => \@userlist);
     403
    478404} elsif ($webvar{action} eq 'updacl') {
    479   print "Updating ACL for $webvar{username}:<br>\n";
     405
     406  $page->param(username => $webvar{username});
    480407  my $acl = 'b';
    481408  if ($webvar{admin} eq 'on') {
     
    487414        ($webvar{sysnet} eq 'on' ? 's' : '');
    488415  }
    489   print "New ACL: $acl<br>\n";
     416  $page->param(acl => $acl);
    490417
    491418  $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'");
    492419  $sth->execute;
    493   print "OK\n" if !$sth->err;
    494 
    495   print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
     420  $page->param(errmsg => $sth->errstr) if $sth->err;
    496421
    497422} elsif ($webvar{action} eq 'newuser') {
    498   print "Adding user $webvar{username}...\n";
     423
     424  $page->param(username => $webvar{username});
    499425  my $cr_pass = ($webvar{preenc} ? $webvar{password} :
    500426        crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]));
     
    502428        "('$webvar{username}','$cr_pass','b')");
    503429  $sth->execute;
    504   if ($sth->err) {
    505     print "<br>Error adding user: ".$sth->errstr;
    506   } else {
    507     print "OK\n";
    508   }
    509 
    510   print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
     430  $page->param(errmsg => $sth->errstr) if $sth->err;
    511431
    512432} elsif ($webvar{action} eq 'deluser') {
    513   print "Deleting user $webvar{username}.<br>\n";
     433
     434  $page->param(username => $webvar{username});
    514435  $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'");
    515436  $sth->execute;
    516   print "OK\n" if !$sth->err;
    517 
    518   print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n);
     437  $page->param(errmsg => $sth->errstr) if $sth->err;
    519438
    520439} elsif ($webvar{action} eq 'emailnotice') {
    521   print "<h4>Email notice management:</h4>\nClick the email addresses to edit that list.";
     440
    522441  $sth = $ip_dbh->prepare("SELECT action,reciplist FROM notify");
    523442  $sth->execute;
    524 
    525   print "<table border=1>\n";
     443  my @spamlist;
    526444  while (my ($notice_code,$reciplist) = $sth->fetchrow_array() ) {
    527445##fixme: hairy mess, only a few things call mailNotify() anyway, so many possible notices won't work.
    528446    my $action_out = dispNoticeCode($notice_code);
    529     print "<tr><td>$action_out</td>".
    530         qq(<td><a href="admin.cgi?action=ednotice&code=$notice_code">$reciplist</a></td>).
    531         qq(<td><a href="admin.cgi?action=delnotice&code=$notice_code">Delete</a></tr>\n);
    532   }
    533   print qq(<tr><td colspan=2>Known "special" codes:<br>
    534 <ul style="margin-top: 0px; margin-bottom: 0px;">
    535         <li>swi: Notify if block being updated has SWIP flag set</li>
    536 </ul></td></tr>
    537 </table>
    538 );
    539 
    540 # add new entries from this tangle:
    541   print "<h4>Add new notification:</h4>\n".
    542         "Note:  Failure notices on most conditions are not yet supported.\n";
    543 
    544   print qq(<table border=1><form action=admin.cgi method="POST">
    545 <input type=hidden name=action value=addnotice>
    546 <tr>
    547 <td>Recipients</td><td colspan=3><textarea name=reciplist cols=50 rows=5></textarea></td></tr>
    548 <tr><td>Action</td><td>
    549         <table><tr>
    550                 <td><input type=radio name=msgaction value=a>Add &nbsp;
    551                 <input type=radio name=msgaction value=u>Update &nbsp;
    552                 <input type=radio name=msgaction value=d>Delete &nbsp;
    553                 <input type=radio name=msgaction value=n>New listitem</td>
    554         </tr><tr>
    555                 <td>
    556                 <input type=radio name=msgaction value=s:>Special: <input name=special>(requires code changes)
    557         </td></tr></table>
    558 </td>
    559 <td>Failure?</td><td><input type=checkbox name=onfail></td></tr>
    560 <tr><td>Event/Allocation type:</td><td colspan=3>
    561         <table>
    562         <tr>
    563                 <td><input type=radio name=alloctype value=a>All allocations</td>
    564                 <td><input type=radio name=alloctype value=.i>All static IPs</td>
    565                 <td><input type=radio name=alloctype value=ci>New city</td>
    566                 <td><input type=radio name=alloctype value=no>New node</td>
    567         </tr>
    568         <tr>
    569 );
     447    my %row = (
     448        action => $action_out,
     449        code => $notice_code,
     450        recips => $reciplist
     451        );
     452    push @spamlist, \%row;
     453  }
     454  $page->param(spamlist => \@spamlist);
    570455
    571456  $sth = $ip_dbh->prepare("SELECT type,dispname FROM alloctypes WHERE listorder < 500 ".
     
    573458  $sth->execute;
    574459  my $i=0;
     460  my @typelist;
    575461  while (my ($type,$disp) = $sth->fetchrow_array) {
    576     print "             <td><input type=radio name=alloctype value=$type>$disp</td>";
    577     $i++;
    578     print "     </tr>\n\t<tr>"
    579         if ($i % 4 == 0);
    580   }
    581 
    582   print qq(     </tr>
    583         </table>
    584 </tr>
    585 <tr><td colspan=4 align=center><input type=submit value="Add notice"></td></tr>
    586 </table>
    587 </form>
    588 );
    589   ## done spitting out add-new-spam-me-now table
     462    my %row = (
     463        type => $type,
     464        disptype => $disp,
     465# ahh, off-by-one counts, how we do love thee...  NOT!
     466        newrow => ($i+2 > $sth->rows ? 1 : (++$i % 4)),
     467        );
     468    push @typelist, \%row;
     469  }
     470  $page->param(typelist => \@typelist);
    590471
    591472} elsif ($webvar{action} eq 'addnotice') {
     473
    592474  $webvar{alloctype} = $webvar{special} if $webvar{msgaction} eq 's:';
    593475  if ($webvar{msgaction} && $webvar{alloctype} && $webvar{reciplist}) {
     476    $page->param(cantry => 1);
    594477    $webvar{reciplist} =~ s/[\r\n]+/,/g;
    595478    $webvar{msgaction} = "f:$webvar{msgaction}" if $webvar{onfail};
    596     print "Adding notice to $webvar{reciplist} for ".dispNoticeCode($webvar{msgaction}.$webvar{alloctype}).":\n";
     479    $page->param(reciplist => $webvar{reciplist});
     480    $page->param(dispnotice => dispNoticeCode($webvar{msgaction}.$webvar{alloctype}));
    597481    $sth = $ip_dbh->prepare("INSERT INTO notify (action, reciplist) VALUES (?,?)");
    598482##fixme:  automagically merge reciplists iff action already exists
    599483    $sth->execute($webvar{msgaction}.$webvar{alloctype}, $webvar{reciplist});
    600     if ($sth->err) {
    601       print "Failed:  DB error: ".$sth->errstr."\n";
    602     } else {
    603       print "OK!<br>\n"
    604     }
    605   } else {
    606     print "Need to specify at least one recipient, an action, and an allocation type. ".
    607         qq{("Special" content is considered an allocation type).  Hit the Back button and try again.<br>\n};
    608   }
    609   print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n);
     484    $page->param(addfailed => $sth->errstr) if $sth->err;
     485  }
    610486
    611487} elsif ($webvar{action} eq 'delnotice') {
    612   print "Deleting notices on ".dispNoticeCode($webvar{code}.$webvar{alloctype}).":\n";
     488
     489  $page->param(dispnotice => dispNoticeCode($webvar{code}.$webvar{alloctype}));
    613490  $sth = $ip_dbh->prepare("DELETE FROM notify WHERE action=?");
    614491  $sth->execute($webvar{code});
    615   if ($sth->err) {
    616     print "Failed:  DB error: ".$sth->errstr."\n";
    617   } else {
    618     print "OK!<br>\n"
    619   }
    620   print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n);
     492  $page->param(delfailed => $sth->errstr) if $sth->err;
    621493
    622494} elsif ($webvar{action} eq 'ednotice') {
    623   print "<h4>Editing recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n";
     495
     496  $page->param(dispnotice => dispNoticeCode($webvar{code}));
     497  $page->param(code => $webvar{code});
    624498  $sth = $ip_dbh->prepare("SELECT reciplist FROM notify WHERE action=?");
    625499  $sth->execute($webvar{code});
    626500  my ($reciplist) = $sth->fetchrow_array;
    627501  $reciplist =~ s/,/\n/g;
    628   print qq(<form action=admin.cgi method=POST><input type=hidden name=code value="$webvar{code}">\n).
    629         qq(<input type=hidden name=action value="updnotice"><table border=1><tr><td>).
    630         qq(<textarea cols="40" rows="5" name=reciplist>$reciplist</textarea></td><td><input type=submit value="Update">\n).
    631         "</td></tr></table></form>\n";
     502  $page->param(reciplist => $reciplist);
     503
    632504} elsif ($webvar{action} eq 'updnotice') {
    633   print "<h4>Updating recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n";
     505
     506  $page->param(dispnotice => dispNoticeCode($webvar{code}));
    634507  $sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?");
    635508  $webvar{reciplist} =~ s/[\r\n]+/,/g;
    636509  $sth->execute($webvar{reciplist}, $webvar{code});
    637   if ($sth->err) {
    638     print "Failed:  DB error: ".$sth->errstr."\n";
    639   } else {
    640     print "OK!<br>\n"
    641   }
    642   print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n);
     510  $page->param(updfailed => $sth->errstr) if $sth->err;
     511
    643512} elsif ($webvar{action} ne '<NULL>') {
    644   print "webvar{action} check failed: Don't know how to $webvar{action}";
    645 }
     513  $page->param(dunno => $webvar{action});
     514}
     515
     516ERRJUMP: print "Content-type: text/html\n\n".$header->output;
     517print $page->output;
     518
     519##fixme:  make me a footer param!
     520print qq(<hr><div><a href="$IPDB::webpath/">Back</a> to main interface</div>\n);
     521
     522# We print the footer here, so we don't have to do it elsewhere.
     523my $footer = HTML::Template->new(filename => "footer.tmpl");
     524# we're already in the admin tools, no need to provide a bottom link.  maybe.
     525#$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
     526
     527print $footer->output;
     528
     529$ip_dbh->disconnect;
     530
     531exit;
     532
    646533
    647534# Hokay.  This is a little different.  We have a few specific functions here:
     
    649536#  -> Tweak individual DB fields
    650537#
    651 
    652 print qq(<hr><a href="$IPDB::webpath/">Back</a> to main interface</a>\n);
    653 
    654 printFooter;
    655 
    656 $ip_dbh->disconnect;
    657 
    658 exit;
    659538
    660539
     
    671550
    672551
    673 # List free blocks in a /24 for arbitrary manual allocation
    674 sub showfree($) {
    675   my $cidr = new NetAddr::IP $_[0];
    676   print "Showing free blocks in $cidr<br>\n".
    677         "<table border=1>\n";
    678   $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");
    679   $sth->execute;
    680   while (my @data = $sth->fetchrow_array) {
    681     my $temp = new NetAddr::IP $data[0];
    682     print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".
    683         qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).
    684         "<td>".
    685         (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'
    686           : "<select name=masklen><option>30</option>\n<option>29</option>\n") .
    687         (($temp->masklen < 29) ? "<option>28</option>\n" : '') .
    688         (($temp->masklen < 28) ? "<option>27</option>\n" : '') .
    689         (($temp->masklen < 27) ? "<option>26</option>\n" : '') .
    690         (($temp->masklen < 26) ? "<option>25</option>\n" : '') .
    691         (($temp->masklen < 25) ? "<option>24</option>\n" : '') .
    692         "</td>".
    693         qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).
    694         "\n</form></tr>\n";
    695   }
    696   print "</table>\n";
    697 }
    698 
    699 
    700552# Show allocations to allow editing.
    701 sub showAllocs($) {
    702   my $cidr = new NetAddr::IP $_[0];
    703   print "Edit custID, allocation type, city for allocations in ".
    704         "$cidr:\n<table border=1>";
    705   $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr");
    706   $sth->execute;
    707   while (my @data = $sth->fetchrow_array) {
    708     print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n".
    709         qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n).
    710         qq(<td><input name=custid value="$data[1]"></td>\n).
    711         "<td><select name=alloctype>";
    712 
     553sub showAllocs {
     554
     555  my $within = new NetAddr::IP $_[0];
     556  $page->param(within => $within);
     557
     558  $sth = $ip_dbh->prepare("select cidr,custid,type,city,description from allocations where cidr <<= '$within' order by cidr");
     559  $sth->execute;
     560  my @blocklist;
     561  while (my ($cidr,$custid,$type,$city,$desc) = $sth->fetchrow_array) {
     562    my %row = (
     563        cidr => $cidr,
     564        custid => $custid,
     565        city => $city,
     566        desc => $desc,
     567        );
     568
     569##fixme:  don't wanna retrieve the whole type list *every time around the outer loop*
    713570    my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes".
    714571        " where listorder < 500 and not (type like '_i') order by listorder");
    715572    $sth2->execute;
    716     while (my @types = $sth2->fetchrow_array) {
    717       print "<option". (($data[2] eq $types[0]) ? ' selected' : '') .
    718         " value='$types[0]'>$types[1]</option>\n";
     573    my @typelist;
     574    while (my ($listtype,$dispname) = $sth2->fetchrow_array) {
     575      my %subrow = (
     576        type => $listtype,
     577        dispname => $dispname,
     578        selected => ($listtype eq $type)
     579        );
     580      push @typelist, \%subrow;
    719581    }
    720 
    721     print qq(<td><input name=city value="$data[3]"></td>\n).
    722         "<td>$data[4]</td><td>$data[5]</td>".
    723         qq(<td><input type=submit value="Update"></td></form></tr>\n);
    724   }
    725   print "</table>\n";
    726 
    727   # notes
    728   print "<hr><b>Notes:</b>\n".
    729         "<ul>\n<li>Use the main interface to update description and notes fields\n".
    730         "<li>Changing the allocation type here will NOT affect IP pool data.\n".
    731         "</ul>\n";
    732 }
     582    $row{typelist} = \@typelist;
     583    push @blocklist, \%row;
     584  }
     585  $page->param(blocklist => \@blocklist);
     586} # end showAllocs()
    733587
    734588
    735589# Stuff updates into DB
    736590sub update {
    737   eval {
    738     # Relatively simple SQL transaction here.  Note that we're deliberately NOT
    739     # updating notes/desc here as it's available through the main interface.
    740     $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
    741         "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'");
    742     $sth->execute;
    743     $ip_dbh->commit;
    744   };
    745   if ($@) {
    746     carp "Transaction aborted because $@";
    747     eval { $ip_dbh->rollback; };
    748     syslog "err", "$authuser could not update block '$webvar{block}': '$@'";
     591  # Relatively simple SQL transaction here.  Note that we're deliberately NOT
     592  # updating notes/desc here as it's available through the main interface.
     593  $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',".
     594        "city=?,type='$webvar{alloctype}' where cidr='$webvar{block}'");
     595  $sth->execute($webvar{city});
     596
     597  $page->param(block => $webvar{block});
     598  if ($sth->err) {
     599    $page->param(updfailed => $sth->errstr);
     600    syslog "err", "$authuser could not update block '$webvar{block}': '".$sth->errstr."'";
    749601  } else {
    750     # If we get here, the operation succeeded.
    751602    syslog "notice", "$authuser updated $webvar{block}";
    752     print "Allocation $webvar{block} updated<hr>\n";
    753603  }
    754604  # need to get /24 that block is part of
     
    756606  $bits[3] = "0/24";
    757607  showAllocs((join ".", @bits));
    758 }
     608} # end update()
    759609
    760610
     
    764614sub showPool($) {
    765615  my $pool = new NetAddr::IP $_[0];
    766   print qq(Listing pool $pool:\n<table border=1>
    767 <form action=admin.cgi method=POST>
    768 <input type=hidden name=action value=updatepool>
    769 <tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>
    770 <tr><td align=right>Customer location:</td><td><input name=city></td></tr>
    771 <tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n);
    772616
    773617  $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder");
    774618  $sth->execute;
    775   while (my @data = $sth->fetchrow_array) {
    776     print "<option value='$data[0]'>$data[1]</option>\n";
    777   }
    778 
    779   print qq(</select></td></tr>
    780 <tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr>
    781 <tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr>
    782 <tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr>
    783 <tr><td colspan=2 align=center><input type=submit value="Update"></td></tr>
    784 ).
    785         "</table>Update the following record:<table border=1>\n";
    786   $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
    787   $sth->execute;
    788   while (my @data = $sth->fetchrow_array) {
    789     print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>).
    790         "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>".
    791         "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n";
    792   }
    793   print "</form></table>\n";
    794 }
     619  my @typelist;
     620  while (my ($type,$dispname) = $sth->fetchrow_array) {
     621    my %row = (
     622        type => $type,
     623        dispname => $dispname
     624        );
     625    push @typelist, \%row;
     626  }
     627  $page->param(typelist => \@typelist);
     628
     629  $sth = $ip_dbh->prepare("select ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip");
     630  $sth->execute;
     631  my @iplist;
     632  while (my ($ip,$custid,$city,$type,$avail,$desc,$notes) = $sth->fetchrow_array) {
     633    my %row = (
     634        ip => $ip,
     635        custid => $custid,
     636        city => $city,
     637        type => $type,
     638        avail => $avail,
     639        desc => $desc,
     640        notes => $notes
     641        );
     642    push @iplist, \%row;
     643  }
     644  $page->param(iplist => \@iplist);
     645} # end showPool()
    795646
    796647
  • branches/stable/cgi-bin/allocate.pl

    r445 r593  
    1111use warnings;
    1212use DBI;
    13 use CommonWeb qw(:ALL);
    1413use NetAddr::IP;
    1514
     
    3837my $errstr;
    3938($ip_dbh,$errstr) = connectDB_My;
    40 if (!$ip_dbh) {
    41   printAndExit("Failed to connect to database: $errstr\n");
    42 }
     39die "Failed to connect to database: $errstr\n"
     40        if !$ip_dbh;
     41
    4342checkDBSanity($ip_dbh);
    4443initIPDBGlobals($ip_dbh);
  • branches/stable/cgi-bin/combineblocks.pl

    r445 r593  
    1313#use CGI::Carp qw(fatalsToBrowser);
    1414use DBI;
    15 #use CommonWeb qw(:ALL);
    1615#use POSIX qw(ceil);
    1716use NetAddr::IP;
  • 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;
  • branches/stable/cgi-bin/newcity.cgi

    r445 r593  
    1313use warnings;
    1414#use CGI::Carp qw(fatalsToBrowser);
     15use CGI::Simple;
     16use HTML::Template;
    1517use DBI;
    16 use CommonWeb qw(:ALL);
    1718#use POSIX qw(ceil);
    1819use NetAddr::IP;
     
    3536}
    3637
    37 my %webvar = parse_post();
    38 cleanInput(\%webvar);
     38# Set up the CGI object...
     39my $q = new CGI::Simple;
     40# ... and get query-string params as well as POST params if necessary
     41$q->parse_query_string;
     42
     43# Convenience;  saves changing all references to %webvar
     44##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     45my %webvar = $q->Vars;
    3946
    4047my ($dbh,$errstr) = connectDB_My;
    4148my $sth;
    4249
     50$ENV{HTML_TEMPLATE_ROOT} = '../templates';
     51
     52my $page = HTML::Template->new(filename => "newcity.tmpl");
     53
     54if ($webvar{city}) {
     55  if ($webvar{pop} eq 'on') {
     56    $sth = $dbh->prepare("insert into cities (city,routing) values (?,'y')");
     57  } else {
     58    $sth = $dbh->prepare("insert into cities (city,routing) values (?,'n')");
     59  }
     60##fixme:  don't allow duplicate cities
     61  $sth->execute($webvar{city});
     62  $page->param(city => $webvar{city});
     63  if ($sth->err) {
     64    $page->param(err => $sth->errstr);
     65    my $msg = "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr;
     66    mailNotify($dbh, 'f:nci', "IPDB city add failure", $msg);
     67    syslog "err", $msg;
     68  } else {
     69    syslog "notice", "$authuser added city/location '$webvar{pop}'".
     70        (($webvar{pop} eq 'on') ? ' as POP location' : '');
     71  }
     72}
     73
    4374print "Content-type: text/html\n\n";
    4475
    45 if ($webvar{pop} eq 'on') {
    46   $sth = $dbh->prepare("insert into cities (city,routing) values ('$webvar{city}','y')");
    47 } else {
    48   $sth = $dbh->prepare("insert into cities (city,routing) values ('$webvar{city}','n')");
    49 }
    50 $sth->execute;
    51 
    52 if ($sth->err) {
    53   print "Error adding city to database: ".$sth->errstr;
    54   mailNotify($dbh, 'f:nci', "IPDB city add failure",
    55         "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr);
    56   syslog "err", "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr;
    57 } else {
    58   print "City added.  Closing this window should refresh the page.";
    59   syslog "notice", "$authuser added city/location '$webvar{pop}'".
    60         (($webvar{pop} eq 'on') ? ' as POP location' : '');
    61 }
     76print $page->output;
    6277
    6378finish($dbh);
     79
  • branches/stable/cgi-bin/newnode.cgi

    r445 r593  
    1313use warnings;
    1414#use CGI::Carp qw(fatalsToBrowser);
     15use CGI::Simple;
     16use HTML::Template;
    1517use DBI;
    16 use CommonWeb qw(:ALL);
    1718#use POSIX qw(ceil);
    1819use NetAddr::IP;
     
    3435}
    3536
    36 my %webvar = parse_post();
    37 cleanInput(\%webvar);
     37# Set up the CGI object...
     38my $q = new CGI::Simple;
     39# ... and get query-string params as well as POST params if necessary
     40$q->parse_query_string;
     41
     42# Convenience;  saves changing all references to %webvar
     43##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     44my %webvar = $q->Vars;
    3845
    3946my ($dbh,$errstr) = connectDB_My;
    4047my $sth;
    4148
     49$ENV{HTML_TEMPLATE_ROOT} = '../templates';
     50
     51my $page = HTML::Template->new(filename => "newnode.tmpl");
     52
     53if ($webvar{nodename}) {
     54  $sth = $dbh->prepare("insert into nodes (node_type,node_name,node_ip) values (?,?,?)");
     55  $sth->execute($webvar{type}, $webvar{nodename}, $webvar{nodeip});
     56  $page->param(nodename => $webvar{nodename});
     57  if ($sth->err) {
     58    $page->param(err => $sth->errstr);
     59    my $msg = "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr;
     60    mailNotify($dbh, 'f:nno', "IPDB node add failure", $msg);
     61    syslog "err", $msg;
     62  } else {
     63    syslog "notice", "$authuser added node '$webvar{nodename}'";
     64  }
     65}
     66
    4267print "Content-type: text/html\n\n";
    4368
    44 $sth = $dbh->prepare("insert into nodes (node_type,node_name,node_ip)".
    45         " values ('$webvar{type}','$webvar{nodename}','$webvar{nodeip}')");
    46 $sth->execute;
    47 
    48 if ($sth->err) {
    49   print "Error adding node to database: ".$sth->errstr;
    50   mailNotify($dbh, 'f:nno', "IPDB node add failure",
    51         "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr);
    52   syslog "err", "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr;
    53 } else {
    54   print "Node added.  Closing this window should refresh the page.";
    55   syslog "notice", "$authuser added node '$webvar{nodename}'";
    56 }
     69print $page->output;
    5770
    5871finish($dbh);
  • branches/stable/cgi-bin/search.cgi

    r592 r593  
    1414use warnings;   
    1515use CGI::Carp qw(fatalsToBrowser);
     16use CGI::Simple;
     17use HTML::Template;
    1618use DBI;
    17 use CommonWeb qw(:ALL);
    1819use POSIX qw(ceil);
    1920use NetAddr::IP;
     
    3839}
    3940
     41# Global variables
     42my $RESULTS_PER_PAGE = 25;
     43
     44# anyone got a better name?  :P
     45my $thingroot = $ENV{SCRIPT_FILENAME};
     46$thingroot =~ s|cgi-bin/search.cgi||;
     47
     48# Set up the CGI object...
     49my $q = new CGI::Simple;
     50# ... and get query-string params as well as POST params if necessary
     51$q->parse_query_string;
     52
     53# Convenience;  saves changing all references to %webvar
     54##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     55my %webvar = $q->Vars;
     56
     57if (defined($webvar{rpp})) {
     58  ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/);
     59}
     60
    4061# Why not a global DB handle?  (And a global statement handle, as well...)
    4162# Use the connectDB function, otherwise we end up confusing ourselves
     
    4465my $errstr;
    4566($ip_dbh,$errstr) = connectDB_My;
    46 if (!$ip_dbh) {
    47   printAndExit("Failed to connect to database: $errstr\n");
     67if ($ip_dbh) {
     68  checkDBSanity($ip_dbh);
     69  initIPDBGlobals($ip_dbh);
    4870}
    49 checkDBSanity($ip_dbh);
    50 initIPDBGlobals($ip_dbh);
    51 
    52 # Global variables
    53 my $RESULTS_PER_PAGE = 25;
    54 my %webvar = parse_post();
    55 cleanInput(\%webvar);
    56 
    57 if (defined($webvar{rpp})) {
    58   ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/);
    59 }
    60 
     71
     72# Set up some globals
     73$ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates";
     74
     75my $page;
    6176if (!defined($webvar{stype})) {
    6277  $webvar{stype} = "<NULL>";   #shuts up the warnings.
     78  $page = HTML::Template->new(filename => "search/compsearch.tmpl");
     79} else {
     80  $page = HTML::Template->new(filename => "search/sresults.tmpl");
    6381}
    6482
    65 # Headerize!  Make sure we replace the $$EXTRA0$$ bit as needed.
    66 printHeader('', $IPDB::webpath, ($IPDBacl{$authuser} =~ /a/ ?
    67         '<td align=right><a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=assign">Add new assignment</a></td>' : ''
    68         ));
    69 
    70 if ($webvar{stype} eq 'q') {
     83my $header = HTML::Template->new(filename => "header.tmpl");
     84$header->param(version => $IPDB::VERSION);
     85$header->param(addperm => $IPDBacl{$authuser} =~ /a/);
     86print "Content-type: text/html\n\n", $header->output;
     87
     88# Handle the DB error first
     89if (!$ip_dbh) {
     90  $page = HTML::Template->new(filename => "dberr.tmpl");
     91  $page->param(errmsg => $errstr);
     92} elsif ($webvar{stype} eq 'q') {
    7193  # Quick search.
    7294
     
    111133    $sqlconcat = "UNION";
    112134  } else {
    113     # We can't get here.  PTHBTT!
    114     printAndExit "PTHBTT!!  Your search has been rejected due to Microsoft excuse #4432: ".
    115         "Not enough mana";
     135    # sum-buddy tryn'a game the system.  Match "all"
     136    $sqlconcat = "INTERSECT";
    116137  }
    117138
     
    190211        "text(cidr) like '$webvar{cidr}%')";
    191212  } else {
    192     # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    193     printAndExit("Invalid netblock query.");
     213    # do nothing.
     214    ##fixme  we'll ignore this to clear out the references to legacy code.
    194215  } # done with CIDR query options.
    195216
     
    201222
    202223  if ($count == 0) {
    203     printError "No matches found.  Try eliminating one of the criteria,".
    204         " or making one or more criteria more general.";
     224    $page->param(errmsg => "No matches found.  Try eliminating one of the criteria,".
     225        " or making one or more criteria more general.");
    205226  } else {
    206227    # Add the limit/offset clauses
     
    225246
    226247  if ($count == 0) {
    227     printError "No customers currently listed as connected through this node.";
     248    $page->param(errmsg => "No customers currently listed as connected through this node.");
     249##fixme:  still get the results table header
    228250  } else {
    229251    # Add the limit/offset clauses
     
    237259} else { # how script was called.  General case is to show the search criteria page.
    238260
    239   # Display search page.  We have to do this here, because otherwise
    240   # we can't retrieve data from the database for the types and cities.  >:(
    241   my $html;
    242   open HTML,"<../compsearch.html";
    243   $html = join('',<HTML>);
    244   close HTML;
    245   $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;
    246 
    247261# Generate table of types
    248   my $typetable = "<table class=regular cellspacing=0>\n<tr>";
    249262  $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ".
    250263        "order by listorder");
    251264  $sth->execute;
    252265  my $i=0;
    253   while (my @data = $sth->fetchrow_array) {
    254     $typetable .= "<td><input type=checkbox name=type[$data[0]]>$data[1]</td>";
    255     $i++;
    256     $typetable .= "</tr>\n<tr>"
    257         if ($i % 4 == 0);
    258   }
    259   if ($i %4 == 0) {
    260     $typetable =~ s/<tr>$//;
    261   } else {
    262     $typetable .= "</tr>\n";
    263   }
    264   $typetable .= "</table>\n";
     266  my @typelist;
     267  while (my ($type,$dispname) = $sth->fetchrow_array) {
     268    my %row = (
     269        newrow => ($i % 4 == 0),
     270        type => $type,
     271        dispname => $dispname,
     272        endrow => ($i++ % 4 == 3)
     273        );
     274    push @typelist, \%row;
     275  }
     276  $page->param(typelist => \@typelist);
    265277
    266278# Generate table of cities
    267   my $citytable = "<table class=regular cellspacing=0>\n<tr>";
    268279  $sth = $ip_dbh->prepare("select id,city from cities order by city");
    269280  $sth->execute;
    270   my $i=0;
    271   while (my @data = $sth->fetchrow_array) {
    272     $citytable .= "<td><input type=checkbox name=city[$data[0]]>$data[1]</td>";
    273     $i++;
    274     $citytable .= "</tr>\n<tr>"
    275         if ($i % 5 == 0);
    276   }
    277   if ($i %5 == 0) {
    278     $citytable =~ s/<tr>$//;
    279   } else {
    280     $citytable .= "</tr>\n";
    281   }
    282   $citytable .= "</table>\n";
    283 
    284   $html =~ s/\$\$TYPELIST\$\$/$typetable/;
    285   $html =~ s/\$\$CITYLIST\$\$/$citytable/;
    286 
    287   print $html;
     281  $i=0;
     282  my @citylist;
     283  while (my ($id, $city) = $sth->fetchrow_array) {
     284    my %row = (
     285        newrow => ($i % 4 == 0),
     286        id => $id,
     287        city => $city,
     288        endrow => ($i++ % 4 == 3)
     289        );     
     290    push @citylist, \%row;
     291  }
     292  $page->param(citylist => \@citylist);
     293
    288294}
     295
     296print $page->output;
    289297
    290298# Shut down and clean up.
    291299finish($ip_dbh);
    292 printFooter;
     300
     301# We print the footer here, so we don't have to do it elsewhere.
     302my $footer = HTML::Template->new(filename => "footer.tmpl");
     303# include the admin tools link in the output?
     304$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/));
     305
     306print $footer->output;
     307
    293308# We shouldn't need to directly execute any code below here;  it's all subroutines.
    294309exit 0;
     
    323338  if ($category eq 'all') {
    324339
    325     print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
    326340    $sql = "select $cols from searchme";
    327341    my $count = countRows($sql);
     
    331345  } elsif ($category eq 'cust') {
    332346
     347##fixme:  this and other quick-search areas;  fix up page heading title similar to first grouping above
    333348    print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
    334349
     
    394409    } else {
    395410      # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    396       printError("Invalid query.");
     411      $page->param(errmsg => "Invalid query.");
    397412    }
    398413  } else {
    399414    # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    400     printError("Invalid searchfor.");
     415    $page->param(errmsg => "Invalid searchfor.");
    401416  }
    402417} # viewBy
     
    438453  $sth->execute();
    439454
    440   startTable('Allocation','CustID','Type','City','Description/Name');
     455  $page->param(searchtitle => "Showing all netblock and static-IP allocations");
     456
    441457  my $count = 0;
    442 
    443   while (my @data = $sth->fetchrow_array) {
    444 
    445     # cidr,custid,type,city,description,notes
    446     # Another bit of HairyPerl(TM) to prefix subblocks with "Sub"
    447     my @row = (($data[2] =~ /^.r$/ ? 'Sub ' : '').
    448         qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    449         $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
    450     # Allow listing of pool if desired/required.
    451     if ($data[2] =~ /^.[pd]$/) {
    452       $row[0] .= ' &nbsp; <a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=listpool'.
    453         "&pool=$data[0]\">List IPs</a>";
    454     }
    455     printRow(\@row, 'color1', 1) if ($count%2==0);
    456     printRow(\@row, 'color2', 1) if ($count%2!=0);
    457     $count++;
    458   }
     458  my @sresults;
     459  while (my ($block, $custid, $type, $city, $desc) = $sth->fetchrow_array) {
     460    my %row = (
     461        rowclass => $count++ % 2,
     462        issub => ($type =~ /^.r$/ ? 1 : 0),
     463        block => $block,
     464        ispool => ($type =~ /^.[pd]$/ ? 1 : 0),
     465        custid => $custid,
     466        disptype => $disp_alloctypes{$type},
     467        city => $city,
     468        desc => $desc
     469        );
     470    push @sresults, \%row;
     471  }
     472  $page->param(sresults => \@sresults);
    459473
    460474  # Have to think on this call, it's primarily to clean up unfetched rows from a select.
     
    463477
    464478  my $upper = $offset+$count;
    465   print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: ".($offset+1)." - $upper</i></td></tr>\n";
    466   print "</table></center>\n";
     479
     480  $page->param(resfound => $rowCount);
     481  $page->param(resstart => $offset+1);
     482  $page->param(resstop => $upper);
    467483
    468484  # print the page thing..
    469485  if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) {
     486    $page->param(multipage => 1);
    470487    my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
    471     print qq(<div class="center"> Page: );
     488    my @pagelist;
    472489    for (my $i = 1; $i <= $pages; $i++) {
     490      my %row;
     491      $row{pgnum} = $i;
    473492      if ($i == $pageNo) {
    474         print "<b>$i&nbsp;</b>\n";
     493        $row{thispage} = 1;
    475494      } else {
    476         print qq(<a href="$IPDB::webpath/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);
     495        $row{stype} = $webvar{stype};
    477496        if ($webvar{stype} eq 'c') {
    478           print "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".
     497          $row{extraopts} = "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".
    479498                "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&".
    480499                "allcities=$webvar{allcities}&";
    481500          foreach my $key (keys %webvar) {
    482501            if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) {
    483               print "$key=$webvar{$key}&";
     502              $row{extraopts} .= "$key=$webvar{$key}&";
    484503            }
    485504          }
    486505        } else {
    487           print "input=$webvar{input}&";
     506          $row{extraopts} = "input=$webvar{input}&";
    488507        }
    489         print qq(">$i</a>&nbsp;\n);
    490508      }
    491     }
    492     print "</div>";
    493   }
     509      push @pagelist, \%row;
     510    }
     511    $page->param(pgnums => \@pagelist);
     512  }
     513
    494514} # queryResults
    495515
  • branches/stable/cgi-bin/snCalc.cgi

    r507 r593  
    44use warnings;   
    55use CGI::Carp qw(fatalsToBrowser);
     6use CGI::Simple;
     7use HTML::Template;
    68use NetAddr::IP;
    7 use CommonWeb qw(:ALL);;
    89
    910#file snCalc.cgi        little subnet calculator app
    1011use MyIPDB;
    1112
    12 my %webvar = parse_post();
     13# Set up the CGI object...
     14my $q = new CGI::Simple;
     15# ... and get query-string params as well as POST params if necessary
     16$q->parse_query_string;
     17
     18# Convenience;  saves changing all references to %webvar
     19##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     20my %webvar = $q->Vars;
     21
    1322my $input;
    1423
    1524print "Content-Type: text/html\n\n";
    1625
    17 open(HTML, "../startsn.html")|| die "Could not open startsn.html :$!";
    18 my $start = join('', <HTML>);
    19 close(HTML);
    20 $start =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;
    21 print $start;
     26##fixme:  need better method to find templates.
     27$ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME};
     28$ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||;
     29
     30my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl");
    2231
    2332# Clean up input so we don't divide by zero or something equally silly
     
    3746my $postnet = new NetAddr::IP "0.0.0.0/$gtinput";
    3847
    39 print qq(<div class="center">
    40 <table align="center" cellspacing="3" cellpadding="3">
    41 <tr>
    42         <td class="heading" align="center">Results for /$ltinput</td>
    43         <td class="heading" align="center">Results for /$input</td>
    44         <td class="heading" align="center">Results for /$gtinput</td>
    45 </tr>
    46 );
     48$page->param(prenet => $ltinput);
     49$page->param(net => $input);
     50$page->param(postnet => $gtinput);
     51$page->param(premask => $prenet->mask);
     52$page->param(mask => $net->mask);
     53$page->param(postmask => $postnet->mask);
     54$page->param(prewildcard => scalar($prenet->wildcard));
     55$page->param(wildcard => scalar($net->wildcard));
     56$page->param(postwildcard => scalar($postnet->wildcard));
    4757
    48 print qq(<tr><td valign="top">\n).
    49         qq(     <div class="mask">).$prenet->mask."</div>\n".
    50         qq(     <div class="wildcard">).$prenet->wildcard."</div>\n".
    51         getranges($ltinput).
    52         qq(</td>\n<td valign="top" bgcolor="#d0e0e0">\n).
    53         qq(     <div class="mask">).$net->mask."</div>\n".
    54         qq(     <div class="wildcard">).$net->wildcard."</div>\n".
    55         getranges($input).
    56         qq(</td>\n<td valign="top">).
    57         qq(     <div class="mask">).$postnet->mask."</div>\n".
    58         qq(     <div class="wildcard">).$postnet->wildcard."</div>\n".
    59         getranges($gtinput);
     58my @prenets;
     59foreach (getranges($ltinput)) {
     60  my %row = (netrange => $_);
     61  push (@prenets, \%row);
     62}
     63$page->param(prenets => \@prenets);
     64my @nets;
     65foreach (getranges($input)) {
     66  my %row = (netrange => $_);
     67  push (@nets, \%row);
     68}
     69$page->param(nets => \@nets);
     70my @postnets;
     71foreach (getranges($gtinput)) {
     72  my %row = (netrange => $_);
     73  push @postnets, \%row;
     74}
     75$page->param(postnets => \@postnets);
    6076
    61 print "</td></tr>\n</table>\n";
    62 
    63 print qq(<input type="button" value="Back" onclick="history.go(-1)" class="heading">
    64 </div>
    65 </body>
    66 </html>
    67 );
     77print $page->output;
    6878       
    6979# Just In Case
     
    8898sub getranges {
    8999  my $masklen = shift;
    90   my $ret = '';
     100  my @ret;
    91101  my $super;
    92102  if ($masklen < 8) {
     
    100110  }
    101111  foreach my $net ($super->split($masklen)) {
    102     $ret .= "\t".xrange($net,$masklen)."<br />\n";
     112    push @ret, xrange($net,$masklen);
    103113  }
    104   return $ret;
     114  return @ret;
    105115} # getranges()
Note: See TracChangeset for help on using the changeset viewer.