Changeset 517


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

/trunk

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

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

Closes #3.

Location:
trunk
Files:
15 deleted
18 edited
54 copied

Legend:

Unmodified
Added
Removed
  • trunk

  • trunk/INSTALL

    r440 r517  
    65655) Configure your webserver to call the IPDB scripts at an appropriate
    6666web path.  A webroot pointing to the HTML files (first level under
    67 the ipdb-#VERSION#/ tarball directory, or /usr/local/lib/ipdb-#VERSION#) 
    68 with a symlink or alias for ip/ -> . should work fine;  a server alias
    69 under an existing virtual host should work as well.
     67the ipdb-#VERSION#/ tarball directory, or /usr/local/lib/ipdb-#VERSION#)
     68should work fine;  a server alias under an existing virtual host should
     69work as well.
    7070
    71 Note that all URLs referenced internally currently assume they will be
    72 presented at http://host/ip/;  you cannot put the IPDB at
    73 http://host/noc/misc/ipdb/.
     71Set $IPDB::webpath (the web path to your IPDB install) in MyIPDB.pm.
     72Straight out of the tarball it should work at the webroot, but if you
     73want it in a subdirectory, you'll need to set this variable to get all
     74of the internal links to behave properly.
    7475
    7576The directory containing the HTML and scripts must have at least the
    7677following Apache directives (or other server equivalent) set:
    7778
    78   Options ExecCGI IncludesNoEXEC FollowSymlinks
     79  Options ExecCGI IncludesNoEXEC
    7980
    80816) User lists can be maintained two basic ways:
  • trunk/Makefile

    r441 r517  
    2828DESTDIR =
    2929
    30 MANIFEST = \
    31         INSTALL COPYING Makefile ipdb.spec \
    32         \
    33         addmaster.html alloctypes.html assign.html compsearch.html \
    34         confirm.html confirmRemove.html editDisplay.html fb-assign.html footer.inc \
    35         header.inc help.html index.shtml ipdb.css \
    36         newcity.html newnode.html nodesearch.html startsn.html updated.html \
    37         images/logo.png \
    38         \
    39         cgi-bin/combineblocks.pl cgi-bin/access-pwd-update.pl \
    40         cgi-bin/newnode.cgi cgi-bin/CustIDCK.pm cgi-bin/freespace.pl \
    41         cgi-bin/admin.cgi cgi-bin/MyIPDB.pm cgi-bin/IPDB.pm \
    42         cgi-bin/main.cgi cgi-bin/checkcusts.pl cgi-bin/newcity.cgi \
    43         cgi-bin/allocate.pl cgi-bin/search.cgi \
    44         cgi-bin/snCalc.cgi cgi-bin/CommonWeb.pm cgi-bin/ipdb.psql \
    45         cgi-bin/consistency-check.pl \
    46         \
    47         cgi-bin/extras/db2rwhois.pl cgi-bin/extras/rwhois-net-skel.tar.gz cgi-bin/extras/rwhois-config \
    48         cgi-bin/extras/network.tmpl
     30HTML = \
     31        alloctypes.html help.html index.shtml ipdb.css
    4932
    50 HTML = \
    51         addmaster.html alloctypes.html assign.html changes.html compsearch.html \
    52         confirm.html confirmRemove.html editDisplay.html fb-assign.html footer.inc \
    53         header.inc help.html index.shtml ipdb.css \
    54         newcity.html newnode.html nodesearch.html startsn.html updated.html
     33JS = templates/widgets.js
    5534
    5635IMAGES = images/logo.png
     36
     37TEMPLATES = \
     38        templates/aclerror.tmpl templates/addmaster.tmpl templates/assign.tmpl templates/confirm.tmpl \
     39        templates/dberr.tmpl templates/delete.tmpl templates/dunno.tmpl templates/edit.tmpl \
     40        templates/finaldelete.tmpl templates/footer.tmpl templates/header.tmpl templates/index.tmpl \
     41        templates/insert.tmpl templates/listpool.tmpl templates/newcity.tmpl templates/newmaster.tmpl \
     42        templates/newnode.tmpl templates/nodesearch.tmpl templates/showmaster.tmpl templates/showrouted.tmpl \
     43        templates/subnet-calc.tmpl templates/update.tmpl \
     44        \
     45        templates/admin/aclerr.tmpl templates/admin/addnotice.tmpl templates/admin/alloc.tmpl \
     46        templates/admin/alloctweak.tmpl templates/admin/confirm.tmpl templates/admin/dberr.tmpl \
     47        templates/admin/delnotice.tmpl templates/admin/deluser.tmpl templates/admin/dunno.tmpl \
     48        templates/admin/edcust.tmpl templates/admin/ednotice.tmpl templates/admin/emailnotice.tmpl \
     49        templates/admin/header.tmpl templates/admin/listcust.tmpl templates/admin/main.tmpl \
     50        templates/admin/newuser.tmpl templates/admin/showallocs.tmpl templates/admin/showpools.tmpl \
     51        templates/admin/showusers.tmpl templates/admin/touch.tmpl templates/admin/tweakpool.tmpl \
     52        templates/admin/updacl.tmpl templates/admin/updatepool.tmpl templates/admin/update.tmpl \
     53        templates/admin/updcust.tmpl templates/admin/updnotice.tmpl \
     54        \
     55        templates/search/compsearch.tmpl templates/search/sresults.tmpl
    5756
    5857SCRIPTS = \
     
    6766
    6867RWHOIS = \
    69         cgi-bin/extras/db2rwhois.pl cgi-bin/extras/rwhois-net-skel.tar.gz cgi-bin/extras/rwhois-config \
     68        cgi-bin/extras/rwhois-net-skel.tar.gz cgi-bin/extras/rwhois-config \
    7069        cgi-bin/extras/network.tmpl
    7170
    72 DIRS = images cgi-bin cgi-bin/extras
     71DIRS = images templates cgi-bin cgi-bin/extras
    7372
    74 # hmm.  not sure what do do about you, m'friend...
    75 #ip@
     73MANIFEST = \
     74        $(HTML) \
     75        $(JS) \
     76        $(IMAGES) \
     77        $(TEMPLATES) \
     78        $(SCRIPTS) \
     79        $(MODULES) \
     80        $(CONFIGMODULES) \
     81        $(RWHOIS)
    7682
    7783all:
     
    7985
    8086install:
    81         @for i in $(HTML) $(IMAGES); do \
     87        @for i in $(HTML) $(IMAGES) $(JS) $(TEMPLATES); do \
    8288                $(INSTALL_DATA) -D $$i $(DESTDIR)${libdir}/ipdb-$(VERSION)/$$i ; \
    8389        done
  • trunk/alloctypes.html

    r442 r517  
    1 <html><head>
    2 
    3 <title>IP Database</title><meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
    4 
    5 <link rel="stylesheet" type="text/css" href="/ip/ipdb.css">
    6 <link rel="stylesheet" type="text/css" href="/ip/local.css">
    7 
     1<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
     2<html>
     3<head>
     4        <title>IP Database - Allocation Types</title>
     5        <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
     6        <link rel="stylesheet" type="text/css" href="ipdb.css">
     7        <link rel="stylesheet" type="text/css" href="local.css">
    88</head>
     9
    910<body>
    1011
    1112<table class="regular">
    1213
    13 <tr><td colspan=2 class="heading">Preseeded Allocation Types:</td><tr>
    14 
    15 <tr class="color1">
     14<tr><td colspan=2 class="heading">Preseeded Allocation Types:</td></tr>
     15
     16<tr class="row0">
    1617<td>Customer netblock (default)</td>
    1718<td>A direct allocation /30 or larger to a customer.  Note that this does NOT
     
    2021</tr>
    2122
    22 <tr class="color2">
     23<tr class="row1">
    2324<td>Static IP - Server pool</td>
    2425<td>A single IP from a pool designated for servers</td>
    2526</tr>
    2627
    27 <tr class="color1">
     28<tr class="row0">
    2829<td>Static IP - Cable</td>
    2930<td>A single IP address from a designated pool on the cable network.</td>
    3031</tr>
    3132
    32 <tr class="color2">
     33<tr class="row1">
    3334<td>Static IP - DSL</td>
    3435<td>A single IP address from a designated pool on the DSL network.</td>
    3536</tr>
    3637
    37 <tr class="color1">
     38<tr class="row0">
    3839<td>Static IP - Dialup</td>
    3940<td>A single IP address from a designated pool on a dialup RAS.</td>
    4041</tr>
    4142
    42 <tr class="color2">
     43<tr class="row1">
    4344<td>Static IP - Wireless</td>
    4445<td>A single IP address from a designated pool on a wireless connection.</td>
    4546</tr>
    4647
    47 <tr class="color1">
     48<tr class="row0">
    4849<td>Static pool - Servers</td>
    4950<td>A pool of IP addresses available for one-by-one assignment to servers in a
     
    5152</tr>
    5253
    53 <tr class="color2">
     54<tr class="row1">
    5455<td>Static pool - Cable</td>
    5556<td>A pool of IP addresses available for one-by-one assignment to customers on
     
    5758</tr>
    5859
    59 <tr class="color1">
     60<tr class="row0">
    6061<td>Static pool - DSL</td>
    6162<td>A pool of IP addresses available for one-by-one assignment to customers on
     
    6465</tr>
    6566
    66 <tr class="color2">
     67<tr class="row1">
    6768<td>Static pool - Dialup</td>
    6869<td>A pool of IP addresses available for one-by-one assignment to dialup
     
    7071</tr>
    7172
    72 <tr class="color1">
     73<tr class="row0">
    7374<td>Static pool - Wireless</td>
    7475<td>A pool of IP addresses available for one-by-one assignment to customers on a
     
    7677</tr>
    7778
    78 <tr class="color2">
     79<tr class="row1">
    7980<td>End-use netblock</td>
    8081<td>A /30 or larger allocation for arbitrary services - note this should not
     
    8384</tr>
    8485
    85 <tr class="color1">
     86<tr class="row0">
    8687<td>Dialup netblock</td>
    8788<td>Netblock assigned to one or more RAS units in a POP</td>
    8889</tr>
    8990
    90 <tr class="color2">
     91<tr class="row1">
    9192<td>Dynamic DSL block</td>
    9293<td>Netblock for (mostly residential) PPPoE DSL.</td>
    9394</tr>
    9495
    95 <tr class="color1">
     96<tr class="row0">
    9697<td>Dynamic cable block</td>
    9798<td>Netblock for (mostly residential) DHCP cable.</td>
    9899</tr>
    99100
    100 <tr class="color2">
     101<tr class="row1">
    101102<td>Dynamic WiFi block</td>
    102103<td>Netblock for (mostly residential) (mostly) PPPoE wireless.</td>
    103104</tr>
    104105
    105 <tr class="color1">
     106<tr class="row0">
    106107<td>Dynamic VoIP block</td>
    107108<td>Netblock for DHCP-assigned VoIP services.</td>
    108109</tr>
    109110
    110 <tr class="color2">
     111<tr class="row1">
    111112<td>Static IP - LAN/POP</td>
    112113<td>A single IP address from a designated pool for internal LANs - either at a
     
    114115</tr>
    115116
    116 <tr class="color1">
     117<tr class="row0">
    117118<td>Static IP - Managment</td>
    118119<td>A single IP address from a designated pool for managed devices.</td>
    119120</tr>
    120121
    121 <tr class="color2">
     122<tr class="row1">
    122123<td>Static IP - Wifi CPE</td>
    123124<td>A single IP address from a designated pool for wireless CPE devices.</td>
    124125</tr>
    125126
    126 <tr class="color1">
     127<tr class="row0">
    127128<td>Static pool - LAN/POP</td>
    128129<td>A pool of IP addresses available for one-by-one assignment to internal LAN
     
    130131</tr>
    131132
    132 <tr class="color2">
     133<tr class="row1">
    133134<td>Static Pool - Managment</td>
    134135<td>A pool of IP addresses available for assignment to managed devices.</td>
    135136</tr>
    136137
    137 <tr class="color1">
     138<tr class="row0">
    138139<td>Static pool - Wifi CPE</td>
    139140<td>A pool of IP addresses available for assignment to wireless CPE devices.</td>
    140141</tr>
    141142
    142 <tr class="color2">
     143<tr class="row1">
    143144<td>Reserve for WAN blocks</td>
    144145<td>Reserve a chunk of IP space for core routers/etc.</td>
    145146</tr>
    146147
    147 <tr class="color1">
     148<tr class="row0">
    148149<td>Reserve for dynamic-route DSL netblocks</td>
    149150<td>Reserve a chunk of IP space for netblocks configured on the customer end via
     
    152153</tr>
    153154
    154 <tr class="color2">
     155<tr class="row1">
    155156<td>Reserve for ATM</td>
    156157<td>Reserve a chunk of IP space for allocation to customers on ATM.</td>
    157158</tr>
    158159
    159 <tr class="color1">
     160<tr class="row0">
    160161<td>Reserve for fibre</td>
    161162<td>Reserve a chunk of IP space for customers on a fibre connection.</td>
    162163</tr>
    163164
    164 <tr class="color2">
     165<tr class="row1">
    165166<td>WAN block</td>
    166167<td>Individual netblock assignment for a core router.  Always taken from a
     
    168169</tr>
    169170
    170 <tr class="color1">
     171<tr class="row0">
    171172<td>Dynamic-route DSL netblock</td>
    172173<td>Customer assignment for a netblock configured on the customer end via
     
    175176</tr>
    176177
    177 <tr class="color2">
     178<tr class="row1">
    178179<td>ATM block</td>
    179180<td>Customer assignment for a customer on ATM.  Always taken from a
     
    181182</tr>
    182183
    183 <tr class="color1">
     184<tr class="row0">
    184185<td>Fibre</td>
    185186<td>Customer assignment for a customer on fibre. Always taken from a block
     
    187188</tr>
    188189
    189 <tr class="color2">
     190<tr class="row1">
    190191<td>Routing</td>
    191192<td>Blocks not actually assigned to a service on their own, but which
     
    193194</tr>
    194195
    195 <tr class="color1">
     196<tr class="row0">
    196197<td>Master block</td>
    197198<td>Allocations provided by the regional registry (ARIN, RIPE, LACNIC, AfriNIC,
  • trunk/cgi-bin/CustIDCK.pm

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

    r486 r517  
    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';
     
    122130  }
    123131
     132##fixme:  initialize HTML::Template env var for template path
     133# something like $self->path().'/templates' ?
     134#  $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar';
     135
    124136  return (1,"OK");
    125137} # end initIPDBGlobals
     
    170182sub finish {
    171183  my $dbh = $_[0];
    172   $dbh->disconnect;
     184  $dbh->disconnect if $dbh;
    173185} # end finish
    174186
     
    352364      $cidr = $data[0];  # $cidr is already declared when we get here!
    353365
    354       $sth = $dbh->prepare("update poolips set custid='$custid',".
    355         "city='$city',available='n',description='$desc',notes='$notes',".
    356         "circuitid='$circid',privdata='$privdata'".
    357         " where ip='$cidr'");
    358       $sth->execute;
     366      $sth = $dbh->prepare("update poolips set custid=?,city=?,".
     367        "available='n',description=?,notes=?,circuitid=?,privdata=?".
     368        " where ip=?");
     369      $sth->execute($custid, $city, $desc, $notes, $circid, $privdata, "$cidr");
    359370# node hack
    360371      if ($nodeid && $nodeid ne '') {
     
    404415          $sth = $dbh->prepare("insert into allocations".
    405416                " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)".
    406                 " values ('$cidr','$custid','$type','$city','$desc','$notes',".
    407                 $cidr->masklen.",'$circid','$privdata')");
    408           $sth->execute;
     417                " values (?,?,?,?,?,?,?,?,?)");
     418          $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
    409419
    410420          # And initialize the pool, if necessary
     
    514524          $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,".
    515525                "description,notes,maskbits,circuitid,privdata)".
    516                 " values ('$cidr','$custid','$type','$city','$desc','$notes',".
    517                 $cidr->masklen.",'$circid','$privdata')");
    518           $sth->execute;
     526                " values (?,?,?,?,?,?,?,?,?)");
     527          $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata);
    519528
    520529          # And initialize the pool, if necessary
     
    638647    eval {
    639648      $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr";
    640       $sth = $dbh->prepare("update poolips set custid='$defcustid',available='y',".
    641         "city=(select city from allocations where cidr >>= '$cidr'".
     649      $sth = $dbh->prepare("update poolips set custid=?,available='y',".
     650        "city=(select city from allocations where cidr >>= ?".
    642651        " order by masklen(cidr) desc limit 1),".
    643         "description='',notes='',circuitid='' where ip='$cidr'");
    644       $sth->execute;
     652        "description='',notes='',circuitid='' where ip=?");
     653      $sth->execute($defcustid, "$cidr", "$cidr");
    645654      $dbh->commit;
    646655    };
  • trunk/cgi-bin/MyIPDB.pm

    r437 r517  
    2222# DB host is optional.
    2323my $dbhost = 'ipdb-db';
     24
     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 = '';
    2428
    2529# Set some globals declared in IPDB.pm.  Most of these only affect mailNotify().
  • trunk/cgi-bin/admin.cgi

    r515 r517  
    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="/ip/ipdb.css">\n).
    57         qq(\t<link rel="stylesheet" type="text/css" href="/ip/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="/ip/ipdb.css">\n).
    70         qq(\t<link rel="stylesheet" type="text/css" href="/ip/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 '<a href="/ip/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.
     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') {
    134137
    135138  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");
     139    $page->param(errmsg => "Can't allocate something that's not a netblock/ip");
     140    goto ERRJUMP;
    137141  }
    138142
     
    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('/ip/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="/ip/">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
  • trunk/cgi-bin/allocate.pl

    r431 r517  
    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);
  • trunk/cgi-bin/combineblocks.pl

    r417 r517  
    1313#use CGI::Carp qw(fatalsToBrowser);
    1414use DBI;
    15 #use CommonWeb qw(:ALL);
    1615#use POSIX qw(ceil);
    1716use NetAddr::IP;
  • trunk/cgi-bin/main.cgi

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

    r431 r517  
    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
  • trunk/cgi-bin/newnode.cgi

    r417 r517  
    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);
  • trunk/cgi-bin/search.cgi

    r455 r517  
    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('', ($IPDBacl{$authuser} =~ /a/ ?
    67         '<td align=right><a href="/ip/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 
    246261# Generate table of types
    247   my $typetable = "<table class=regular cellspacing=0>\n<tr>";
    248262  $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ".
    249263        "order by listorder");
    250264  $sth->execute;
    251265  my $i=0;
    252   while (my @data = $sth->fetchrow_array) {
    253     $typetable .= "<td><input type=checkbox name=type[$data[0]]>$data[1]</td>";
    254     $i++;
    255     $typetable .= "</tr>\n<tr>"
    256         if ($i % 4 == 0);
    257   }
    258   if ($i %4 == 0) {
    259     $typetable =~ s/<tr>$//;
    260   } else {
    261     $typetable .= "</tr>\n";
    262   }
    263   $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);
    264277
    265278# Generate table of cities
    266   my $citytable = "<table class=regular cellspacing=0>\n<tr>";
    267279  $sth = $ip_dbh->prepare("select id,city from cities order by city");
    268280  $sth->execute;
    269   my $i=0;
    270   while (my @data = $sth->fetchrow_array) {
    271     $citytable .= "<td><input type=checkbox name=city[$data[0]]>$data[1]</td>";
    272     $i++;
    273     $citytable .= "</tr>\n<tr>"
    274         if ($i % 5 == 0);
    275   }
    276   if ($i %5 == 0) {
    277     $citytable =~ s/<tr>$//;
    278   } else {
    279     $citytable .= "</tr>\n";
    280   }
    281   $citytable .= "</table>\n";
    282 
    283   $html =~ s/\$\$TYPELIST\$\$/$typetable/;
    284   $html =~ s/\$\$CITYLIST\$\$/$citytable/;
    285 
    286   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
    287294}
     295
     296print $page->output;
    288297
    289298# Shut down and clean up.
    290299finish($ip_dbh);
    291 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
    292308# We shouldn't need to directly execute any code below here;  it's all subroutines.
    293309exit 0;
     
    322338  if ($category eq 'all') {
    323339
    324     print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
    325340    $sql = "select $cols from searchme";
    326341    my $count = countRows($sql);
     
    330345  } elsif ($category eq 'cust') {
    331346
     347##fixme:  this and other quick-search areas;  fix up page heading title similar to first grouping above
    332348    print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
    333349
     
    393409    } else {
    394410      # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    395       printError("Invalid query.");
     411      $page->param(errmsg => "Invalid query.");
    396412    }
    397413  } else {
    398414    # This shouldn't happen, but if it does, whoever gets it deserves what they get...
    399     printError("Invalid searchfor.");
     415    $page->param(errmsg => "Invalid searchfor.");
    400416  }
    401417} # viewBy
     
    437453  $sth->execute();
    438454
    439   startTable('Allocation','CustID','Type','City','Description/Name');
     455  $page->param(searchtitle => "Showing all netblock and static-IP allocations");
     456
    440457  my $count = 0;
    441 
    442   while (my @data = $sth->fetchrow_array) {
    443 
    444     # cidr,custid,type,city,description,notes
    445     # Another bit of HairyPerl(TM) to prefix subblocks with "Sub"
    446     my @row = (($data[2] =~ /^.r$/ ? 'Sub ' : '').
    447         qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
    448         $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
    449     # Allow listing of pool if desired/required.
    450     if ($data[2] =~ /^.[pd]$/) {
    451       $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
    452         "&pool=$data[0]\">List IPs</a>";
    453     }
    454     printRow(\@row, 'color1', 1) if ($count%2==0);
    455     printRow(\@row, 'color2', 1) if ($count%2!=0);
    456     $count++;
    457   }
     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);
    458473
    459474  # Have to think on this call, it's primarily to clean up unfetched rows from a select.
     
    462477
    463478  my $upper = $offset+$count;
    464   print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: ".($offset+1)." - $upper</i></td></tr>\n";
    465   print "</table></center>\n";
     479
     480  $page->param(resfound => $rowCount);
     481  $page->param(resstart => $offset+1);
     482  $page->param(resstop => $upper);
    466483
    467484  # print the page thing..
    468485  if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) {
     486    $page->param(multipage => 1);
    469487    my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
    470     print qq(<div class="center"> Page: );
     488    my @pagelist;
    471489    for (my $i = 1; $i <= $pages; $i++) {
     490      my %row;
     491      $row{pgnum} = $i;
    472492      if ($i == $pageNo) {
    473         print "<b>$i&nbsp;</b>\n";
     493        $row{thispage} = 1;
    474494      } else {
    475         print qq(<a href="/ip/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);
     495        $row{stype} = $webvar{stype};
    476496        if ($webvar{stype} eq 'c') {
    477           print "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".
     497          $row{extraopts} = "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".
    478498                "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&".
    479499                "allcities=$webvar{allcities}&";
    480500          foreach my $key (keys %webvar) {
    481501            if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) {
    482               print "$key=$webvar{$key}&";
     502              $row{extraopts} .= "$key=$webvar{$key}&";
    483503            }
    484504          }
    485505        } else {
    486           print "input=$webvar{input}&";
     506          $row{extraopts} = "input=$webvar{input}&";
    487507        }
    488         print qq(">$i</a>&nbsp;\n);
    489508      }
    490     }
    491     print "</div>";
    492   }
     509      push @pagelist, \%row;
     510    }
     511    $page->param(pgnums => \@pagelist);
     512  }
     513
    493514} # queryResults
    494515
  • trunk/cgi-bin/snCalc.cgi

    r371 r517  
    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
    1011
    11 my %webvar = parse_post();
     12# Set up the CGI object...
     13my $q = new CGI::Simple;
     14# ... and get query-string params as well as POST params if necessary
     15$q->parse_query_string;
     16
     17# Convenience;  saves changing all references to %webvar
     18##fixme:  tweak for handling <select multiple='y' size=3> (list with multiple selection)
     19my %webvar = $q->Vars;
     20
    1221my $input;
    1322
    1423print "Content-Type: text/html\n\n";
    1524
    16 open(HTML, "../startsn.html")|| die "Could not open startsn.html :$!";
    17 my $start = join('', <HTML>);
    18 close(HTML);
    19 print $start;
     25##fixme:  need better method to find templates.
     26$ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME};
     27$ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||;
     28
     29my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl");
    2030
    2131# Clean up input so we don't divide by zero or something equally silly
     
    3545my $postnet = new NetAddr::IP "0.0.0.0/$gtinput";
    3646
    37 print qq(<div class="center">
    38 <table align="center" cellspacing="3" cellpadding="3">
    39 <tr>
    40         <td class="heading" align="center">Results for /$ltinput</td>
    41         <td class="heading" align="center">Results for /$input</td>
    42         <td class="heading" align="center">Results for /$gtinput</td>
    43 </tr>
    44 );
     47$page->param(prenet => $ltinput);
     48$page->param(net => $input);
     49$page->param(postnet => $gtinput);
     50$page->param(premask => $prenet->mask);
     51$page->param(mask => $net->mask);
     52$page->param(postmask => $postnet->mask);
     53$page->param(prewildcard => scalar($prenet->wildcard));
     54$page->param(wildcard => scalar($net->wildcard));
     55$page->param(postwildcard => scalar($postnet->wildcard));
    4556
    46 print qq(<tr><td valign="top">\n).
    47         qq(     <div class="mask">).$prenet->mask."</div>\n".
    48         qq(     <div class="wildcard">).$prenet->wildcard."</div>\n".
    49         getranges($ltinput).
    50         qq(</td>\n<td valign="top" bgcolor="#d0e0e0">\n).
    51         qq(     <div class="mask">).$net->mask."</div>\n".
    52         qq(     <div class="wildcard">).$net->wildcard."</div>\n".
    53         getranges($input).
    54         qq(</td>\n<td valign="top">).
    55         qq(     <div class="mask">).$postnet->mask."</div>\n".
    56         qq(     <div class="wildcard">).$postnet->wildcard."</div>\n".
    57         getranges($gtinput);
     57my @prenets;
     58foreach (getranges($ltinput)) {
     59  my %row = (netrange => $_);
     60  push (@prenets, \%row);
     61}
     62$page->param(prenets => \@prenets);
     63my @nets;
     64foreach (getranges($input)) {
     65  my %row = (netrange => $_);
     66  push (@nets, \%row);
     67}
     68$page->param(nets => \@nets);
     69my @postnets;
     70foreach (getranges($gtinput)) {
     71  my %row = (netrange => $_);
     72  push @postnets, \%row;
     73}
     74$page->param(postnets => \@postnets);
    5875
    59 print "</td></tr>\n</table>\n";
    60 
    61 print qq(<input type="button" value="Back" onclick="history.go(-1)" class="heading">
    62 </div>
    63 </body>
    64 </html>
    65 );
     76print $page->output;
    6677       
    6778# Just In Case
     
    8697sub getranges {
    8798  my $masklen = shift;
    88   my $ret = '';
     99  my @ret;
    89100  my $super;
    90101  if ($masklen < 8) {
     
    98109  }
    99110  foreach my $net ($super->split($masklen)) {
    100     $ret .= "\t".xrange($net,$masklen)."<br />\n";
     111    push @ret, xrange($net,$masklen);
    101112  }
    102   return $ret;
     113  return @ret;
    103114} # getranges()
  • trunk/help.html

    r427 r517  
    1 <html><head>
    2 
    3 <title>IP Database</title><meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
    4 
    5 <link rel="stylesheet" type="text/css" href="/ip/ipdb.css" />
    6 <link rel="stylesheet" type="text/css" href="/ip/local.css" />
    7 
     1<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
     2<html>
     3<head>
     4        <title>IP Database Quick Help</title>
     5        <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
     6        <link rel="stylesheet" type="text/css" href="ipdb.css">
     7        <link rel="stylesheet" type="text/css" href="local.css">
    88</head>
    99<body>
     
    1111<table class="regular">
    1212
    13 <tr><td class="heading">Quick Searches:</td><tr>
     13<tr><td class="heading">Quick Searches:</td></tr>
    1414
    15 <tr class="color1">
    16 <td>IP blocks</td><td>192.168.28 or 192.</td>
     15<tr class="row0">
     16<td>IP blocks</td>
     17<td>192.168.28 or 192.</td>
    1718<td>Lists all alloctions starting with that set of octets.  Note that matches on the
    1819first octet MUST include the period to be considered an IP search.</td>
    1920</tr>
    20 <tr class="color2">
    21 <td>CIDR blocks</td><td>192.168.28/30</br>or
    22 192.168.28.0/30</td><td>Lists all /30's beginning with 192.168.28 or checks for an
     21
     22<tr class="row1">
     23<td>CIDR blocks</td>
     24<td>192.168.28/30<br>or 192.168.28.0/30</td>
     25<td>Lists all /30's beginning with 192.168.28 or checks for an
    2326exact match for 192.168.28.0/30 respectively</td>
    2427</tr>
    25 <tr class="color1">
    26 <td>IP address</td><td>192.168.28.30</td><td>Finds the alloction that IP is a
    27 part of (if any)</td>
    28 </tr>
    29 <tr class="color2">
    30 <td>Customer ID:</td><td>123456</td><td>Find all alloctions to that
    31 customer.  Customer IDs are assumed to be numeric for this search.
    32 </td>
    33 </tr>
    34 <tr class="color1">
    35 <td>Description:</td><td>cable or BigCustomer</td><td>Find all allocations with the search term in
    36 the description.  Note that searches for CustIDs with letters will fall under this category
    37 unless CustIDs are all-numeric.</td>
     28
     29<tr class="row0">
     30<td>IP address</td>
     31<td>192.168.28.30</td>
     32<td>Finds the alloction that IP is a part of (if any)</td>
    3833</tr>
    3934
    40 <tr class="regular"><!-- blank row --><td></td></tr>
     35<tr class="row1">
     36<td>Customer ID:</td>
     37<td>123456</td>
     38<td>Find all alloctions to that customer.  Customer IDs are assumed to be
     39numeric for this search.</td>
     40</tr>
     41
     42<tr class="row0">
     43<td>Description:</td>
     44<td>cable or BigCustomer</td>
     45<td>Find all allocations with the search term in the description.  Note that searches for CustIDs with letters
     46will fall under this category unless CustIDs are all-numeric.</td>
     47</tr>
     48
    4149<tr><td colspan="3">A blank query will "show all"</td></tr>
    4250<tr><td colspan="3">The title in the top right hand corner is a link home.</td></tr>
    4351
    44 <tr class="regular"><!-- blank row --><td></td></tr>
    45 <tr class="regular"><!-- blank row --><td></td></tr>
    46 <tr class="regular"><!-- blank row --><td></td></tr>
    47 
    48 <tr class="color1"><td>Subnet Calculator</td>
     52<tr class="row0"><td>Subnet Calculator</td>
    4953<td colspan="2">
    5054<form method="POST" action="cgi-bin/snCalc.cgi">
     55<fieldset><legend></legend>
    5156 / <input type="text" size="5" maxlength="10" name="input" class="regular">
    5257<input type="submit" value="Calculate" class="heading">&nbsp; Show
    5358<span class="mask">subnet mask</span>, <span class="wildcard">wildcard mask</span>,
    5459and possible subnet ranges for the entered mask length.
     60</fieldset>
    5561</form>
    5662</tr>
  • trunk/index.shtml

    r233 r517  
    1 <!--#include virtual="/ip/cgi-bin/main.cgi?action=index" -->
     1<!--#include virtual="cgi-bin/main.cgi?action=index" -->
  • trunk/ipdb.css

    r413 r517  
     1/* Default/global defs for specific tags */
     2fieldset {
     3        border: none;
     4        padding: 0px;
     5        margin: 0px;
     6}
     7
     8#debug {
     9        background-color: #990066;
     10        padding: 2px;
     11}
     12
     13/* Specific divs */
     14#bodyheader {
     15        margin-left: 4px;
     16        position: relative;
     17}
     18#homelink {
     19        font-size: 13px;
     20        font-weight: bold;
     21        position: absolute;
     22        right: 10px;
     23        bottom: 2px;
     24        text-align: right;
     25}
     26#subheader {
     27        background-color: #D0E0E0;
     28        font-size: 90%;
     29        padding: 3px;
     30        border-top: thin solid #000000;
     31        /* apparently this is required to keep "contained" position: absolute divs from escaping.  O_o */
     32        position: relative;
     33}
     34#csearch {
     35        float: right;
     36        padding: 3px;
     37}
     38#newlink {
     39        position: absolute;
     40        right: 10px;
     41        top: 6px;
     42        text-align: right;
     43}
     44#main {
     45        padding: 10px;
     46        border-top: thin solid #000000;
     47/*        text-align: center;*/
     48        padding-top: 20px;
     49        position: relative;
     50}
     51#utils {
     52        font-size: 13px;
     53        font-weight: bold;
     54        position: absolute;
     55        right: 10px;
     56        top: 2px;
     57        text-align: right;
     58}
     59#adminlink {
     60        position: absolute;
     61        right: 10px;
     62        bottom: 5px;
     63}
     64#footer {
     65        border-top: thin solid #000000;
     66}
     67#contact {
     68        font-size: 10px;
     69        position: absolute;
     70        right: 10px;
     71        text-align: right;
     72}
     73
    174body {
    275  background-color: #ffffff;
    3   text-color: #000000;
     76  color: #000000;
    477  font-family: helvetica;
    578  margin: 0;
     
    1285a:active        { color:#cc0000; }      /* selected link */
    1386
    14 tr.color0 {
     87table.center {
     88        margin-left: auto;
     89        margin-right: auto;
     90        text-align: center;
     91}
     92
     93/* Defs for bulk-data rows */
     94tr.header {
     95        background-color: #CCCCCC;
     96        font-family: Verdana, Arial, Helvetica, sans-serif;
     97}
     98/* for reasons of Please The Validation Gods, these may be applied to
     99   things that are not technically table rows */
     100.row0 {
     101        background-color: #D0E0E0;
     102        font-family: Verdana, Arial, Helvetica, sans-serif;
     103        font-size: 90%;
     104}
     105.row1 {
    15106        background-color: #A8C4D0;
    16107        font-family: Verdana, Arial, Helvetica, sans-serif;
     
    18109}
    19110
    20 tr.color1 {
    21         background-color: #d0e0e0;
    22         font-family: Verdana, Arial, Helvetica, sans-serif;
    23         font-size: 90%;
    24 }
    25 
    26 tr.color2 {
    27         background-color: #A8C4D0;
    28         font-family: Verdana, Arial, Helvetica, sans-serif;
    29         font-size: 90%;
    30 }
    31 
     111hr.w60 {
     112        width: 60%;
     113}
     114hr.w30 {
     115        width: 30%;
     116}
     117
     118/* legacy defs */
    32119tr.hack {
    33120        background-color: #E4EEE8;
     
    48135}
    49136
     137td {
     138        padding-right: 2px;
     139        padding-left: 2px;
     140}
     141
     142/* Generic classes */
    50143.indent {
    51144        margin-left: 5%;
     
    64157}
    65158
     159.tbltitle {
     160        text-align: center;
     161        font-size: 110%;
     162        font-weight: bold;
     163        font-family: Verdana, Arial, Helvetica, sans-serif;
     164}
     165.tblsubtitle {
     166        font-size: 105%;
     167        font-weight: bold;
     168        font-family: Verdana, Arial, Helvetica, sans-serif;
     169}
     170
     171.ljust {
     172        text-align: left;
     173}
     174.topalign {
     175        vertical-align: top;
     176}
     177
    66178.small {
    67179        font-size: 60%;
     
    74186}
    75187
     188.err {
     189        text-align: center;
     190        font-size: 1em;
     191}
     192
    76193.red {
    77194        font-weight: bold;
     
    88205        background: #ffff00;
    89206}
     207
     208.altbg {
     209        background: #d0e0e0;
     210}
     211
     212.noshow {
     213        visibility: none;
     214        height: 0;
     215        width: 0;
     216}
Note: See TracChangeset for help on using the changeset viewer.