Changeset 593 for branches/stable/cgi-bin
- Timestamp:
- 05/14/13 18:10:22 (12 years ago)
- Location:
- branches/stable
- Files:
-
- 1 deleted
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/stable
- Property svn:mergeinfo changed
/branches/htmlform (added) merged: 446-451,456-461,463-484,487-505,511-514,516 /trunk merged: 517
- Property svn:mergeinfo changed
-
branches/stable/cgi-bin/CustIDCK.pm
r445 r593 31 31 # the local admin on installation 32 32 sub custid_exist { 33 my $self = shift; 33 34 my $custid = shift; 34 35 -
branches/stable/cgi-bin/IPDB.pm
r592 r593 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'; … … 126 134 } 127 135 136 ##fixme: initialize HTML::Template env var for template path 137 # something like $self->path().'/templates' ? 138 # $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar'; 139 128 140 return (1,"OK"); 129 141 } # end initIPDBGlobals … … 174 186 sub finish { 175 187 my $dbh = $_[0]; 176 $dbh->disconnect ;188 $dbh->disconnect if $dbh; 177 189 } # end finish 178 190 … … 360 372 } 361 373 362 $sth = $dbh->prepare("update poolips set custid='$custid',". 363 "city='$city',available='n',description='$desc',notes='$notes',". 364 "circuitid='$circid',privdata='$privdata'". 365 " where ip='$cidr'"); 366 $sth->execute; 374 $sth = $dbh->prepare("update poolips set custid=?,city=?,". 375 "available='n',description=?,notes=?,circuitid=?,privdata=?". 376 " where ip=?"); 377 $sth->execute($custid, $city, $desc, $notes, $circid, $privdata, "$cidr"); 367 378 # node hack 368 379 if ($nodeid && $nodeid ne '') { … … 413 424 $sth = $dbh->prepare("insert into allocations". 414 425 " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)". 415 " values ('$cidr','$custid','$type','$city',?,?,". 416 $cidr->masklen.",?,?)"); 417 $sth->execute($desc,$notes,$circid,$privdata); 426 " values (?,?,?,?,?,?,?,?,?)"); 427 $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata); 418 428 419 429 # And initialize the pool, if necessary … … 527 537 $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,". 528 538 "description,notes,maskbits,circuitid,privdata)". 529 " values ('$cidr','$custid','$type','$city',?,?,". 530 $cidr->masklen.",?,?)"); 531 $sth->execute($desc,$notes,$circid,$privdata); 539 " values (?,?,?,?,?,?,?,?,?)"); 540 $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata); 532 541 533 542 # And initialize the pool, if necessary … … 653 662 eval { 654 663 $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr"; 655 $sth = $dbh->prepare("update poolips set custid= '$defcustid',available='y',".656 "city=(select city from allocations where cidr >>= '$cidr'".664 $sth = $dbh->prepare("update poolips set custid=?,available='y',". 665 "city=(select city from allocations where cidr >>= ?". 657 666 " order by masklen(cidr) desc limit 1),". 658 "description='',notes='',circuitid='' where ip= '$cidr'");659 $sth->execute ;667 "description='',notes='',circuitid='' where ip=?"); 668 $sth->execute($defcustid, "$cidr", "$cidr"); 660 669 $dbh->commit; 661 670 }; -
branches/stable/cgi-bin/MyIPDB.pm
r509 r593 23 23 my $dbhost = 'ipdb-db'; 24 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 = ''; 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 = ''; 28 28 29 29 # Set some globals declared in IPDB.pm. Most of these only affect mailNotify(). -
branches/stable/cgi-bin/admin.cgi
r592 r593 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="$IPDB::webpath/ipdb.css">\n). 57 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n). 58 "</head>\n<body>\n". 59 qq(Access to this tool is restricted. Contact the <a href="mailto:ipdbadmin\@example.com">IPDB administrator</a> \n). 60 "for more information.\n</body>\n</html>\n"; 80 my $page = HTML::Template->new(filename => "admin/aclerr.tmpl"); 81 ##fixme: need params for IPDB admin email and name 82 $page->param(ipdbadmin_email => 'ipdbadmin@example.com'); 83 $page->param(ipdbadmin_name => 'the IPDB administrator'); 84 print "Content-Type: text/html\n\n".$page->output; 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="$IPDB::webpath/ipdb.css">\n). 70 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n). 71 "</head>\n<body>\n". 72 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n"; 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 qq(<a href="$IPDB::webpath/cgi-bin/admin.cgi">Back</a> to main<hr>); 128 } 129 130 131 ## Possible actions. 132 if ($webvar{action} eq 'alloc') { 133 # OK, we know what we're allocating. 134 135 # if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 136 # printAndExit("Can't allocate something that's not a netblock/ip"); 137 # } 123 while (my ($cidr,$mtime) = $sth->fetchrow_array) { 124 my %row = ( 125 master => $cidr, 126 masterdate => $mtime 127 ); 128 push @masterlist, \%row; 129 } 130 $page->param(masterlist => \@masterlist); 131 132 } 133 134 ## Non-default actions. 135 136 elsif ($webvar{action} eq 'alloc') { 137 138 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 139 $page->param(errmsg => "Can't allocate something that's not a netblock/ip"); 140 goto ERRJUMP; 141 } 138 142 139 143 $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'"); … … 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('$IPDB::webpath/newcity.html')">Add new location</a> 216 </td> 217 </tr> 218 <tr class="color2"> 219 <td>Circuit ID:</td><td><input name=circid size=40></td> 220 </tr><tr class="color1"> 221 <td>Description/Name:</td><td><input name="desc" size=40></td> 222 </tr><tr class="color2"> 223 <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td> 224 </tr><tr class="warning"> 225 <td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td> 226 </tr><tr class="color2"> 227 <td class="center" colspan="2"><input type="submit" value=" Assign "></td> 228 <input type="hidden" name="action" value="confirm"> 229 </form> 230 </tr> 231 </table> 232 ); 233 204 my %row = (city => $city); 205 push @cities, \%row; 206 } 207 $page->param( 208 cidr => $cidr, 209 disptype => $disp_alloctypes{$webvar{alloctype}}, 210 type => $webvar{alloctype}, 211 alloc_from => $alloc_from, 212 custid => $custid, 213 citylist => \@cities 214 ); 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="$IPDB::webpath/">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 -
branches/stable/cgi-bin/allocate.pl
r445 r593 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); -
branches/stable/cgi-bin/combineblocks.pl
r445 r593 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; -
branches/stable/cgi-bin/main.cgi
r592 r593 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('', $IPDB::webpath, ($IPDBacl{$authuser} =~ /a/ ? 53 '<td align=right><a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=assign">Add new assignment</a>' : '' 54 )); 55 56 57 # Global variables 58 my %webvar = parse_post(); 59 cleanInput(\%webvar); 66 $webvar{action} = "dberr"; 67 } else { 68 initIPDBGlobals($ip_dbh); 69 } 70 71 # Set up some globals 72 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 73 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 my $html = join('',<HTML>);76 close HTML;77 $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;78 print $html;79 }80 } elsif ($webvar{action} eq 'newmaster') {81 82 if ($IPDBacl{$authuser} !~ /a/) {83 printError("You shouldn't have been able to get here. Access denied.");84 } else {85 86 108 my $cidr = new NetAddr::IP $webvar{cidr}; 87 88 print "<div type=heading align=center>Adding $cidr as master block....</div>\n"; 109 $page->param(cidr => "$cidr"); 89 110 90 111 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}); 91 112 92 113 if ($code eq 'FAIL') { 93 carp "Transaction aborted because $msg";94 114 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'"; 95 printError("Could not add master block $webvar{cidr} to database: $msg");115 $page->param(err => $msg); 96 116 } else { 97 print "<div type=heading align=center>Success!</div>\n";98 117 syslog "info", "$authuser added master block $webvar{cidr}"; 99 118 } … … 136 155 } 137 156 elsif ($webvar{action} eq 'nodesearch') { 138 open HTML, "<../nodesearch.html";139 my $html = join('',<HTML>);140 close HTML;141 $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;142 143 157 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 144 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";145 my $nodes = '';158 $sth->execute() or $page->param(errmsg => $sth->errstr); 159 my @nodelist; 146 160 while (my ($nid,$nname) = $sth->fetchrow_array()) { 147 $nodes .= "<option value='$nid'>$nname</option>\n"; 148 } 149 $html =~ s/\$\$NODELIST\$\$/$nodes/; 150 151 print $html; 152 } 153 154 # Default is an error. It shouldn't be possible to easily get here. 155 # The only way I can think of offhand is to just call main.cgi bare- 156 # which is not in any way guaranteed to provide anything useful. 161 my %row = (nodeid => $nid, nodename => $nname); 162 push @nodelist, \%row; 163 } 164 $page->param(nodelist => \@nodelist); 165 } 166 167 # DB failure. Can't do much here, really. 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}. 157 174 else { 158 175 my $rnd = rand 500; 159 176 my $boing = sprintf("%.2f", rand 500); 160 my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.", 161 "Because one of it's legs are both the same", "*wibble*", 162 "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9", 163 "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"); 164 printAndExit("Error $boing: ".$excuses[$rnd/30.0]); 177 my @excuses = ( 178 "Aether cloudy. Ask again later about $webvar{action}.", 179 "The gods are unhappy with your sacrificial $webvar{action}.", 180 "Because one of $webvar{action}'s legs are both the same", 181 "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!", 182 "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....", 183 "I ain't done $webvar{action}", 184 "Oooo, look! A flying $webvar{action}!", 185 "$webvar{action} too evil, avoiding.", 186 "Rocks fall, $webvar{action} dies.", 187 "Bit bucket must be emptied before I can $webvar{action}..." 188 ); 189 $page->param(dunno => $excuses[$rnd/50.0]); 165 190 } 166 191 ## Finally! Done with that NASTY "case" emulation! 167 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 } 168 202 169 203 … … 171 205 finish($ip_dbh); 172 206 173 print qq(<div align=right style="position: absolute; right: 30px;">). 174 qq(<a href="$IPDB::webpath/cgi-bin/admin.cgi">Admin tools</a></div><br>\n) 175 if $IPDBacl{$authuser} =~ /A/; 176 177 # We print the footer here, so we don't have to do it elsewhere. 178 printFooter; 207 ## Do all our printing here so we can generate errors and stick them into the slots in the templates. 208 209 # can't do this yet, too many blowups 210 #print "Content-type: text/html\n\n", $header->output; 211 $page->param(webpath => $IPDB::webpath); 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 179 219 # Just in case something waaaayyy down isn't in place 180 220 # properly... we exit explicitly. 181 exit; 182 183 184 185 # args are: a reference to an array with the row to be printed and the 186 # class(stylesheet) to use for formatting. 187 # if ommitting the class - call the sub as &printRow(\@array) 188 sub printRow { 189 my ($rowRef,$class) = @_; 190 191 if (!$class) { 192 print "<tr>\n"; 193 } else { 194 print "<tr class=\"$class\">\n"; 195 } 196 197 ELEMENT: foreach my $element (@$rowRef) { 198 if (!defined($element)) { 199 print "<td></td>\n"; 200 next ELEMENT; 201 } 202 $element =~ s|\n|</br>|g; 203 print "<td>$element</td>\n"; 204 } 205 print "</tr>"; 206 } # printRow 207 208 209 # Prints table headings. Accepts any number of arguments; 210 # each argument is a table heading. 211 sub startTable { 212 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>); 213 214 foreach(@_) { 215 print qq(<td class="heading">$_</td>); 216 } 217 print "</tr>\n"; 218 } # startTable 221 exit 0; 219 222 220 223 221 224 # Initial display: Show master blocks with total allocated subnets, total free subnets 222 225 sub showSummary { 223 224 startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',225 'Free netblocks', 'Largest free block');226 227 226 my %allocated; 228 227 my %free; … … 264 263 } 265 264 266 # Print the data. 267 my $count=0; 265 # Assemble the data to stuff into the template. 266 my @masterlist; 267 my $rowclass=0; 268 268 foreach my $master (@masterblocks) { 269 my @row = ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>", 270 $routed{"$master"}, $allocated{"$master"}, $free{"$master"}, 271 ( ($bigfree{"$master"} eq '') ? ("<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"}) ) 272 276 ); 273 274 printRow(\@row, 'color1' ) if($count%2==0); 275 printRow(\@row, 'color2' ) if($count%2!=0); 276 $count++; 277 } 278 print "</table>\n"; 279 if ($IPDBacl{$authuser} =~ /a/) { 280 print qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n); 281 } 282 print "Note: Free blocks noted here include both routed and unrouted blocks.\n"; 277 push (@masterlist, \%row); 278 } 279 $page->param(masterlist => \@masterlist); 280 281 $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) ); 283 282 284 283 } # showSummary … … 292 291 sub showMaster { 293 292 294 print qq(<center><div class="heading">Summarizing routed blocks for ). 295 qq($webvar{block}:</div></center><br>\n); 293 $page->param(master => $webvar{block}); 296 294 297 295 my %allocated; 298 296 my %free; 299 my % routed;297 my %cities; 300 298 my %bigfree; 301 299 … … 315 313 $bigfree{"$cidr"} = 128; 316 314 # Retain the routing destination 317 $ routed{"$cidr"} = $data[1];315 $cities{"$cidr"} = $data[1]; 318 316 } 319 317 320 318 # Check if there were actually any blocks routed from this master 321 319 if ($i > 0) { 322 startTable('Routed block','Routed to','Allocated blocks',323 'Free blocks','Largest free block');324 320 325 321 # Count the allocations … … 349 345 } 350 346 351 # Print the data.352 my $ count=0;347 my @routed; 348 my $rowclass = 0; 353 349 foreach my $master (@localmasters) { 354 my @row = ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>", 355 $routed{"$master"}, $allocated{"$master"}, 356 $free{"$master"}, 357 ( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 358 ); 359 printRow(\@row, 'color1' ) if($count%2==0); 360 printRow(\@row, 'color2' ) if($count%2!=0); 361 $count++; 362 } 363 } else { 364 # If a master block has no routed blocks, then by definition it has no 365 # allocations, and can be deleted. 366 print qq(<hr width="60%"><center><div class="heading">No allocations in ). 367 qq($master.</div>\n). 368 ($IPDBacl{$authuser} =~ /d/ ? 369 qq(<form action="$IPDB::webpath/cgi-bin/main.cgi" method=POST>\n). 370 qq(<input type=hidden name=action value="delete">\n). 371 qq(<input type=hidden name=block value="$master">\n). 372 qq(<input type=hidden name=alloctype value="mm">\n). 373 qq(<input type=submit value=" Remove this master ">\n). 374 qq(</form></center>\n) : 375 ''); 350 my %row = ( 351 rowclass => $rowclass++ % 2, 352 block => "$master", 353 city => $cities{"$master"}, 354 nsubs => $allocated{"$master"}, 355 nfree => $free{"$master"}, 356 lfree => ( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 357 ); 358 push @routed, \%row; 359 } 360 $page->param(routedlist => \@routed); 376 361 377 362 } # end check for existence of routed blocks in master 378 363 379 print qq(</table>\n<hr width="60%">\n). 380 qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n); 381 382 startTable('Netblock','Range'); 364 $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/)); 383 365 384 366 # Snag the free blocks. … … 387 369 "routed='n' order by cidr"); 388 370 $sth->execute(); 371 my @unrouted; 372 my $rowclass = 0; 389 373 while (my @data = $sth->fetchrow_array()) { 390 374 my $cidr = new NetAddr::IP $data[0]; 391 my @row = ( 392 ($IPDBacl{$authuser} =~ /a/ ? 393 qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=n">$cidr</a>) 394 : $cidr), 395 $cidr->range); 396 printRow(\@row, 'color1' ) if($count%2==0); 397 printRow(\@row, 'color2' ) if($count%2!=0); 398 $count++; 399 } 400 401 print "</table>\n"; 375 my %row = ( 376 rowclass => $rowclass++ % 2, 377 fblock => "$cidr", 378 frange => $cidr->range 379 ); 380 push @unrouted, \%row; 381 } 382 $page->param(unrouted => \@unrouted); 383 402 384 } # showMaster 403 385 … … 416 398 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'"); 417 399 $sth->execute; 418 my @data = $sth->fetchrow_array; 419 420 print qq(<center><div class="heading">Summarizing allocated blocks for ). 421 qq($master ($data[0]):</div></center><br>\n); 422 423 startTable('CIDR allocation','Customer Location','Type','CustID','SWIPed?','Description/Name'); 400 my ($rcity) = $sth->fetchrow_array; 401 402 $page->param(master => "$master"); 403 $page->param(rcity => $rcity); 424 404 425 405 # Snag the allocations for this block … … 432 412 my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?"); 433 413 434 my $count=0; 435 while (my @data = $sth->fetchrow_array()) { 436 # cidr,city,type,custid,swip,description, as per the SELECT 437 my $cidr = new NetAddr::IP $data[0]; 438 439 # Clean up extra spaces that are borking things. 440 # $data[2] =~ s/\s+//g; 441 442 $custsth->execute($data[3]); 414 my $rowclass = 0; 415 my @blocklist; 416 while (my ($cidr,$city,$type,$custid,$swip,$desc) = $sth->fetchrow_array()) { 417 $custsth->execute($custid); 443 418 my ($ncust) = $custsth->fetchrow_array(); 444 419 445 # Prefix subblocks with "Sub " 446 my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : ''). 447 qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]&reallyblock=1">$data[0]</a>), 448 $data[1], $disp_alloctypes{$data[2]}, $data[3], 449 ($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), $data[5]); 450 # If the allocation is a pool, allow listing of the IPs in the pool. 451 if ($data[2] =~ /^.[pd]$/) { 452 $row[0] .= qq( <a href="$IPDB::webpath/cgi-bin/main.cgi?action=listpool). 453 "&pool=$data[0]\">List IPs</a>"; 454 } 455 456 printRow(\@row, 'color1') if ($count%2 == 0); 457 printRow(\@row, 'color2') if ($count%2 != 0); 458 $count++; 459 } 460 461 print "</table>\n"; 462 463 # If the routed block has no allocations, by definition it only has 464 # one free block, and therefore may be deleted. 465 if ($count == 0) { 466 print qq(<hr width="60%"><center><div class="heading">No allocations in ). 467 qq($master.</div></center>\n). 468 ($IPDBacl{$authuser} =~ /d/ ? 469 qq(<form action="$IPDB::webpath/cgi-bin/main.cgi" method=POST>\n). 470 qq(<input type=hidden name=action value="delete">\n). 471 qq(<input type=hidden name=block value="$master">\n). 472 qq(<input type=hidden name=alloctype value="rm">\n). 473 qq(<input type=submit value=" Remove this block ">\n). 474 qq(</form>\n) : 475 ''); 476 } 477 478 print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ). 479 qq(submaster $master</div></center>\n); 480 481 startTable('CIDR block','Range'); 420 my %row = ( 421 rowclass => $rowclass++ % 2, 422 block => $cidr, 423 city => $city, 424 type => $disp_alloctypes{$type}, 425 custid => $custid, 426 swip => ($swip eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), 427 desc => $desc 428 ); 429 $row{subblock} = ($type =~ /^.r$/); # hmf. wonder why these won't work in the hash declaration... 430 $row{listpool} = ($type =~ /^.[pd]$/); 431 push (@blocklist, \%row); 432 } 433 $page->param(blocklist => \@blocklist); 434 435 $page->param(delrouted => $IPDBacl{$authuser} =~ /d/); 482 436 483 437 # Snag the free blocks. We don't really *need* to be pedantic about avoiding 484 438 # unrouted free blocks, but it's better to let the database do the work if we can. 485 $count = 0; 439 $rowclass = 0; 440 my @unassigned; 486 441 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'". 487 442 " order by cidr"); 488 443 $sth->execute(); 489 while (my @data = $sth->fetchrow_array()) { 490 # cidr,routed 491 my $cidr = new NetAddr::IP $data[0]; 492 # Include some HairyPerl(TM) to prefix subblocks with "Sub " 493 my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : ''). 494 ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr), 495 $cidr->range); 496 printRow(\@row, 'color1') if ($count%2 == 0); 497 printRow(\@row, 'color2') if ($count%2 != 0); 498 $count++; 499 } 500 501 print "</table>\n"; 444 while (my ($cidr_db,$routed) = $sth->fetchrow_array()) { 445 my $cidr = new NetAddr::IP $cidr_db; 446 447 my %row = ( 448 rowclass => $rowclass++ % 2, 449 subblock => ($routed ne 'y' && $routed ne 'n'), 450 fblock => $cidr_db, 451 fbtype => $routed, 452 frange => $cidr->range, 453 ); 454 push @unassigned, \%row; 455 } 456 $page->param(unassigned => \@unassigned); 457 502 458 } # showRBlock 503 459 … … 508 464 my $cidr = new NetAddr::IP $webvar{pool}; 509 465 510 my ($pooltype,$poolcity); 466 $page->param(block => $webvar{pool}); 467 $page->param(netip => $cidr->addr); 468 $cidr++; 469 $page->param(gate => $cidr->addr); 470 $cidr--; $cidr--; 471 $page->param(bcast => $cidr->addr); 472 $page->param(mask => $cidr->mask); 511 473 512 474 # Snag pool info for heading 513 $sth = $ip_dbh->prepare("select type,city from allocations where cidr= '$cidr'");514 $sth->execute ;515 $sth->bind_columns(\$pooltype, \$poolcity);516 $sth->fetch() || carp $sth->errstr; 517 518 print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).519 qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n); 475 $sth = $ip_dbh->prepare("select type,city from allocations where cidr=?"); 476 $sth->execute($webvar{pool}); 477 my ($pooltype, $poolcity) = $sth->fetchrow_array; 478 479 $page->param(disptype => $disp_alloctypes{$pooltype}); 480 $page->param(city => $poolcity); 481 520 482 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy 521 if ($pooltype =~ /^.d$/) { 522 print qq(<div class="indent"><b>Reserved IPs:</b><br>\n); 523 print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>). 524 $cidr->addr."</td></tr>\n"; 525 $cidr++; 526 print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n"; 527 $cidr--; $cidr--; 528 print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n". 529 "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n". 530 "</table></div></div>\n"; 531 } 483 $page->param(realblock => $pooltype =~ /^.d$/); 532 484 533 485 # probably have to add an "edit IP allocation" link here somewhere. 534 486 535 startTable('IP','Customer ID','Available?','Description','');536 487 $sth = $ip_dbh->prepare("select ip,custid,available,description,type". 537 488 " from poolips where pool='$webvar{pool}' order by ip"); 538 489 $sth->execute; 539 my $count = 0; 540 while (my @data = $sth->fetchrow_array) { 541 # pool,ip,custid,city,ptype,available,notes,description,circuitid 542 # ip,custid,available,description,type 543 # If desc is "null", make it not null. <g> 544 if ($data[3] eq '') { 545 $data[3] = ' '; 546 } 547 # Some nice hairy Perl to decide whether to allow unassigning each IP 548 # -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link 549 # else we print a blank space 550 my @row; 551 if ($data[2] eq 'y' && $IPDBacl{$authuser} =~ /a/) { 552 push @row, qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=assign&block=$data[0]&fbtype=i">$data[0]</a>); 553 } else { 554 push @row, qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>); 555 } 556 push @row, ( 557 $data[1],$data[2],$data[3], 558 ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ? 559 ("<a href=\"$IPDB::webpath/cgi-bin/main.cgi?action=delete&block=$data[0]&". 560 "alloctype=$data[4]\">Unassign this IP</a>") : 561 (" ") ) 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' 562 501 ); 563 printRow(\@row, 'color1') if($count%2==0); 564 printRow(\@row, 'color2') if($count%2!=0); 565 $count++; 566 } 567 print "</table>\n"; 502 push @poolips, \%row; 503 } 504 $page->param(poolips => \@poolips); 568 505 569 506 } # end listPool … … 575 512 576 513 if ($IPDBacl{$authuser} !~ /a/) { 577 printError("You shouldn't have been able to get here. Access denied.");514 $aclerr = 'addblock'; 578 515 return; 579 516 } 580 517 581 my $html; 518 # hack pthbttt eww 519 $webvar{block} = '' if !$webvar{block}; 520 521 # hmm. TMPL_IF block and TMPL_ELSE block on these instead? 522 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0)); 523 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1)); 524 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign 525 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y')); 582 526 583 527 # New special case- block to assign is specified 584 528 if ($webvar{block} ne '') { 585 open HTML, "../fb-assign.html"586 or croak "Could not open fb-assign.html: $!";587 $html = join('',<HTML>);588 close HTML;589 529 my $block = new NetAddr::IP $webvar{block}; 590 530 591 my $typelist = ''; 592 593 $html =~ s|\$\$WEBPATH\$\$|$IPDB::webpath|g; 594 if ($IPDB::allowprivrange eq 'y' or $IPDB::allowprivrange eq 'on') { 595 $html =~ s/\$\$ALLOWPRIV\$\$/checked=checked/; 596 } else { 597 $html =~ s/\$\$ALLOWPRIV\$\$//; 598 } 599 531 # Handle contained freeblock allocation. 600 532 # This is a little dangerous, as it's *theoretically* possible to 601 533 # get fbtype='n' (aka a non-routed freeblock). However, should 602 534 # someone manage to get there, they get what they deserve. 603 # if ($webvar{fbtype} ne 'y') { 604 # # Snag the type of the block from the database. We have no 605 # # convenient way to pass this in from the calling location. :/ 606 # $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'"); 607 # $sth->execute; 608 # my @data = $sth->fetchrow_array; 609 # $data[0] =~ s/c$/r/; # Munge the type into the correct form 610 # $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n"; 611 # } else { 612 if ($webvar{fbtype} eq 'n') { 613 $typelist = "Routed netblock<input type=hidden name=alloctype value=rm>\n"; 614 $html =~ s|\$\$ALLOCBLOCK\$\$|<input name=block size=25 value="$block">|; 615 $html =~ s|\$\$BLOCK\$\$|$block|g; 616 } elsif ($webvar{fbtype} eq 'i') { 617 my ($iptype,$pool) = $ip_dbh->selectrow_array("SELECT type,pool FROM poolips WHERE ip = ?", undef, ($block)); 618 $typelist = "$list_alloctypes{$iptype}<input type=hidden name=alloctype value=$iptype>\n"; 619 $html =~ s|\$\$ALLOCBLOCK\$\$|$block<input type=hidden name=block size=25 value="$block">|; 620 $html =~ s|\$\$BLOCK\$\$|$pool|g; 621 } else { 622 $html =~ s|\$\$ALLOCBLOCK\$\$|<input name=block size=25 value="$block">|; 623 $html =~ s|\$\$BLOCK\$\$|$block|g; 624 $typelist .= qq(<select name="alloctype">\n); 535 if ($webvar{fbtype} ne 'y') { 536 # Snag the type of the container block from the database. 537 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'"); 538 $sth->execute; 539 my @data = $sth->fetchrow_array; 540 $data[0] =~ s/c$/r/; # Munge the type into the correct form 541 $page->param(fbdisptype => $list_alloctypes{$data[0]}); 542 $page->param(type => $data[0]); 543 } else { 625 544 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ". 626 545 "and type not like '_i' order by listorder"); 627 546 $sth->execute; 628 my @data = $sth->fetchrow_array; 629 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n"; 630 while (@data = $sth->fetchrow_array) { 631 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 547 my @typelist; 548 my $selflag = 0; 549 while (my @data = $sth->fetchrow_array) { 550 my %row = (tval => $data[0], 551 type => $data[1], 552 sel => ($selflag == 0 ? ' selected' : '') 553 ); 554 push (@typelist, \%row); 555 $selflag++; 632 556 } 633 $typelist .= "</select>\n"; 634 } 635 $html =~ s|\$\$TYPELIST\$\$|$typelist|g; 557 $page->param(typelist => \@typelist); 558 } 636 559 } else { 637 open HTML, "../assign.html" 638 or croak "Could not open assign.html: $!"; 639 $html = join('',<HTML>); 640 close HTML; 641 $html =~ s|\$\$WEBPATH\$\$|$IPDB::webpath|g; 642 if ($IPDB::allowprivrange eq 'y' or $IPDB::allowprivrange eq 'on') { 643 $html =~ s/\$\$ALLOWPRIV\$\$/checked=checked/; 644 } else { 645 $html =~ s/\$\$ALLOWPRIV\$\$//; 646 } 647 my $masterlist = "<select name=allocfrom><option selected>-</option>\n"; 560 my @masterlist; 648 561 foreach my $master (@masterblocks) { 649 $masterlist .= "<option>$master</option>\n"; 650 } 651 $masterlist .= "</select>\n"; 652 $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g; 653 my $pops = ''; 562 my %row = (master => "$master"); 563 push (@masterlist, \%row); 564 } 565 $page->param(masterlist => \@masterlist); 566 567 my @pops; 654 568 foreach my $pop (@poplist) { 655 $pops .= "<option>$pop</option>\n"; 656 } 657 $html =~ s|\$\$POPLIST\$\$|$pops|g; 658 my $typelist = ''; 659 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 569 my %row = (pop => $pop); 570 push (@pops, \%row); 571 } 572 $page->param(pops => \@pops); 573 574 # could arguably include routing (500) in the list, but ATM it doesn't 575 # make sense, and in any case that shouldn't be structurally possible here. 576 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder"); 660 577 $sth->execute; 661 my @ data = $sth->fetchrow_array;662 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";578 my @typelist; 579 my $selflag = 0; 663 580 while (my @data = $sth->fetchrow_array) { 664 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 665 } 666 $html =~ s|\$\$TYPELIST\$\$|$typelist|g; 667 } 668 my $cities = ''; 581 my %row = (tval => $data[0], 582 type => $data[1], 583 sel => ($selflag == 0 ? ' selected' : '') 584 ); 585 push (@typelist, \%row); 586 $selflag++; 587 } 588 $page->param(typelist => \@typelist); 589 } 590 591 my @cities; 669 592 foreach my $city (@citylist) { 670 $cities .= "<option>$city</option>\n"; 671 } 672 $html =~ s|\$\$ALLCITIES\$\$|$cities|g; 593 my %row = (city => $city); 594 push (@cities, \%row); 595 } 596 $page->param(citylist => \@cities); 673 597 674 598 ## node hack 675 599 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 676 600 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n"; 677 my $nodes = '';601 my @nodes; 678 602 while (my ($nid,$nname) = $sth->fetchrow_array()) { 679 $nodes .= "<option value='$nid'>$nname</option>\n"; 680 } 681 $html =~ s/\$\$NODELIST\$\$/$nodes/; 603 my %row = (nid => $nid, nname => $nname); 604 push (@nodes, \%row); 605 } 606 $page->param(nodelist => \@nodes); 682 607 ## end node hack 683 608 684 my $i = 0; 685 $i++ if $webvar{fbtype} eq 'y'; 686 # Check to see if user is allowed to do anything with sensitive data 687 my $privdata = ''; 688 if ($IPDBacl{$authuser} =~ /s/) { 689 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 690 qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">). 691 qq(</textarea></td></tr>\n); 692 $i++; 693 } 694 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 695 696 $i = $i % 2; 697 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 698 699 print $html; 609 $page->param(privdata => $IPDBacl{$authuser} =~ /s/); 700 610 701 611 } # assignBlock … … 705 615 sub confirmAssign { 706 616 if ($IPDBacl{$authuser} !~ /a/) { 707 printError("You shouldn't have been able to get here. Access denied.");617 $aclerr = 'addblock'; 708 618 return; 709 619 } … … 731 641 $sth->execute; 732 642 my $optionlist; 733 while (my @data = $sth->fetchrow_array) { 643 644 my @poollist; 645 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) { 734 646 # city,pool cidr,free IP count 735 if ($data[2] > 0) { 736 $optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n"; 647 if ($poolfree > 0) { 648 my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree); 649 push (@poollist, \%row); 737 650 } 738 651 } 652 $page->param(staticip => 1); 653 $page->param(poollist => \@poollist); 739 654 $cidr = "Single static IP"; 740 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n"; 655 ##fixme: need to handle "no available pools" 741 656 742 657 } else { # end show pool options … … 751 666 752 667 if (!$webvar{maskbits}) { 753 printError("Please specify a CIDR mask length.");668 $page->param(err => "Please specify a CIDR mask length."); 754 669 return; 755 670 } … … 789 704 " block size for the pool."; 790 705 } else { 706 if (!$webvar{pop}) { 707 $page->param(err => 'Please select a POP to route the block from/through.'); 708 return; 709 } 791 710 $city = $webvar{pop}; 792 711 $failmsg = "No suitable free block found.<br>\nYou will have to route another". … … 810 729 my @data = $sth->fetchrow_array(); 811 730 if ($data[0] eq "") { 812 printError($failmsg);731 $page->param(err => $failmsg); 813 732 return; 814 733 } … … 829 748 } # check for freeblocks assignment or IPDB-controlled assignment 830 749 750 $alloc_from = "$cidr"; 831 751 832 752 } # if ($webvar{alloctype} =~ /^.i$/) 833 834 open HTML, "../confirm.html"835 or croak "Could not open confirm.html: $!";836 my $html = join '', <HTML>;837 close HTML;838 753 839 754 ## node hack … … 842 757 $sth->execute($webvar{node}); 843 758 my ($nodename) = $sth->fetchrow_array(); 844 $html =~ s/\$\$NODENAME\$\$/$nodename/; 845 $html =~ s/\$\$NODEID\$\$/$webvar{node}/; 846 } else { 847 $html =~ s/\$\$NODENAME\$\$//; 848 $html =~ s/\$\$NODEID\$\$//; 759 $page->param(nodename => $nodename); 760 $page->param(nodeid => $webvar{node}); 849 761 } 850 762 ## end node hack 851 763 852 ### gotta fix this in final853 # Stick in customer info as necessary - if it's blank, it just ends854 # up as blank lines ignored in the rendering of the page855 my $custbits;856 $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;857 ###858 859 764 # Stick in the allocation data 860 $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g; 861 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g; 862 $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g; 863 $html =~ s|\$\$CIDR\$\$|$cidr|g; 864 $webvar{city} = desanitize($webvar{city}); 865 $html =~ s|\$\$CITY\$\$|$webvar{city}|g; 866 $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g; 867 $webvar{circid} = desanitize($webvar{circid}); 868 $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g; 869 $webvar{desc} = desanitize($webvar{desc}); 870 $html =~ s|\$\$DESC\$\$|$webvar{desc}|g; 871 $webvar{notes} = desanitize($webvar{notes}); 872 $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g; 873 $html =~ s|\$\$ACTION\$\$|insert|g; 874 875 my $i=1; 765 $page->param(alloc_type => $webvar{alloctype}); 766 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}})); 767 $page->param(alloc_from => $alloc_from); 768 $page->param(cidr => $cidr); 769 $page->param(city => $q->escapeHTML($webvar{city})); 770 $page->param(custid => $webvar{custid}); 771 $page->param(circid => $q->escapeHTML($webvar{circid})); 772 $page->param(desc => $q->escapeHTML($webvar{desc})); 773 774 ##fixme: find a way to have the displayed copy have <br> substitutions 775 # for newlines, and the <input> value have either encoded or bare newlines. 776 # Also applies to privdata. 777 $page->param(notes => $q->escapeHTML($webvar{notes},'y')); 778 876 779 # Check to see if user is allowed to do anything with sensitive data 877 780 my $privdata = ''; 878 if ($IPDBacl{$authuser} =~ /s/) { 879 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 880 qq(<td class=regular>$webvar{privdata}). 881 qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n); 882 $i++; 883 } 884 # We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing. 885 $privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n" 781 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y')) 782 if $IPDBacl{$authuser} =~ /s/; 783 784 # Yay! This now has it's very own little home. 785 $page->param(billinguser => $webvar{userid}) 886 786 if $webvar{userid}; 887 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 888 889 $i = $i % 2; 890 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 891 892 print $html; 787 788 ##fixme: this is only needed iff confirm.tmpl and 789 # confirmRemove.tmpl are merged (quite possible, just 790 # a little tedious) 791 $page->param(action => "insert"); 893 792 894 793 } # end confirmAssign … … 898 797 sub insertAssign { 899 798 if ($IPDBacl{$authuser} !~ /a/) { 900 printError("You shouldn't have been able to get here. Access denied.");799 $aclerr = 'addblock'; 901 800 return; 902 801 } … … 910 809 # successful netblock allocation, the IP allocated for static 911 810 # IP, or the error message if an error occurred. 811 912 812 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from}, 913 813 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes}, … … 917 817 if ($webvar{alloctype} =~ /^.i$/) { 918 818 $msg =~ s|/32||; 919 print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>). 920 ( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ? 921 qq(<div><a href="https://billing.example.com/radius.pl?). 922 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}". 923 qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>) 924 : "</div>"); 819 $page->param(staticip => $msg); 820 $page->param(custid => $webvar{custid}); 821 $page->param(billinguser => $webvar{billinguser}); 925 822 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 926 823 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n". … … 928 825 } else { 929 826 my $netblock = new NetAddr::IP $webvar{fullcidr}; 930 if ($code eq 'OK') { 931 print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ). 932 "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>"; 933 } else { 934 print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ). 935 " added as $disp_alloctypes{$webvar{alloctype}} with a warning:<br>$msg</div>"; 827 $page->param(fullcidr => $webvar{fullcidr}); 828 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}}); 829 $page->param(custid => $webvar{custid}); 830 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) { 831 $page->param(billinguser => $webvar{billinguser}); 832 $page->param(custid => $webvar{custid}); 833 $page->param(netaddr => $netblock->addr); 834 $page->param(masklen => $netblock->masklen); 936 835 } 937 print ( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ?938 qq(<div><a href="https://billing.example.com/radius.pl?).939 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".940 "&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.941 "&include_routed_subnet=1&ipdb=1".942 qq(">Add this netblock to RADIUS user table</a></div>)943 : "</div>");944 836 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 945 837 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n". … … 951 843 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ". 952 844 "'$webvar{alloctype}' by $authuser failed: '$msg'"; 953 printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".845 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'". 954 846 " failed:<br>\n$msg\n"); 955 847 } … … 963 855 sub validateInput { 964 856 if ($webvar{city} eq '-') { 965 printError("Please choose a city.");857 $page->param(err => 'Please choose a city'); 966 858 return; 967 859 } … … 972 864 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone 973 865 # managing to call things in such a way as to cause this deserves a cryptic error. 974 printError("Invalid alloctype");866 $page->param(err => 'Invalid alloctype'); 975 867 return; 976 868 } … … 980 872 if ($def_custids{$webvar{alloctype}} eq '') { 981 873 if (!$webvar{custid}) { 982 printError("Please enter a customer ID.");874 $page->param(err => 'Please enter a customer ID.'); 983 875 return; 984 876 } … … 989 881 my $status = CustIDCK->custid_exist($webvar{custid}); 990 882 if ($CustIDCK::Error) { 991 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);883 $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg); 992 884 return; 993 885 } 994 886 if (!$status) { 995 printError("Customer ID not valid. Make sure the Customer ID ".887 $page->param(err => "Customer ID not valid. Make sure the Customer ID ". 996 888 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 997 889 "non-customer assignments."); … … 1025 917 } 1026 918 } 919 920 # if the alloctype has a restricted city/POP list as determined above, 921 # and the reqested city/POP does not match that list, complain 1027 922 if ($flag ne 'n') { 1028 printError("Please choose a valid POP location $flag. Valid ".923 $page->param(err => "Please choose a valid POP location $flag. Valid ". 1029 924 "POP locations are currently:<br>\n".join (" - ", @poplist)); 1030 925 return; … … 1044 939 # Two cases: block is a netblock, or block is a static IP from a pool 1045 940 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data 1046 if ($webvar{block} =~ /\/32$/ && !$webvar{reallyblock}) { 941 ##fixme: allow "SWIP" (publication to rWHOIS) of static IP data 942 if ($webvar{block} =~ /\/32$/) { 1047 943 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'"; 1048 944 } else { … … 1057 953 # Clean up extra whitespace on alloc type 1058 954 $data[2] =~ s/\s//; 1059 1060 open (HTML, "../editDisplay.html")1061 or croak "Could not open editDisplay.html :$!";1062 my $html = join('', <HTML>);1063 955 1064 956 # We can't let the city be changed here; this block is a part of … … 1067 959 ##fixme 1068 960 # Needs thinking. Have to allow changes to city to correct errors, no? 1069 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g; 1070 1071 if ($IPDBacl{$authuser} =~ /c/) { 1072 $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/; 1073 1074 # Screw it. Changing allocation types gets very ugly VERY quickly- especially 1075 # with the much longer list of allocation types. 1076 # We'll just show what type of block it is. 1077 1078 # this has now been Requested, so here goes. 961 # Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads 962 963 # @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip 964 965 $page->param(block => $webvar{block}); 966 967 $page->param(custid => $data[1]); 968 $page->param(city => $data[3]); 969 $page->param(circid => $data[4]); 970 $page->param(desc => $data[5]); 971 $page->param(notes => $data[6]); 1079 972 1080 973 ##fixme The check here should be built from the database 1081 if ($data[2] =~ /^.[ne]$/) { 1082 # Block that can be changed 1083 my $blockoptions = "<select name=alloctype><option". 1084 (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option". 1085 (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option". 1086 (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option". 1087 (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option". 1088 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option". 1089 (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option". 1090 (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n". 1091 "</select>\n"; 1092 $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g; 1093 } else { 1094 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g; 1095 } 974 # Need to expand to support pool types too 975 if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) { 976 $page->param(changetype => 1); 977 $page->param(alloctype => [ 978 { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" }, 979 { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" }, 980 { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" }, 981 { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" }, 982 { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" }, 983 { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" }, 984 { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" }, 985 ] 986 ); 987 } else { 988 $page->param(disptype => $disp_alloctypes{$data[2]}); 989 $page->param(type => $data[2]); 990 } 991 1096 992 ## node hack 1097 $sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'"); 993 $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef". 994 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'"); 1098 995 $sth->execute; 1099 my ($nodeid ) = $sth->fetchrow_array();1100 if ($nodeid) {1101 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 1102 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";1103 my $nodes = "<select name=node>\n";1104 while (my ($nid,$nname) = $sth->fetchrow_array()) {1105 $nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n"; 1106 } 1107 $nodes .= "</select>\n"; 1108 $html =~ s/\$\$NODE\$\$/$nodes/; 1109 } else { 1110 if ($ data[2] eq 'fr' || $data[2] eq 'bi') {996 my ($nodeid,$nodename) = $sth->fetchrow_array(); 997 $page->param(havenodeid => $nodeid); 998 999 if ($data[2] eq 'fr' || $data[2] eq 'bi') { 1000 $page->param(typesupportsnodes => 1); 1001 $page->param(nodename => $nodename); 1002 1003 ##fixme: this whole hack needs cleanup and generalization for all alloctypes 1004 ##fixme: arguably a bug that presence of a nodeid implies it can be changed.. 1005 # but except for manual database changes, only the two types fr and bi can 1006 # (currently) have a nodeid set in the first place. 1007 if ($IPDBacl{$authuser} =~ /c/) { 1111 1008 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 1112 $sth->execute () or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";1113 my $nodes = "<select name=node>\n<option value=>--</option>\n";1009 $sth->execute; 1010 my @nodelist; 1114 1011 while (my ($nid,$nname) = $sth->fetchrow_array()) { 1115 $nodes .= "<option value='$nid'>$nname</option>\n"; 1012 my %row = ( 1013 selme => ($nodeid == $nid), 1014 nodeid => $nid, 1015 nodename => $nname, 1016 ); 1017 push (@nodelist, \%row); 1116 1018 } 1117 $nodes .= "</select>\n"; 1118 $html =~ s/\$\$NODE\$\$/$nodes/; 1119 } else { 1120 $html =~ s|\$\$NODE\$\$|N/A|; 1019 $page->param(nodelist => \@nodelist); 1121 1020 } 1122 1021 } 1123 1022 ## end node hack 1124 $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g; 1125 $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g; 1126 $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g; 1127 $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g; 1128 } else { 1129 ## node hack 1130 if ($data[2] eq 'fr' || $data[2] eq 'bi') { 1131 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef". 1132 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'"); 1133 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n"; 1134 my ($node) = $sth->fetchrow_array; 1135 $html =~ s/\$\$NODE\$\$/$node/; 1136 } else { 1137 $html =~ s|\$\$NODE\$\$|N/A|; 1138 } 1139 ## end node hack 1140 $html =~ s/\$\$CUSTID\$\$/$data[1]/g; 1141 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g; 1142 $html =~ s/\$\$CITY\$\$/$data[3]/g; 1143 $html =~ s/\$\$CIRCID\$\$/$data[4]/g; 1144 $html =~ s/\$\$DESC\$\$/$data[5]/g; 1145 $html =~ s/\$\$NOTES\$\$/$data[6]/g; 1146 } 1023 1147 1024 my ($lastmod,undef) = split /\s+/, $data[7]; 1148 $html =~ s/\$\$LASTMOD\$\$/$lastmod/g; 1149 1150 ## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs. 1151 if ($data[2] =~ /.i/) { 1152 $html =~ s/\$\$SWIP\$\$/N\/A/; 1153 } else { 1154 my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' : 1155 '<input type=checkbox name=swip checked=yes>'); 1156 $html =~ s/\$\$SWIP\$\$/$tmp/; 1157 } 1158 1159 # Allows us to "correctly" colour backgrounds in table 1160 my $i=1; 1025 $page->param(lastmod => $lastmod); 1026 1027 # not happy with the upside-down logic, but... 1028 $page->param(swipable => $data[2] !~ /.i/); 1029 $page->param(swip => $data[10] ne 'n'); 1161 1030 1162 1031 # Check to see if we can display sensitive data 1163 my $privdata = ''; 1164 if ($IPDBacl{$authuser} =~ /s/) { 1165 $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>). 1166 qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">). 1167 qq($data[8]</textarea></td></tr>\n); 1168 $i++; 1169 } 1170 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1171 1172 # More ACL trickery - we can live with forms that don't submit, 1173 # but we can't leave the extra table rows there, and we *really* 1174 # can't leave the submit buttons there. 1175 my $updok = ''; 1176 if ($IPDBacl{$authuser} =~ /c/) { 1177 $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">). 1178 qq(<input type="submit" value=" Update this block " class="regular">). 1179 "</div></td></tr></form>\n"; 1180 $i++; 1181 } 1182 $html =~ s/\$\$UPDOK\$\$/$updok/g; 1183 1184 my $delok = ''; 1185 if ($IPDBacl{$authuser} =~ /d/) { 1186 $delok = qq(<form method="POST" action="main.cgi"> 1187 <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center> 1188 <input type="hidden" name="action" value="delete"> 1189 <input type="hidden" name="block" value="$webvar{block}"> 1190 <input type="hidden" name="alloctype" value="$data[2]"> 1191 <input type=submit value=" Delete this block "> 1192 </div></td></tr>); 1193 } 1194 $html =~ s/\$\$DELOK\$\$/$delok/; 1195 1196 print $html; 1032 $page->param(nocling => $IPDBacl{$authuser} =~ /s/); 1033 $page->param(privdata => $data[8]); 1034 1035 # ACL trickery - these two template booleans control the presence of all form/input tags 1036 $page->param(maychange => $IPDBacl{$authuser} =~ /c/); 1037 $page->param(maydel => $IPDBacl{$authuser} =~ /d/); 1197 1038 1198 1039 } # edit() … … 1203 1044 sub update { 1204 1045 if ($IPDBacl{$authuser} !~ /c/) { 1205 printError("You shouldn't have been able to get here. Access denied.");1046 $aclerr = 'updateblock'; 1206 1047 return; 1207 1048 } … … 1221 1062 my $sql; 1222 1063 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) { 1223 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',". 1224 "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'". 1064 $sql = "UPDATE poolips SET custid='$webvar{custid}',". 1065 "city=?,description=?,notes=?,". 1066 "circuitid='$webvar{circid}',". 1225 1067 "$privdata where ip='$webvar{block}'"; 1226 1068 } else { 1227 $sql = "update allocations set custid='$webvar{custid}',". 1228 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',". 1229 "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,". 1069 $sql = "UPDATE allocations SET custid='$webvar{custid}',". 1070 "city=?,description=?,notes=?,". 1071 "circuitid='$webvar{circid}'$privdata,". 1072 "type='$webvar{alloctype}',". 1230 1073 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ". 1231 1074 "where cidr='$webvar{block}'"; … … 1234 1077 syslog "debug", $sql; 1235 1078 $sth = $ip_dbh->prepare($sql); 1236 $sth->execute ;1079 $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes}); 1237 1080 ## node hack 1238 1081 if ($webvar{node}) { 1082 # done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there 1239 1083 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'"); 1240 1084 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)"); … … 1246 1090 if ($@) { 1247 1091 my $msg = $@; 1248 carp "Transaction aborted because $msg";1249 1092 eval { $ip_dbh->rollback; }; 1250 1093 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'"; 1251 printError("Could not update block/IP $webvar{block}: $msg");1094 $page->param(err => "Could not update block/IP $webvar{block}: $msg"); 1252 1095 return; 1253 1096 } … … 1259 1102 mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}", 1260 1103 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on'; 1261 open (HTML, "../updated.html") 1262 or croak "Could not open updated.html :$!"; 1263 my $html = join('', <HTML>); 1104 1105 ## node hack 1106 if ($webvar{node} && $webvar{node} ne '-') { 1107 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?"); 1108 $sth->execute($webvar{node}); 1109 my ($nodename) = $sth->fetchrow_array(); 1110 $page->param(nodename => $nodename); 1111 } 1112 ## end node hack 1264 1113 1265 1114 # Link back to browse-routed or list-pool page on "Update complete" page. 1266 my $backlink = "$IPDB::webpath/cgi-bin/main.cgi?action=";1267 1115 my $cblock; # to contain the CIDR of the container block we're retrieving. 1268 1116 my $sql; 1269 1117 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) { 1118 $page->param(backpool => 1); 1270 1119 $sql = "select pool from poolips where ip='$webvar{block}'"; 1271 $backlink .= "listpool&pool=";1272 1120 } else { 1273 1121 $sql = "select cidr from routed where cidr >>= '$webvar{block}'"; 1274 $backlink .= "showrouted&block=";1275 1122 } 1276 1123 # I define there to be no errors on this operation... so we don't need to check for them. … … 1280 1127 $sth->fetch(); 1281 1128 $sth->finish; 1282 $backlink .= $cblock; 1283 1284 my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No'); 1285 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g; 1286 $webvar{city} = desanitize($webvar{city}); 1287 $html =~ s/\$\$CITY\$\$/$webvar{city}/g; 1288 $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g; 1289 $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g; 1290 $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g; 1291 $html =~ s/\$\$SWIP\$\$/$swiptmp/g; 1292 $webvar{circid} = desanitize($webvar{circid}); 1293 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g; 1294 $webvar{desc} = desanitize($webvar{desc}); 1295 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g; 1296 $webvar{notes} = desanitize($webvar{notes}); 1297 $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g; 1298 $html =~ s/\$\$BACKLINK\$\$/$backlink/g; 1299 $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g; 1300 1301 if ($IPDBacl{$authuser} =~ /s/) { 1302 $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>). 1303 qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n); 1304 } 1305 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1306 1307 print $html; 1129 $page->param(backblock => $cblock); 1130 1131 $page->param(cidr => $webvar{block}); 1132 $page->param(city => $webvar{city}); 1133 $page->param(disptype => $disp_alloctypes{$webvar{alloctype}}); 1134 $page->param(custid => $webvar{custid}); 1135 $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No'); 1136 $page->param(circid => $q->escapeHTML($webvar{circid})); 1137 $page->param(desc => $q->escapeHTML($webvar{desc})); 1138 $page->param(notes => $q->escapeHTML($webvar{notes})); 1139 $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " "); 1140 $page->param(privdata => $webvar{privdata}) 1141 if $IPDBacl{$authuser} =~ /s/; 1308 1142 1309 1143 } # update() … … 1313 1147 sub remove { 1314 1148 if ($IPDBacl{$authuser} !~ /d/) { 1315 printError("You shouldn't have been able to get here. Access denied.");1149 $aclerr = 'delblock'; 1316 1150 return; 1317 1151 } 1318 1319 #show confirm screen.1320 open HTML, "../confirmRemove.html"1321 or croak "Could not open confirmRemove.html :$!";1322 my $html = join('', <HTML>);1323 close HTML;1324 1152 1325 1153 # Serves'em right for getting here... 1326 1154 if (!defined($webvar{block})) { 1327 printError("Error 332");1155 $page->param(err => "Can't delete a block that doesn't exist"); 1328 1156 return; 1329 1157 } … … 1346 1174 $desc = "N/A"; 1347 1175 $notes = "N/A"; 1176 $privdata = "N/A"; 1348 1177 1349 1178 } elsif ($webvar{alloctype} eq 'mm') { 1179 1350 1180 $cidr = $webvar{block}; 1351 1181 $city = "N/A"; … … 1355 1185 $desc = "N/A"; 1356 1186 $notes = "N/A"; 1187 $privdata = "N/A"; 1188 1357 1189 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m 1358 1190 … … 1379 1211 } # end cases for different alloctypes 1380 1212 1381 # Munge everything into HTML 1382 $html =~ s|Please confirm|Please confirm <b>removal</b> of|; 1383 $html =~ s|\$\$BLOCK\$\$|$cidr|g; 1384 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g; 1385 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g; 1386 $html =~ s|\$\$CITY\$\$|$city|g; 1387 $html =~ s|\$\$CUSTID\$\$|$custid|g; 1388 $html =~ s|\$\$CIRCID\$\$|$circid|g; 1389 $html =~ s|\$\$DESC\$\$|$desc|g; 1390 $html =~ s|\$\$NOTES\$\$|$notes|g; 1391 1392 $html =~ s|\$\$ACTION\$\$|finaldelete|g; 1393 1394 # Set the warning text. 1395 if ($alloctype =~ /^.[pd]$/) { 1396 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>|; 1397 } else { 1398 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|; 1399 } 1400 1401 my $i = 1; 1402 # Check to see if user is allowed to do anything with sensitive data 1403 if ($IPDBacl{$authuser} =~ /s/) { 1404 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 1405 qq(<td class=regular>$privdata</td></tr>\n); 1406 $i++; 1407 } 1408 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1409 1410 $i = ++$i % 2; 1411 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 1412 1413 print $html; 1414 } # end edit() 1213 $page->param(block => $cidr); 1214 $page->param(disptype => $disp_alloctypes{$alloctype}); 1215 $page->param(type => $alloctype); 1216 $page->param(city => $city); 1217 $page->param(custid => $custid); 1218 $page->param(circid => $circid); 1219 $page->param(desc => $desc); 1220 $page->param(notes => $notes); 1221 $privdata = ' ' if $privdata eq ''; 1222 $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/; 1223 $page->param(delpool => $alloctype =~ /^.[pd]$/); 1224 1225 } # end remove() 1415 1226 1416 1227 … … 1421 1232 sub finalDelete { 1422 1233 if ($IPDBacl{$authuser} !~ /d/) { 1423 printError("You shouldn't have been able to get here. Access denied.");1234 $aclerr = 'delblock'; 1424 1235 return; 1425 1236 } … … 1430 1241 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype}); 1431 1242 1243 $page->param(block => $webvar{block}); 1432 1244 if ($code eq 'OK') { 1433 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";1434 1245 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}". 1435 1246 " $custid, $city, desc='$description'"; … … 1438 1249 "CustID: $custid\nCity: $city\nDescription: $description\n"); 1439 1250 } else { 1251 $page->param(failmsg => $msg); 1440 1252 if ($webvar{alloctype} =~ /^.i$/) { 1441 1253 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'"; 1442 printError("Could not deallocate static IP $webvar{block}: $msg");1443 1254 } else { 1444 1255 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'"; 1445 printError("Could not deallocate netblock $webvar{block}: $msg");1256 $page->param(netblock => 1); 1446 1257 } 1447 1258 } 1448 1259 1449 1260 } # finalDelete 1450 1451 1452 sub exitError {1453 my $errStr = $_[0];1454 printHeader('', $IPDB::webpath, '');1455 print qq(<center><p class="regular"> $errStr </p>1456 <input type="button" value="Back" onclick="history.go(-1)">1457 </center>1458 );1459 printFooter();1460 exit;1461 } # errorExit1462 1463 1464 # Just in case we manage to get here.1465 exit 0; -
branches/stable/cgi-bin/newcity.cgi
r445 r593 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 -
branches/stable/cgi-bin/newnode.cgi
r445 r593 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); -
branches/stable/cgi-bin/search.cgi
r592 r593 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('', $IPDB::webpath, ($IPDBacl{$authuser} =~ /a/ ? 67 '<td align=right><a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=assign">Add new assignment</a></td>' : '' 68 )); 69 70 if ($webvar{stype} eq 'q') { 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 $html =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g;246 247 261 # Generate table of types 248 my $typetable = "<table class=regular cellspacing=0>\n<tr>";249 262 $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ". 250 263 "order by listorder"); 251 264 $sth->execute; 252 265 my $i=0; 253 while (my @data = $sth->fetchrow_array) { 254 $typetable .= "<td><input type=checkbox name=type[$data[0]]>$data[1]</td>"; 255 $i++; 256 $typetable .= "</tr>\n<tr>" 257 if ($i % 4 == 0); 258 } 259 if ($i %4 == 0) { 260 $typetable =~ s/<tr>$//; 261 } else { 262 $typetable .= "</tr>\n"; 263 } 264 $typetable .= "</table>\n"; 266 my @typelist; 267 while (my ($type,$dispname) = $sth->fetchrow_array) { 268 my %row = ( 269 newrow => ($i % 4 == 0), 270 type => $type, 271 dispname => $dispname, 272 endrow => ($i++ % 4 == 3) 273 ); 274 push @typelist, \%row; 275 } 276 $page->param(typelist => \@typelist); 265 277 266 278 # Generate table of cities 267 my $citytable = "<table class=regular cellspacing=0>\n<tr>";268 279 $sth = $ip_dbh->prepare("select id,city from cities order by city"); 269 280 $sth->execute; 270 my $i=0; 271 while (my @data = $sth->fetchrow_array) { 272 $citytable .= "<td><input type=checkbox name=city[$data[0]]>$data[1]</td>"; 273 $i++; 274 $citytable .= "</tr>\n<tr>" 275 if ($i % 5 == 0); 276 } 277 if ($i %5 == 0) { 278 $citytable =~ s/<tr>$//; 279 } else { 280 $citytable .= "</tr>\n"; 281 } 282 $citytable .= "</table>\n"; 283 284 $html =~ s/\$\$TYPELIST\$\$/$typetable/; 285 $html =~ s/\$\$CITYLIST\$\$/$citytable/; 286 287 print $html; 281 $i=0; 282 my @citylist; 283 while (my ($id, $city) = $sth->fetchrow_array) { 284 my %row = ( 285 newrow => ($i % 4 == 0), 286 id => $id, 287 city => $city, 288 endrow => ($i++ % 4 == 3) 289 ); 290 push @citylist, \%row; 291 } 292 $page->param(citylist => \@citylist); 293 288 294 } 295 296 print $page->output; 289 297 290 298 # Shut down and clean up. 291 299 finish($ip_dbh); 292 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 293 308 # We shouldn't need to directly execute any code below here; it's all subroutines. 294 309 exit 0; … … 323 338 if ($category eq 'all') { 324 339 325 print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);326 340 $sql = "select $cols from searchme"; 327 341 my $count = countRows($sql); … … 331 345 } elsif ($category eq 'cust') { 332 346 347 ##fixme: this and other quick-search areas; fix up page heading title similar to first grouping above 333 348 print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n); 334 349 … … 394 409 } else { 395 410 # This shouldn't happen, but if it does, whoever gets it deserves what they get... 396 printError("Invalid query.");411 $page->param(errmsg => "Invalid query."); 397 412 } 398 413 } else { 399 414 # This shouldn't happen, but if it does, whoever gets it deserves what they get... 400 printError("Invalid searchfor.");415 $page->param(errmsg => "Invalid searchfor."); 401 416 } 402 417 } # viewBy … … 438 453 $sth->execute(); 439 454 440 startTable('Allocation','CustID','Type','City','Description/Name'); 455 $page->param(searchtitle => "Showing all netblock and static-IP allocations"); 456 441 457 my $count = 0; 442 443 while (my @data = $sth->fetchrow_array) { 444 445 # cidr,custid,type,city,description,notes 446 # Another bit of HairyPerl(TM) to prefix subblocks with "Sub" 447 my @row = (($data[2] =~ /^.r$/ ? 'Sub ' : ''). 448 qq(<a href="$IPDB::webpath/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>), 449 $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]); 450 # Allow listing of pool if desired/required. 451 if ($data[2] =~ /^.[pd]$/) { 452 $row[0] .= ' <a href="'.$IPDB::webpath.'/cgi-bin/main.cgi?action=listpool'. 453 "&pool=$data[0]\">List IPs</a>"; 454 } 455 printRow(\@row, 'color1', 1) if ($count%2==0); 456 printRow(\@row, 'color2', 1) if ($count%2!=0); 457 $count++; 458 } 458 my @sresults; 459 while (my ($block, $custid, $type, $city, $desc) = $sth->fetchrow_array) { 460 my %row = ( 461 rowclass => $count++ % 2, 462 issub => ($type =~ /^.r$/ ? 1 : 0), 463 block => $block, 464 ispool => ($type =~ /^.[pd]$/ ? 1 : 0), 465 custid => $custid, 466 disptype => $disp_alloctypes{$type}, 467 city => $city, 468 desc => $desc 469 ); 470 push @sresults, \%row; 471 } 472 $page->param(sresults => \@sresults); 459 473 460 474 # Have to think on this call, it's primarily to clean up unfetched rows from a select. … … 463 477 464 478 my $upper = $offset+$count; 465 print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: ".($offset+1)." - $upper</i></td></tr>\n"; 466 print "</table></center>\n"; 479 480 $page->param(resfound => $rowCount); 481 $page->param(resstart => $offset+1); 482 $page->param(resstop => $upper); 467 483 468 484 # print the page thing.. 469 485 if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) { 486 $page->param(multipage => 1); 470 487 my $pages = ceil($rowCount/$RESULTS_PER_PAGE); 471 print qq(<div class="center"> Page: );488 my @pagelist; 472 489 for (my $i = 1; $i <= $pages; $i++) { 490 my %row; 491 $row{pgnum} = $i; 473 492 if ($i == $pageNo) { 474 print "<b>$i </b>\n";493 $row{thispage} = 1; 475 494 } else { 476 print qq(<a href="$IPDB::webpath/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);495 $row{stype} = $webvar{stype}; 477 496 if ($webvar{stype} eq 'c') { 478 print"cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".497 $row{extraopts} = "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&". 479 498 "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&". 480 499 "allcities=$webvar{allcities}&"; 481 500 foreach my $key (keys %webvar) { 482 501 if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) { 483 print"$key=$webvar{$key}&";502 $row{extraopts} .= "$key=$webvar{$key}&"; 484 503 } 485 504 } 486 505 } else { 487 print"input=$webvar{input}&";506 $row{extraopts} = "input=$webvar{input}&"; 488 507 } 489 print qq(">$i</a> \n);490 508 } 491 } 492 print "</div>"; 493 } 509 push @pagelist, \%row; 510 } 511 $page->param(pgnums => \@pagelist); 512 } 513 494 514 } # queryResults 495 515 -
branches/stable/cgi-bin/snCalc.cgi
r507 r593 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 use MyIPDB; 11 12 12 my %webvar = parse_post(); 13 # Set up the CGI object... 14 my $q = new CGI::Simple; 15 # ... and get query-string params as well as POST params if necessary 16 $q->parse_query_string; 17 18 # Convenience; saves changing all references to %webvar 19 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 20 my %webvar = $q->Vars; 21 13 22 my $input; 14 23 15 24 print "Content-Type: text/html\n\n"; 16 25 17 open(HTML, "../startsn.html")|| die "Could not open startsn.html :$!"; 18 my $start = join('', <HTML>);19 close(HTML);20 $start =~ s/\$\$WEBPATH\$\$/$IPDB::webpath/g; 21 print $start;26 ##fixme: need better method to find templates. 27 $ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME}; 28 $ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||; 29 30 my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl"); 22 31 23 32 # Clean up input so we don't divide by zero or something equally silly … … 37 46 my $postnet = new NetAddr::IP "0.0.0.0/$gtinput"; 38 47 39 print qq(<div class="center"> 40 <table align="center" cellspacing="3" cellpadding="3"> 41 <tr> 42 <td class="heading" align="center">Results for /$ltinput</td> 43 <td class="heading" align="center">Results for /$input</td> 44 <td class="heading" align="center">Results for /$gtinput</td> 45 </tr> 46 ); 48 $page->param(prenet => $ltinput); 49 $page->param(net => $input); 50 $page->param(postnet => $gtinput); 51 $page->param(premask => $prenet->mask); 52 $page->param(mask => $net->mask); 53 $page->param(postmask => $postnet->mask); 54 $page->param(prewildcard => scalar($prenet->wildcard)); 55 $page->param(wildcard => scalar($net->wildcard)); 56 $page->param(postwildcard => scalar($postnet->wildcard)); 47 57 48 print qq(<tr><td valign="top">\n). 49 qq( <div class="mask">).$prenet->mask."</div>\n". 50 qq( <div class="wildcard">).$prenet->wildcard."</div>\n". 51 getranges($ltinput). 52 qq(</td>\n<td valign="top" bgcolor="#d0e0e0">\n). 53 qq( <div class="mask">).$net->mask."</div>\n". 54 qq( <div class="wildcard">).$net->wildcard."</div>\n". 55 getranges($input). 56 qq(</td>\n<td valign="top">). 57 qq( <div class="mask">).$postnet->mask."</div>\n". 58 qq( <div class="wildcard">).$postnet->wildcard."</div>\n". 59 getranges($gtinput); 58 my @prenets; 59 foreach (getranges($ltinput)) { 60 my %row = (netrange => $_); 61 push (@prenets, \%row); 62 } 63 $page->param(prenets => \@prenets); 64 my @nets; 65 foreach (getranges($input)) { 66 my %row = (netrange => $_); 67 push (@nets, \%row); 68 } 69 $page->param(nets => \@nets); 70 my @postnets; 71 foreach (getranges($gtinput)) { 72 my %row = (netrange => $_); 73 push @postnets, \%row; 74 } 75 $page->param(postnets => \@postnets); 60 76 61 print "</td></tr>\n</table>\n"; 62 63 print qq(<input type="button" value="Back" onclick="history.go(-1)" class="heading"> 64 </div> 65 </body> 66 </html> 67 ); 77 print $page->output; 68 78 69 79 # Just In Case … … 88 98 sub getranges { 89 99 my $masklen = shift; 90 my $ret = '';100 my @ret; 91 101 my $super; 92 102 if ($masklen < 8) { … … 100 110 } 101 111 foreach my $net ($super->split($masklen)) { 102 $ret .= "\t".xrange($net,$masklen)."<br />\n";112 push @ret, xrange($net,$masklen); 103 113 } 104 return $ret;114 return @ret; 105 115 } # getranges()
Note:
See TracChangeset
for help on using the changeset viewer.