Changeset 517 for trunk/cgi-bin
- Timestamp:
- 10/18/12 16:53:10 (12 years ago)
- Location:
- trunk
- Files:
-
- 1 deleted
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
-
Property svn:mergeinfo
set to
/branches/htmlform merged eligible
-
Property svn:mergeinfo
set to
-
trunk/cgi-bin/CustIDCK.pm
r417 r517 31 31 # the local admin on installation 32 32 sub custid_exist { 33 my $self = shift; 33 34 my $custid = shift; 34 35 -
trunk/cgi-bin/IPDB.pm
r486 r517 24 24 @EXPORT_OK = qw( 25 25 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist @masterblocks 26 %allocated %free %routed %bigfree %IPDBacl 26 %allocated %free %routed %bigfree %IPDBacl %aclmsg 27 27 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock &addMaster 28 28 &deleteBlock &getBlockData &mailNotify … … 32 32 %EXPORT_TAGS = ( ALL => [qw( 33 33 %disp_alloctypes %list_alloctypes %def_custids @citylist @poplist 34 @masterblocks %allocated %free %routed %bigfree %IPDBacl 34 @masterblocks %allocated %free %routed %bigfree %IPDBacl %aclmsg 35 35 &initIPDBGlobals &connectDB &finish &checkDBSanity &allocateBlock 36 36 &addMaster &deleteBlock &getBlockData &mailNotify … … 52 52 our %bigfree; 53 53 our %IPDBacl; 54 55 # mapping table for functional-area => error message 56 our %aclmsg = ( 57 addmaster => 'add a master block', 58 addblock => 'add an allocation', 59 updateblock => 'update a block', 60 delblock => 'delete an allocation', 61 ); 54 62 55 63 our $org_name = 'Example Corp'; … … 122 130 } 123 131 132 ##fixme: initialize HTML::Template env var for template path 133 # something like $self->path().'/templates' ? 134 # $ENV{HTML_TEMPLATE_ROOT} = 'foo/bar'; 135 124 136 return (1,"OK"); 125 137 } # end initIPDBGlobals … … 170 182 sub finish { 171 183 my $dbh = $_[0]; 172 $dbh->disconnect ;184 $dbh->disconnect if $dbh; 173 185 } # end finish 174 186 … … 352 364 $cidr = $data[0]; # $cidr is already declared when we get here! 353 365 354 $sth = $dbh->prepare("update poolips set custid='$custid',". 355 "city='$city',available='n',description='$desc',notes='$notes',". 356 "circuitid='$circid',privdata='$privdata'". 357 " where ip='$cidr'"); 358 $sth->execute; 366 $sth = $dbh->prepare("update poolips set custid=?,city=?,". 367 "available='n',description=?,notes=?,circuitid=?,privdata=?". 368 " where ip=?"); 369 $sth->execute($custid, $city, $desc, $notes, $circid, $privdata, "$cidr"); 359 370 # node hack 360 371 if ($nodeid && $nodeid ne '') { … … 404 415 $sth = $dbh->prepare("insert into allocations". 405 416 " (cidr,custid,type,city,description,notes,maskbits,circuitid,privdata)". 406 " values ('$cidr','$custid','$type','$city','$desc','$notes',". 407 $cidr->masklen.",'$circid','$privdata')"); 408 $sth->execute; 417 " values (?,?,?,?,?,?,?,?,?)"); 418 $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata); 409 419 410 420 # And initialize the pool, if necessary … … 514 524 $sth = $dbh->prepare("insert into allocations (cidr,custid,type,city,". 515 525 "description,notes,maskbits,circuitid,privdata)". 516 " values ('$cidr','$custid','$type','$city','$desc','$notes',". 517 $cidr->masklen.",'$circid','$privdata')"); 518 $sth->execute; 526 " values (?,?,?,?,?,?,?,?,?)"); 527 $sth->execute("$cidr", $custid, $type, $city, $desc, $notes, $cidr->masklen, $circid, $privdata); 519 528 520 529 # And initialize the pool, if necessary … … 638 647 eval { 639 648 $msg = "Unable to deallocate $disp_alloctypes{$type} $cidr"; 640 $sth = $dbh->prepare("update poolips set custid= '$defcustid',available='y',".641 "city=(select city from allocations where cidr >>= '$cidr'".649 $sth = $dbh->prepare("update poolips set custid=?,available='y',". 650 "city=(select city from allocations where cidr >>= ?". 642 651 " order by masklen(cidr) desc limit 1),". 643 "description='',notes='',circuitid='' where ip= '$cidr'");644 $sth->execute ;652 "description='',notes='',circuitid='' where ip=?"); 653 $sth->execute($defcustid, "$cidr", "$cidr"); 645 654 $dbh->commit; 646 655 }; -
trunk/cgi-bin/MyIPDB.pm
r437 r517 22 22 # DB host is optional. 23 23 my $dbhost = 'ipdb-db'; 24 25 # Quick workaround for fixed web path. Set this to the absolute web path to 26 # your IPDB install, or leave blank for installation at the webroot. 27 $IPDB::webpath = ''; 24 28 25 29 # Set some globals declared in IPDB.pm. Most of these only affect mailNotify(). -
trunk/cgi-bin/admin.cgi
r515 r517 15 15 use warnings; 16 16 use CGI::Carp qw(fatalsToBrowser); 17 use CGI::Simple; 18 use HTML::Template; 17 19 use DBI; 18 use CommonWeb qw(:ALL);19 20 #use POSIX qw(ceil); 20 21 use NetAddr::IP; … … 39 40 40 41 syslog "debug", "$authuser active"; 42 43 # Set up the CGI object... 44 my $q = new CGI::Simple; 45 # ... and get query-string params as well as POST params if necessary 46 $q->parse_query_string; 47 48 # Convenience; saves changing all references to %webvar 49 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 50 my %webvar = $q->Vars; 51 52 # anyone got a better name? :P 53 my $thingroot = $ENV{SCRIPT_FILENAME}; 54 $thingroot =~ s|cgi-bin/admin.cgi||; 55 56 # Set up some globals 57 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 41 58 42 59 # Why not a global DB handle? (And a global statement handle, as well...) … … 47 64 ($ip_dbh,$errstr) = connectDB_My; 48 65 if (!$ip_dbh) { 49 printAndExit("Database error: $errstr\n"); 50 } 51 initIPDBGlobals($ip_dbh); 66 $webvar{action} = "dberr"; 67 } else { 68 initIPDBGlobals($ip_dbh); 69 } 70 71 # handle DB error output 72 if ($webvar{action} eq 'dberr') { 73 my $page = HTML::Template->new(filename => "admin/dberr.tmpl"); 74 $page->param(errmsg => $errstr); 75 print "Content-Type: text/html\n\n".$page->output; 76 exit; 77 } 52 78 53 79 if ($IPDBacl{$authuser} !~ /A/) { 54 print "Content-Type: text/html\n\n". 55 "<html>\n<head>\n\t<title>Access denied</title>\n". 56 qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n). 57 qq(\t<link rel="stylesheet" type="text/css" href="/ip/local.css">\n). 58 "</head>\n<body>\n". 59 qq(Access to this tool is restricted. Contact the <a href="mailto:ipdbadmin\@example.com">IPDB administrator</a> \n). 60 "for more information.\n</body>\n</html>\n"; 80 my $page = HTML::Template->new(filename => "admin/aclerr.tmpl"); 81 ##fixme: need params for IPDB admin email and name 82 $page->param(ipdbadmin_email => 'ipdbadmin@example.com'); 83 $page->param(ipdbadmin_name => 'the IPDB administrator'); 84 print "Content-Type: text/html\n\n".$page->output; 61 85 exit; 62 86 } 63 87 64 my %webvar = parse_post(); 65 cleanInput(\%webvar); 66 67 print "Content-type: text/html\n\n". 68 "<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n". 69 qq(\t<link rel="stylesheet" type="text/css" href="/ip/ipdb.css">\n). 70 qq(\t<link rel="stylesheet" type="text/css" href="/ip/local.css">\n). 71 "</head>\n<body>\n". 72 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n"; 88 my $header = HTML::Template->new(filename => "admin/header.tmpl"); 73 89 74 90 if(!defined($webvar{action})) { 75 $webvar{action} = "<NULL>"; #shuts up the warnings. 76 77 my $typelist = ''; 91 $webvar{action} = "main"; #shuts up the warnings. 92 } 93 94 my $page; 95 if (-e "$ENV{HTML_TEMPLATE_ROOT}/admin/$webvar{action}.tmpl") { 96 $page = HTML::Template->new(filename => "admin/$webvar{action}.tmpl"); 97 } else { 98 $page = HTML::Template->new(filename => "admin/dunno.tmpl"); 99 } 100 101 # handle index page 102 if ($webvar{action} eq 'main') { 103 $header->param(mainpage => 1); 104 78 105 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 79 106 $sth->execute; 80 my @data = $sth->fetchrow_array; 81 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n"; 82 while (my @data = $sth->fetchrow_array) { 83 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 84 } 85 86 my $masterlist = ''; 107 108 my @typelist; 109 my $count = 0; 110 while (my ($type,$listname) = $sth->fetchrow_array) { 111 my %row = ( 112 selected => $count++, 113 type => $type, 114 dispname => $listname 115 ); 116 push @typelist, \%row; 117 } 118 $page->param(typelist => \@typelist); 119 120 my @masterlist; 87 121 $sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr"); 88 122 $sth->execute; 89 while (my @data = $sth->fetchrow_array) { 90 $masterlist .= "<option value='$data[0]'>$data[0] ($data[1])</option>\n"; 91 } 92 93 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the 94 main interface if at all possible. 95 <hr> 96 <form action="admin.cgi" method="POST"> 97 <input type=hidden name=action value=alloc> 98 Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid> 99 <input type=submit value=" GIMME!! "></form> 100 <hr><form action="admin.cgi" method="POST"> 101 <input type=hidden name=action value=alloctweak> 102 Manually update allocation data in this /24: <input name=allocfrom> 103 <input type=submit value="Show allocations"> 104 </form> 105 106 <hr>rWHOIS tools: 107 <form action="admin.cgi" method="POST"> 108 <input type=hidden name=action value=touch> 109 Bump "last updated" timestamp on this master: <select name=whichmaster>$masterlist</select> 110 <input type=submit value="Update timestamp"> (Sets timestamp to "now")</form> 111 <a href="admin.cgi?action=listcust">Edit customer data for rWHOIS</a> - data used for 112 blocks with the SWIP box checkmarked. Links to edit/add data are on this page. 113 114 <hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates 115 116 <hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users; change 117 internal access controls - note that this does NOT include IP-based limits)<br> 118 <a href="admin.cgi?action=emailnotice">Manage email notice options</a> (pick which events 119 and allocation types cause notifications; configure recipient lists for notices) 120 121 <hr>Consistency check tools<br> 122 <a href="consistency-check.pl">General</a>: Check general netblock consistency.<br> 123 <a href="freespace.pl">Free space</a>: List total and aggregate free space. Does not 124 include private networks (192.168.0.0/16, 172.16.0.0/12, 10.0.0.0/8) 125 ); 126 } else { 127 print '<a href="/ip/cgi-bin/admin.cgi">Back</a> to main<hr>'; 128 } 129 130 131 ## Possible actions. 132 if ($webvar{action} eq 'alloc') { 133 # OK, we know what we're allocating. 123 while (my ($cidr,$mtime) = $sth->fetchrow_array) { 124 my %row = ( 125 master => $cidr, 126 masterdate => $mtime 127 ); 128 push @masterlist, \%row; 129 } 130 $page->param(masterlist => \@masterlist); 131 132 } 133 134 ## Non-default actions. 135 136 elsif ($webvar{action} eq 'alloc') { 134 137 135 138 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 136 printAndExit("Can't allocate something that's not a netblock/ip"); 139 $page->param(errmsg => "Can't allocate something that's not a netblock/ip"); 140 goto ERRJUMP; 137 141 } 138 142 … … 148 152 my $status = CustIDCK->custid_exist($webvar{custid}); 149 153 if ($CustIDCK::Error) { 150 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);151 return;154 $page->param(errmsg => "Error verifying customer ID: ".$CustIDCK::ErrMsg); 155 goto ERRJUMP; 152 156 } 153 157 if (!$status) { 154 printError("Customer ID not valid. Make sure the Customer ID ".158 $page->param(errmsg => "Customer ID not valid. Make sure the Customer ID ". 155 159 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 156 160 "non-customer assignments."); 157 return;161 goto ERRJUMP; 158 162 } 159 163 } … … 169 173 @data = $sth->fetchrow_array; 170 174 # User deserves errors if user can't be bothered to find the free block first. 171 printAndExit("Can't allocate from outside a free block!!\n") 172 if !$data[0]; 175 if (!$data[0]) { 176 $page->param(errmsg => "Can't allocate from outside a free block!!"); 177 goto ERRJUMP; 178 } 173 179 } elsif ($webvar{alloctype} =~ /^(.)i$/) { 174 180 $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')"); … … 176 182 @data = $sth->fetchrow_array; 177 183 # User deserves errors if user can't be bothered to find the pool and a free IP first. 178 printAndExit("Can't allocate static IP from outside a pool!!\n") 179 if !$data[0]; 184 if (!$data[0]) { 185 $page->param(errmsg => "Can't allocate static IP from outside a pool!!"); 186 goto ERRJUMP; 187 } 180 188 } else { 181 189 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')"); … … 183 191 @data = $sth->fetchrow_array; 184 192 # User deserves errors if user can't be bothered to find the free block first. 185 printAndExit("Can't allocate from outside a routed block!!\n") 186 if !$data[0]; 193 if (!$data[0]) { 194 $page->param(errmsg => "Can't allocate from outside a routed block!!"); 195 goto ERRJUMP; 196 } 187 197 } 188 198 … … 190 200 $sth->finish; 191 201 192 my $cities = '';202 my @cities; 193 203 foreach my $city (@citylist) { 194 $cities .= "<option>$city</option>\n"; 195 } 196 197 print qq(<table class=regular> 198 <form method=POST action=admin.cgi> 199 <tr class=color1> 200 <td>Allocating:</td> 201 <td>$cidr<input type=hidden name=cidr value="$cidr"></td> 202 </tr><tr class=color2> 203 <td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}} 204 <input type=hidden name=alloctype value="$webvar{alloctype}"></td> 205 </tr><tr class=color1> 206 <td>Allocated from:</td> 207 <td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td> 208 </tr><tr class="color2"> 209 <td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td> 210 </tr><tr class=color1> 211 <td>Customer location:</td><td> 212 <select name="city"><option selected>-</option> 213 $cities 214 </select> 215 <a href="javascript:popNotes('/ip/newcity.html')">Add new location</a> 216 </td> 217 </tr> 218 <tr class="color2"> 219 <td>Circuit ID:</td><td><input name=circid size=40></td> 220 </tr><tr class="color1"> 221 <td>Description/Name:</td><td><input name="desc" size=40></td> 222 </tr><tr class="color2"> 223 <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td> 224 </tr><tr class="warning"> 225 <td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td> 226 </tr><tr class="color2"> 227 <td class="center" colspan="2"><input type="submit" value=" Assign "></td> 228 <input type="hidden" name="action" value="confirm"> 229 </form> 230 </tr> 231 </table> 232 ); 233 204 my %row = (city => $city); 205 push @cities, \%row; 206 } 207 $page->param( 208 cidr => $cidr, 209 disptype => $disp_alloctypes{$webvar{alloctype}}, 210 type => $webvar{alloctype}, 211 alloc_from => $alloc_from, 212 custid => $custid, 213 citylist => \@cities 214 ); 234 215 235 216 } elsif ($webvar{action} eq 'confirm') { 236 217 237 print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ". 238 "$disp_alloctypes{$webvar{alloctype}}...<br>\n"; 218 $page->param( 219 cidr => $webvar{cidr}, 220 custid => $webvar{custid}, 221 desc => $webvar{desc}, 222 disptype => $disp_alloctypes{$webvar{alloctype}} 223 ); 239 224 # Only need to check city here. 240 225 if ($webvar{city} eq '-') { 241 printError("Invalid customer location! Go back and select customer's location."); 226 $page->param(locerr => "Invalid customer location! Go back and select customer's location."); 227 goto ERRJUMP; 242 228 } else { 243 229 if ($webvar{alloctype} =~ /^.i$/) { … … 247 233 $sth->execute; 248 234 if ($sth->err) { 249 print "Allocation failed! DBI said:\n".$sth->errstr."\n";235 $page->param(errmsg => $sth->errstr); 250 236 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 251 237 "'$webvar{alloctype}' failed: '".$sth->errstr."'"; 252 238 } else { 253 print "Allocation OK!\n";254 239 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 255 240 "'$webvar{alloctype}'"; … … 263 248 $webvar{circid}); 264 249 if ($retcode eq 'OK') { 265 print "Allocation OK!\n";266 250 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 267 251 "'$webvar{alloctype}'"; 268 252 } else { 269 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";253 $page->param(errmsg => $msg); 270 254 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 271 255 "'$webvar{alloctype}' failed: '$msg'"; … … 276 260 277 261 } elsif ($webvar{action} eq 'alloctweak') { 262 278 263 fix_allocfrom(); 279 264 showAllocs($webvar{allocfrom}); 265 280 266 } elsif ($webvar{action} eq 'update') { 267 281 268 update(); 282 } elsif ($webvar{action} eq 'assign') { 283 # Display a list of possible blocks within the requested block. 284 open (HTML, "../admin_alloc.html") 285 or croak "Could not open admin_alloc.html :$!"; 286 my $html = join('', <HTML>); 287 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g; 288 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g; 289 290 my $from = new NetAddr::IP $webvar{allocfrom}; 291 my @blocklist = $from->split($webvar{masklen}); 292 my $availblocks; 293 foreach (@blocklist) { 294 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n); 295 } 296 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g; 297 298 print $html; 269 299 270 } elsif ($webvar{action} eq 'touch') { 300 print "Touching master $webvar{whichmaster}\n"; 271 272 $page->param(master => $webvar{whichmaster}); 301 273 $sth = $ip_dbh->prepare("update masterblocks set mtime=now() where cidr='$webvar{whichmaster}'"); 302 274 $sth->execute; 303 275 if ($sth->err) { 304 print "<p>Error updating modified timestamp on master $webvar{whichmaster}: ".$sth->errstr."\n"; 305 } 276 $page->param(errmsg => $sth->errstr); 277 } 278 306 279 } elsif ($webvar{action} eq 'listcust') { 307 print qq(Add new entry:\n 308 <form action=admin.cgi method=POST> 309 <table border=1><tr> 310 <input type=hidden name=action value=edcust> 311 <input type=hidden name=newcust value=1> 312 <td>CustID:</td><td><input name=custid></td> 313 <td align=center><input type=submit value="Go to edit page for this custid"></td></tr> 314 </form></table> 315 ); 316 print "<p>Click CustID to edit existing customer contact data:\n". 317 "<table border=1>\n<tr><td>CustID</td><td>Name</td><td>Tech handle</td></tr>\n"; 280 318 281 $sth = $ip_dbh->prepare("select custid,name,tech_handle from customers order by custid"); 319 282 $sth->execute; 283 my @custlist; 320 284 while (my @data = $sth->fetchrow_array) { 321 print qq(<tr><td><a href="admin.cgi?action=edcust&custid=$data[0]">$data[0]</td>). 322 "<td>$data[1]</td><td>$data[2]</td></tr>\n"; 323 } 324 print "</table>\n"; 285 my %row = ( 286 custid => $data[0], 287 custname => $data[1], 288 tech => $data[2] 289 ); 290 push @custlist, \%row; 291 } 292 $page->param(custlist => \@custlist); 293 325 294 } elsif ($webvar{action} eq 'edcust') { 295 326 296 if ($webvar{newcust}) { 327 print "got here?\n";328 297 $sth = $ip_dbh->prepare("INSERT INTO customers (custid) VALUES (?)"); 329 298 $sth->execute($webvar{custid}); … … 335 304 my ($custid, $name, $street, $city, $prov, $country, $pocode, $phone, $tech, $abuse, $admin, $special) = 336 305 $sth->fetchrow_array; 337 print qq(<form action=admin.cgi method=POST> 338 <table border=1><tr> 339 <input type=hidden name=action value=updcust> 340 <td>CustID:</td><td>$custid<input type=hidden name=custid value=$custid></td> 341 <td>Name:</td><td><input name=name value="$name"></td></tr> 342 <tr><td>Street:</td><td><input name=street value="$street"></td> 343 <!-- <td>Street2:</td><td><input name=street2></td> --> 344 <td>City:</td><td><input name=city value="$city"></td></tr> 345 <tr><td>Province/State: (2-letter code)</td><td><input name=province value="$prov" length=2 size=2></td> 346 <td>Country: (2-letter code)</td><td><input name=country value="$country" length=2 size=2></td></tr> 347 <tr><td>Postal/ZIP Code:</td><td><input name=pocode value="$pocode"></td> 348 <td>Phone:</td><td><input name=phone value="$pocode"></td></tr> 349 <!-- <td>Default rDNS:</td><td><input name=def_rdns></td></tr> 350 <td>Description:</td><td><input name=description></td> --> 351 <tr><td>Contacts/ARIN Handles:</td><td> 352 Tech: <input name=tech_handle value="$tech"><br> 353 Abuse: <input name=abuse_handle value="$abuse"><br> 354 Admin: <input name=admin_handle value="$admin"><br> 355 Note: Only tech is required at the moment. 356 </td> 357 <td>"Special":</td><td><textarea name=special rows=4 cols=50>$special</textarea></td> 358 </tr> 359 <tr><td colspan=4 align=center><input type=submit value="Update"></td></tr> 360 </form></table> 361 <div style="margin-left:5px"> 362 <h3>Explanation for "Special" field:</h3> 363 This is a temporary place to define the WHOIS "net name" for a block. 364 It may be removed later, more likely migrated elsewhere. 365 <p>It's formatted like this, one line for each custom net name: 366 <pre>NetName[CIDR block]: NET-NAME</pre> 367 Example: 368 <pre>NetName192.168.236.0/24: MEGAWIDGET-1</pre> 369 Note: 370 <ul style="margin-top: 0px;"> 371 <li>Spacing is important - there should only be ONE space, in between the colon and the net name. 372 <li>The CIDR block name nust include all four octets - no short forms are accepted. 373 <li>Net names must be all uppercase, and consist only of A-Z, 0-9, and - (same as for SWIPed net names). 374 </ul> 375 </div> 376 ); 306 307 $page->param( 308 custid => $custid, 309 name => $name, 310 street => $street, 311 city => $city, 312 prov => $prov, 313 country => $country, 314 pocode => $pocode, 315 phone => $phone, 316 tech => $tech, 317 abuse => $abuse, 318 admin => $admin, 319 special => $special 320 ); 377 321 378 322 } elsif ($webvar{action} eq 'updcust') { 323 379 324 $sth = $ip_dbh->prepare("UPDATE customers SET". 380 325 " name=?, street=?, city=?, province=?, country=?, pocode=?,". … … 384 329 $webvar{country}, $webvar{pocode}, $webvar{phone}, $webvar{tech_handle}, 385 330 $webvar{abuse_handle}, $webvar{admin_handle}, $webvar{special}, $webvar{custid}); 386 print "Updated $webvar{custid}<br>\n". 387 qq(<table border=1> 388 <tr><td>CustID:</td><td>$webvar{custid}</td></tr> 389 <tr><td>Name:</td><td>$webvar{name}</td></tr> 390 <tr><td>Street:</td><td>$webvar{street}</td></tr> 391 <tr><td>City:</td><td>$webvar{city}</td></tr> 392 <tr><td>Province/State:</td><td>$webvar{province}</td></tr> 393 <tr><td>Country:</td><td>$webvar{country}</td></tr> 394 <tr><td>Postal/ZIP Code:</td><td>$webvar{pocode}</td></tr> 395 <tr><td>Phone:</td><td>$webvar{phone}</td></tr> 396 <!-- <td>Default rDNS:</td><td>$webvar{def_rdns}</td></tr> --> 397 <tr><td>Contacts/ARIN Handles:</td><td> 398 Tech: $webvar{tech_handle}<br> 399 Abuse: $webvar{abuse_handle}<br> 400 Admin: $webvar{admin_handle}<br> 401 </td></tr> 402 <tr><td>"Special":</td><td><pre>$webvar{special}</pre></td></tr> 403 </table> 404 <a href="admin.cgi?action=listcust">Back</a> to rWHOIS customer list<br>\n); 331 $page->param( 332 custid => $webvar{custid}, 333 name => $webvar{name}, 334 street => $webvar{street}, 335 city => $webvar{city}, 336 prov => $webvar{province}, 337 country => $webvar{country}, 338 pocode => $webvar{pocode}, 339 phone => $webvar{phone}, 340 tech => $webvar{tech_handle}, 341 abuse => $webvar{abuse_handle}, 342 admin => $webvar{admin_handle}, 343 special => $webvar{special} 344 ); 405 345 406 346 } elsif ($webvar{action} eq 'showpools') { 407 print "IP Pools currently allocated:\n". 408 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n"; 409 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr"); 410 $sth->execute; 411 my %poolfree; 412 while (my @data = $sth->fetchrow_array) { 413 $poolfree{$data[0]} = 0; 414 } 415 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip"); 416 $sth->execute; 417 while (my @data = $sth->fetchrow_array) { 418 $poolfree{$data[0]}++; 419 } 420 foreach my $key (keys %poolfree) { 421 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>). 422 "<td>$poolfree{$key}</td></tr>\n"; 423 } 424 print "</table>\n"; 347 348 $sth = $ip_dbh->prepare("select pool, count(*) from poolips where available='y' group by pool order by pool"); 349 $sth->execute; 350 my @poollist; 351 while (my ($pool,$free) = $sth->fetchrow_array) { 352 my %row = ( 353 pool => $pool, 354 free => $free 355 ); 356 push @poollist, \%row; 357 } 358 $page->param(poollist => \@poollist); 359 425 360 } elsif ($webvar{action} eq 'tweakpool') { 361 426 362 showPool($webvar{pool}); 363 427 364 } elsif ($webvar{action} eq 'updatepool') { 428 365 429 366 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ". 430 "city= '$webvar{city}', type='$webvar{type}', available='".367 "city=?, type='$webvar{type}', available='". 431 368 (($webvar{available} eq 'y') ? 'y' : 'n'). 432 "', notes= '$webvar{notes}', description='$webvar{desc}'".369 "', notes=?, description=? ". 433 370 "where ip='$webvar{ip}'"); 434 $sth->execute; 371 $sth->execute($webvar{city},$webvar{notes},$webvar{desc}); 372 $page->param(ip => $webvar{ip}); 435 373 if ($sth->err) { 436 print "Error updating pool IP $webvar{ip}: $@<hr>\n"; 437 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@"; 438 } else { 439 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); 440 $sth->execute; 441 my @data = $sth->fetchrow_array; 442 print "$webvar{ip} in $data[0] updated\n<hr>\n"; 374 $page->param(errmsg => $sth->errstr); 375 syslog "err", "$authuser could not update pool IP $webvar{ip}: ".$sth->errstr; 376 } else { 443 377 syslog "notice", "$authuser updated pool IP $webvar{ip}"; 444 378 } 379 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); 380 $sth->execute; 381 my @data = $sth->fetchrow_array; 382 $page->param(pool => $data[0]); 383 445 384 } elsif ($webvar{action} eq 'showusers') { 446 print "Notes:<br>\n". 447 "<li>Admin users automatically get all other priviledges.\n". 448 "<li>Everyone has basic read access.\n". 449 "<hr>Add new user:<form action=admin.cgi method=POST>\n". 450 "Username: <input name=username><br>\n". 451 "Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n". 452 "<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n"; 453 454 print "<hr>Users with access:\n<table border=1>\n"; 455 print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n"; 456 print "<tr><td>Username</td><td>Add new</td><td>Change</td>". 457 "<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n". 458 "<form action=admin.cgi method=POST>\n"; 385 459 386 $sth = $ip_dbh->prepare("select username,acl from users order by username"); 460 387 $sth->execute; 461 while (my @data = $sth->fetchrow_array) { 462 print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>". 463 qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>). 464 # Now for the fun bit. We have to pull apart the ACL field and 465 # output a bunch of checkboxes. 466 "<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : ''). 467 "></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : ''). 468 "></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : ''). 469 "></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : ''). 470 "></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : ''). 471 qq(></td><td><input type=submit value="Update"></td></form>\n). 472 "<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>". 473 "<input type=hidden name=username value=$data[0]>". 474 qq(<input type=submit value="Delete user"></tr></form>\n); 475 476 } 477 print "</table>\n"; 388 my @userlist; 389 while (my ($username,$acl) = $sth->fetchrow_array) { 390 ##fixme: funky things happening with HTML::Template here; shouldn't need the "logic ? iftrue : iffalse" structure 391 my %row = ( 392 username => $username, 393 can_add => ($acl =~ /a/ ? 1 : 0), 394 can_change => ($acl =~ /c/ ? 1 : 0), 395 can_del => ($acl =~ /d/ ? 1 : 0), 396 sysnet => ($acl =~ /s/ ? 1 : 0), 397 is_admin => ($acl =~ /A/ ? 1 : 0), 398 acl => $acl 399 ); 400 push @userlist, \%row; 401 } 402 $page->param(userlist => \@userlist); 403 478 404 } elsif ($webvar{action} eq 'updacl') { 479 print "Updating ACL for $webvar{username}:<br>\n"; 405 406 $page->param(username => $webvar{username}); 480 407 my $acl = 'b'; 481 408 if ($webvar{admin} eq 'on') { … … 487 414 ($webvar{sysnet} eq 'on' ? 's' : ''); 488 415 } 489 print "New ACL: $acl<br>\n";416 $page->param(acl => $acl); 490 417 491 418 $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'"); 492 419 $sth->execute; 493 print "OK\n" if !$sth->err; 494 495 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 420 $page->param(errmsg => $sth->errstr) if $sth->err; 496 421 497 422 } elsif ($webvar{action} eq 'newuser') { 498 print "Adding user $webvar{username}...\n"; 423 424 $page->param(username => $webvar{username}); 499 425 my $cr_pass = ($webvar{preenc} ? $webvar{password} : 500 426 crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64])); … … 502 428 "('$webvar{username}','$cr_pass','b')"); 503 429 $sth->execute; 504 if ($sth->err) { 505 print "<br>Error adding user: ".$sth->errstr; 506 } else { 507 print "OK\n"; 508 } 509 510 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 430 $page->param(errmsg => $sth->errstr) if $sth->err; 511 431 512 432 } elsif ($webvar{action} eq 'deluser') { 513 print "Deleting user $webvar{username}.<br>\n"; 433 434 $page->param(username => $webvar{username}); 514 435 $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'"); 515 436 $sth->execute; 516 print "OK\n" if !$sth->err; 517 518 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 437 $page->param(errmsg => $sth->errstr) if $sth->err; 519 438 520 439 } elsif ($webvar{action} eq 'emailnotice') { 521 print "<h4>Email notice management:</h4>\nClick the email addresses to edit that list."; 440 522 441 $sth = $ip_dbh->prepare("SELECT action,reciplist FROM notify"); 523 442 $sth->execute; 524 525 print "<table border=1>\n"; 443 my @spamlist; 526 444 while (my ($notice_code,$reciplist) = $sth->fetchrow_array() ) { 527 445 ##fixme: hairy mess, only a few things call mailNotify() anyway, so many possible notices won't work. 528 446 my $action_out = dispNoticeCode($notice_code); 529 print "<tr><td>$action_out</td>". 530 qq(<td><a href="admin.cgi?action=ednotice&code=$notice_code">$reciplist</a></td>). 531 qq(<td><a href="admin.cgi?action=delnotice&code=$notice_code">Delete</a></tr>\n); 532 } 533 print qq(<tr><td colspan=2>Known "special" codes:<br> 534 <ul style="margin-top: 0px; margin-bottom: 0px;"> 535 <li>swi: Notify if block being updated has SWIP flag set</li> 536 </ul></td></tr> 537 </table> 538 ); 539 540 # add new entries from this tangle: 541 print "<h4>Add new notification:</h4>\n". 542 "Note: Failure notices on most conditions are not yet supported.\n"; 543 544 print qq(<table border=1><form action=admin.cgi method="POST"> 545 <input type=hidden name=action value=addnotice> 546 <tr> 547 <td>Recipients</td><td colspan=3><textarea name=reciplist cols=50 rows=5></textarea></td></tr> 548 <tr><td>Action</td><td> 549 <table><tr> 550 <td><input type=radio name=msgaction value=a>Add 551 <input type=radio name=msgaction value=u>Update 552 <input type=radio name=msgaction value=d>Delete 553 <input type=radio name=msgaction value=n>New listitem</td> 554 </tr><tr> 555 <td> 556 <input type=radio name=msgaction value=s:>Special: <input name=special>(requires code changes) 557 </td></tr></table> 558 </td> 559 <td>Failure?</td><td><input type=checkbox name=onfail></td></tr> 560 <tr><td>Event/Allocation type:</td><td colspan=3> 561 <table> 562 <tr> 563 <td><input type=radio name=alloctype value=a>All allocations</td> 564 <td><input type=radio name=alloctype value=.i>All static IPs</td> 565 <td><input type=radio name=alloctype value=ci>New city</td> 566 <td><input type=radio name=alloctype value=no>New node</td> 567 </tr> 568 <tr> 569 ); 447 my %row = ( 448 action => $action_out, 449 code => $notice_code, 450 recips => $reciplist 451 ); 452 push @spamlist, \%row; 453 } 454 $page->param(spamlist => \@spamlist); 570 455 571 456 $sth = $ip_dbh->prepare("SELECT type,dispname FROM alloctypes WHERE listorder < 500 ". … … 573 458 $sth->execute; 574 459 my $i=0; 460 my @typelist; 575 461 while (my ($type,$disp) = $sth->fetchrow_array) { 576 print " <td><input type=radio name=alloctype value=$type>$disp</td>"; 577 $i++; 578 print " </tr>\n\t<tr>" 579 if ($i % 4 == 0); 580 } 581 582 print qq( </tr> 583 </table> 584 </tr> 585 <tr><td colspan=4 align=center><input type=submit value="Add notice"></td></tr> 586 </table> 587 </form> 588 ); 589 ## done spitting out add-new-spam-me-now table 462 my %row = ( 463 type => $type, 464 disptype => $disp, 465 # ahh, off-by-one counts, how we do love thee... NOT! 466 newrow => ($i+2 > $sth->rows ? 1 : (++$i % 4)), 467 ); 468 push @typelist, \%row; 469 } 470 $page->param(typelist => \@typelist); 590 471 591 472 } elsif ($webvar{action} eq 'addnotice') { 473 592 474 $webvar{alloctype} = $webvar{special} if $webvar{msgaction} eq 's:'; 593 475 if ($webvar{msgaction} && $webvar{alloctype} && $webvar{reciplist}) { 476 $page->param(cantry => 1); 594 477 $webvar{reciplist} =~ s/[\r\n]+/,/g; 595 478 $webvar{msgaction} = "f:$webvar{msgaction}" if $webvar{onfail}; 596 print "Adding notice to $webvar{reciplist} for ".dispNoticeCode($webvar{msgaction}.$webvar{alloctype}).":\n"; 479 $page->param(reciplist => $webvar{reciplist}); 480 $page->param(dispnotice => dispNoticeCode($webvar{msgaction}.$webvar{alloctype})); 597 481 $sth = $ip_dbh->prepare("INSERT INTO notify (action, reciplist) VALUES (?,?)"); 598 482 ##fixme: automagically merge reciplists iff action already exists 599 483 $sth->execute($webvar{msgaction}.$webvar{alloctype}, $webvar{reciplist}); 600 if ($sth->err) { 601 print "Failed: DB error: ".$sth->errstr."\n"; 602 } else { 603 print "OK!<br>\n" 604 } 605 } else { 606 print "Need to specify at least one recipient, an action, and an allocation type. ". 607 qq{("Special" content is considered an allocation type). Hit the Back button and try again.<br>\n}; 608 } 609 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 484 $page->param(addfailed => $sth->errstr) if $sth->err; 485 } 610 486 611 487 } elsif ($webvar{action} eq 'delnotice') { 612 print "Deleting notices on ".dispNoticeCode($webvar{code}.$webvar{alloctype}).":\n"; 488 489 $page->param(dispnotice => dispNoticeCode($webvar{code}.$webvar{alloctype})); 613 490 $sth = $ip_dbh->prepare("DELETE FROM notify WHERE action=?"); 614 491 $sth->execute($webvar{code}); 615 if ($sth->err) { 616 print "Failed: DB error: ".$sth->errstr."\n"; 617 } else { 618 print "OK!<br>\n" 619 } 620 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 492 $page->param(delfailed => $sth->errstr) if $sth->err; 621 493 622 494 } elsif ($webvar{action} eq 'ednotice') { 623 print "<h4>Editing recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; 495 496 $page->param(dispnotice => dispNoticeCode($webvar{code})); 497 $page->param(code => $webvar{code}); 624 498 $sth = $ip_dbh->prepare("SELECT reciplist FROM notify WHERE action=?"); 625 499 $sth->execute($webvar{code}); 626 500 my ($reciplist) = $sth->fetchrow_array; 627 501 $reciplist =~ s/,/\n/g; 628 print qq(<form action=admin.cgi method=POST><input type=hidden name=code value="$webvar{code}">\n). 629 qq(<input type=hidden name=action value="updnotice"><table border=1><tr><td>). 630 qq(<textarea cols="40" rows="5" name=reciplist>$reciplist</textarea></td><td><input type=submit value="Update">\n). 631 "</td></tr></table></form>\n"; 502 $page->param(reciplist => $reciplist); 503 632 504 } elsif ($webvar{action} eq 'updnotice') { 633 print "<h4>Updating recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; 505 506 $page->param(dispnotice => dispNoticeCode($webvar{code})); 634 507 $sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?"); 635 508 $webvar{reciplist} =~ s/[\r\n]+/,/g; 636 509 $sth->execute($webvar{reciplist}, $webvar{code}); 637 if ($sth->err) { 638 print "Failed: DB error: ".$sth->errstr."\n"; 639 } else { 640 print "OK!<br>\n" 641 } 642 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 510 $page->param(updfailed => $sth->errstr) if $sth->err; 511 643 512 } elsif ($webvar{action} ne '<NULL>') { 644 print "webvar{action} check failed: Don't know how to $webvar{action}"; 645 } 513 $page->param(dunno => $webvar{action}); 514 } 515 516 ERRJUMP: print "Content-type: text/html\n\n".$header->output; 517 print $page->output; 518 519 ##fixme: make me a footer param! 520 print qq(<hr><div><a href="$IPDB::webpath/">Back</a> to main interface</div>\n); 521 522 # We print the footer here, so we don't have to do it elsewhere. 523 my $footer = HTML::Template->new(filename => "footer.tmpl"); 524 # we're already in the admin tools, no need to provide a bottom link. maybe. 525 #$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); 526 527 print $footer->output; 528 529 $ip_dbh->disconnect; 530 531 exit; 532 646 533 647 534 # Hokay. This is a little different. We have a few specific functions here: … … 649 536 # -> Tweak individual DB fields 650 537 # 651 652 print qq(<hr><a href="/ip/">Back</a> to main interface</a>\n);653 654 printFooter;655 656 $ip_dbh->disconnect;657 658 exit;659 538 660 539 … … 671 550 672 551 673 # List free blocks in a /24 for arbitrary manual allocation674 sub showfree($) {675 my $cidr = new NetAddr::IP $_[0];676 print "Showing free blocks in $cidr<br>\n".677 "<table border=1>\n";678 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");679 $sth->execute;680 while (my @data = $sth->fetchrow_array) {681 my $temp = new NetAddr::IP $data[0];682 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".683 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).684 "<td>".685 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'686 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .687 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .688 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .689 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .690 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .691 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .692 "</td>".693 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).694 "\n</form></tr>\n";695 }696 print "</table>\n";697 }698 699 700 552 # Show allocations to allow editing. 701 sub showAllocs($) { 702 my $cidr = new NetAddr::IP $_[0]; 703 print "Edit custID, allocation type, city for allocations in ". 704 "$cidr:\n<table border=1>"; 705 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr"); 706 $sth->execute; 707 while (my @data = $sth->fetchrow_array) { 708 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n". 709 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n). 710 qq(<td><input name=custid value="$data[1]"></td>\n). 711 "<td><select name=alloctype>"; 712 553 sub showAllocs { 554 555 my $within = new NetAddr::IP $_[0]; 556 $page->param(within => $within); 557 558 $sth = $ip_dbh->prepare("select cidr,custid,type,city,description from allocations where cidr <<= '$within' order by cidr"); 559 $sth->execute; 560 my @blocklist; 561 while (my ($cidr,$custid,$type,$city,$desc) = $sth->fetchrow_array) { 562 my %row = ( 563 cidr => $cidr, 564 custid => $custid, 565 city => $city, 566 desc => $desc, 567 ); 568 569 ##fixme: don't wanna retrieve the whole type list *every time around the outer loop* 713 570 my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes". 714 571 " where listorder < 500 and not (type like '_i') order by listorder"); 715 572 $sth2->execute; 716 while (my @types = $sth2->fetchrow_array) { 717 print "<option". (($data[2] eq $types[0]) ? ' selected' : '') . 718 " value='$types[0]'>$types[1]</option>\n"; 573 my @typelist; 574 while (my ($listtype,$dispname) = $sth2->fetchrow_array) { 575 my %subrow = ( 576 type => $listtype, 577 dispname => $dispname, 578 selected => ($listtype eq $type) 579 ); 580 push @typelist, \%subrow; 719 581 } 720 721 print qq(<td><input name=city value="$data[3]"></td>\n). 722 "<td>$data[4]</td><td>$data[5]</td>". 723 qq(<td><input type=submit value="Update"></td></form></tr>\n); 724 } 725 print "</table>\n"; 726 727 # notes 728 print "<hr><b>Notes:</b>\n". 729 "<ul>\n<li>Use the main interface to update description and notes fields\n". 730 "<li>Changing the allocation type here will NOT affect IP pool data.\n". 731 "</ul>\n"; 732 } 582 $row{typelist} = \@typelist; 583 push @blocklist, \%row; 584 } 585 $page->param(blocklist => \@blocklist); 586 } # end showAllocs() 733 587 734 588 735 589 # Stuff updates into DB 736 590 sub update { 737 eval { 738 # Relatively simple SQL transaction here. Note that we're deliberately NOT 739 # updating notes/desc here as it's available through the main interface. 740 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',". 741 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'"); 742 $sth->execute; 743 $ip_dbh->commit; 744 }; 745 if ($@) { 746 carp "Transaction aborted because $@"; 747 eval { $ip_dbh->rollback; }; 748 syslog "err", "$authuser could not update block '$webvar{block}': '$@'"; 591 # Relatively simple SQL transaction here. Note that we're deliberately NOT 592 # updating notes/desc here as it's available through the main interface. 593 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',". 594 "city=?,type='$webvar{alloctype}' where cidr='$webvar{block}'"); 595 $sth->execute($webvar{city}); 596 597 $page->param(block => $webvar{block}); 598 if ($sth->err) { 599 $page->param(updfailed => $sth->errstr); 600 syslog "err", "$authuser could not update block '$webvar{block}': '".$sth->errstr."'"; 749 601 } else { 750 # If we get here, the operation succeeded.751 602 syslog "notice", "$authuser updated $webvar{block}"; 752 print "Allocation $webvar{block} updated<hr>\n";753 603 } 754 604 # need to get /24 that block is part of … … 756 606 $bits[3] = "0/24"; 757 607 showAllocs((join ".", @bits)); 758 } 608 } # end update() 759 609 760 610 … … 764 614 sub showPool($) { 765 615 my $pool = new NetAddr::IP $_[0]; 766 print qq(Listing pool $pool:\n<table border=1>767 <form action=admin.cgi method=POST>768 <input type=hidden name=action value=updatepool>769 <tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>770 <tr><td align=right>Customer location:</td><td><input name=city></td></tr>771 <tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n);772 616 773 617 $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder"); 774 618 $sth->execute; 775 while (my @data = $sth->fetchrow_array) { 776 print "<option value='$data[0]'>$data[1]</option>\n"; 777 } 778 779 print qq(</select></td></tr> 780 <tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr> 781 <tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr> 782 <tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr> 783 <tr><td colspan=2 align=center><input type=submit value="Update"></td></tr> 784 ). 785 "</table>Update the following record:<table border=1>\n"; 786 $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); 787 $sth->execute; 788 while (my @data = $sth->fetchrow_array) { 789 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>). 790 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>". 791 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n"; 792 } 793 print "</form></table>\n"; 794 } 619 my @typelist; 620 while (my ($type,$dispname) = $sth->fetchrow_array) { 621 my %row = ( 622 type => $type, 623 dispname => $dispname 624 ); 625 push @typelist, \%row; 626 } 627 $page->param(typelist => \@typelist); 628 629 $sth = $ip_dbh->prepare("select ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); 630 $sth->execute; 631 my @iplist; 632 while (my ($ip,$custid,$city,$type,$avail,$desc,$notes) = $sth->fetchrow_array) { 633 my %row = ( 634 ip => $ip, 635 custid => $custid, 636 city => $city, 637 type => $type, 638 avail => $avail, 639 desc => $desc, 640 notes => $notes 641 ); 642 push @iplist, \%row; 643 } 644 $page->param(iplist => \@iplist); 645 } # end showPool() 795 646 796 647 -
trunk/cgi-bin/allocate.pl
r431 r517 11 11 use warnings; 12 12 use DBI; 13 use CommonWeb qw(:ALL);14 13 use NetAddr::IP; 15 14 … … 38 37 my $errstr; 39 38 ($ip_dbh,$errstr) = connectDB_My; 40 if (!$ip_dbh) { 41 printAndExit("Failed to connect to database: $errstr\n");42 } 39 die "Failed to connect to database: $errstr\n" 40 if !$ip_dbh; 41 43 42 checkDBSanity($ip_dbh); 44 43 initIPDBGlobals($ip_dbh); -
trunk/cgi-bin/combineblocks.pl
r417 r517 13 13 #use CGI::Carp qw(fatalsToBrowser); 14 14 use DBI; 15 #use CommonWeb qw(:ALL);16 15 #use POSIX qw(ceil); 17 16 use NetAddr::IP; -
trunk/cgi-bin/main.cgi
r515 r517 12 12 use warnings; 13 13 use CGI::Carp qw(fatalsToBrowser); 14 use CGI::Simple; 15 use HTML::Template; 14 16 use DBI; 15 use CommonWeb qw(:ALL);16 17 use POSIX qw(ceil); 17 18 use NetAddr::IP; … … 26 27 27 28 openlog "IPDB","pid","$IPDB::syslog_facility"; 29 30 ## Environment. Collect some things, process some things, set some things... 28 31 29 32 # Collect the username from HTTP auth. If undefined, we're in … … 36 39 } 37 40 41 # anyone got a better name? :P 42 my $thingroot = $ENV{SCRIPT_FILENAME}; 43 $thingroot =~ s|cgi-bin/main.cgi||; 44 38 45 syslog "debug", "$authuser active, $ENV{'REMOTE_ADDR'}"; 46 47 ##fixme there *must* be a better order to do things in so this can go back where it was 48 # CGI fiddling done here so we can declare %webvar so we can alter $webvar{action} 49 # to show the right page on DB errors. 50 # Set up the CGI object... 51 my $q = new CGI::Simple; 52 # ... and get query-string params as well as POST params if necessary 53 $q->parse_query_string; 54 55 # Convenience; saves changing all references to %webvar 56 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 57 my %webvar = $q->Vars; 39 58 40 59 # Why not a global DB handle? (And a global statement handle, as well...) … … 45 64 ($ip_dbh,$errstr) = connectDB_My; 46 65 if (!$ip_dbh) { 47 exitError("Database error: $errstr\n"); 48 } 49 initIPDBGlobals($ip_dbh); 50 51 # Headerize! Make sure we replace the $$EXTRA0$$ bit as needed. 52 printHeader('', ($IPDBacl{$authuser} =~ /a/ ? 53 '<td align=right><a href="/ip/cgi-bin/main.cgi?action=assign">Add new assignment</a>' : '' 54 )); 55 56 57 # Global variables 58 my %webvar = parse_post(); 59 cleanInput(\%webvar); 66 $webvar{action} = "dberr"; 67 } else { 68 initIPDBGlobals($ip_dbh); 69 } 70 71 # Set up some globals 72 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 73 74 my $header = HTML::Template->new(filename => "header.tmpl"); 75 my $footer = HTML::Template->new(filename => "footer.tmpl"); 76 77 $header->param(version => $IPDB::VERSION); 78 $header->param(addperm => $IPDBacl{$authuser} =~ /a/); 79 $header->param(webpath => $IPDB::webpath); 80 print "Content-type: text/html\n\n", $header->output; 60 81 61 82 62 83 #main() 84 my $aclerr; 63 85 64 86 if(!defined($webvar{action})) { 65 $webvar{action} = "<NULL>"; #shuts up the warnings. 87 $webvar{action} = "index"; #shuts up the warnings. 88 } 89 90 my $page; 91 if (-e "$ENV{HTML_TEMPLATE_ROOT}/$webvar{action}.tmpl") { 92 $page = HTML::Template->new(filename => "$webvar{action}.tmpl"); 93 } else { 94 $page = HTML::Template->new(filename => "dunno.tmpl"); 66 95 } 67 96 … … 70 99 } elsif ($webvar{action} eq 'addmaster') { 71 100 if ($IPDBacl{$authuser} !~ /a/) { 72 printError("You shouldn't have been able to get here. Access denied."); 101 $aclerr = 'addmaster'; 102 } 103 } elsif ($webvar{action} eq 'newmaster') { 104 105 if ($IPDBacl{$authuser} !~ /a/) { 106 $aclerr = 'addmaster'; 73 107 } else { 74 open HTML, "<../addmaster.html";75 print while <HTML>;76 }77 } elsif ($webvar{action} eq 'newmaster') {78 79 if ($IPDBacl{$authuser} !~ /a/) {80 printError("You shouldn't have been able to get here. Access denied.");81 } else {82 83 108 my $cidr = new NetAddr::IP $webvar{cidr}; 84 85 print "<div type=heading align=center>Adding $cidr as master block....</div>\n"; 109 $page->param(cidr => "$cidr"); 86 110 87 111 my ($code,$msg) = addMaster($ip_dbh, $webvar{cidr}); 88 112 89 113 if ($code eq 'FAIL') { 90 carp "Transaction aborted because $msg";91 114 syslog "err", "Could not add master block '$webvar{cidr}' to database: '$msg'"; 92 printError("Could not add master block $webvar{cidr} to database: $msg");115 $page->param(err => $msg); 93 116 } else { 94 print "<div type=heading align=center>Success!</div>\n";95 117 syslog "info", "$authuser added master block $webvar{cidr}"; 96 118 } … … 133 155 } 134 156 elsif ($webvar{action} eq 'nodesearch') { 135 open HTML, "<../nodesearch.html";136 my $html = join('',<HTML>);137 close HTML;138 139 157 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 140 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";141 my $nodes = '';158 $sth->execute() or $page->param(errmsg => $sth->errstr); 159 my @nodelist; 142 160 while (my ($nid,$nname) = $sth->fetchrow_array()) { 143 $nodes .= "<option value='$nid'>$nname</option>\n"; 144 } 145 $html =~ s/\$\$NODELIST\$\$/$nodes/; 146 147 print $html; 148 } 149 150 # Default is an error. It shouldn't be possible to easily get here. 151 # The only way I can think of offhand is to just call main.cgi bare- 152 # which is not in any way guaranteed to provide anything useful. 161 my %row = (nodeid => $nid, nodename => $nname); 162 push @nodelist, \%row; 163 } 164 $page->param(nodelist => \@nodelist); 165 } 166 167 # DB failure. Can't do much here, really. 168 elsif ($webvar{action} eq 'dberr') { 169 $page->param(errmsg => $errstr); 170 } 171 172 # Default is an error. It shouldn't be possible to get here unless you're 173 # randomly feeding in values for webvar{action}. 153 174 else { 154 175 my $rnd = rand 500; 155 176 my $boing = sprintf("%.2f", rand 500); 156 my @excuses = ("Aether cloudy. Ask again later.","The gods are unhappy with your sacrifice.", 157 "Because one of it's legs are both the same", "*wibble*", 158 "Hey! Stop pushing my buttons!", "I ain't done nuttin'", "9", 159 "8", "9", "10", "11", "12", "13", "14", "15", "16", "17"); 160 printAndExit("Error $boing: ".$excuses[$rnd/30.0]); 177 my @excuses = ( 178 "Aether cloudy. Ask again later about $webvar{action}.", 179 "The gods are unhappy with your sacrificial $webvar{action}.", 180 "Because one of $webvar{action}'s legs are both the same", 181 "<b>wibble</b><br>Can't $webvar{action}, the grue will get me!<br>Can't $webvar{action}, the grue will get me!", 182 "Hey, man, you've had your free $webvar{action}. Next one's gonna... <i>cost</i>....", 183 "I ain't done $webvar{action}", 184 "Oooo, look! A flying $webvar{action}!", 185 "$webvar{action} too evil, avoiding.", 186 "Rocks fall, $webvar{action} dies.", 187 "Bit bucket must be emptied before I can $webvar{action}..." 188 ); 189 $page->param(dunno => $excuses[$rnd/50.0]); 161 190 } 162 191 ## Finally! Done with that NASTY "case" emulation! 163 192 193 194 # Switch to a different template if we've tripped on an ACL error. 195 # Note that this should only be exercised in development, when 196 # deeplinked, or when being attacked; normal ACL handling should 197 # remove the links a user is not allowed to click on. 198 if ($aclerr) { 199 $page = HTML::Template->new(filename => "aclerror.tmpl"); 200 $page->param(ipdbfunc => $aclmsg{$aclerr}); 201 } 164 202 165 203 … … 167 205 finish($ip_dbh); 168 206 169 print qq(<div align=right style="position: absolute; right: 30px;">). 170 qq(<a href="/ip/cgi-bin/admin.cgi">Admin tools</a></div><br>\n) 171 if $IPDBacl{$authuser} =~ /A/; 172 173 # We print the footer here, so we don't have to do it elsewhere. 174 printFooter; 207 ## Do all our printing here so we can generate errors and stick them into the slots in the templates. 208 209 # can't do this yet, too many blowups 210 #print "Content-type: text/html\n\n", $header->output; 211 $page->param(webpath => $IPDB::webpath); 212 print $page->output; 213 214 # include the admin tools link in the output? 215 $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); 216 $footer->param(webpath => $IPDB::webpath); 217 print $footer->output; 218 175 219 # Just in case something waaaayyy down isn't in place 176 220 # properly... we exit explicitly. 177 exit; 178 179 180 181 # args are: a reference to an array with the row to be printed and the 182 # class(stylesheet) to use for formatting. 183 # if ommitting the class - call the sub as &printRow(\@array) 184 sub printRow { 185 my ($rowRef,$class) = @_; 186 187 if (!$class) { 188 print "<tr>\n"; 189 } else { 190 print "<tr class=\"$class\">\n"; 191 } 192 193 ELEMENT: foreach my $element (@$rowRef) { 194 if (!defined($element)) { 195 print "<td></td>\n"; 196 next ELEMENT; 197 } 198 $element =~ s|\n|</br>|g; 199 print "<td>$element</td>\n"; 200 } 201 print "</tr>"; 202 } # printRow 203 204 205 # Prints table headings. Accepts any number of arguments; 206 # each argument is a table heading. 207 sub startTable { 208 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>); 209 210 foreach(@_) { 211 print qq(<td class="heading">$_</td>); 212 } 213 print "</tr>\n"; 214 } # startTable 221 exit 0; 215 222 216 223 217 224 # Initial display: Show master blocks with total allocated subnets, total free subnets 218 225 sub showSummary { 219 220 startTable('Master netblock', 'Routed netblocks', 'Allocated netblocks',221 'Free netblocks', 'Largest free block');222 223 226 my %allocated; 224 227 my %free; … … 260 263 } 261 264 262 # Print the data. 263 my $count=0; 265 # Assemble the data to stuff into the template. 266 my @masterlist; 267 my $rowclass=0; 264 268 foreach my $master (@masterblocks) { 265 my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showmaster&block=$master\">$master</a>", 266 $routed{"$master"}, $allocated{"$master"}, $free{"$master"}, 267 ( ($bigfree{"$master"} eq '') ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 269 my %row = ( 270 rowclass => $rowclass++ % 2, 271 master => "$master", 272 routed => $routed{"$master"}, 273 allocated => $allocated{"$master"}, 274 free => $free{"$master"}, 275 bigfree => ( ($bigfree{"$master"} eq '') ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 268 276 ); 269 270 printRow(\@row, 'color1' ) if($count%2==0); 271 printRow(\@row, 'color2' ) if($count%2!=0); 272 $count++; 273 } 274 print "</table>\n"; 275 if ($IPDBacl{$authuser} =~ /a/) { 276 print qq(<a href="/ip/cgi-bin/main.cgi?action=addmaster">Add new master block</a><br><br>\n); 277 } 278 print "Note: Free blocks noted here include both routed and unrouted blocks.\n"; 277 push (@masterlist, \%row); 278 } 279 $page->param(masterlist => \@masterlist); 280 281 $page->param(addmaster => ($IPDBacl{$authuser} =~ /a/) ); 279 282 280 283 } # showSummary … … 288 291 sub showMaster { 289 292 290 print qq(<center><div class="heading">Summarizing routed blocks for ). 291 qq($webvar{block}:</div></center><br>\n); 293 $page->param(master => $webvar{block}); 292 294 293 295 my %allocated; 294 296 my %free; 295 my % routed;297 my %cities; 296 298 my %bigfree; 297 299 … … 311 313 $bigfree{"$cidr"} = 128; 312 314 # Retain the routing destination 313 $ routed{"$cidr"} = $data[1];315 $cities{"$cidr"} = $data[1]; 314 316 } 315 317 316 318 # Check if there were actually any blocks routed from this master 317 319 if ($i > 0) { 318 startTable('Routed block','Routed to','Allocated blocks',319 'Free blocks','Largest free block');320 320 321 321 # Count the allocations … … 345 345 } 346 346 347 # Print the data.348 my $ count=0;347 my @routed; 348 my $rowclass = 0; 349 349 foreach my $master (@localmasters) { 350 my @row = ("<a href=\"/ip/cgi-bin/main.cgi?action=showrouted&block=$master\">$master</a>", 351 $routed{"$master"}, $allocated{"$master"}, 352 $free{"$master"}, 353 ( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 354 ); 355 printRow(\@row, 'color1' ) if($count%2==0); 356 printRow(\@row, 'color2' ) if($count%2!=0); 357 $count++; 358 } 359 } else { 360 # If a master block has no routed blocks, then by definition it has no 361 # allocations, and can be deleted. 362 print qq(<hr width="60%"><center><div class="heading">No allocations in ). 363 qq($master.</div>\n). 364 ($IPDBacl{$authuser} =~ /d/ ? 365 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n). 366 qq(<input type=hidden name=action value="delete">\n). 367 qq(<input type=hidden name=block value="$master">\n). 368 qq(<input type=hidden name=alloctype value="mm">\n). 369 qq(<input type=submit value=" Remove this master ">\n). 370 qq(</form></center>\n) : 371 ''); 350 my %row = ( 351 rowclass => $rowclass++ % 2, 352 block => "$master", 353 city => $cities{"$master"}, 354 nsubs => $allocated{"$master"}, 355 nfree => $free{"$master"}, 356 lfree => ( ($bigfree{"$master"} eq 128) ? ("<NONE>") : ("/".$bigfree{"$master"}) ) 357 ); 358 push @routed, \%row; 359 } 360 $page->param(routedlist => \@routed); 372 361 373 362 } # end check for existence of routed blocks in master 374 363 375 print qq(</table>\n<hr width="60%">\n). 376 qq(<center><div class="heading">Unrouted blocks in $master:</div></center><br>\n); 377 378 startTable('Netblock','Range'); 364 $page->param(delmaster => ($IPDBacl{$authuser} =~ /d/)); 379 365 380 366 # Snag the free blocks. … … 383 369 "routed='n' order by cidr"); 384 370 $sth->execute(); 371 my @unrouted; 372 my $rowclass = 0; 385 373 while (my @data = $sth->fetchrow_array()) { 386 374 my $cidr = new NetAddr::IP $data[0]; 387 my @row = ("$cidr", $cidr->range); 388 printRow(\@row, 'color1' ) if($count%2==0); 389 printRow(\@row, 'color2' ) if($count%2!=0); 390 $count++; 391 } 392 393 print "</table>\n"; 375 my %row = ( 376 rowclass => $rowclass++ % 2, 377 fblock => "$cidr", 378 frange => $cidr->range 379 ); 380 push @unrouted, \%row; 381 } 382 $page->param(unrouted => \@unrouted); 383 394 384 } # showMaster 395 385 … … 408 398 $sth = $ip_dbh->prepare("select city from routed where cidr='$master'"); 409 399 $sth->execute; 410 my @data = $sth->fetchrow_array; 411 412 print qq(<center><div class="heading">Summarizing allocated blocks for ). 413 qq($master ($data[0]):</div></center><br>\n); 414 415 startTable('CIDR allocation','Customer Location','Type','CustID','SWIPed?','Description/Name'); 400 my ($rcity) = $sth->fetchrow_array; 401 402 $page->param(master => "$master"); 403 $page->param(rcity => $rcity); 416 404 417 405 # Snag the allocations for this block … … 424 412 my $custsth = $ip_dbh->prepare("select count(*) from customers where custid=?"); 425 413 426 my $count=0; 427 while (my @data = $sth->fetchrow_array()) { 428 # cidr,city,type,custid,swip,description, as per the SELECT 429 my $cidr = new NetAddr::IP $data[0]; 430 431 # Clean up extra spaces that are borking things. 432 # $data[2] =~ s/\s+//g; 433 434 $custsth->execute($data[3]); 414 my $rowclass = 0; 415 my @blocklist; 416 while (my ($cidr,$city,$type,$custid,$swip,$desc) = $sth->fetchrow_array()) { 417 $custsth->execute($custid); 435 418 my ($ncust) = $custsth->fetchrow_array(); 436 419 437 # Prefix subblocks with "Sub " 438 my @row = ( (($data[2] =~ /^.r$/) ? 'Sub ' : ''). 439 qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>), 440 $data[1], $disp_alloctypes{$data[2]}, $data[3], 441 ($data[4] eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), $data[5]); 442 # If the allocation is a pool, allow listing of the IPs in the pool. 443 if ($data[2] =~ /^.[pd]$/) { 444 $row[0] .= ' <a href="/ip/cgi-bin/main.cgi?action=listpool'. 445 "&pool=$data[0]\">List IPs</a>"; 446 } 447 448 printRow(\@row, 'color1') if ($count%2 == 0); 449 printRow(\@row, 'color2') if ($count%2 != 0); 450 $count++; 451 } 452 453 print "</table>\n"; 454 455 # If the routed block has no allocations, by definition it only has 456 # one free block, and therefore may be deleted. 457 if ($count == 0) { 458 print qq(<hr width="60%"><center><div class="heading">No allocations in ). 459 qq($master.</div></center>\n). 460 ($IPDBacl{$authuser} =~ /d/ ? 461 qq(<form action="/ip/cgi-bin/main.cgi" method=POST>\n). 462 qq(<input type=hidden name=action value="delete">\n). 463 qq(<input type=hidden name=block value="$master">\n). 464 qq(<input type=hidden name=alloctype value="rm">\n). 465 qq(<input type=submit value=" Remove this block ">\n). 466 qq(</form>\n) : 467 ''); 468 } 469 470 print qq(<hr width="60%">\n<center><div class="heading">Free blocks within routed ). 471 qq(submaster $master</div></center>\n); 472 473 startTable('CIDR block','Range'); 420 my %row = ( 421 rowclass => $rowclass++ % 2, 422 block => $cidr, 423 city => $city, 424 type => $disp_alloctypes{$type}, 425 custid => $custid, 426 swip => ($swip eq 'y' ? ($ncust == 0 ? 'Yes<small>*</small>' : 'Yes') : 'No'), 427 desc => $desc 428 ); 429 $row{subblock} = ($type =~ /^.r$/); # hmf. wonder why these won't work in the hash declaration... 430 $row{listpool} = ($type =~ /^.[pd]$/); 431 push (@blocklist, \%row); 432 } 433 $page->param(blocklist => \@blocklist); 434 435 $page->param(delrouted => $IPDBacl{$authuser} =~ /d/); 474 436 475 437 # Snag the free blocks. We don't really *need* to be pedantic about avoiding 476 438 # unrouted free blocks, but it's better to let the database do the work if we can. 477 $count = 0; 439 $rowclass = 0; 440 my @unassigned; 478 441 $sth = $ip_dbh->prepare("select cidr,routed from freeblocks where cidr <<= '$master'". 479 442 " order by cidr"); 480 443 $sth->execute(); 481 while (my @data = $sth->fetchrow_array()) { 482 # cidr,routed 483 my $cidr = new NetAddr::IP $data[0]; 484 # Include some HairyPerl(TM) to prefix subblocks with "Sub " 485 my @row = ((($data[1] ne 'y' && $data[1] ne 'n') ? 'Sub ' : ''). 486 ($IPDBacl{$authuser} =~ /a/ ? qq(<a href="/ip/cgi-bin/main.cgi?action=assign&block=$cidr&fbtype=$data[1]">$cidr</a>) : $cidr), 487 $cidr->range); 488 printRow(\@row, 'color1') if ($count%2 == 0); 489 printRow(\@row, 'color2') if ($count%2 != 0); 490 $count++; 491 } 492 493 print "</table>\n"; 444 while (my ($cidr_db,$routed) = $sth->fetchrow_array()) { 445 my $cidr = new NetAddr::IP $cidr_db; 446 447 my %row = ( 448 rowclass => $rowclass++ % 2, 449 subblock => ($routed ne 'y' && $routed ne 'n'), 450 fblock => $cidr_db, 451 fbtype => $routed, 452 frange => $cidr->range, 453 ); 454 push @unassigned, \%row; 455 } 456 $page->param(unassigned => \@unassigned); 457 494 458 } # showRBlock 495 459 … … 500 464 my $cidr = new NetAddr::IP $webvar{pool}; 501 465 502 my ($pooltype,$poolcity); 466 $page->param(block => $webvar{pool}); 467 $page->param(netip => $cidr->addr); 468 $cidr++; 469 $page->param(gate => $cidr->addr); 470 $cidr--; $cidr--; 471 $page->param(bcast => $cidr->addr); 472 $page->param(mask => $cidr->mask); 503 473 504 474 # Snag pool info for heading 505 $sth = $ip_dbh->prepare("select type,city from allocations where cidr= '$cidr'");506 $sth->execute ;507 $sth->bind_columns(\$pooltype, \$poolcity);508 $sth->fetch() || carp $sth->errstr; 509 510 print qq(<center><div class="heading">Listing pool IPs for $cidr<br>\n).511 qq(($disp_alloctypes{$pooltype} in $poolcity)</div></center><br>\n); 475 $sth = $ip_dbh->prepare("select type,city from allocations where cidr=?"); 476 $sth->execute($webvar{pool}); 477 my ($pooltype, $poolcity) = $sth->fetchrow_array; 478 479 $page->param(disptype => $disp_alloctypes{$pooltype}); 480 $page->param(city => $poolcity); 481 512 482 # Only display net/gw/bcast if it's a "real" netblock and not a PPP(oE) lunacy 513 if ($pooltype =~ /^.d$/) { 514 print qq(<div class="indent"><b>Reserved IPs:</b><br>\n); 515 print qq(<div class="indent"><table><tr class=color1><td>Network IP:</td><td>). 516 $cidr->addr."</td></tr>\n"; 517 $cidr++; 518 print "<tr class=color2><td>Gateway:</td><td>".$cidr->addr."</td></tr>\n"; 519 $cidr--; $cidr--; 520 print "<tr class=color1><td>Broadcast:</td><td>".$cidr->addr."</td></tr>\n". 521 "<tr><td>Netmask:</td><td>".$cidr->mask."</td></tr>\n". 522 "</table></div></div>\n"; 523 } 483 $page->param(realblock => $pooltype =~ /^.d$/); 524 484 525 485 # probably have to add an "edit IP allocation" link here somewhere. 526 486 527 startTable('IP','Customer ID','Available?','Description','');528 487 $sth = $ip_dbh->prepare("select ip,custid,available,description,type". 529 488 " from poolips where pool='$webvar{pool}' order by ip"); 530 489 $sth->execute; 531 my $count = 0; 532 while (my @data = $sth->fetchrow_array) { 533 # pool,ip,custid,city,ptype,available,notes,description,circuitid 534 # ip,custid,available,description,type 535 # If desc is "null", make it not null. <g> 536 if ($data[3] eq '') { 537 $data[3] = ' '; 538 } 539 # Some nice hairy Perl to decide whether to allow unassigning each IP 540 # -> if $data[2] (aka poolips.available) == 'n' then we print the unassign link 541 # else we print a blank space 542 my @row = ( qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>), 543 $data[1],$data[2],$data[3], 544 ( (($data[2] eq 'n') && ($IPDBacl{$authuser} =~ /d/)) ? 545 ("<a href=\"/ip/cgi-bin/main.cgi?action=delete&block=$data[0]&". 546 "alloctype=$data[4]\">Unassign this IP</a>") : 547 (" ") ) 490 my @poolips; 491 my $rowclass = 0; 492 while (my ($ip,$custid,$available,$desc,$type) = $sth->fetchrow_array) { 493 my %row = ( 494 rowclass => $rowclass++ % 2, 495 ip => $ip, 496 custid => $custid, 497 available => $available, 498 desc => $desc, 499 maydel => $IPDBacl{$authuser} =~ /d/, 500 delme => $available eq 'n' 548 501 ); 549 printRow(\@row, 'color1') if($count%2==0); 550 printRow(\@row, 'color2') if($count%2!=0); 551 $count++; 552 } 553 print "</table>\n"; 502 push @poolips, \%row; 503 } 504 $page->param(poolips => \@poolips); 554 505 555 506 } # end listPool … … 561 512 562 513 if ($IPDBacl{$authuser} !~ /a/) { 563 printError("You shouldn't have been able to get here. Access denied.");514 $aclerr = 'addblock'; 564 515 return; 565 516 } 566 517 567 my $html; 518 # hack pthbttt eww 519 $webvar{block} = '' if !$webvar{block}; 520 521 # hmm. TMPL_IF block and TMPL_ELSE block on these instead? 522 $page->param(rowa => 'row'.($webvar{block} eq '' ? 1 : 0)); 523 $page->param(rowb => 'row'.($webvar{block} eq '' ? 0 : 1)); 524 $page->param(block => $webvar{block}); # fb-assign flag, if block is set, we're in fb-assign 525 $page->param(iscontained => ($webvar{fbtype} && $webvar{fbtype} ne 'y')); 568 526 569 527 # New special case- block to assign is specified 570 528 if ($webvar{block} ne '') { 571 open HTML, "../fb-assign.html"572 or croak "Could not open fb-assign.html: $!";573 $html = join('',<HTML>);574 close HTML;575 529 my $block = new NetAddr::IP $webvar{block}; 576 $html =~ s|\$\$BLOCK\$\$|$block|g; 577 $html =~ s|\$\$MASKBITS\$\$|$block->masklen|; 578 my $typelist = ''; 579 530 531 # Handle contained freeblock allocation. 580 532 # This is a little dangerous, as it's *theoretically* possible to 581 533 # get fbtype='n' (aka a non-routed freeblock). However, should 582 534 # someone manage to get there, they get what they deserve. 583 535 if ($webvar{fbtype} ne 'y') { 584 # Snag the type of the block from the database. We have no 585 # convenient way to pass this in from the calling location. :/ 536 # Snag the type of the container block from the database. 586 537 $sth = $ip_dbh->prepare("select type from allocations where cidr >>='$block'"); 587 538 $sth->execute; 588 539 my @data = $sth->fetchrow_array; 589 540 $data[0] =~ s/c$/r/; # Munge the type into the correct form 590 $typelist = "$list_alloctypes{$data[0]}<input type=hidden name=alloctype value=$data[0]>\n"; 541 $page->param(fbdisptype => $list_alloctypes{$data[0]}); 542 $page->param(type => $data[0]); 591 543 } else { 592 $typelist .= qq(<select name="alloctype">\n);593 544 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 500 ". 594 545 "and type not like '_i' and type not like '_r' order by listorder"); 595 546 $sth->execute; 596 my @ data = $sth->fetchrow_array;597 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";547 my @typelist; 548 my $selflag = 0; 598 549 while (my @data = $sth->fetchrow_array) { 599 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 550 my %row = (tval => $data[0], 551 type => $data[1], 552 sel => ($selflag == 0 ? ' selected' : '') 553 ); 554 push (@typelist, \%row); 555 $selflag++; 600 556 } 601 $typelist .= "</select>\n"; 602 } 603 $html =~ s|\$\$TYPELIST\$\$|$typelist|g; 557 $page->param(typelist => \@typelist); 558 } 604 559 } else { 605 open HTML, "../assign.html" 606 or croak "Could not open assign.html: $!"; 607 $html = join('',<HTML>); 608 close HTML; 609 my $masterlist = "<select name=allocfrom><option selected>-</option>\n"; 560 my @masterlist; 610 561 foreach my $master (@masterblocks) { 611 $masterlist .= "<option>$master</option>\n"; 612 } 613 $masterlist .= "</select>\n"; 614 $html =~ s|\$\$MASTERLIST\$\$|$masterlist|g; 615 my $pops = ''; 562 my %row = (master => "$master"); 563 push (@masterlist, \%row); 564 } 565 $page->param(masterlist => \@masterlist); 566 567 my @pops; 616 568 foreach my $pop (@poplist) { 617 $pops .= "<option>$pop</option>\n"; 618 } 619 $html =~ s|\$\$POPLIST\$\$|$pops|g; 620 my $typelist = ''; 621 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 569 my %row = (pop => $pop); 570 push (@pops, \%row); 571 } 572 $page->param(pops => \@pops); 573 574 # could arguably include routing (500) in the list, but ATM it doesn't 575 # make sense, and in any case that shouldn't be structurally possible here. 576 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder <= 500 order by listorder"); 622 577 $sth->execute; 623 my @ data = $sth->fetchrow_array;624 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n";578 my @typelist; 579 my $selflag = 0; 625 580 while (my @data = $sth->fetchrow_array) { 626 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 627 } 628 $html =~ s|\$\$TYPELIST\$\$|$typelist|g; 629 } 630 my $cities = ''; 581 my %row = (tval => $data[0], 582 type => $data[1], 583 sel => ($selflag == 0 ? ' selected' : '') 584 ); 585 push (@typelist, \%row); 586 $selflag++; 587 } 588 $page->param(typelist => \@typelist); 589 } 590 591 my @cities; 631 592 foreach my $city (@citylist) { 632 $cities .= "<option>$city</option>\n"; 633 } 634 $html =~ s|\$\$ALLCITIES\$\$|$cities|g; 593 my %row = (city => $city); 594 push (@cities, \%row); 595 } 596 $page->param(citylist => \@cities); 635 597 636 598 ## node hack 637 599 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 638 600 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n"; 639 my $nodes = '';601 my @nodes; 640 602 while (my ($nid,$nname) = $sth->fetchrow_array()) { 641 $nodes .= "<option value='$nid'>$nname</option>\n"; 642 } 643 $html =~ s/\$\$NODELIST\$\$/$nodes/; 603 my %row = (nid => $nid, nname => $nname); 604 push (@nodes, \%row); 605 } 606 $page->param(nodelist => \@nodes); 644 607 ## end node hack 645 608 646 my $i = 0; 647 $i++ if $webvar{fbtype} eq 'y'; 648 # Check to see if user is allowed to do anything with sensitive data 649 my $privdata = ''; 650 if ($IPDBacl{$authuser} =~ /s/) { 651 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 652 qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">). 653 qq(</textarea></td></tr>\n); 654 $i++; 655 } 656 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 657 658 $i = $i % 2; 659 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 660 661 print $html; 609 $page->param(privdata => $IPDBacl{$authuser} =~ /s/); 662 610 663 611 } # assignBlock … … 667 615 sub confirmAssign { 668 616 if ($IPDBacl{$authuser} !~ /a/) { 669 printError("You shouldn't have been able to get here. Access denied.");617 $aclerr = 'addblock'; 670 618 return; 671 619 } … … 693 641 $sth->execute; 694 642 my $optionlist; 695 while (my @data = $sth->fetchrow_array) { 643 644 my @poollist; 645 while (my ($poolcit,$poolblock,$poolfree) = $sth->fetchrow_array) { 696 646 # city,pool cidr,free IP count 697 if ($data[2] > 0) { 698 $optionlist .= "<option value='$data[1]'>$data[1] [$data[2] free IP(s)] in $data[0]</option>\n"; 647 if ($poolfree > 0) { 648 my %row = (poolcit => $poolcit, poolblock => $poolblock, poolfree => $poolfree); 649 push (@poollist, \%row); 699 650 } 700 651 } 652 $page->param(staticip => 1); 653 $page->param(poollist => \@poollist); 701 654 $cidr = "Single static IP"; 702 $alloc_from = "<select name=alloc_from>".$optionlist."</select>\n"; 655 ##fixme: need to handle "no available pools" 703 656 704 657 } else { # end show pool options … … 710 663 711 664 if (!$webvar{maskbits}) { 712 printError("Please specify a CIDR mask length.");665 $page->param(err => "Please specify a CIDR mask length."); 713 666 return; 714 667 } … … 748 701 " block size for the pool."; 749 702 } else { 703 if (!$webvar{pop}) { 704 $page->param(err => 'Please select a POP to route the block from/through.'); 705 return; 706 } 750 707 $city = $webvar{pop}; 751 708 $failmsg = "No suitable free block found.<br>\nYou will have to route another". … … 769 726 my @data = $sth->fetchrow_array(); 770 727 if ($data[0] eq "") { 771 printError($failmsg);728 $page->param(err => $failmsg); 772 729 return; 773 730 } … … 775 732 } # check for freeblocks assignment or IPDB-controlled assignment 776 733 777 $alloc_from = qq($cidr<input type=hidden name=alloc_from value="$cidr">);734 $alloc_from = "$cidr"; 778 735 779 736 # If the block to be allocated is smaller than the one we found, … … 789 746 } # if ($webvar{alloctype} =~ /^.i$/) 790 747 791 open HTML, "../confirm.html"792 or croak "Could not open confirm.html: $!";793 my $html = join '', <HTML>;794 close HTML;795 796 748 ## node hack 797 749 if ($webvar{node} && $webvar{node} ne '-') { … … 799 751 $sth->execute($webvar{node}); 800 752 my ($nodename) = $sth->fetchrow_array(); 801 $html =~ s/\$\$NODENAME\$\$/$nodename/; 802 $html =~ s/\$\$NODEID\$\$/$webvar{node}/; 803 } else { 804 $html =~ s/\$\$NODENAME\$\$//; 805 $html =~ s/\$\$NODEID\$\$//; 753 $page->param(nodename => $nodename); 754 $page->param(nodeid => $webvar{node}); 806 755 } 807 756 ## end node hack 808 757 809 ### gotta fix this in final810 # Stick in customer info as necessary - if it's blank, it just ends811 # up as blank lines ignored in the rendering of the page812 my $custbits;813 $html =~ s|\$\$CUSTBITS\$\$|$custbits|g;814 ###815 816 758 # Stick in the allocation data 817 $html =~ s|\$\$ALLOC_TYPE\$\$|$webvar{alloctype}|g; 818 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$webvar{alloctype}}|g; 819 $html =~ s|\$\$ALLOC_FROM\$\$|$alloc_from|g; 820 $html =~ s|\$\$CIDR\$\$|$cidr|g; 821 $webvar{city} = desanitize($webvar{city}); 822 $html =~ s|\$\$CITY\$\$|$webvar{city}|g; 823 $html =~ s|\$\$CUSTID\$\$|$webvar{custid}|g; 824 $webvar{circid} = desanitize($webvar{circid}); 825 $html =~ s|\$\$CIRCID\$\$|$webvar{circid}|g; 826 $webvar{desc} = desanitize($webvar{desc}); 827 $html =~ s|\$\$DESC\$\$|$webvar{desc}|g; 828 $webvar{notes} = desanitize($webvar{notes}); 829 $html =~ s|\$\$NOTES\$\$|$webvar{notes}|g; 830 $html =~ s|\$\$ACTION\$\$|insert|g; 831 832 my $i=1; 759 $page->param(alloc_type => $webvar{alloctype}); 760 $page->param(typefull => $q->escapeHTML($disp_alloctypes{$webvar{alloctype}})); 761 $page->param(alloc_from => $alloc_from); 762 $page->param(cidr => $cidr); 763 $page->param(city => $q->escapeHTML($webvar{city})); 764 $page->param(custid => $webvar{custid}); 765 $page->param(circid => $q->escapeHTML($webvar{circid})); 766 $page->param(desc => $q->escapeHTML($webvar{desc})); 767 768 ##fixme: find a way to have the displayed copy have <br> substitutions 769 # for newlines, and the <input> value have either encoded or bare newlines. 770 # Also applies to privdata. 771 $page->param(notes => $q->escapeHTML($webvar{notes},'y')); 772 833 773 # Check to see if user is allowed to do anything with sensitive data 834 774 my $privdata = ''; 835 if ($IPDBacl{$authuser} =~ /s/) { 836 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 837 qq(<td class=regular>$webvar{privdata}). 838 qq(<input type=hidden name=privdata value="$webvar{privdata}"></td></tr>\n); 839 $i++; 840 } 841 # We're going to abuse $$PRIVDATA$$ to stuff in some stuff for billing. 842 $privdata .= "<input type=hidden name=billinguser value=$webvar{userid}>\n" 775 $page->param(privdata => $q->escapeHTML($webvar{privdata},'y')) 776 if $IPDBacl{$authuser} =~ /s/; 777 778 # Yay! This now has it's very own little home. 779 $page->param(billinguser => $webvar{userid}) 843 780 if $webvar{userid}; 844 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 845 846 $i = $i % 2; 847 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 848 849 print $html; 781 782 ##fixme: this is only needed iff confirm.tmpl and 783 # confirmRemove.tmpl are merged (quite possible, just 784 # a little tedious) 785 $page->param(action => "insert"); 850 786 851 787 } # end confirmAssign … … 855 791 sub insertAssign { 856 792 if ($IPDBacl{$authuser} !~ /a/) { 857 printError("You shouldn't have been able to get here. Access denied.");793 $aclerr = 'addblock'; 858 794 return; 859 795 } … … 867 803 # successful netblock allocation, the IP allocated for static 868 804 # IP, or the error message if an error occurred. 805 869 806 my ($code,$msg) = allocateBlock($ip_dbh, $webvar{fullcidr}, $webvar{alloc_from}, 870 807 $webvar{custid}, $webvar{alloctype}, $webvar{city}, $webvar{desc}, $webvar{notes}, … … 874 811 if ($webvar{alloctype} =~ /^.i$/) { 875 812 $msg =~ s|/32||; 876 print qq(<div class="center"><div class="heading">The IP $msg has been allocated to customer $webvar{custid}</div>). 877 ( ($webvar{alloctype} eq 'di' && $webvar{billinguser}) ? 878 qq(<div><a href="https://billing.example.com/radius.pl?). 879 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}". 880 qq(&ipdb=1&ip=$msg">Add this IP to RADIUS user table</a></div>) 881 : "</div>"); 813 $page->param(staticip => $msg); 814 $page->param(custid => $webvar{custid}); 815 $page->param(billinguser => $webvar{billinguser}); 882 816 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 883 817 "$disp_alloctypes{$webvar{alloctype}} $msg allocated to customer $webvar{custid}\n". … … 885 819 } else { 886 820 my $netblock = new NetAddr::IP $webvar{fullcidr}; 887 print qq(<div class="center"><div class="heading">The block $webvar{fullcidr} was ).888 "sucessfully added as: $disp_alloctypes{$webvar{alloctype}}</div>". 889 ( ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) ? 890 qq(<div><a href="https://billing.example.com/radius.pl?). 891 "action=new_radius_user&custid=$webvar{custid}&userid=$webvar{billinguser}".892 "&route_subnet=".$netblock->addr."&subnet_slash=".$netblock->masklen.893 "&include_routed_subnet=1&ipdb=1".894 qq(">Add this netblock to RADIUS user table</a></div>)895 : "</div>"); 821 $page->param(fullcidr => $webvar{fullcidr}); 822 $page->param(alloctype => $disp_alloctypes{$webvar{alloctype}}); 823 $page->param(custid => $webvar{custid}); 824 if ($webvar{alloctype} eq 'pr' && $webvar{billinguser}) { 825 $page->param(billinguser => $webvar{billinguser}); 826 $page->param(custid => $webvar{custid}); 827 $page->param(netaddr => $netblock->addr); 828 $page->param(masklen => $netblock->masklen); 829 } 896 830 mailNotify($ip_dbh, "a$webvar{alloctype}", "ADDED: $disp_alloctypes{$webvar{alloctype}} allocation", 897 831 "$disp_alloctypes{$webvar{alloctype}} $webvar{fullcidr} allocated to customer $webvar{custid}\n". … … 903 837 syslog "err", "Allocation of '$webvar{fullcidr}' to '$webvar{custid}' as ". 904 838 "'$webvar{alloctype}' by $authuser failed: '$msg'"; 905 printError("Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'".839 $page->param(err => "Allocation of $webvar{fullcidr} as '$disp_alloctypes{$webvar{alloctype}}'". 906 840 " failed:<br>\n$msg\n"); 907 841 } … … 915 849 sub validateInput { 916 850 if ($webvar{city} eq '-') { 917 printError("Please choose a city.");851 $page->param(err => 'Please choose a city'); 918 852 return; 919 853 } … … 924 858 # Danger! Danger! alloctype should ALWAYS be set by a dropdown. Anyone 925 859 # managing to call things in such a way as to cause this deserves a cryptic error. 926 printError("Invalid alloctype");860 $page->param(err => 'Invalid alloctype'); 927 861 return; 928 862 } … … 932 866 if ($def_custids{$webvar{alloctype}} eq '') { 933 867 if (!$webvar{custid}) { 934 printError("Please enter a customer ID.");868 $page->param(err => 'Please enter a customer ID.'); 935 869 return; 936 870 } … … 941 875 my $status = CustIDCK->custid_exist($webvar{custid}); 942 876 if ($CustIDCK::Error) { 943 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);877 $page->param(err => "Error verifying customer ID: ".$CustIDCK::ErrMsg); 944 878 return; 945 879 } 946 880 if (!$status) { 947 printError("Customer ID not valid. Make sure the Customer ID ".881 $page->param(err => "Customer ID not valid. Make sure the Customer ID ". 948 882 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 949 883 "non-customer assignments."); … … 977 911 } 978 912 } 913 914 # if the alloctype has a restricted city/POP list as determined above, 915 # and the reqested city/POP does not match that list, complain 979 916 if ($flag ne 'n') { 980 printError("Please choose a valid POP location $flag. Valid ".917 $page->param(err => "Please choose a valid POP location $flag. Valid ". 981 918 "POP locations are currently:<br>\n".join (" - ", @poplist)); 982 919 return; … … 996 933 # Two cases: block is a netblock, or block is a static IP from a pool 997 934 # because I'm lazy, we'll try to make the SELECT's bring out identical)ish) data 935 ##fixme: allow "SWIP" (publication to rWHOIS) of static IP data 998 936 if ($webvar{block} =~ /\/32$/) { 999 937 $sql = "select ip,custid,type,city,circuitid,description,notes,modifystamp,privdata from poolips where ip='$webvar{block}'"; … … 1009 947 # Clean up extra whitespace on alloc type 1010 948 $data[2] =~ s/\s//; 1011 1012 open (HTML, "../editDisplay.html")1013 or croak "Could not open editDisplay.html :$!";1014 my $html = join('', <HTML>);1015 949 1016 950 # We can't let the city be changed here; this block is a part of … … 1019 953 ##fixme 1020 954 # Needs thinking. Have to allow changes to city to correct errors, no? 1021 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g; 1022 1023 if ($IPDBacl{$authuser} =~ /c/) { 1024 $html =~ s/\$\$CUSTID\$\$/<input type=text name=custid value="$data[1]" maxlength=15 class="regular">/; 1025 1026 # Screw it. Changing allocation types gets very ugly VERY quickly- especially 1027 # with the much longer list of allocation types. 1028 # We'll just show what type of block it is. 1029 1030 # this has now been Requested, so here goes. 955 # Also have areas where a routed block at a POP serves "many" cities/towns/named crossroads 956 957 # @data: cidr,custid,type,city,circuitid,description,notes,modifystamp,privdata,swip 958 959 $page->param(block => $webvar{block}); 960 961 $page->param(custid => $data[1]); 962 $page->param(city => $data[3]); 963 $page->param(circid => $data[4]); 964 $page->param(desc => $data[5]); 965 $page->param(notes => $data[6]); 1031 966 1032 967 ##fixme The check here should be built from the database 1033 if ($data[2] =~ /^.[ne]$/) { 1034 # Block that can be changed 1035 my $blockoptions = "<select name=alloctype><option". 1036 (($data[2] eq 'me') ? ' selected' : '') ." value='me'>Dialup netblock</option>\n<option". 1037 (($data[2] eq 'de') ? ' selected' : '') ." value='de'>Dynamic DSL netblock</option>\n<option". 1038 (($data[2] eq 'ce') ? ' selected' : '') ." value='ce'>Dynamic cable netblock</option>\n<option". 1039 (($data[2] eq 'we') ? ' selected' : '') ." value='we'>Dynamic wireless netblock</option>\n<option". 1040 (($data[2] eq 'cn') ? ' selected' : '') ." value='cn'>Customer netblock</option>\n<option". 1041 (($data[2] eq 'en') ? ' selected' : '') ." value='en'>End-use netblock</option>\n<option". 1042 (($data[2] eq 'in') ? ' selected' : '') ." value='in'>Internal netblock</option>\n". 1043 "</select>\n"; 1044 $html =~ s/\$\$TYPESELECT\$\$/$blockoptions/g; 1045 } else { 1046 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}<input type=hidden name=alloctype value="$data[2]">/g; 1047 } 968 # Need to expand to support pool types too 969 if ($data[2] =~ /^.[ne]$/ && $IPDBacl{$authuser} =~ /c/) { 970 $page->param(changetype => 1); 971 $page->param(alloctype => [ 972 { selme => ($data[2] eq 'me'), type => "me", disptype => "Dialup netblock" }, 973 { selme => ($data[2] eq 'de'), type => "de", disptype => "Dynamic DSL netblock" }, 974 { selme => ($data[2] eq 'ce'), type => "ce", disptype => "Dynamic cable netblock" }, 975 { selme => ($data[2] eq 'we'), type => "we", disptype => "Dynamic wireless netblock" }, 976 { selme => ($data[2] eq 'cn'), type => "cn", disptype => "Customer netblock" }, 977 { selme => ($data[2] eq 'en'), type => "en", disptype => "End-use netblock" }, 978 { selme => ($data[2] eq 'in'), type => "in", disptype => "Internal netblock" }, 979 ] 980 ); 981 } else { 982 $page->param(disptype => $disp_alloctypes{$data[2]}); 983 $page->param(type => $data[2]); 984 } 985 1048 986 ## node hack 1049 $sth = $ip_dbh->prepare("SELECT node_id FROM noderef WHERE block='$webvar{block}'"); 987 $sth = $ip_dbh->prepare("SELECT nodes.node_id,node_name FROM nodes INNER JOIN noderef". 988 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'"); 1050 989 $sth->execute; 1051 my ($nodeid ) = $sth->fetchrow_array();1052 if ($nodeid) {1053 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 1054 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";1055 my $nodes = "<select name=node>\n";1056 while (my ($nid,$nname) = $sth->fetchrow_array()) {1057 $nodes .= "<option".($nodeid == $nid ? ' selected' : '')." value='$nid'>$nname</option>\n"; 1058 } 1059 $nodes .= "</select>\n"; 1060 $html =~ s/\$\$NODE\$\$/$nodes/; 1061 } else { 1062 if ($ data[2] eq 'fr' || $data[2] eq 'bi') {990 my ($nodeid,$nodename) = $sth->fetchrow_array(); 991 $page->param(havenodeid => $nodeid); 992 993 if ($data[2] eq 'fr' || $data[2] eq 'bi') { 994 $page->param(typesupportsnodes => 1); 995 $page->param(nodename => $nodename); 996 997 ##fixme: this whole hack needs cleanup and generalization for all alloctypes 998 ##fixme: arguably a bug that presence of a nodeid implies it can be changed.. 999 # but except for manual database changes, only the two types fr and bi can 1000 # (currently) have a nodeid set in the first place. 1001 if ($IPDBacl{$authuser} =~ /c/) { 1063 1002 $sth = $ip_dbh->prepare("SELECT node_id, node_name FROM nodes ORDER BY node_type,node_id"); 1064 $sth->execute () or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n";1065 my $nodes = "<select name=node>\n<option value=>--</option>\n";1003 $sth->execute; 1004 my @nodelist; 1066 1005 while (my ($nid,$nname) = $sth->fetchrow_array()) { 1067 $nodes .= "<option value='$nid'>$nname</option>\n"; 1006 my %row = ( 1007 selme => ($nodeid == $nid), 1008 nodeid => $nid, 1009 nodename => $nname, 1010 ); 1011 push (@nodelist, \%row); 1068 1012 } 1069 $nodes .= "</select>\n"; 1070 $html =~ s/\$\$NODE\$\$/$nodes/; 1071 } else { 1072 $html =~ s|\$\$NODE\$\$|N/A|; 1013 $page->param(nodelist => \@nodelist); 1073 1014 } 1074 1015 } 1075 1016 ## end node hack 1076 $html =~ s/\$\$CITY\$\$/<input type=text name=city value="$data[3]">/g; 1077 $html =~ s/\$\$CIRCID\$\$/<input type="text" name="circid" value="$data[4]" maxlength=64 size=64 class="regular">/g; 1078 $html =~ s/\$\$DESC\$\$/<input type="text" name="desc" value="$data[5]" maxlength=64 size=64 class="regular">/g; 1079 $html =~ s|\$\$NOTES\$\$|<textarea rows="8" cols="64" name="notes" class="regular">$data[6]</textarea>|g; 1080 } else { 1081 ## node hack 1082 if ($data[2] eq 'fr' || $data[2] eq 'bi') { 1083 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes INNER JOIN noderef". 1084 " ON nodes.node_id=noderef.node_id WHERE noderef.block='$webvar{block}'"); 1085 $sth->execute() or print "DEBUG: failed retrieval from nodes: ".$sth->errstr,"<br>\n"; 1086 my ($node) = $sth->fetchrow_array; 1087 $html =~ s/\$\$NODE\$\$/$node/; 1088 } else { 1089 $html =~ s|\$\$NODE\$\$|N/A|; 1090 } 1091 ## end node hack 1092 $html =~ s/\$\$CUSTID\$\$/$data[1]/g; 1093 $html =~ s/\$\$TYPESELECT\$\$/$disp_alloctypes{$data[2]}/g; 1094 $html =~ s/\$\$CITY\$\$/$data[3]/g; 1095 $html =~ s/\$\$CIRCID\$\$/$data[4]/g; 1096 $html =~ s/\$\$DESC\$\$/$data[5]/g; 1097 $html =~ s/\$\$NOTES\$\$/$data[6]/g; 1098 } 1017 1099 1018 my ($lastmod,undef) = split /\s+/, $data[7]; 1100 $html =~ s/\$\$LASTMOD\$\$/$lastmod/g; 1101 1102 ## Hack time! SWIP isn't going to stay, so I'm not going to integrate it with ACLs. 1103 if ($data[2] =~ /.i/) { 1104 $html =~ s/\$\$SWIP\$\$/N\/A/; 1105 } else { 1106 my $tmp = (($data[10] eq 'n') ? '<input type=checkbox name=swip>' : 1107 '<input type=checkbox name=swip checked=yes>'); 1108 $html =~ s/\$\$SWIP\$\$/$tmp/; 1109 } 1110 1111 # Allows us to "correctly" colour backgrounds in table 1112 my $i=1; 1019 $page->param(lastmod => $lastmod); 1020 1021 # not happy with the upside-down logic, but... 1022 $page->param(swipable => $data[2] !~ /.i/); 1023 $page->param(swip => $data[10] ne 'n'); 1113 1024 1114 1025 # Check to see if we can display sensitive data 1115 my $privdata = ''; 1116 if ($IPDBacl{$authuser} =~ /s/) { 1117 $privdata = qq(<tr class="color).($i%2).qq("><td class=heading>Restricted data:</td>). 1118 qq(<td class=regular><textarea rows="3" cols="64" name="privdata" class="regular">). 1119 qq($data[8]</textarea></td></tr>\n); 1120 $i++; 1121 } 1122 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1123 1124 # More ACL trickery - we can live with forms that don't submit, 1125 # but we can't leave the extra table rows there, and we *really* 1126 # can't leave the submit buttons there. 1127 my $updok = ''; 1128 if ($IPDBacl{$authuser} =~ /c/) { 1129 $updok = qq(<tr class="color).($i%2).qq("><td colspan=2><div class="center">). 1130 qq(<input type="submit" value=" Update this block " class="regular">). 1131 "</div></td></tr></form>\n"; 1132 $i++; 1133 } 1134 $html =~ s/\$\$UPDOK\$\$/$updok/g; 1135 1136 my $delok = ''; 1137 if ($IPDBacl{$authuser} =~ /d/) { 1138 $delok = qq(<form method="POST" action="main.cgi"> 1139 <tr class="color).($i%2).qq("><td colspan=2 class="regular"><div class=center> 1140 <input type="hidden" name="action" value="delete"> 1141 <input type="hidden" name="block" value="$webvar{block}"> 1142 <input type="hidden" name="alloctype" value="$data[2]"> 1143 <input type=submit value=" Delete this block "> 1144 </div></td></tr>); 1145 } 1146 $html =~ s/\$\$DELOK\$\$/$delok/; 1147 1148 print $html; 1026 $page->param(nocling => $IPDBacl{$authuser} =~ /s/); 1027 $page->param(privdata => $data[8]); 1028 1029 # ACL trickery - these two template booleans control the presence of all form/input tags 1030 $page->param(maychange => $IPDBacl{$authuser} =~ /c/); 1031 $page->param(maydel => $IPDBacl{$authuser} =~ /d/); 1149 1032 1150 1033 } # edit() … … 1155 1038 sub update { 1156 1039 if ($IPDBacl{$authuser} !~ /c/) { 1157 printError("You shouldn't have been able to get here. Access denied.");1040 $aclerr = 'updateblock'; 1158 1041 return; 1159 1042 } … … 1173 1056 my $sql; 1174 1057 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) { 1175 $sql = "update poolips set custid='$webvar{custid}',notes='$webvar{notes}',". 1176 "circuitid='$webvar{circid}',description='$webvar{desc}',city='$webvar{city}'". 1058 $sql = "UPDATE poolips SET custid='$webvar{custid}',". 1059 "city=?,description=?,notes=?,". 1060 "circuitid='$webvar{circid}',". 1177 1061 "$privdata where ip='$webvar{block}'"; 1178 1062 } else { 1179 $sql = "update allocations set custid='$webvar{custid}',". 1180 "description='$webvar{desc}',notes='$webvar{notes}',city='$webvar{city}',". 1181 "type='$webvar{alloctype}',circuitid='$webvar{circid}'$privdata,". 1063 $sql = "UPDATE allocations SET custid='$webvar{custid}',". 1064 "city=?,description=?,notes=?,". 1065 "circuitid='$webvar{circid}'$privdata,". 1066 "type='$webvar{alloctype}',". 1182 1067 "swip='".($webvar{swip} eq 'on' ? 'y' : 'n')."' ". 1183 1068 "where cidr='$webvar{block}'"; … … 1186 1071 syslog "debug", $sql; 1187 1072 $sth = $ip_dbh->prepare($sql); 1188 $sth->execute ;1073 $sth->execute($webvar{city}, $webvar{desc}, $webvar{notes}); 1189 1074 ## node hack 1190 1075 if ($webvar{node}) { 1076 # done with delete/insert so we don't have to worry about funkyness updating a node ref that isn't there 1191 1077 $ip_dbh->do("DELETE FROM noderef WHERE block='$webvar{block}'"); 1192 1078 $sth = $ip_dbh->prepare("INSERT INTO noderef (block,node_id) VALUES (?,?)"); … … 1198 1084 if ($@) { 1199 1085 my $msg = $@; 1200 carp "Transaction aborted because $msg";1201 1086 eval { $ip_dbh->rollback; }; 1202 1087 syslog "err", "$authuser could not update block/IP '$webvar{block}': '$msg'"; 1203 printError("Could not update block/IP $webvar{block}: $msg");1088 $page->param(err => "Could not update block/IP $webvar{block}: $msg"); 1204 1089 return; 1205 1090 } … … 1211 1096 mailNotify($ip_dbh, 's:swi', "SWIPed: $disp_alloctypes{$webvar{alloctype}} $webvar{block}", 1212 1097 "$webvar{block} had SWIP status changed to \"Yes\" by $authuser") if $webvar{swip} eq 'on'; 1213 open (HTML, "../updated.html") 1214 or croak "Could not open updated.html :$!"; 1215 my $html = join('', <HTML>); 1098 1099 ## node hack 1100 if ($webvar{node} && $webvar{node} ne '-') { 1101 $sth = $ip_dbh->prepare("SELECT node_name FROM nodes WHERE node_id=?"); 1102 $sth->execute($webvar{node}); 1103 my ($nodename) = $sth->fetchrow_array(); 1104 $page->param(nodename => $nodename); 1105 } 1106 ## end node hack 1216 1107 1217 1108 # Link back to browse-routed or list-pool page on "Update complete" page. 1218 my $backlink = "/ip/cgi-bin/main.cgi?action=";1219 1109 my $cblock; # to contain the CIDR of the container block we're retrieving. 1220 1110 my $sql; 1221 1111 if (my $pooltype = ($webvar{alloctype} =~ /^(.)i$/) ) { 1112 $page->param(backpool => 1); 1222 1113 $sql = "select pool from poolips where ip='$webvar{block}'"; 1223 $backlink .= "listpool&pool=";1224 1114 } else { 1225 1115 $sql = "select cidr from routed where cidr >>= '$webvar{block}'"; 1226 $backlink .= "showrouted&block=";1227 1116 } 1228 1117 # I define there to be no errors on this operation... so we don't need to check for them. … … 1232 1121 $sth->fetch(); 1233 1122 $sth->finish; 1234 $backlink .= $cblock; 1235 1236 my $swiptmp = ($webvar{swip} eq 'on' ? 'Yes' : 'No'); 1237 $html =~ s/\$\$BLOCK\$\$/$webvar{block}/g; 1238 $webvar{city} = desanitize($webvar{city}); 1239 $html =~ s/\$\$CITY\$\$/$webvar{city}/g; 1240 $html =~ s/\$\$ALLOCTYPE\$\$/$webvar{alloctype}/g; 1241 $html =~ s/\$\$TYPEFULL\$\$/$disp_alloctypes{$webvar{alloctype}}/g; 1242 $html =~ s/\$\$CUSTID\$\$/$webvar{custid}/g; 1243 $html =~ s/\$\$SWIP\$\$/$swiptmp/g; 1244 $webvar{circid} = desanitize($webvar{circid}); 1245 $html =~ s/\$\$CIRCID\$\$/$webvar{circid}/g; 1246 $webvar{desc} = desanitize($webvar{desc}); 1247 $html =~ s/\$\$DESC\$\$/$webvar{desc}/g; 1248 $webvar{notes} = desanitize($webvar{notes}); 1249 $html =~ s/\$\$NOTES\$\$/$webvar{notes}/g; 1250 $html =~ s/\$\$BACKLINK\$\$/$backlink/g; 1251 $html =~ s/\$\$BACKBLOCK\$\$/$cblock/g; 1252 1253 if ($IPDBacl{$authuser} =~ /s/) { 1254 $privdata = qq(<tr class="color2"><td valign="top">Restricted data:</td>). 1255 qq(<td class="regular">).desanitize($webvar{privdata}).qq(</td></tr>\n); 1256 } 1257 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1258 1259 print $html; 1123 $page->param(backblock => $cblock); 1124 1125 $page->param(cidr => $webvar{block}); 1126 $page->param(city => $webvar{city}); 1127 $page->param(disptype => $disp_alloctypes{$webvar{alloctype}}); 1128 $page->param(custid => $webvar{custid}); 1129 $page->param(swip => $webvar{swip} eq 'on' ? 'Yes' : 'No'); 1130 $page->param(circid => $q->escapeHTML($webvar{circid})); 1131 $page->param(desc => $q->escapeHTML($webvar{desc})); 1132 $page->param(notes => $q->escapeHTML($webvar{notes})); 1133 $webvar{privdata} = ($webvar{privdata} ? $q->escapeHTML($webvar{privdata}) : " "); 1134 $page->param(privdata => $webvar{privdata}) 1135 if $IPDBacl{$authuser} =~ /s/; 1260 1136 1261 1137 } # update() … … 1265 1141 sub remove { 1266 1142 if ($IPDBacl{$authuser} !~ /d/) { 1267 printError("You shouldn't have been able to get here. Access denied.");1143 $aclerr = 'delblock'; 1268 1144 return; 1269 1145 } 1270 1271 #show confirm screen.1272 open HTML, "../confirmRemove.html"1273 or croak "Could not open confirmRemove.html :$!";1274 my $html = join('', <HTML>);1275 close HTML;1276 1146 1277 1147 # Serves'em right for getting here... 1278 1148 if (!defined($webvar{block})) { 1279 printError("Error 332");1149 $page->param(err => "Can't delete a block that doesn't exist"); 1280 1150 return; 1281 1151 } … … 1298 1168 $desc = "N/A"; 1299 1169 $notes = "N/A"; 1170 $privdata = "N/A"; 1300 1171 1301 1172 } elsif ($webvar{alloctype} eq 'mm') { 1173 1302 1174 $cidr = $webvar{block}; 1303 1175 $city = "N/A"; … … 1307 1179 $desc = "N/A"; 1308 1180 $notes = "N/A"; 1181 $privdata = "N/A"; 1182 1309 1183 } elsif ($webvar{alloctype} =~ /^.i$/) { # done with alloctype=[rm]m 1310 1184 … … 1331 1205 } # end cases for different alloctypes 1332 1206 1333 # Munge everything into HTML 1334 $html =~ s|Please confirm|Please confirm <b>removal</b> of|; 1335 $html =~ s|\$\$BLOCK\$\$|$cidr|g; 1336 $html =~ s|\$\$TYPEFULL\$\$|$disp_alloctypes{$alloctype}|g; 1337 $html =~ s|\$\$ALLOCTYPE\$\$|$alloctype|g; 1338 $html =~ s|\$\$CITY\$\$|$city|g; 1339 $html =~ s|\$\$CUSTID\$\$|$custid|g; 1340 $html =~ s|\$\$CIRCID\$\$|$circid|g; 1341 $html =~ s|\$\$DESC\$\$|$desc|g; 1342 $html =~ s|\$\$NOTES\$\$|$notes|g; 1343 1344 $html =~ s|\$\$ACTION\$\$|finaldelete|g; 1345 1346 # Set the warning text. 1347 if ($alloctype =~ /^.[pd]$/) { 1348 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.<br>Any IPs allocated from this pool will also be removed!</div></td></tr>|; 1349 } else { 1350 $html =~ s|<!--warn-->|<tr bgcolor="black"><td colspan="2"><div class="red">Warning: clicking confirm will remove this record entirely.</div></td></tr>|; 1351 } 1352 1353 my $i = 1; 1354 # Check to see if user is allowed to do anything with sensitive data 1355 if ($IPDBacl{$authuser} =~ /s/) { 1356 $privdata = qq(<tr class="color).($i%2).qq("><td>Restricted data:</td>). 1357 qq(<td class=regular>$privdata</td></tr>\n); 1358 $i++; 1359 } 1360 $html =~ s/\$\$PRIVDATA\$\$/$privdata/g; 1361 1362 $i = ++$i % 2; 1363 $html =~ s/\$\$BUTTONROWCOLOUR\$\$/color$i/; 1364 1365 print $html; 1366 } # end edit() 1207 $page->param(block => $cidr); 1208 $page->param(disptype => $disp_alloctypes{$alloctype}); 1209 $page->param(type => $alloctype); 1210 $page->param(city => $city); 1211 $page->param(custid => $custid); 1212 $page->param(circid => $circid); 1213 $page->param(desc => $desc); 1214 $page->param(notes => $notes); 1215 $privdata = ' ' if $privdata eq ''; 1216 $page->param(privdata => $privdata) if $IPDBacl{$authuser} =~ /s/; 1217 $page->param(delpool => $alloctype =~ /^.[pd]$/); 1218 1219 } # end remove() 1367 1220 1368 1221 … … 1373 1226 sub finalDelete { 1374 1227 if ($IPDBacl{$authuser} !~ /d/) { 1375 printError("You shouldn't have been able to get here. Access denied.");1228 $aclerr = 'delblock'; 1376 1229 return; 1377 1230 } … … 1382 1235 my ($code,$msg) = deleteBlock($ip_dbh, $webvar{block}, $webvar{alloctype}); 1383 1236 1237 $page->param(block => $webvar{block}); 1384 1238 if ($code eq 'OK') { 1385 print "<div class=heading align=center>Success! $webvar{block} deallocated.</div>\n";1386 1239 syslog "notice", "$authuser deallocated '$webvar{alloctype}'-type netblock $webvar{block}". 1387 1240 " $custid, $city, desc='$description'"; … … 1390 1243 "CustID: $custid\nCity: $city\nDescription: $description\n"); 1391 1244 } else { 1245 $page->param(failmsg => $msg); 1392 1246 if ($webvar{alloctype} =~ /^.i$/) { 1393 1247 syslog "err", "$authuser could not deallocate static IP '$webvar{block}': '$msg'"; 1394 printError("Could not deallocate static IP $webvar{block}: $msg");1395 1248 } else { 1396 1249 syslog "err", "$authuser could not deallocate netblock '$webvar{block}': '$msg'"; 1397 printError("Could not deallocate netblock $webvar{block}: $msg");1250 $page->param(netblock => 1); 1398 1251 } 1399 1252 } 1400 1253 1401 1254 } # finalDelete 1402 1403 1404 sub exitError {1405 my $errStr = $_[0];1406 printHeader('','');1407 print qq(<center><p class="regular"> $errStr </p>1408 <input type="button" value="Back" onclick="history.go(-1)">1409 </center>1410 );1411 printFooter();1412 exit;1413 } # errorExit1414 1415 1416 # Just in case we manage to get here.1417 exit 0; -
trunk/cgi-bin/newcity.cgi
r431 r517 13 13 use warnings; 14 14 #use CGI::Carp qw(fatalsToBrowser); 15 use CGI::Simple; 16 use HTML::Template; 15 17 use DBI; 16 use CommonWeb qw(:ALL);17 18 #use POSIX qw(ceil); 18 19 use NetAddr::IP; … … 35 36 } 36 37 37 my %webvar = parse_post(); 38 cleanInput(\%webvar); 38 # Set up the CGI object... 39 my $q = new CGI::Simple; 40 # ... and get query-string params as well as POST params if necessary 41 $q->parse_query_string; 42 43 # Convenience; saves changing all references to %webvar 44 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 45 my %webvar = $q->Vars; 39 46 40 47 my ($dbh,$errstr) = connectDB_My; 41 48 my $sth; 42 49 50 $ENV{HTML_TEMPLATE_ROOT} = '../templates'; 51 52 my $page = HTML::Template->new(filename => "newcity.tmpl"); 53 54 if ($webvar{city}) { 55 if ($webvar{pop} eq 'on') { 56 $sth = $dbh->prepare("insert into cities (city,routing) values (?,'y')"); 57 } else { 58 $sth = $dbh->prepare("insert into cities (city,routing) values (?,'n')"); 59 } 60 ##fixme: don't allow duplicate cities 61 $sth->execute($webvar{city}); 62 $page->param(city => $webvar{city}); 63 if ($sth->err) { 64 $page->param(err => $sth->errstr); 65 my $msg = "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr; 66 mailNotify($dbh, 'f:nci', "IPDB city add failure", $msg); 67 syslog "err", $msg; 68 } else { 69 syslog "notice", "$authuser added city/location '$webvar{pop}'". 70 (($webvar{pop} eq 'on') ? ' as POP location' : ''); 71 } 72 } 73 43 74 print "Content-type: text/html\n\n"; 44 75 45 if ($webvar{pop} eq 'on') { 46 $sth = $dbh->prepare("insert into cities (city,routing) values ('$webvar{city}','y')"); 47 } else { 48 $sth = $dbh->prepare("insert into cities (city,routing) values ('$webvar{city}','n')"); 49 } 50 $sth->execute; 51 52 if ($sth->err) { 53 print "Error adding city to database: ".$sth->errstr; 54 mailNotify($dbh, 'f:nci', "IPDB city add failure", 55 "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr); 56 syslog "err", "$authuser could not add city '$webvar{city}' to database: ".$sth->errstr; 57 } else { 58 print "City added. Closing this window should refresh the page."; 59 syslog "notice", "$authuser added city/location '$webvar{pop}'". 60 (($webvar{pop} eq 'on') ? ' as POP location' : ''); 61 } 76 print $page->output; 62 77 63 78 finish($dbh); 79 -
trunk/cgi-bin/newnode.cgi
r417 r517 13 13 use warnings; 14 14 #use CGI::Carp qw(fatalsToBrowser); 15 use CGI::Simple; 16 use HTML::Template; 15 17 use DBI; 16 use CommonWeb qw(:ALL);17 18 #use POSIX qw(ceil); 18 19 use NetAddr::IP; … … 34 35 } 35 36 36 my %webvar = parse_post(); 37 cleanInput(\%webvar); 37 # Set up the CGI object... 38 my $q = new CGI::Simple; 39 # ... and get query-string params as well as POST params if necessary 40 $q->parse_query_string; 41 42 # Convenience; saves changing all references to %webvar 43 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 44 my %webvar = $q->Vars; 38 45 39 46 my ($dbh,$errstr) = connectDB_My; 40 47 my $sth; 41 48 49 $ENV{HTML_TEMPLATE_ROOT} = '../templates'; 50 51 my $page = HTML::Template->new(filename => "newnode.tmpl"); 52 53 if ($webvar{nodename}) { 54 $sth = $dbh->prepare("insert into nodes (node_type,node_name,node_ip) values (?,?,?)"); 55 $sth->execute($webvar{type}, $webvar{nodename}, $webvar{nodeip}); 56 $page->param(nodename => $webvar{nodename}); 57 if ($sth->err) { 58 $page->param(err => $sth->errstr); 59 my $msg = "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr; 60 mailNotify($dbh, 'f:nno', "IPDB node add failure", $msg); 61 syslog "err", $msg; 62 } else { 63 syslog "notice", "$authuser added node '$webvar{nodename}'"; 64 } 65 } 66 42 67 print "Content-type: text/html\n\n"; 43 68 44 $sth = $dbh->prepare("insert into nodes (node_type,node_name,node_ip)". 45 " values ('$webvar{type}','$webvar{nodename}','$webvar{nodeip}')"); 46 $sth->execute; 47 48 if ($sth->err) { 49 print "Error adding node to database: ".$sth->errstr; 50 mailNotify($dbh, 'f:nno', "IPDB node add failure", 51 "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr); 52 syslog "err", "$authuser could not add node '$webvar{nodename}','$webvar{type}' to database: ".$sth->errstr; 53 } else { 54 print "Node added. Closing this window should refresh the page."; 55 syslog "notice", "$authuser added node '$webvar{nodename}'"; 56 } 69 print $page->output; 57 70 58 71 finish($dbh); -
trunk/cgi-bin/search.cgi
r455 r517 14 14 use warnings; 15 15 use CGI::Carp qw(fatalsToBrowser); 16 use CGI::Simple; 17 use HTML::Template; 16 18 use DBI; 17 use CommonWeb qw(:ALL);18 19 use POSIX qw(ceil); 19 20 use NetAddr::IP; … … 38 39 } 39 40 41 # Global variables 42 my $RESULTS_PER_PAGE = 25; 43 44 # anyone got a better name? :P 45 my $thingroot = $ENV{SCRIPT_FILENAME}; 46 $thingroot =~ s|cgi-bin/search.cgi||; 47 48 # Set up the CGI object... 49 my $q = new CGI::Simple; 50 # ... and get query-string params as well as POST params if necessary 51 $q->parse_query_string; 52 53 # Convenience; saves changing all references to %webvar 54 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 55 my %webvar = $q->Vars; 56 57 if (defined($webvar{rpp})) { 58 ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/); 59 } 60 40 61 # Why not a global DB handle? (And a global statement handle, as well...) 41 62 # Use the connectDB function, otherwise we end up confusing ourselves … … 44 65 my $errstr; 45 66 ($ip_dbh,$errstr) = connectDB_My; 46 if (!$ip_dbh) { 47 printAndExit("Failed to connect to database: $errstr\n"); 67 if ($ip_dbh) { 68 checkDBSanity($ip_dbh); 69 initIPDBGlobals($ip_dbh); 48 70 } 49 checkDBSanity($ip_dbh); 50 initIPDBGlobals($ip_dbh); 51 52 # Global variables 53 my $RESULTS_PER_PAGE = 25; 54 my %webvar = parse_post(); 55 cleanInput(\%webvar); 56 57 if (defined($webvar{rpp})) { 58 ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/); 59 } 60 71 72 # Set up some globals 73 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 74 75 my $page; 61 76 if (!defined($webvar{stype})) { 62 77 $webvar{stype} = "<NULL>"; #shuts up the warnings. 78 $page = HTML::Template->new(filename => "search/compsearch.tmpl"); 79 } else { 80 $page = HTML::Template->new(filename => "search/sresults.tmpl"); 63 81 } 64 82 65 # Headerize! Make sure we replace the $$EXTRA0$$ bit as needed. 66 printHeader('', ($IPDBacl{$authuser} =~ /a/ ? 67 '<td align=right><a href="/ip/cgi-bin/main.cgi?action=assign">Add new assignment</a></td>' : '' 68 )); 69 70 if ($webvar{stype} eq 'q') { 83 my $header = HTML::Template->new(filename => "header.tmpl"); 84 $header->param(version => $IPDB::VERSION); 85 $header->param(addperm => $IPDBacl{$authuser} =~ /a/); 86 print "Content-type: text/html\n\n", $header->output; 87 88 # Handle the DB error first 89 if (!$ip_dbh) { 90 $page = HTML::Template->new(filename => "dberr.tmpl"); 91 $page->param(errmsg => $errstr); 92 } elsif ($webvar{stype} eq 'q') { 71 93 # Quick search. 72 94 … … 111 133 $sqlconcat = "UNION"; 112 134 } else { 113 # We can't get here. PTHBTT! 114 printAndExit "PTHBTT!! Your search has been rejected due to Microsoft excuse #4432: ". 115 "Not enough mana"; 135 # sum-buddy tryn'a game the system. Match "all" 136 $sqlconcat = "INTERSECT"; 116 137 } 117 138 … … 190 211 "text(cidr) like '$webvar{cidr}%')"; 191 212 } else { 192 # This shouldn't happen, but if it does, whoever gets it deserves what they get...193 printAndExit("Invalid netblock query.");213 # do nothing. 214 ##fixme we'll ignore this to clear out the references to legacy code. 194 215 } # done with CIDR query options. 195 216 … … 201 222 202 223 if ($count == 0) { 203 printError"No matches found. Try eliminating one of the criteria,".204 " or making one or more criteria more general." ;224 $page->param(errmsg => "No matches found. Try eliminating one of the criteria,". 225 " or making one or more criteria more general."); 205 226 } else { 206 227 # Add the limit/offset clauses … … 225 246 226 247 if ($count == 0) { 227 printError "No customers currently listed as connected through this node."; 248 $page->param(errmsg => "No customers currently listed as connected through this node."); 249 ##fixme: still get the results table header 228 250 } else { 229 251 # Add the limit/offset clauses … … 237 259 } else { # how script was called. General case is to show the search criteria page. 238 260 239 # Display search page. We have to do this here, because otherwise240 # we can't retrieve data from the database for the types and cities. >:(241 my $html;242 open HTML,"<../compsearch.html";243 $html = join('',<HTML>);244 close HTML;245 246 261 # Generate table of types 247 my $typetable = "<table class=regular cellspacing=0>\n<tr>";248 262 $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ". 249 263 "order by listorder"); 250 264 $sth->execute; 251 265 my $i=0; 252 while (my @data = $sth->fetchrow_array) { 253 $typetable .= "<td><input type=checkbox name=type[$data[0]]>$data[1]</td>"; 254 $i++; 255 $typetable .= "</tr>\n<tr>" 256 if ($i % 4 == 0); 257 } 258 if ($i %4 == 0) { 259 $typetable =~ s/<tr>$//; 260 } else { 261 $typetable .= "</tr>\n"; 262 } 263 $typetable .= "</table>\n"; 266 my @typelist; 267 while (my ($type,$dispname) = $sth->fetchrow_array) { 268 my %row = ( 269 newrow => ($i % 4 == 0), 270 type => $type, 271 dispname => $dispname, 272 endrow => ($i++ % 4 == 3) 273 ); 274 push @typelist, \%row; 275 } 276 $page->param(typelist => \@typelist); 264 277 265 278 # Generate table of cities 266 my $citytable = "<table class=regular cellspacing=0>\n<tr>";267 279 $sth = $ip_dbh->prepare("select id,city from cities order by city"); 268 280 $sth->execute; 269 my $i=0; 270 while (my @data = $sth->fetchrow_array) { 271 $citytable .= "<td><input type=checkbox name=city[$data[0]]>$data[1]</td>"; 272 $i++; 273 $citytable .= "</tr>\n<tr>" 274 if ($i % 5 == 0); 275 } 276 if ($i %5 == 0) { 277 $citytable =~ s/<tr>$//; 278 } else { 279 $citytable .= "</tr>\n"; 280 } 281 $citytable .= "</table>\n"; 282 283 $html =~ s/\$\$TYPELIST\$\$/$typetable/; 284 $html =~ s/\$\$CITYLIST\$\$/$citytable/; 285 286 print $html; 281 $i=0; 282 my @citylist; 283 while (my ($id, $city) = $sth->fetchrow_array) { 284 my %row = ( 285 newrow => ($i % 4 == 0), 286 id => $id, 287 city => $city, 288 endrow => ($i++ % 4 == 3) 289 ); 290 push @citylist, \%row; 291 } 292 $page->param(citylist => \@citylist); 293 287 294 } 295 296 print $page->output; 288 297 289 298 # Shut down and clean up. 290 299 finish($ip_dbh); 291 printFooter; 300 301 # We print the footer here, so we don't have to do it elsewhere. 302 my $footer = HTML::Template->new(filename => "footer.tmpl"); 303 # include the admin tools link in the output? 304 $footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); 305 306 print $footer->output; 307 292 308 # We shouldn't need to directly execute any code below here; it's all subroutines. 293 309 exit 0; … … 322 338 if ($category eq 'all') { 323 339 324 print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);325 340 $sql = "select $cols from searchme"; 326 341 my $count = countRows($sql); … … 330 345 } elsif ($category eq 'cust') { 331 346 347 ##fixme: this and other quick-search areas; fix up page heading title similar to first grouping above 332 348 print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n); 333 349 … … 393 409 } else { 394 410 # This shouldn't happen, but if it does, whoever gets it deserves what they get... 395 printError("Invalid query.");411 $page->param(errmsg => "Invalid query."); 396 412 } 397 413 } else { 398 414 # This shouldn't happen, but if it does, whoever gets it deserves what they get... 399 printError("Invalid searchfor.");415 $page->param(errmsg => "Invalid searchfor."); 400 416 } 401 417 } # viewBy … … 437 453 $sth->execute(); 438 454 439 startTable('Allocation','CustID','Type','City','Description/Name'); 455 $page->param(searchtitle => "Showing all netblock and static-IP allocations"); 456 440 457 my $count = 0; 441 442 while (my @data = $sth->fetchrow_array) { 443 444 # cidr,custid,type,city,description,notes 445 # Another bit of HairyPerl(TM) to prefix subblocks with "Sub" 446 my @row = (($data[2] =~ /^.r$/ ? 'Sub ' : ''). 447 qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>), 448 $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]); 449 # Allow listing of pool if desired/required. 450 if ($data[2] =~ /^.[pd]$/) { 451 $row[0] .= ' <a href="/ip/cgi-bin/main.cgi?action=listpool'. 452 "&pool=$data[0]\">List IPs</a>"; 453 } 454 printRow(\@row, 'color1', 1) if ($count%2==0); 455 printRow(\@row, 'color2', 1) if ($count%2!=0); 456 $count++; 457 } 458 my @sresults; 459 while (my ($block, $custid, $type, $city, $desc) = $sth->fetchrow_array) { 460 my %row = ( 461 rowclass => $count++ % 2, 462 issub => ($type =~ /^.r$/ ? 1 : 0), 463 block => $block, 464 ispool => ($type =~ /^.[pd]$/ ? 1 : 0), 465 custid => $custid, 466 disptype => $disp_alloctypes{$type}, 467 city => $city, 468 desc => $desc 469 ); 470 push @sresults, \%row; 471 } 472 $page->param(sresults => \@sresults); 458 473 459 474 # Have to think on this call, it's primarily to clean up unfetched rows from a select. … … 462 477 463 478 my $upper = $offset+$count; 464 print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: ".($offset+1)." - $upper</i></td></tr>\n"; 465 print "</table></center>\n"; 479 480 $page->param(resfound => $rowCount); 481 $page->param(resstart => $offset+1); 482 $page->param(resstop => $upper); 466 483 467 484 # print the page thing.. 468 485 if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) { 486 $page->param(multipage => 1); 469 487 my $pages = ceil($rowCount/$RESULTS_PER_PAGE); 470 print qq(<div class="center"> Page: );488 my @pagelist; 471 489 for (my $i = 1; $i <= $pages; $i++) { 490 my %row; 491 $row{pgnum} = $i; 472 492 if ($i == $pageNo) { 473 print "<b>$i </b>\n";493 $row{thispage} = 1; 474 494 } else { 475 print qq(<a href="/ip/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);495 $row{stype} = $webvar{stype}; 476 496 if ($webvar{stype} eq 'c') { 477 print"cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".497 $row{extraopts} = "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&". 478 498 "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&". 479 499 "allcities=$webvar{allcities}&"; 480 500 foreach my $key (keys %webvar) { 481 501 if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) { 482 print"$key=$webvar{$key}&";502 $row{extraopts} .= "$key=$webvar{$key}&"; 483 503 } 484 504 } 485 505 } else { 486 print"input=$webvar{input}&";506 $row{extraopts} = "input=$webvar{input}&"; 487 507 } 488 print qq(">$i</a> \n);489 508 } 490 } 491 print "</div>"; 492 } 509 push @pagelist, \%row; 510 } 511 $page->param(pgnums => \@pagelist); 512 } 513 493 514 } # queryResults 494 515 -
trunk/cgi-bin/snCalc.cgi
r371 r517 4 4 use warnings; 5 5 use CGI::Carp qw(fatalsToBrowser); 6 use CGI::Simple; 7 use HTML::Template; 6 8 use NetAddr::IP; 7 use CommonWeb qw(:ALL);;8 9 9 10 #file snCalc.cgi little subnet calculator app 10 11 11 my %webvar = parse_post(); 12 # Set up the CGI object... 13 my $q = new CGI::Simple; 14 # ... and get query-string params as well as POST params if necessary 15 $q->parse_query_string; 16 17 # Convenience; saves changing all references to %webvar 18 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 19 my %webvar = $q->Vars; 20 12 21 my $input; 13 22 14 23 print "Content-Type: text/html\n\n"; 15 24 16 open(HTML, "../startsn.html")|| die "Could not open startsn.html :$!"; 17 my $start = join('', <HTML>); 18 close(HTML); 19 print $start; 25 ##fixme: need better method to find templates. 26 $ENV{HTML_TEMPLATE_ROOT} = $ENV{SCRIPT_FILENAME}; 27 $ENV{HTML_TEMPLATE_ROOT} =~ s|cgi-bin/snCalc.cgi||; 28 29 my $page = HTML::Template->new(filename => "templates/subnet-calc.tmpl"); 20 30 21 31 # Clean up input so we don't divide by zero or something equally silly … … 35 45 my $postnet = new NetAddr::IP "0.0.0.0/$gtinput"; 36 46 37 print qq(<div class="center"> 38 <table align="center" cellspacing="3" cellpadding="3"> 39 <tr> 40 <td class="heading" align="center">Results for /$ltinput</td> 41 <td class="heading" align="center">Results for /$input</td> 42 <td class="heading" align="center">Results for /$gtinput</td> 43 </tr> 44 ); 47 $page->param(prenet => $ltinput); 48 $page->param(net => $input); 49 $page->param(postnet => $gtinput); 50 $page->param(premask => $prenet->mask); 51 $page->param(mask => $net->mask); 52 $page->param(postmask => $postnet->mask); 53 $page->param(prewildcard => scalar($prenet->wildcard)); 54 $page->param(wildcard => scalar($net->wildcard)); 55 $page->param(postwildcard => scalar($postnet->wildcard)); 45 56 46 print qq(<tr><td valign="top">\n). 47 qq( <div class="mask">).$prenet->mask."</div>\n". 48 qq( <div class="wildcard">).$prenet->wildcard."</div>\n". 49 getranges($ltinput). 50 qq(</td>\n<td valign="top" bgcolor="#d0e0e0">\n). 51 qq( <div class="mask">).$net->mask."</div>\n". 52 qq( <div class="wildcard">).$net->wildcard."</div>\n". 53 getranges($input). 54 qq(</td>\n<td valign="top">). 55 qq( <div class="mask">).$postnet->mask."</div>\n". 56 qq( <div class="wildcard">).$postnet->wildcard."</div>\n". 57 getranges($gtinput); 57 my @prenets; 58 foreach (getranges($ltinput)) { 59 my %row = (netrange => $_); 60 push (@prenets, \%row); 61 } 62 $page->param(prenets => \@prenets); 63 my @nets; 64 foreach (getranges($input)) { 65 my %row = (netrange => $_); 66 push (@nets, \%row); 67 } 68 $page->param(nets => \@nets); 69 my @postnets; 70 foreach (getranges($gtinput)) { 71 my %row = (netrange => $_); 72 push @postnets, \%row; 73 } 74 $page->param(postnets => \@postnets); 58 75 59 print "</td></tr>\n</table>\n"; 60 61 print qq(<input type="button" value="Back" onclick="history.go(-1)" class="heading"> 62 </div> 63 </body> 64 </html> 65 ); 76 print $page->output; 66 77 67 78 # Just In Case … … 86 97 sub getranges { 87 98 my $masklen = shift; 88 my $ret = '';99 my @ret; 89 100 my $super; 90 101 if ($masklen < 8) { … … 98 109 } 99 110 foreach my $net ($super->split($masklen)) { 100 $ret .= "\t".xrange($net,$masklen)."<br />\n";111 push @ret, xrange($net,$masklen); 101 112 } 102 return $ret;113 return @ret; 103 114 } # getranges()
Note:
See TracChangeset
for help on using the changeset viewer.