Changeset 517
- Timestamp:
- 10/18/12 16:53:10 (12 years ago)
- Location:
- trunk
- Files:
-
- 15 deleted
- 18 edited
- 54 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk
-
Property svn:mergeinfo
set to
/branches/htmlform merged eligible
-
Property svn:mergeinfo
set to
-
trunk/INSTALL
r440 r517 65 65 5) Configure your webserver to call the IPDB scripts at an appropriate 66 66 web 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 shouldwork as well.67 the ipdb-#VERSION#/ tarball directory, or /usr/local/lib/ipdb-#VERSION#) 68 should work fine; a server alias under an existing virtual host should 69 work as well. 70 70 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/. 71 Set $IPDB::webpath (the web path to your IPDB install) in MyIPDB.pm. 72 Straight out of the tarball it should work at the webroot, but if you 73 want it in a subdirectory, you'll need to set this variable to get all 74 of the internal links to behave properly. 74 75 75 76 The directory containing the HTML and scripts must have at least the 76 77 following Apache directives (or other server equivalent) set: 77 78 78 Options ExecCGI IncludesNoEXEC FollowSymlinks79 Options ExecCGI IncludesNoEXEC 79 80 80 81 6) User lists can be maintained two basic ways: -
trunk/Makefile
r441 r517 28 28 DESTDIR = 29 29 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 30 HTML = \ 31 alloctypes.html help.html index.shtml ipdb.css 49 32 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 33 JS = templates/widgets.js 55 34 56 35 IMAGES = images/logo.png 36 37 TEMPLATES = \ 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 57 56 58 57 SCRIPTS = \ … … 67 66 68 67 RWHOIS = \ 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 \ 70 69 cgi-bin/extras/network.tmpl 71 70 72 DIRS = images cgi-bin cgi-bin/extras71 DIRS = images templates cgi-bin cgi-bin/extras 73 72 74 # hmm. not sure what do do about you, m'friend... 75 #ip@ 73 MANIFEST = \ 74 $(HTML) \ 75 $(JS) \ 76 $(IMAGES) \ 77 $(TEMPLATES) \ 78 $(SCRIPTS) \ 79 $(MODULES) \ 80 $(CONFIGMODULES) \ 81 $(RWHOIS) 76 82 77 83 all: … … 79 85 80 86 install: 81 @for i in $(HTML) $(IMAGES) ; do \87 @for i in $(HTML) $(IMAGES) $(JS) $(TEMPLATES); do \ 82 88 $(INSTALL_DATA) -D $$i $(DESTDIR)${libdir}/ipdb-$(VERSION)/$$i ; \ 83 89 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"> 8 8 </head> 9 9 10 <body> 10 11 11 12 <table class="regular"> 12 13 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"> 16 17 <td>Customer netblock (default)</td> 17 18 <td>A direct allocation /30 or larger to a customer. Note that this does NOT … … 20 21 </tr> 21 22 22 <tr class=" color2">23 <tr class="row1"> 23 24 <td>Static IP - Server pool</td> 24 25 <td>A single IP from a pool designated for servers</td> 25 26 </tr> 26 27 27 <tr class=" color1">28 <tr class="row0"> 28 29 <td>Static IP - Cable</td> 29 30 <td>A single IP address from a designated pool on the cable network.</td> 30 31 </tr> 31 32 32 <tr class=" color2">33 <tr class="row1"> 33 34 <td>Static IP - DSL</td> 34 35 <td>A single IP address from a designated pool on the DSL network.</td> 35 36 </tr> 36 37 37 <tr class=" color1">38 <tr class="row0"> 38 39 <td>Static IP - Dialup</td> 39 40 <td>A single IP address from a designated pool on a dialup RAS.</td> 40 41 </tr> 41 42 42 <tr class=" color2">43 <tr class="row1"> 43 44 <td>Static IP - Wireless</td> 44 45 <td>A single IP address from a designated pool on a wireless connection.</td> 45 46 </tr> 46 47 47 <tr class=" color1">48 <tr class="row0"> 48 49 <td>Static pool - Servers</td> 49 50 <td>A pool of IP addresses available for one-by-one assignment to servers in a … … 51 52 </tr> 52 53 53 <tr class=" color2">54 <tr class="row1"> 54 55 <td>Static pool - Cable</td> 55 56 <td>A pool of IP addresses available for one-by-one assignment to customers on … … 57 58 </tr> 58 59 59 <tr class=" color1">60 <tr class="row0"> 60 61 <td>Static pool - DSL</td> 61 62 <td>A pool of IP addresses available for one-by-one assignment to customers on … … 64 65 </tr> 65 66 66 <tr class=" color2">67 <tr class="row1"> 67 68 <td>Static pool - Dialup</td> 68 69 <td>A pool of IP addresses available for one-by-one assignment to dialup … … 70 71 </tr> 71 72 72 <tr class=" color1">73 <tr class="row0"> 73 74 <td>Static pool - Wireless</td> 74 75 <td>A pool of IP addresses available for one-by-one assignment to customers on a … … 76 77 </tr> 77 78 78 <tr class=" color2">79 <tr class="row1"> 79 80 <td>End-use netblock</td> 80 81 <td>A /30 or larger allocation for arbitrary services - note this should not … … 83 84 </tr> 84 85 85 <tr class=" color1">86 <tr class="row0"> 86 87 <td>Dialup netblock</td> 87 88 <td>Netblock assigned to one or more RAS units in a POP</td> 88 89 </tr> 89 90 90 <tr class=" color2">91 <tr class="row1"> 91 92 <td>Dynamic DSL block</td> 92 93 <td>Netblock for (mostly residential) PPPoE DSL.</td> 93 94 </tr> 94 95 95 <tr class=" color1">96 <tr class="row0"> 96 97 <td>Dynamic cable block</td> 97 98 <td>Netblock for (mostly residential) DHCP cable.</td> 98 99 </tr> 99 100 100 <tr class=" color2">101 <tr class="row1"> 101 102 <td>Dynamic WiFi block</td> 102 103 <td>Netblock for (mostly residential) (mostly) PPPoE wireless.</td> 103 104 </tr> 104 105 105 <tr class=" color1">106 <tr class="row0"> 106 107 <td>Dynamic VoIP block</td> 107 108 <td>Netblock for DHCP-assigned VoIP services.</td> 108 109 </tr> 109 110 110 <tr class=" color2">111 <tr class="row1"> 111 112 <td>Static IP - LAN/POP</td> 112 113 <td>A single IP address from a designated pool for internal LANs - either at a … … 114 115 </tr> 115 116 116 <tr class=" color1">117 <tr class="row0"> 117 118 <td>Static IP - Managment</td> 118 119 <td>A single IP address from a designated pool for managed devices.</td> 119 120 </tr> 120 121 121 <tr class=" color2">122 <tr class="row1"> 122 123 <td>Static IP - Wifi CPE</td> 123 124 <td>A single IP address from a designated pool for wireless CPE devices.</td> 124 125 </tr> 125 126 126 <tr class=" color1">127 <tr class="row0"> 127 128 <td>Static pool - LAN/POP</td> 128 129 <td>A pool of IP addresses available for one-by-one assignment to internal LAN … … 130 131 </tr> 131 132 132 <tr class=" color2">133 <tr class="row1"> 133 134 <td>Static Pool - Managment</td> 134 135 <td>A pool of IP addresses available for assignment to managed devices.</td> 135 136 </tr> 136 137 137 <tr class=" color1">138 <tr class="row0"> 138 139 <td>Static pool - Wifi CPE</td> 139 140 <td>A pool of IP addresses available for assignment to wireless CPE devices.</td> 140 141 </tr> 141 142 142 <tr class=" color2">143 <tr class="row1"> 143 144 <td>Reserve for WAN blocks</td> 144 145 <td>Reserve a chunk of IP space for core routers/etc.</td> 145 146 </tr> 146 147 147 <tr class=" color1">148 <tr class="row0"> 148 149 <td>Reserve for dynamic-route DSL netblocks</td> 149 150 <td>Reserve a chunk of IP space for netblocks configured on the customer end via … … 152 153 </tr> 153 154 154 <tr class=" color2">155 <tr class="row1"> 155 156 <td>Reserve for ATM</td> 156 157 <td>Reserve a chunk of IP space for allocation to customers on ATM.</td> 157 158 </tr> 158 159 159 <tr class=" color1">160 <tr class="row0"> 160 161 <td>Reserve for fibre</td> 161 162 <td>Reserve a chunk of IP space for customers on a fibre connection.</td> 162 163 </tr> 163 164 164 <tr class=" color2">165 <tr class="row1"> 165 166 <td>WAN block</td> 166 167 <td>Individual netblock assignment for a core router. Always taken from a … … 168 169 </tr> 169 170 170 <tr class=" color1">171 <tr class="row0"> 171 172 <td>Dynamic-route DSL netblock</td> 172 173 <td>Customer assignment for a netblock configured on the customer end via … … 175 176 </tr> 176 177 177 <tr class=" color2">178 <tr class="row1"> 178 179 <td>ATM block</td> 179 180 <td>Customer assignment for a customer on ATM. Always taken from a … … 181 182 </tr> 182 183 183 <tr class=" color1">184 <tr class="row0"> 184 185 <td>Fibre</td> 185 186 <td>Customer assignment for a customer on fibre. Always taken from a block … … 187 188 </tr> 188 189 189 <tr class=" color2">190 <tr class="row1"> 190 191 <td>Routing</td> 191 192 <td>Blocks not actually assigned to a service on their own, but which … … 193 194 </tr> 194 195 195 <tr class=" color1">196 <tr class="row0"> 196 197 <td>Master block</td> 197 198 <td>Allocations provided by the regional registry (ARIN, RIPE, LACNIC, AfriNIC, -
trunk/cgi-bin/CustIDCK.pm
r417 r517 31 31 # the local admin on installation 32 32 sub custid_exist { 33 my $self = shift; 33 34 my $custid = shift; 34 35 -
trunk/cgi-bin/IPDB.pm
r486 r517 24 24 @EXPORT_OK = qw( 25 25 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks 26 %allocated %free %routed %bigfree %IPDBacl 26 %allocated %free %routed %bigfree %IPDBacl %aclmsg 27 27 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &addMaster 28 28 &deleteBlock &getBlockData &mailNotify … … 32 32 %EXPORT_TAGS = ( ALL => [qw( 33 33 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist 34 @masterblocks %allocated %free %routed %bigfree %IPDBacl 34 @masterblocks %allocated %free %routed %bigfree %IPDBacl %aclmsg 35 35 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock 36 36 &addMaster &deleteBlock &getBlockData &mailNotify … … 52 52 our %bigfree; 53 53 our %IPDBacl; 54 55 # mapping table for functional-area => error message 56 our %aclmsg = ( 57 addmaster => 'add a master block', 58 addblock => 'add an allocation', 59 updateblock => 'update a block', 60 delblock => 'delete an allocation', 61 ); 54 62 55 63 our $org_name = 'Example Corp'; … … 122 130 } 123 131 132 ##fixme: initialize HTML::Template env var for template path 133 # something like $self->path().'/templates' ? 134 # $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar'; 135 124 136 return (1,"OK"); 125 137 } # end initIPDBGlobals … … 170 182 sub finish { 171 183 my $dbh = $_[0]; 172 $dbh->disconnect ;184 $dbh->disconnect if $dbh; 173 185 } # end finish 174 186 … … 352 364 $cidr = $data[0]; # $cidr is already declared when we get here! 353 365 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"); 359 370 # node hack 360 371 if ($nodeid && $nodeid ne '') { … … 404 415 $sth = $dbh->prepare("insert into allocations". 405 416 " (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); 409 419 410 420 # And initialize the pool, if necessary … … 514 524 $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,". 515 525 "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); 519 528 520 529 # And initialize the pool, if necessary … … 638 647 eval { 639 648 $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 >>= ?". 642 651 " 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"); 645 654 $dbh->commit; 646 655 }; -
trunk/cgi-bin/MyIPDB.pm
r437 r517 22 22 # DB host is optional. 23 23 my $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 = ''; 24 28 25 29 # Set some globals declared in IPDB.pm. Most of these only affect mailNotify(). -
trunk/cgi-bin/admin.cgi
r515 r517 15 15 use warnings; 16 16 use CGI::Carp qw(fatalsToBrowser); 17 use CGI::Simple; 18 use HTML::Template; 17 19 use DBI; 18 use CommonWeb qw(:ALL);19 20 #use POSIX qw(ceil); 20 21 use NetAddr::IP; … … 39 40 40 41 syslog "debug", "$authuser active"; 42 43 # Set up the CGI object... 44 my $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) 50 my %webvar = $q->Vars; 51 52 # anyone got a better name? :P 53 my $thingroot = $ENV{SCRIPT_FILENAME}; 54 $thingroot =~ s|cgi-bin/admin.cgi||; 55 56 # Set up some globals 57 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 41 58 42 59 # Why not a global DB handle? (And a global statement handle, as well...) … … 47 64 ($ip_dbh,$errstr) = connectDB_My; 48 65 if (!$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 72 if ($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 } 52 78 53 79 if ($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; 61 85 exit; 62 86 } 63 87 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"; 88 my $header = HTML::Template->new(filename => "admin/header.tmpl"); 73 89 74 90 if(!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 94 my $page; 95 if (-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 102 if ($webvar{action} eq 'main') { 103 $header->param(mainpage => 1); 104 78 105 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 79 106 $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; 87 121 $sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr"); 88 122 $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 136 elsif ($webvar{action} eq 'alloc') { 134 137 135 138 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; 137 141 } 138 142 … … 148 152 my $status = CustIDCK->custid_exist($webvar{custid}); 149 153 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; 152 156 } 153 157 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 ". 155 159 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 156 160 "non-customer assignments."); 157 return;161 goto ERRJUMP; 158 162 } 159 163 } … … 169 173 @data = $sth->fetchrow_array; 170 174 # 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 } 173 179 } elsif ($webvar{alloctype} =~ /^(.)i$/) { 174 180 $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')"); … … 176 182 @data = $sth->fetchrow_array; 177 183 # 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 } 180 188 } else { 181 189 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')"); … … 183 191 @data = $sth->fetchrow_array; 184 192 # 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 } 187 197 } 188 198 … … 190 200 $sth->finish; 191 201 192 my $cities = '';202 my @cities; 193 203 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 <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 ); 234 215 235 216 } elsif ($webvar{action} eq 'confirm') { 236 217 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 ); 239 224 # Only need to check city here. 240 225 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; 242 228 } else { 243 229 if ($webvar{alloctype} =~ /^.i$/) { … … 247 233 $sth->execute; 248 234 if ($sth->err) { 249 print "Allocation failed! DBI said:\n".$sth->errstr."\n";235 $page->param(errmsg => $sth->errstr); 250 236 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 251 237 "'$webvar{alloctype}' failed: '".$sth->errstr."'"; 252 238 } else { 253 print "Allocation OK!\n";254 239 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 255 240 "'$webvar{alloctype}'"; … … 263 248 $webvar{circid}); 264 249 if ($retcode eq 'OK') { 265 print "Allocation OK!\n";266 250 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 267 251 "'$webvar{alloctype}'"; 268 252 } else { 269 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";253 $page->param(errmsg => $msg); 270 254 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 271 255 "'$webvar{alloctype}' failed: '$msg'"; … … 276 260 277 261 } elsif ($webvar{action} eq 'alloctweak') { 262 278 263 fix_allocfrom(); 279 264 showAllocs($webvar{allocfrom}); 265 280 266 } elsif ($webvar{action} eq 'update') { 267 281 268 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 299 270 } elsif ($webvar{action} eq 'touch') { 300 print "Touching master $webvar{whichmaster}\n"; 271 272 $page->param(master => $webvar{whichmaster}); 301 273 $sth = $ip_dbh->prepare("update masterblocks set mtime=now() where cidr='$webvar{whichmaster}'"); 302 274 $sth->execute; 303 275 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 306 279 } 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 318 281 $sth = $ip_dbh->prepare("select custid,name,tech_handle from customers order by custid"); 319 282 $sth->execute; 283 my @custlist; 320 284 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 325 294 } elsif ($webvar{action} eq 'edcust') { 295 326 296 if ($webvar{newcust}) { 327 print "got here?\n";328 297 $sth = $ip_dbh->prepare("INSERT INTO customers (custid) VALUES (?)"); 329 298 $sth->execute($webvar{custid}); … … 335 304 my ($custid, $name, $street, $city, $prov, $country, $pocode, $phone, $tech, $abuse, $admin, $special) = 336 305 $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 ); 377 321 378 322 } elsif ($webvar{action} eq 'updcust') { 323 379 324 $sth = $ip_dbh->prepare("UPDATE customers SET". 380 325 " name=?, street=?, city=?, province=?, country=?, pocode=?,". … … 384 329 $webvar{country}, $webvar{pocode}, $webvar{phone}, $webvar{tech_handle}, 385 330 $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 ); 405 345 406 346 } 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 425 360 } elsif ($webvar{action} eq 'tweakpool') { 361 426 362 showPool($webvar{pool}); 363 427 364 } elsif ($webvar{action} eq 'updatepool') { 428 365 429 366 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ". 430 "city= '$webvar{city}', type='$webvar{type}', available='".367 "city=?, type='$webvar{type}', available='". 431 368 (($webvar{available} eq 'y') ? 'y' : 'n'). 432 "', notes= '$webvar{notes}', description='$webvar{desc}'".369 "', notes=?, description=? ". 433 370 "where ip='$webvar{ip}'"); 434 $sth->execute; 371 $sth->execute($webvar{city},$webvar{notes},$webvar{desc}); 372 $page->param(ip => $webvar{ip}); 435 373 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 { 443 377 syslog "notice", "$authuser updated pool IP $webvar{ip}"; 444 378 } 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 445 384 } 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 459 386 $sth = $ip_dbh->prepare("select username,acl from users order by username"); 460 387 $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 478 404 } elsif ($webvar{action} eq 'updacl') { 479 print "Updating ACL for $webvar{username}:<br>\n"; 405 406 $page->param(username => $webvar{username}); 480 407 my $acl = 'b'; 481 408 if ($webvar{admin} eq 'on') { … … 487 414 ($webvar{sysnet} eq 'on' ? 's' : ''); 488 415 } 489 print "New ACL: $acl<br>\n";416 $page->param(acl => $acl); 490 417 491 418 $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'"); 492 419 $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; 496 421 497 422 } elsif ($webvar{action} eq 'newuser') { 498 print "Adding user $webvar{username}...\n"; 423 424 $page->param(username => $webvar{username}); 499 425 my $cr_pass = ($webvar{preenc} ? $webvar{password} : 500 426 crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64])); … … 502 428 "('$webvar{username}','$cr_pass','b')"); 503 429 $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; 511 431 512 432 } elsif ($webvar{action} eq 'deluser') { 513 print "Deleting user $webvar{username}.<br>\n"; 433 434 $page->param(username => $webvar{username}); 514 435 $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'"); 515 436 $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; 519 438 520 439 } elsif ($webvar{action} eq 'emailnotice') { 521 print "<h4>Email notice management:</h4>\nClick the email addresses to edit that list."; 440 522 441 $sth = $ip_dbh->prepare("SELECT action,reciplist FROM notify"); 523 442 $sth->execute; 524 525 print "<table border=1>\n"; 443 my @spamlist; 526 444 while (my ($notice_code,$reciplist) = $sth->fetchrow_array() ) { 527 445 ##fixme: hairy mess, only a few things call mailNotify() anyway, so many possible notices won't work. 528 446 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 551 <input type=radio name=msgaction value=u>Update 552 <input type=radio name=msgaction value=d>Delete 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); 570 455 571 456 $sth = $ip_dbh->prepare("SELECT type,dispname FROM alloctypes WHERE listorder < 500 ". … … 573 458 $sth->execute; 574 459 my $i=0; 460 my @typelist; 575 461 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); 590 471 591 472 } elsif ($webvar{action} eq 'addnotice') { 473 592 474 $webvar{alloctype} = $webvar{special} if $webvar{msgaction} eq 's:'; 593 475 if ($webvar{msgaction} && $webvar{alloctype} && $webvar{reciplist}) { 476 $page->param(cantry => 1); 594 477 $webvar{reciplist} =~ s/[\r\n]+/,/g; 595 478 $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})); 597 481 $sth = $ip_dbh->prepare("INSERT INTO notify (action, reciplist) VALUES (?,?)"); 598 482 ##fixme: automagically merge reciplists iff action already exists 599 483 $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 } 610 486 611 487 } 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})); 613 490 $sth = $ip_dbh->prepare("DELETE FROM notify WHERE action=?"); 614 491 $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; 621 493 622 494 } 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}); 624 498 $sth = $ip_dbh->prepare("SELECT reciplist FROM notify WHERE action=?"); 625 499 $sth->execute($webvar{code}); 626 500 my ($reciplist) = $sth->fetchrow_array; 627 501 $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 632 504 } 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})); 634 507 $sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?"); 635 508 $webvar{reciplist} =~ s/[\r\n]+/,/g; 636 509 $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 643 512 } 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 516 ERRJUMP: print "Content-type: text/html\n\n".$header->output; 517 print $page->output; 518 519 ##fixme: make me a footer param! 520 print 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. 523 my $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 527 print $footer->output; 528 529 $ip_dbh->disconnect; 530 531 exit; 532 646 533 647 534 # Hokay. This is a little different. We have a few specific functions here: … … 649 536 # -> Tweak individual DB fields 650 537 # 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;659 538 660 539 … … 671 550 672 551 673 # List free blocks in a /24 for arbitrary manual allocation674 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 700 552 # 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 553 sub 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* 713 570 my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes". 714 571 " where listorder < 500 and not (type like '_i') order by listorder"); 715 572 $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; 719 581 } 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() 733 587 734 588 735 589 # Stuff updates into DB 736 590 sub 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."'"; 749 601 } else { 750 # If we get here, the operation succeeded.751 602 syslog "notice", "$authuser updated $webvar{block}"; 752 print "Allocation $webvar{block} updated<hr>\n";753 603 } 754 604 # need to get /24 that block is part of … … 756 606 $bits[3] = "0/24"; 757 607 showAllocs((join ".", @bits)); 758 } 608 } # end update() 759 609 760 610 … … 764 614 sub showPool($) { 765 615 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);772 616 773 617 $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder"); 774 618 $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() 795 646 796 647 -
trunk/cgi-bin/allocate.pl
r431 r517 11 11 use warnings; 12 12 use DBI; 13 use CommonWeb qw(:ALL);14 13 use NetAddr::IP; 15 14 … … 38 37 my $errstr; 39 38 ($ip_dbh,$errstr) = connectDB_My; 40 if (!$ip_dbh) { 41 printAndExit("Failed to connect to database: $errstr\n");42 } 39 die "Failed to connect to database: $errstr\n" 40 if !$ip_dbh; 41 43 42 checkDBSanity($ip_dbh); 44 43 initIPDBGlobals($ip_dbh); -
trunk/cgi-bin/combineblocks.pl
r417 r517 13 13 #use CGI::Carp qw(fatalsToBrowser); 14 14 use DBI; 15 #use CommonWeb qw(:ALL);16 15 #use POSIX qw(ceil); 17 16 use NetAddr::IP; -
trunk/cgi-bin/main.cgi
r515 r517 12 12 use warnings; 13 13 use CGI::Carp qw(fatalsToBrowser); 14 use CGI::Simple; 15 use HTML::Template; 14 16 use DBI; 15 use CommonWeb qw(:ALL);16 17 use POSIX qw(ceil); 17 18 use NetAddr::IP; … … 26 27 27 28 openlog "IPDB","pid","$IPDB::syslog_facility"; 29 30 ## Environment. Collect some things, process some things, set some things... 28 31 29 32 # Collect the username from HTTP auth. If undefined, we're in … … 36 39 } 37 40 41 # anyone got a better name? :P 42 my $thingroot = $ENV{SCRIPT_FILENAME}; 43 $thingroot =~ s|cgi-bin/main.cgi||; 44 38 45 syslog "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... 51 my $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) 57 my %webvar = $q->Vars; 39 58 40 59 # Why not a global DB handle? (And a global statement handle, as well...) … … 45 64 ($ip_dbh,$errstr) = connectDB_My; 46 65 if (!$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 74 my $header = HTML::Template->new(filename => "header.tmpl"); 75 my $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); 80 print "Content-type: text/html\n\n", $header->output; 60 81 61 82 62 83 #main() 84 my $aclerr; 63 85 64 86 if(!defined($webvar{action})) { 65 $webvar{action} = "<NULL>"; #shuts up the warnings. 87 $webvar{action} = "index"; #shuts up the warnings. 88 } 89 90 my $page; 91 if (-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"); 66 95 } 67 96 … … 70 99 } elsif ($webvar{action} eq 'addmaster') { 71 100 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'; 73 107 } 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 83 108 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"); 86 110 87 111 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}); 88 112 89 113 if ($code eq 'FAIL') { 90 carp "Transaction aborted because $msg";91 114 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); 93 116 } else { 94 print "<div type=heading align=center>Success!</div>\n";95 117 syslog "info", "$authuser added master block $webvar{cidr}"; 96 118 } … … 133 155 } 134 156 elsif ($webvar{action} eq 'nodesearch') { 135 open HTML, "<../nodesearch.html";136 my $html = join('',<HTML>);137 close HTML;138 139 157 $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; 142 160 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. 168 elsif ($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}. 153 174 else { 154 175 my $rnd = rand 500; 155 176 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]); 161 190 } 162 191 ## Finally! Done with that NASTY "case" emulation! 163 192 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. 198 if ($aclerr) { 199 $page = HTML::Template->new(filename => "aclerror.tmpl"); 200 $page->param(ipdbfunc => $aclmsg{$aclerr}); 201 } 164 202 165 203 … … 167 205 finish($ip_dbh); 168 206 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); 212 print $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); 217 print $footer->output; 218 175 219 # Just in case something waaaayyy down isn't in place 176 220 # 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 221 exit 0; 215 222 216 223 217 224 # Initial display: Show master blocks with total allocated subnets, total free subnets 218 225 sub showSummary { 219 220 startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',221 'Free netblocks', 'Largest free block');222 223 226 my %allocated; 224 227 my %free; … … 260 263 } 261 264 262 # Print the data. 263 my $count=0; 265 # Assemble the data to stuff into the template. 266 my @masterlist; 267 my $rowclass=0; 264 268 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 '') ? ("<NONE>") : ("/".$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 '') ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 268 276 ); 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/) ); 279 282 280 283 } # showSummary … … 288 291 sub showMaster { 289 292 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}); 292 294 293 295 my %allocated; 294 296 my %free; 295 my % routed;297 my %cities; 296 298 my %bigfree; 297 299 … … 311 313 $bigfree{"$cidr"} = 128; 312 314 # Retain the routing destination 313 $ routed{"$cidr"} = $data[1];315 $cities{"$cidr"} = $data[1]; 314 316 } 315 317 316 318 # Check if there were actually any blocks routed from this master 317 319 if ($i > 0) { 318 startTable('Routed block','Routed to','Allocated blocks',319 'Free blocks','Largest free block');320 320 321 321 # Count the allocations … … 345 345 } 346 346 347 # Print the data.348 my $ count=0;347 my @routed; 348 my $rowclass = 0; 349 349 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) ? ("<NONE>") : ("/".$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) ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 357 ); 358 push @routed, \%row; 359 } 360 $page->param(routedlist => \@routed); 372 361 373 362 } # end check for existence of routed blocks in master 374 363 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/)); 379 365 380 366 # Snag the free blocks. … … 383 369 "routed='n' order by cidr"); 384 370 $sth->execute(); 371 my @unrouted; 372 my $rowclass = 0; 385 373 while (my @data = $sth->fetchrow_array()) { 386 374 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 394 384 } # showMaster 395 385 … … 408 398 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'"); 409 399 $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); 416 404 417 405 # Snag the allocations for this block … … 424 412 my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?"); 425 413 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); 435 418 my ($ncust) = $custsth->fetchrow_array(); 436 419 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] .= ' <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/); 474 436 475 437 # Snag the free blocks. We don't really *need* to be pedantic about avoiding 476 438 # 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; 478 441 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'". 479 442 " order by cidr"); 480 443 $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 494 458 } # showRBlock 495 459 … … 500 464 my $cidr = new NetAddr::IP $webvar{pool}; 501 465 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); 503 473 504 474 # 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 512 482 # 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$/); 524 484 525 485 # probably have to add an "edit IP allocation" link here somewhere. 526 486 527 startTable('IP','Customer ID','Available?','Description','');528 487 $sth = $ip_dbh->prepare("select ip,custid,available,description,type". 529 488 " from poolips where pool='$webvar{pool}' order by ip"); 530 489 $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] = ' '; 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 (" ") ) 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' 548 501 ); 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); 554 505 555 506 } # end listPool … … 561 512 562 513 if ($IPDBacl{$authuser} !~ /a/) { 563 printError("You shouldn't have been able to get here. Access denied.");514 $aclerr = 'addblock'; 564 515 return; 565 516 } 566 517 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')); 568 526 569 527 # New special case- block to assign is specified 570 528 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;575 529 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. 580 532 # This is a little dangerous, as it's *theoretically* possible to 581 533 # get fbtype='n' (aka a non-routed freeblock). However, should 582 534 # someone manage to get there, they get what they deserve. 583 535 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. 586 537 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'"); 587 538 $sth->execute; 588 539 my @data = $sth->fetchrow_array; 589 540 $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]); 591 543 } else { 592 $typelist .= qq(<select name="alloctype">\n);593 544 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ". 594 545 "and type not like '_i' and type not like '_r' order by listorder"); 595 546 $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; 598 549 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++; 600 556 } 601 $typelist .= "</select>\n"; 602 } 603 $html =~ s|\$\$TYPELIST\$\$|$typelist|g; 557 $page->param(typelist => \@typelist); 558 } 604 559 } 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; 610 561 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; 616 568 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"); 622 577 $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; 625 580 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; 631 592 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); 635 597 636 598 ## node hack 637 599 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 638 600 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n"; 639 my $nodes = '';601 my @nodes; 640 602 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); 644 607 ## end node hack 645 608 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/); 662 610 663 611 } # assignBlock … … 667 615 sub confirmAssign { 668 616 if ($IPDBacl{$authuser} !~ /a/) { 669 printError("You shouldn't have been able to get here. Access denied.");617 $aclerr = 'addblock'; 670 618 return; 671 619 } … … 693 641 $sth->execute; 694 642 my $optionlist; 695 while (my @data = $sth->fetchrow_array) { 643 644 my @poollist; 645 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) { 696 646 # 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); 699 650 } 700 651 } 652 $page->param(staticip => 1); 653 $page->param(poollist => \@poollist); 701 654 $cidr = "Single static IP"; 702 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n"; 655 ##fixme: need to handle "no available pools" 703 656 704 657 } else { # end show pool options … … 710 663 711 664 if (!$webvar{maskbits}) { 712 printError("Please specify a CIDR mask length.");665 $page->param(err => "Please specify a CIDR mask length."); 713 666 return; 714 667 } … … 748 701 " block size for the pool."; 749 702 } else { 703 if (!$webvar{pop}) { 704 $page->param(err => 'Please select a POP to route the block from/through.'); 705 return; 706 } 750 707 $city = $webvar{pop}; 751 708 $failmsg = "No suitable free block found.<br>\nYou will have to route another". … … 769 726 my @data = $sth->fetchrow_array(); 770 727 if ($data[0] eq "") { 771 printError($failmsg);728 $page->param(err => $failmsg); 772 729 return; 773 730 } … … 775 732 } # check for freeblocks assignment or IPDB-controlled assignment 776 733 777 $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);734 $alloc_from = "$cidr"; 778 735 779 736 # If the block to be allocated is smaller than the one we found, … … 789 746 } # if ($webvar{alloctype} =~ /^.i$/) 790 747 791 open HTML, "../confirm.html"792 or croak "Could not open confirm.html: $!";793 my $html = join '', <HTML>;794 close HTML;795 796 748 ## node hack 797 749 if ($webvar{node} && $webvar{node} ne '-') { … … 799 751 $sth->execute($webvar{node}); 800 752 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}); 806 755 } 807 756 ## end node hack 808 757 809 ### gotta fix this in final810 # Stick in customer info as necessary - if it's blank, it just ends811 # up as blank lines ignored in the rendering of the page812 my $custbits;813 $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;814 ###815 816 758 # 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 833 773 # Check to see if user is allowed to do anything with sensitive data 834 774 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}) 843 780 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"); 850 786 851 787 } # end confirmAssign … … 855 791 sub insertAssign { 856 792 if ($IPDBacl{$authuser} !~ /a/) { 857 printError("You shouldn't have been able to get here. Access denied.");793 $aclerr = 'addblock'; 858 794 return; 859 795 } … … 867 803 # successful netblock allocation, the IP allocated for static 868 804 # IP, or the error message if an error occurred. 805 869 806 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from}, 870 807 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes}, … … 874 811 if ($webvar{alloctype} =~ /^.i$/) { 875 812 $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}); 882 816 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 883 817 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n". … … 885 819 } else { 886 820 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 } 896 830 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 897 831 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n". … … 903 837 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ". 904 838 "'$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}}'". 906 840 " failed:<br>\n$msg\n"); 907 841 } … … 915 849 sub validateInput { 916 850 if ($webvar{city} eq '-') { 917 printError("Please choose a city.");851 $page->param(err => 'Please choose a city'); 918 852 return; 919 853 } … … 924 858 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone 925 859 # 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'); 927 861 return; 928 862 } … … 932 866 if ($def_custids{$webvar{alloctype}} eq '') { 933 867 if (!$webvar{custid}) { 934 printError("Please enter a customer ID.");868 $page->param(err => 'Please enter a customer ID.'); 935 869 return; 936 870 } … … 941 875 my $status = CustIDCK->custid_exist($webvar{custid}); 942 876 if ($CustIDCK::Error) { 943 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);877 $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg); 944 878 return; 945 879 } 946 880 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 ". 948 882 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 949 883 "non-customer assignments."); … … 977 911 } 978 912 } 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 979 916 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 ". 981 918 "POP locations are currently:<br>\n".join (" - ", @poplist)); 982 919 return; … … 996 933 # Two cases: block is a netblock, or block is a static IP from a pool 997 934 # 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 998 936 if ($webvar{block} =~ /\/32$/) { 999 937 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'"; … … 1009 947 # Clean up extra whitespace on alloc type 1010 948 $data[2] =~ s/\s//; 1011 1012 open (HTML, "../editDisplay.html")1013 or croak "Could not open editDisplay.html :$!";1014 my $html = join('', <HTML>);1015 949 1016 950 # We can't let the city be changed here; this block is a part of … … 1019 953 ##fixme 1020 954 # 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]); 1031 966 1032 967 ##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 1048 986 ## 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}'"); 1050 989 $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/) { 1063 1002 $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; 1066 1005 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); 1068 1012 } 1069 $nodes .= "</select>\n"; 1070 $html =~ s/\$\$NODE\$\$/$nodes/; 1071 } else { 1072 $html =~ s|\$\$NODE\$\$|N/A|; 1013 $page->param(nodelist => \@nodelist); 1073 1014 } 1074 1015 } 1075 1016 ## 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 1099 1018 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'); 1113 1024 1114 1025 # 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/); 1149 1032 1150 1033 } # edit() … … 1155 1038 sub update { 1156 1039 if ($IPDBacl{$authuser} !~ /c/) { 1157 printError("You shouldn't have been able to get here. Access denied.");1040 $aclerr = 'updateblock'; 1158 1041 return; 1159 1042 } … … 1173 1056 my $sql; 1174 1057 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}',". 1177 1061 "$privdata where ip='$webvar{block}'"; 1178 1062 } 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}',". 1182 1067 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ". 1183 1068 "where cidr='$webvar{block}'"; … … 1186 1071 syslog "debug", $sql; 1187 1072 $sth = $ip_dbh->prepare($sql); 1188 $sth->execute ;1073 $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes}); 1189 1074 ## node hack 1190 1075 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 1191 1077 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'"); 1192 1078 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)"); … … 1198 1084 if ($@) { 1199 1085 my $msg = $@; 1200 carp "Transaction aborted because $msg";1201 1086 eval { $ip_dbh->rollback; }; 1202 1087 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"); 1204 1089 return; 1205 1090 } … … 1211 1096 mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}", 1212 1097 "$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 1216 1107 1217 1108 # Link back to browse-routed or list-pool page on "Update complete" page. 1218 my $backlink = "/ip/cgi-bin/main.cgi?action=";1219 1109 my $cblock; # to contain the CIDR of the container block we're retrieving. 1220 1110 my $sql; 1221 1111 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) { 1112 $page->param(backpool => 1); 1222 1113 $sql = "select pool from poolips where ip='$webvar{block}'"; 1223 $backlink .= "listpool&pool=";1224 1114 } else { 1225 1115 $sql = "select cidr from routed where cidr >>= '$webvar{block}'"; 1226 $backlink .= "showrouted&block=";1227 1116 } 1228 1117 # I define there to be no errors on this operation... so we don't need to check for them. … … 1232 1121 $sth->fetch(); 1233 1122 $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}) : " "); 1134 $page->param(privdata => $webvar{privdata}) 1135 if $IPDBacl{$authuser} =~ /s/; 1260 1136 1261 1137 } # update() … … 1265 1141 sub remove { 1266 1142 if ($IPDBacl{$authuser} !~ /d/) { 1267 printError("You shouldn't have been able to get here. Access denied.");1143 $aclerr = 'delblock'; 1268 1144 return; 1269 1145 } 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;1276 1146 1277 1147 # Serves'em right for getting here... 1278 1148 if (!defined($webvar{block})) { 1279 printError("Error 332");1149 $page->param(err => "Can't delete a block that doesn't exist"); 1280 1150 return; 1281 1151 } … … 1298 1168 $desc = "N/A"; 1299 1169 $notes = "N/A"; 1170 $privdata = "N/A"; 1300 1171 1301 1172 } elsif ($webvar{alloctype} eq 'mm') { 1173 1302 1174 $cidr = $webvar{block}; 1303 1175 $city = "N/A"; … … 1307 1179 $desc = "N/A"; 1308 1180 $notes = "N/A"; 1181 $privdata = "N/A"; 1182 1309 1183 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m 1310 1184 … … 1331 1205 } # end cases for different alloctypes 1332 1206 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 = ' ' if $privdata eq ''; 1216 $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/; 1217 $page->param(delpool => $alloctype =~ /^.[pd]$/); 1218 1219 } # end remove() 1367 1220 1368 1221 … … 1373 1226 sub finalDelete { 1374 1227 if ($IPDBacl{$authuser} !~ /d/) { 1375 printError("You shouldn't have been able to get here. Access denied.");1228 $aclerr = 'delblock'; 1376 1229 return; 1377 1230 } … … 1382 1235 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype}); 1383 1236 1237 $page->param(block => $webvar{block}); 1384 1238 if ($code eq 'OK') { 1385 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";1386 1239 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}". 1387 1240 " $custid, $city, desc='$description'"; … … 1390 1243 "CustID: $custid\nCity: $city\nDescription: $description\n"); 1391 1244 } else { 1245 $page->param(failmsg => $msg); 1392 1246 if ($webvar{alloctype} =~ /^.i$/) { 1393 1247 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'"; 1394 printError("Could not deallocate static IP $webvar{block}: $msg");1395 1248 } else { 1396 1249 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'"; 1397 printError("Could not deallocate netblock $webvar{block}: $msg");1250 $page->param(netblock => 1); 1398 1251 } 1399 1252 } 1400 1253 1401 1254 } # 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 } # errorExit1414 1415 1416 # Just in case we manage to get here.1417 exit 0; -
trunk/cgi-bin/newcity.cgi
r431 r517 13 13 use warnings; 14 14 #use CGI::Carp qw(fatalsToBrowser); 15 use CGI::Simple; 16 use HTML::Template; 15 17 use DBI; 16 use CommonWeb qw(:ALL);17 18 #use POSIX qw(ceil); 18 19 use NetAddr::IP; … … 35 36 } 36 37 37 my %webvar = parse_post(); 38 cleanInput(\%webvar); 38 # Set up the CGI object... 39 my $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) 45 my %webvar = $q->Vars; 39 46 40 47 my ($dbh,$errstr) = connectDB_My; 41 48 my $sth; 42 49 50 $ENV{HTML_TEMPLATE_ROOT} = '../templates'; 51 52 my $page = HTML::Template->new(filename => "newcity.tmpl"); 53 54 if ($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 43 74 print "Content-type: text/html\n\n"; 44 75 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 } 76 print $page->output; 62 77 63 78 finish($dbh); 79 -
trunk/cgi-bin/newnode.cgi
r417 r517 13 13 use warnings; 14 14 #use CGI::Carp qw(fatalsToBrowser); 15 use CGI::Simple; 16 use HTML::Template; 15 17 use DBI; 16 use CommonWeb qw(:ALL);17 18 #use POSIX qw(ceil); 18 19 use NetAddr::IP; … … 34 35 } 35 36 36 my %webvar = parse_post(); 37 cleanInput(\%webvar); 37 # Set up the CGI object... 38 my $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) 44 my %webvar = $q->Vars; 38 45 39 46 my ($dbh,$errstr) = connectDB_My; 40 47 my $sth; 41 48 49 $ENV{HTML_TEMPLATE_ROOT} = '../templates'; 50 51 my $page = HTML::Template->new(filename => "newnode.tmpl"); 52 53 if ($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 42 67 print "Content-type: text/html\n\n"; 43 68 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 } 69 print $page->output; 57 70 58 71 finish($dbh); -
trunk/cgi-bin/search.cgi
r455 r517 14 14 use warnings; 15 15 use CGI::Carp qw(fatalsToBrowser); 16 use CGI::Simple; 17 use HTML::Template; 16 18 use DBI; 17 use CommonWeb qw(:ALL);18 19 use POSIX qw(ceil); 19 20 use NetAddr::IP; … … 38 39 } 39 40 41 # Global variables 42 my $RESULTS_PER_PAGE = 25; 43 44 # anyone got a better name? :P 45 my $thingroot = $ENV{SCRIPT_FILENAME}; 46 $thingroot =~ s|cgi-bin/search.cgi||; 47 48 # Set up the CGI object... 49 my $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) 55 my %webvar = $q->Vars; 56 57 if (defined($webvar{rpp})) { 58 ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/); 59 } 60 40 61 # Why not a global DB handle? (And a global statement handle, as well...) 41 62 # Use the connectDB function, otherwise we end up confusing ourselves … … 44 65 my $errstr; 45 66 ($ip_dbh,$errstr) = connectDB_My; 46 if (!$ip_dbh) { 47 printAndExit("Failed to connect to database: $errstr\n"); 67 if ($ip_dbh) { 68 checkDBSanity($ip_dbh); 69 initIPDBGlobals($ip_dbh); 48 70 } 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 75 my $page; 61 76 if (!defined($webvar{stype})) { 62 77 $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"); 63 81 } 64 82 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') { 83 my $header = HTML::Template->new(filename => "header.tmpl"); 84 $header->param(version => $IPDB::VERSION); 85 $header->param(addperm => $IPDBacl{$authuser} =~ /a/); 86 print "Content-type: text/html\n\n", $header->output; 87 88 # Handle the DB error first 89 if (!$ip_dbh) { 90 $page = HTML::Template->new(filename => "dberr.tmpl"); 91 $page->param(errmsg => $errstr); 92 } elsif ($webvar{stype} eq 'q') { 71 93 # Quick search. 72 94 … … 111 133 $sqlconcat = "UNION"; 112 134 } 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"; 116 137 } 117 138 … … 190 211 "text(cidr) like '$webvar{cidr}%')"; 191 212 } 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. 194 215 } # done with CIDR query options. 195 216 … … 201 222 202 223 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."); 205 226 } else { 206 227 # Add the limit/offset clauses … … 225 246 226 247 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 228 250 } else { 229 251 # Add the limit/offset clauses … … 237 259 } else { # how script was called. General case is to show the search criteria page. 238 260 239 # Display search page. We have to do this here, because otherwise240 # 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 246 261 # Generate table of types 247 my $typetable = "<table class=regular cellspacing=0>\n<tr>";248 262 $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ". 249 263 "order by listorder"); 250 264 $sth->execute; 251 265 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); 264 277 265 278 # Generate table of cities 266 my $citytable = "<table class=regular cellspacing=0>\n<tr>";267 279 $sth = $ip_dbh->prepare("select id,city from cities order by city"); 268 280 $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 287 294 } 295 296 print $page->output; 288 297 289 298 # Shut down and clean up. 290 299 finish($ip_dbh); 291 printFooter; 300 301 # We print the footer here, so we don't have to do it elsewhere. 302 my $footer = HTML::Template->new(filename => "footer.tmpl"); 303 # include the admin tools link in the output? 304 $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); 305 306 print $footer->output; 307 292 308 # We shouldn't need to directly execute any code below here; it's all subroutines. 293 309 exit 0; … … 322 338 if ($category eq 'all') { 323 339 324 print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);325 340 $sql = "select $cols from searchme"; 326 341 my $count = countRows($sql); … … 330 345 } elsif ($category eq 'cust') { 331 346 347 ##fixme: this and other quick-search areas; fix up page heading title similar to first grouping above 332 348 print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n); 333 349 … … 393 409 } else { 394 410 # 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."); 396 412 } 397 413 } else { 398 414 # 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."); 400 416 } 401 417 } # viewBy … … 437 453 $sth->execute(); 438 454 439 startTable('Allocation','CustID','Type','City','Description/Name'); 455 $page->param(searchtitle => "Showing all netblock and static-IP allocations"); 456 440 457 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] .= ' <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); 458 473 459 474 # Have to think on this call, it's primarily to clean up unfetched rows from a select. … … 462 477 463 478 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); 466 483 467 484 # print the page thing.. 468 485 if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) { 486 $page->param(multipage => 1); 469 487 my $pages = ceil($rowCount/$RESULTS_PER_PAGE); 470 print qq(<div class="center"> Page: );488 my @pagelist; 471 489 for (my $i = 1; $i <= $pages; $i++) { 490 my %row; 491 $row{pgnum} = $i; 472 492 if ($i == $pageNo) { 473 print "<b>$i </b>\n";493 $row{thispage} = 1; 474 494 } else { 475 print qq(<a href="/ip/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);495 $row{stype} = $webvar{stype}; 476 496 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}&". 478 498 "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&". 479 499 "allcities=$webvar{allcities}&"; 480 500 foreach my $key (keys %webvar) { 481 501 if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) { 482 print"$key=$webvar{$key}&";502 $row{extraopts} .= "$key=$webvar{$key}&"; 483 503 } 484 504 } 485 505 } else { 486 print"input=$webvar{input}&";506 $row{extraopts} = "input=$webvar{input}&"; 487 507 } 488 print qq(">$i</a> \n);489 508 } 490 } 491 print "</div>"; 492 } 509 push @pagelist, \%row; 510 } 511 $page->param(pgnums => \@pagelist); 512 } 513 493 514 } # queryResults 494 515 -
trunk/cgi-bin/snCalc.cgi
r371 r517 4 4 use warnings; 5 5 use CGI::Carp qw(fatalsToBrowser); 6 use CGI::Simple; 7 use HTML::Template; 6 8 use NetAddr::IP; 7 use CommonWeb qw(:ALL);;8 9 9 10 #file snCalc.cgi little subnet calculator app 10 11 11 my %webvar = parse_post(); 12 # Set up the CGI object... 13 my $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) 19 my %webvar = $q->Vars; 20 12 21 my $input; 13 22 14 23 print "Content-Type: text/html\n\n"; 15 24 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 29 my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl"); 20 30 21 31 # Clean up input so we don't divide by zero or something equally silly … … 35 45 my $postnet = new NetAddr::IP "0.0.0.0/$gtinput"; 36 46 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)); 45 56 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); 57 my @prenets; 58 foreach (getranges($ltinput)) { 59 my %row = (netrange => $_); 60 push (@prenets, \%row); 61 } 62 $page->param(prenets => \@prenets); 63 my @nets; 64 foreach (getranges($input)) { 65 my %row = (netrange => $_); 66 push (@nets, \%row); 67 } 68 $page->param(nets => \@nets); 69 my @postnets; 70 foreach (getranges($gtinput)) { 71 my %row = (netrange => $_); 72 push @postnets, \%row; 73 } 74 $page->param(postnets => \@postnets); 58 75 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 ); 76 print $page->output; 66 77 67 78 # Just In Case … … 86 97 sub getranges { 87 98 my $masklen = shift; 88 my $ret = '';99 my @ret; 89 100 my $super; 90 101 if ($masklen < 8) { … … 98 109 } 99 110 foreach my $net ($super->split($masklen)) { 100 $ret .= "\t".xrange($net,$masklen)."<br />\n";111 push @ret, xrange($net,$masklen); 101 112 } 102 return $ret;113 return @ret; 103 114 } # 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"> 8 8 </head> 9 9 <body> … … 11 11 <table class="regular"> 12 12 13 <tr><td class="heading">Quick Searches:</td>< tr>13 <tr><td class="heading">Quick Searches:</td></tr> 14 14 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> 17 18 <td>Lists all alloctions starting with that set of octets. Note that matches on the 18 19 first octet MUST include the period to be considered an IP search.</td> 19 20 </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 23 26 exact match for 192.168.28.0/30 respectively</td> 24 27 </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> 38 33 </tr> 39 34 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 39 numeric 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 46 will fall under this category unless CustIDs are all-numeric.</td> 47 </tr> 48 41 49 <tr><td colspan="3">A blank query will "show all"</td></tr> 42 50 <tr><td colspan="3">The title in the top right hand corner is a link home.</td></tr> 43 51 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> 49 53 <td colspan="2"> 50 54 <form method="POST" action="cgi-bin/snCalc.cgi"> 55 <fieldset><legend></legend> 51 56 / <input type="text" size="5" maxlength="10" name="input" class="regular"> 52 57 <input type="submit" value="Calculate" class="heading"> Show 53 58 <span class="mask">subnet mask</span>, <span class="wildcard">wildcard mask</span>, 54 59 and possible subnet ranges for the entered mask length. 60 </fieldset> 55 61 </form> 56 62 </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 */ 2 fieldset { 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 1 74 body { 2 75 background-color: #ffffff; 3 text-color: #000000;76 color: #000000; 4 77 font-family: helvetica; 5 78 margin: 0; … … 12 85 a:active { color:#cc0000; } /* selected link */ 13 86 14 tr.color0 { 87 table.center { 88 margin-left: auto; 89 margin-right: auto; 90 text-align: center; 91 } 92 93 /* Defs for bulk-data rows */ 94 tr.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 { 15 106 background-color: #A8C4D0; 16 107 font-family: Verdana, Arial, Helvetica, sans-serif; … … 18 109 } 19 110 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 111 hr.w60 { 112 width: 60%; 113 } 114 hr.w30 { 115 width: 30%; 116 } 117 118 /* legacy defs */ 32 119 tr.hack { 33 120 background-color: #E4EEE8; … … 48 135 } 49 136 137 td { 138 padding-right: 2px; 139 padding-left: 2px; 140 } 141 142 /* Generic classes */ 50 143 .indent { 51 144 margin-left: 5%; … … 64 157 } 65 158 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 66 178 .small { 67 179 font-size: 60%; … … 74 186 } 75 187 188 .err { 189 text-align: center; 190 font-size: 1em; 191 } 192 76 193 .red { 77 194 font-weight: bold; … … 88 205 background: #ffff00; 89 206 } 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.