![[ DeepNet IP Database ]](/images/ipdb-logo.png){kind=logo}
Changeset 593 for branches/stable/cgi-bin/admin.cgi
- Timestamp:
- 05/14/13 18:10:22 (11 years ago)
- Location:
- branches/stable
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
cgi-bin/admin.cgi (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/stable
- Property svn:mergeinfo changed
/branches/htmlform (added) merged: 446-451,456-461,463-484,487-505,511-514,516 /trunk merged: 517
- Property svn:mergeinfo changed
-
branches/stable/cgi-bin/admin.cgi
r592 r593 15 15 use warnings; 16 16 use CGI::Carp qw(fatalsToBrowser); 17 use CGI::Simple; 18 use HTML::Template; 17 19 use DBI; 18 use CommonWeb qw(:ALL);19 20 #use POSIX qw(ceil); 20 21 use NetAddr::IP; … … 39 40 40 41 syslog "debug", "$authuser active"; 42 43 # Set up the CGI object... 44 my $q = new CGI::Simple; 45 # ... and get query-string params as well as POST params if necessary 46 $q->parse_query_string; 47 48 # Convenience; saves changing all references to %webvar 49 ##fixme: tweak for handling <select multiple='y' size=3> (list with multiple selection) 50 my %webvar = $q->Vars; 51 52 # anyone got a better name? :P 53 my $thingroot = $ENV{SCRIPT_FILENAME}; 54 $thingroot =~ s|cgi-bin/admin.cgi||; 55 56 # Set up some globals 57 $ENV{HTML_TEMPLATE_ROOT} = $thingroot."templates"; 41 58 42 59 # Why not a global DB handle? (And a global statement handle, as well...) … … 47 64 ($ip_dbh,$errstr) = connectDB_My; 48 65 if (!$ip_dbh) { 49 printAndExit("Database error: $errstr\n"); 50 } 51 initIPDBGlobals($ip_dbh); 66 $webvar{action} = "dberr"; 67 } else { 68 initIPDBGlobals($ip_dbh); 69 } 70 71 # handle DB error output 72 if ($webvar{action} eq 'dberr') { 73 my $page = HTML::Template->new(filename => "admin/dberr.tmpl"); 74 $page->param(errmsg => $errstr); 75 print "Content-Type: text/html\n\n".$page->output; 76 exit; 77 } 52 78 53 79 if ($IPDBacl{$authuser} !~ /A/) { 54 print "Content-Type: text/html\n\n". 55 "<html>\n<head>\n\t<title>Access denied</title>\n". 56 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/ipdb.css">\n). 57 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n). 58 "</head>\n<body>\n". 59 qq(Access to this tool is restricted. Contact the <a href="mailto:ipdbadmin\@example.com">IPDB administrator</a> \n). 60 "for more information.\n</body>\n</html>\n"; 80 my $page = HTML::Template->new(filename => "admin/aclerr.tmpl"); 81 ##fixme: need params for IPDB admin email and name 82 $page->param(ipdbadmin_email => 'ipdbadmin@example.com'); 83 $page->param(ipdbadmin_name => 'the IPDB administrator'); 84 print "Content-Type: text/html\n\n".$page->output; 61 85 exit; 62 86 } 63 87 64 my %webvar = parse_post(); 65 cleanInput(\%webvar); 66 67 print "Content-type: text/html\n\n". 68 "<html>\n<head>\n\t<title>[IPDB admin tools]</title>\n". 69 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/ipdb.css">\n). 70 qq(\t<link rel="stylesheet" type="text/css" href="$IPDB::webpath/local.css">\n). 71 "</head>\n<body>\n". 72 "<h2>IPDB - Administrative Tools</h2>\n<hr>\n"; 88 my $header = HTML::Template->new(filename => "admin/header.tmpl"); 73 89 74 90 if(!defined($webvar{action})) { 75 $webvar{action} = "<NULL>"; #shuts up the warnings. 76 77 my $typelist = ''; 91 $webvar{action} = "main"; #shuts up the warnings. 92 } 93 94 my $page; 95 if (-e "$ENV{HTML_TEMPLATE_ROOT}/admin/$webvar{action}.tmpl") { 96 $page = HTML::Template->new(filename => "admin/$webvar{action}.tmpl"); 97 } else { 98 $page = HTML::Template->new(filename => "admin/dunno.tmpl"); 99 } 100 101 # handle index page 102 if ($webvar{action} eq 'main') { 103 $header->param(mainpage => 1); 104 78 105 $sth = $ip_dbh->prepare("select type,listname from alloctypes where listorder < 900 order by listorder"); 79 106 $sth->execute; 80 my @data = $sth->fetchrow_array; 81 $typelist .= "<option value='$data[0]' selected>$data[1]</option>\n"; 82 while (my @data = $sth->fetchrow_array) { 83 $typelist .= "<option value='$data[0]'>$data[1]</option>\n"; 84 } 85 86 my $masterlist = ''; 107 108 my @typelist; 109 my $count = 0; 110 while (my ($type,$listname) = $sth->fetchrow_array) { 111 my %row = ( 112 selected => $count++, 113 type => $type, 114 dispname => $listname 115 ); 116 push @typelist, \%row; 117 } 118 $page->param(typelist => \@typelist); 119 120 my @masterlist; 87 121 $sth = $ip_dbh->prepare("select cidr,mtime from masterblocks order by cidr"); 88 122 $sth->execute; 89 while (my @data = $sth->fetchrow_array) { 90 $masterlist .= "<option value='$data[0]'>$data[0] ($data[1])</option>\n"; 91 } 92 93 print qq(WARNING: There are FAR fewer controls on what you can do here. Use the 94 main interface if at all possible. 95 <hr> 96 <form action="admin.cgi" method="POST"> 97 <input type=hidden name=action value=alloc> 98 Allocate block/IP: <input name=cidr> as <select name=alloctype>$typelist</select> to <input name=custid> 99 <input type=submit value=" GIMME!! "></form> 100 <hr><form action="admin.cgi" method="POST"> 101 <input type=hidden name=action value=alloctweak> 102 Manually update allocation data in this /24: <input name=allocfrom> 103 <input type=submit value="Show allocations"> 104 </form> 105 106 <hr>rWHOIS tools: 107 <form action="admin.cgi" method="POST"> 108 <input type=hidden name=action value=touch> 109 Bump "last updated" timestamp on this master: <select name=whichmaster>$masterlist</select> 110 <input type=submit value="Update timestamp"> (Sets timestamp to "now")</form> 111 <a href="admin.cgi?action=listcust">Edit customer data for rWHOIS</a> - data used for 112 blocks with the SWIP box checkmarked. Links to edit/add data are on this page. 113 114 <hr><a href="admin.cgi?action=showpools">List IP Pools</a> for manual tweaking and updates 115 116 <hr><a href="admin.cgi?action=showusers">Manage users</a> (add/remove users; change 117 internal access controls - note that this does NOT include IP-based limits)<br> 118 <a href="admin.cgi?action=emailnotice">Manage email notice options</a> (pick which events 119 and allocation types cause notifications; configure recipient lists for notices) 120 121 <hr>Consistency check tools<br> 122 <a href="consistency-check.pl">General</a>: Check general netblock consistency.<br> 123 <a href="freespace.pl">Free space</a>: List total and aggregate free space. Does not 124 include private networks (192.168.0.0/16, 172.16.0.0/12, 10.0.0.0/8) 125 ); 126 } else { 127 print qq(<a href="$IPDB::webpath/cgi-bin/admin.cgi">Back</a> to main<hr>); 128 } 129 130 131 ## Possible actions. 132 if ($webvar{action} eq 'alloc') { 133 # OK, we know what we're allocating. 134 135 # if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 136 # printAndExit("Can't allocate something that's not a netblock/ip"); 137 # } 123 while (my ($cidr,$mtime) = $sth->fetchrow_array) { 124 my %row = ( 125 master => $cidr, 126 masterdate => $mtime 127 ); 128 push @masterlist, \%row; 129 } 130 $page->param(masterlist => \@masterlist); 131 132 } 133 134 ## Non-default actions. 135 136 elsif ($webvar{action} eq 'alloc') { 137 138 if ($webvar{cidr} !~ /^\s*(\d{1,3}\.){3}\d{1,3}(\/\d{2})?\s*$/) { 139 $page->param(errmsg => "Can't allocate something that's not a netblock/ip"); 140 goto ERRJUMP; 141 } 138 142 139 143 $sth = $ip_dbh->prepare("select def_custid from alloctypes where type='$webvar{alloctype}'"); … … 148 152 my $status = CustIDCK->custid_exist($webvar{custid}); 149 153 if ($CustIDCK::Error) { 150 printError("Error verifying customer ID: ".$CustIDCK::ErrMsg);151 return;154 $page->param(errmsg => "Error verifying customer ID: ".$CustIDCK::ErrMsg); 155 goto ERRJUMP; 152 156 } 153 157 if (!$status) { 154 printError("Customer ID not valid. Make sure the Customer ID ".158 $page->param(errmsg => "Customer ID not valid. Make sure the Customer ID ". 155 159 "is correct.<br>\nUse STAFF for staff static IPs, and $IPDB::defcustid for any other ". 156 160 "non-customer assignments."); 157 return;161 goto ERRJUMP; 158 162 } 159 163 } … … 169 173 @data = $sth->fetchrow_array; 170 174 # User deserves errors if user can't be bothered to find the free block first. 171 printAndExit("Can't allocate from outside a free block!!\n") 172 if !$data[0]; 175 if (!$data[0]) { 176 $page->param(errmsg => "Can't allocate from outside a free block!!"); 177 goto ERRJUMP; 178 } 173 179 } elsif ($webvar{alloctype} =~ /^(.)i$/) { 174 180 $sth = $ip_dbh->prepare("select cidr from allocations where cidr >>='$cidr' and (type like '_d' or type like '_p')"); … … 176 182 @data = $sth->fetchrow_array; 177 183 # User deserves errors if user can't be bothered to find the pool and a free IP first. 178 printAndExit("Can't allocate static IP from outside a pool!!\n") 179 if !$data[0]; 184 if (!$data[0]) { 185 $page->param(errmsg => "Can't allocate static IP from outside a pool!!"); 186 goto ERRJUMP; 187 } 180 188 } else { 181 189 $sth = $ip_dbh->prepare("select cidr from freeblocks where cidr >>='$cidr' and not (routed='n')"); … … 183 191 @data = $sth->fetchrow_array; 184 192 # User deserves errors if user can't be bothered to find the free block first. 185 printAndExit("Can't allocate from outside a routed block!!\n") 186 if !$data[0]; 193 if (!$data[0]) { 194 $page->param(errmsg => "Can't allocate from outside a routed block!!"); 195 goto ERRJUMP; 196 } 187 197 } 188 198 … … 190 200 $sth->finish; 191 201 192 my $cities = '';202 my @cities; 193 203 foreach my $city (@citylist) { 194 $cities .= "<option>$city</option>\n"; 195 } 196 197 print qq(<table class=regular> 198 <form method=POST action=admin.cgi> 199 <tr class=color1> 200 <td>Allocating:</td> 201 <td>$cidr<input type=hidden name=cidr value="$cidr"></td> 202 </tr><tr class=color2> 203 <td>Type:</td><td>$disp_alloctypes{$webvar{alloctype}} 204 <input type=hidden name=alloctype value="$webvar{alloctype}"></td> 205 </tr><tr class=color1> 206 <td>Allocated from:</td> 207 <td>$alloc_from<input type=hidden name=alloc_from value="$alloc_from"></td> 208 </tr><tr class="color2"> 209 <td>Customer ID:</td><td>$custid<input type=hidden name=custid value="$custid"></td> 210 </tr><tr class=color1> 211 <td>Customer location:</td><td> 212 <select name="city"><option selected>-</option> 213 $cities 214 </select> 215 <a href="javascript:popNotes('$IPDB::webpath/newcity.html')">Add new location</a> 216 </td> 217 </tr> 218 <tr class="color2"> 219 <td>Circuit ID:</td><td><input name=circid size=40></td> 220 </tr><tr class="color1"> 221 <td>Description/Name:</td><td><input name="desc" size=40></td> 222 </tr><tr class="color2"> 223 <td>Notes:</td><td><textarea name="notes" rows="3" cols="40"></textarea></td> 224 </tr><tr class="warning"> 225 <td colspan=2><center>WARNING: This will IMMEDIATELY assign this block!!</center></td> 226 </tr><tr class="color2"> 227 <td class="center" colspan="2"><input type="submit" value=" Assign "></td> 228 <input type="hidden" name="action" value="confirm"> 229 </form> 230 </tr> 231 </table> 232 ); 233 204 my %row = (city => $city); 205 push @cities, \%row; 206 } 207 $page->param( 208 cidr => $cidr, 209 disptype => $disp_alloctypes{$webvar{alloctype}}, 210 type => $webvar{alloctype}, 211 alloc_from => $alloc_from, 212 custid => $custid, 213 citylist => \@cities 214 ); 234 215 235 216 } elsif ($webvar{action} eq 'confirm') { 236 217 237 print "Assigning $webvar{cidr} to $webvar{custid} (\"$webvar{desc}\") as ". 238 "$disp_alloctypes{$webvar{alloctype}}...<br>\n"; 218 $page->param( 219 cidr => $webvar{cidr}, 220 custid => $webvar{custid}, 221 desc => $webvar{desc}, 222 disptype => $disp_alloctypes{$webvar{alloctype}} 223 ); 239 224 # Only need to check city here. 240 225 if ($webvar{city} eq '-') { 241 printError("Invalid customer location! Go back and select customer's location."); 226 $page->param(locerr => "Invalid customer location! Go back and select customer's location."); 227 goto ERRJUMP; 242 228 } else { 243 229 if ($webvar{alloctype} =~ /^.i$/) { … … 247 233 $sth->execute; 248 234 if ($sth->err) { 249 print "Allocation failed! DBI said:\n".$sth->errstr."\n";235 $page->param(errmsg => $sth->errstr); 250 236 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 251 237 "'$webvar{alloctype}' failed: '".$sth->errstr."'"; 252 238 } else { 253 print "Allocation OK!\n";254 239 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 255 240 "'$webvar{alloctype}'"; … … 263 248 $webvar{circid}); 264 249 if ($retcode eq 'OK') { 265 print "Allocation OK!\n";266 250 syslog "notice", "$authuser allocated '$webvar{cidr}' to '$webvar{custid}' as ". 267 251 "'$webvar{alloctype}'"; 268 252 } else { 269 print "Allocation failed! IPDB::allocateBlock said:\n$msg\n";253 $page->param(errmsg => $msg); 270 254 syslog "err", "($authuser) Allocation of '$webvar{cidr}' to '$webvar{custid}' as ". 271 255 "'$webvar{alloctype}' failed: '$msg'"; … … 276 260 277 261 } elsif ($webvar{action} eq 'alloctweak') { 262 278 263 fix_allocfrom(); 279 264 showAllocs($webvar{allocfrom}); 265 280 266 } elsif ($webvar{action} eq 'update') { 267 281 268 update(); 282 } elsif ($webvar{action} eq 'assign') { 283 # Display a list of possible blocks within the requested block. 284 open (HTML, "../admin_alloc.html") 285 or croak "Could not open admin_alloc.html :$!"; 286 my $html = join('', <HTML>); 287 $html =~ s/\$\$MASK\$\$/$webvar{masklen}/g; 288 $html =~ s/\$\$ALLOCFROM\$\$/$webvar{allocfrom}/g; 289 290 my $from = new NetAddr::IP $webvar{allocfrom}; 291 my @blocklist = $from->split($webvar{masklen}); 292 my $availblocks; 293 foreach (@blocklist) { 294 $availblocks .= qq(<tr><td colspan=2 align=center><input type=radio name=block value="$_">$_</td></tr>\n); 295 } 296 $html =~ s/\$\$BLOCKLIST\$\$/$availblocks/g; 297 298 print $html; 269 299 270 } elsif ($webvar{action} eq 'touch') { 300 print "Touching master $webvar{whichmaster}\n"; 271 272 $page->param(master => $webvar{whichmaster}); 301 273 $sth = $ip_dbh->prepare("update masterblocks set mtime=now() where cidr='$webvar{whichmaster}'"); 302 274 $sth->execute; 303 275 if ($sth->err) { 304 print "<p>Error updating modified timestamp on master $webvar{whichmaster}: ".$sth->errstr."\n"; 305 } 276 $page->param(errmsg => $sth->errstr); 277 } 278 306 279 } elsif ($webvar{action} eq 'listcust') { 307 print qq(Add new entry:\n 308 <form action=admin.cgi method=POST> 309 <table border=1><tr> 310 <input type=hidden name=action value=edcust> 311 <input type=hidden name=newcust value=1> 312 <td>CustID:</td><td><input name=custid></td> 313 <td align=center><input type=submit value="Go to edit page for this custid"></td></tr> 314 </form></table> 315 ); 316 print "<p>Click CustID to edit existing customer contact data:\n". 317 "<table border=1>\n<tr><td>CustID</td><td>Name</td><td>Tech handle</td></tr>\n"; 280 318 281 $sth = $ip_dbh->prepare("select custid,name,tech_handle from customers order by custid"); 319 282 $sth->execute; 283 my @custlist; 320 284 while (my @data = $sth->fetchrow_array) { 321 print qq(<tr><td><a href="admin.cgi?action=edcust&custid=$data[0]">$data[0]</td>). 322 "<td>$data[1]</td><td>$data[2]</td></tr>\n"; 323 } 324 print "</table>\n"; 285 my %row = ( 286 custid => $data[0], 287 custname => $data[1], 288 tech => $data[2] 289 ); 290 push @custlist, \%row; 291 } 292 $page->param(custlist => \@custlist); 293 325 294 } elsif ($webvar{action} eq 'edcust') { 295 326 296 if ($webvar{newcust}) { 327 print "got here?\n";328 297 $sth = $ip_dbh->prepare("INSERT INTO customers (custid) VALUES (?)"); 329 298 $sth->execute($webvar{custid}); … … 335 304 my ($custid, $name, $street, $city, $prov, $country, $pocode, $phone, $tech, $abuse, $admin, $special) = 336 305 $sth->fetchrow_array; 337 print qq(<form action=admin.cgi method=POST> 338 <table border=1><tr> 339 <input type=hidden name=action value=updcust> 340 <td>CustID:</td><td>$custid<input type=hidden name=custid value=$custid></td> 341 <td>Name:</td><td><input name=name value="$name"></td></tr> 342 <tr><td>Street:</td><td><input name=street value="$street"></td> 343 <!-- <td>Street2:</td><td><input name=street2></td> --> 344 <td>City:</td><td><input name=city value="$city"></td></tr> 345 <tr><td>Province/State: (2-letter code)</td><td><input name=province value="$prov" length=2 size=2></td> 346 <td>Country: (2-letter code)</td><td><input name=country value="$country" length=2 size=2></td></tr> 347 <tr><td>Postal/ZIP Code:</td><td><input name=pocode value="$pocode"></td> 348 <td>Phone:</td><td><input name=phone value="$pocode"></td></tr> 349 <!-- <td>Default rDNS:</td><td><input name=def_rdns></td></tr> 350 <td>Description:</td><td><input name=description></td> --> 351 <tr><td>Contacts/ARIN Handles:</td><td> 352 Tech: <input name=tech_handle value="$tech"><br> 353 Abuse: <input name=abuse_handle value="$abuse"><br> 354 Admin: <input name=admin_handle value="$admin"><br> 355 Note: Only tech is required at the moment. 356 </td> 357 <td>"Special":</td><td><textarea name=special rows=4 cols=50>$special</textarea></td> 358 </tr> 359 <tr><td colspan=4 align=center><input type=submit value="Update"></td></tr> 360 </form></table> 361 <div style="margin-left:5px"> 362 <h3>Explanation for "Special" field:</h3> 363 This is a temporary place to define the WHOIS "net name" for a block. 364 It may be removed later, more likely migrated elsewhere. 365 <p>It's formatted like this, one line for each custom net name: 366 <pre>NetName[CIDR block]: NET-NAME</pre> 367 Example: 368 <pre>NetName192.168.236.0/24: MEGAWIDGET-1</pre> 369 Note: 370 <ul style="margin-top: 0px;"> 371 <li>Spacing is important - there should only be ONE space, in between the colon and the net name. 372 <li>The CIDR block name nust include all four octets - no short forms are accepted. 373 <li>Net names must be all uppercase, and consist only of A-Z, 0-9, and - (same as for SWIPed net names). 374 </ul> 375 </div> 376 ); 306 307 $page->param( 308 custid => $custid, 309 name => $name, 310 street => $street, 311 city => $city, 312 prov => $prov, 313 country => $country, 314 pocode => $pocode, 315 phone => $phone, 316 tech => $tech, 317 abuse => $abuse, 318 admin => $admin, 319 special => $special 320 ); 377 321 378 322 } elsif ($webvar{action} eq 'updcust') { 323 379 324 $sth = $ip_dbh->prepare("UPDATE customers SET". 380 325 " name=?, street=?, city=?, province=?, country=?, pocode=?,". … … 384 329 $webvar{country}, $webvar{pocode}, $webvar{phone}, $webvar{tech_handle}, 385 330 $webvar{abuse_handle}, $webvar{admin_handle}, $webvar{special}, $webvar{custid}); 386 print "Updated $webvar{custid}<br>\n". 387 qq(<table border=1> 388 <tr><td>CustID:</td><td>$webvar{custid}</td></tr> 389 <tr><td>Name:</td><td>$webvar{name}</td></tr> 390 <tr><td>Street:</td><td>$webvar{street}</td></tr> 391 <tr><td>City:</td><td>$webvar{city}</td></tr> 392 <tr><td>Province/State:</td><td>$webvar{province}</td></tr> 393 <tr><td>Country:</td><td>$webvar{country}</td></tr> 394 <tr><td>Postal/ZIP Code:</td><td>$webvar{pocode}</td></tr> 395 <tr><td>Phone:</td><td>$webvar{phone}</td></tr> 396 <!-- <td>Default rDNS:</td><td>$webvar{def_rdns}</td></tr> --> 397 <tr><td>Contacts/ARIN Handles:</td><td> 398 Tech: $webvar{tech_handle}<br> 399 Abuse: $webvar{abuse_handle}<br> 400 Admin: $webvar{admin_handle}<br> 401 </td></tr> 402 <tr><td>"Special":</td><td><pre>$webvar{special}</pre></td></tr> 403 </table> 404 <a href="admin.cgi?action=listcust">Back</a> to rWHOIS customer list<br>\n); 331 $page->param( 332 custid => $webvar{custid}, 333 name => $webvar{name}, 334 street => $webvar{street}, 335 city => $webvar{city}, 336 prov => $webvar{province}, 337 country => $webvar{country}, 338 pocode => $webvar{pocode}, 339 phone => $webvar{phone}, 340 tech => $webvar{tech_handle}, 341 abuse => $webvar{abuse_handle}, 342 admin => $webvar{admin_handle}, 343 special => $webvar{special} 344 ); 405 345 406 346 } elsif ($webvar{action} eq 'showpools') { 407 print "IP Pools currently allocated:\n". 408 "<table border=1>\n<tr><td>Pool</td><td># of free IPs</td></tr>\n"; 409 $sth = $ip_dbh->prepare("select cidr from allocations where type like '%p' or type like '%d' order by cidr"); 410 $sth->execute; 411 my %poolfree; 412 while (my @data = $sth->fetchrow_array) { 413 $poolfree{$data[0]} = 0; 414 } 415 $sth = $ip_dbh->prepare("select pool,ip from poolips where available='y' order by ip"); 416 $sth->execute; 417 while (my @data = $sth->fetchrow_array) { 418 $poolfree{$data[0]}++; 419 } 420 foreach my $key (keys %poolfree) { 421 print qq(<tr><td><a href="admin.cgi?action=tweakpool&pool=$key">$key</a></td>). 422 "<td>$poolfree{$key}</td></tr>\n"; 423 } 424 print "</table>\n"; 347 348 $sth = $ip_dbh->prepare("select pool, count(*) from poolips where available='y' group by pool order by pool"); 349 $sth->execute; 350 my @poollist; 351 while (my ($pool,$free) = $sth->fetchrow_array) { 352 my %row = ( 353 pool => $pool, 354 free => $free 355 ); 356 push @poollist, \%row; 357 } 358 $page->param(poollist => \@poollist); 359 425 360 } elsif ($webvar{action} eq 'tweakpool') { 361 426 362 showPool($webvar{pool}); 363 427 364 } elsif ($webvar{action} eq 'updatepool') { 428 365 429 366 $sth = $ip_dbh->prepare("update poolips set custid='$webvar{custid}', ". 430 "city= '$webvar{city}', type='$webvar{type}', available='".367 "city=?, type='$webvar{type}', available='". 431 368 (($webvar{available} eq 'y') ? 'y' : 'n'). 432 "', notes= '$webvar{notes}', description='$webvar{desc}'".369 "', notes=?, description=? ". 433 370 "where ip='$webvar{ip}'"); 434 $sth->execute; 371 $sth->execute($webvar{city},$webvar{notes},$webvar{desc}); 372 $page->param(ip => $webvar{ip}); 435 373 if ($sth->err) { 436 print "Error updating pool IP $webvar{ip}: $@<hr>\n"; 437 syslog "err", "$authuser could not update pool IP $webvar{ip}: $@"; 438 } else { 439 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); 440 $sth->execute; 441 my @data = $sth->fetchrow_array; 442 print "$webvar{ip} in $data[0] updated\n<hr>\n"; 374 $page->param(errmsg => $sth->errstr); 375 syslog "err", "$authuser could not update pool IP $webvar{ip}: ".$sth->errstr; 376 } else { 443 377 syslog "notice", "$authuser updated pool IP $webvar{ip}"; 444 378 } 379 $sth = $ip_dbh->prepare("select pool from poolips where ip='$webvar{ip}'"); 380 $sth->execute; 381 my @data = $sth->fetchrow_array; 382 $page->param(pool => $data[0]); 383 445 384 } elsif ($webvar{action} eq 'showusers') { 446 print "Notes:<br>\n". 447 "<li>Admin users automatically get all other priviledges.\n". 448 "<li>Everyone has basic read access.\n". 449 "<hr>Add new user:<form action=admin.cgi method=POST>\n". 450 "Username: <input name=username><br>\n". 451 "Password: <input name=password> <input type=checkbox name=preenc>Password is pre-encrypted (MUST be crypt() encrypted)<br>\n". 452 "<input type=submit value='Add user'><input type=hidden name=action value=newuser></form>\n"; 453 454 print "<hr>Users with access:\n<table border=1>\n"; 455 print "<tr><td></td><td align=center colspan=3>General access</td></tr>\n"; 456 print "<tr><td>Username</td><td>Add new</td><td>Change</td>". 457 "<td>Delete</td><td>Systems/Networking</td><td>Admin user</td></tr>\n". 458 "<form action=admin.cgi method=POST>\n"; 385 459 386 $sth = $ip_dbh->prepare("select username,acl from users order by username"); 460 387 $sth->execute; 461 while (my @data = $sth->fetchrow_array) { 462 print "<form action=admin.cgi method=POST><input type=hidden name=action value=updacl>". 463 qq(<tr><td>$data[0]<input type=hidden name=username value="$data[0]"></td><td>). 464 # Now for the fun bit. We have to pull apart the ACL field and 465 # output a bunch of checkboxes. 466 "<input type=checkbox name=add".($data[1] =~ /a/ ? ' checked=y' : ''). 467 "></td><td><input type=checkbox name=change".($data[1] =~ /c/ ? ' checked=y' : ''). 468 "></td><td><input type=checkbox name=del".($data[1] =~ /d/ ? ' checked=y' : ''). 469 "></td><td><input type=checkbox name=sysnet".($data[1] =~ /s/ ? ' checked=y' : ''). 470 "></td><td><input type=checkbox name=admin".($data[1] =~ /A/ ? ' checked=y' : ''). 471 qq(></td><td><input type=submit value="Update"></td></form>\n). 472 "<form action=admin.cgi method=POST><td><input type=hidden name=action value=deluser>". 473 "<input type=hidden name=username value=$data[0]>". 474 qq(<input type=submit value="Delete user"></tr></form>\n); 475 476 } 477 print "</table>\n"; 388 my @userlist; 389 while (my ($username,$acl) = $sth->fetchrow_array) { 390 ##fixme: funky things happening with HTML::Template here; shouldn't need the "logic ? iftrue : iffalse" structure 391 my %row = ( 392 username => $username, 393 can_add => ($acl =~ /a/ ? 1 : 0), 394 can_change => ($acl =~ /c/ ? 1 : 0), 395 can_del => ($acl =~ /d/ ? 1 : 0), 396 sysnet => ($acl =~ /s/ ? 1 : 0), 397 is_admin => ($acl =~ /A/ ? 1 : 0), 398 acl => $acl 399 ); 400 push @userlist, \%row; 401 } 402 $page->param(userlist => \@userlist); 403 478 404 } elsif ($webvar{action} eq 'updacl') { 479 print "Updating ACL for $webvar{username}:<br>\n"; 405 406 $page->param(username => $webvar{username}); 480 407 my $acl = 'b'; 481 408 if ($webvar{admin} eq 'on') { … … 487 414 ($webvar{sysnet} eq 'on' ? 's' : ''); 488 415 } 489 print "New ACL: $acl<br>\n";416 $page->param(acl => $acl); 490 417 491 418 $sth = $ip_dbh->prepare("update users set acl='$acl' where username='$webvar{username}'"); 492 419 $sth->execute; 493 print "OK\n" if !$sth->err; 494 495 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 420 $page->param(errmsg => $sth->errstr) if $sth->err; 496 421 497 422 } elsif ($webvar{action} eq 'newuser') { 498 print "Adding user $webvar{username}...\n"; 423 424 $page->param(username => $webvar{username}); 499 425 my $cr_pass = ($webvar{preenc} ? $webvar{password} : 500 426 crypt $webvar{password}, join('',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64])); … … 502 428 "('$webvar{username}','$cr_pass','b')"); 503 429 $sth->execute; 504 if ($sth->err) { 505 print "<br>Error adding user: ".$sth->errstr; 506 } else { 507 print "OK\n"; 508 } 509 510 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 430 $page->param(errmsg => $sth->errstr) if $sth->err; 511 431 512 432 } elsif ($webvar{action} eq 'deluser') { 513 print "Deleting user $webvar{username}.<br>\n"; 433 434 $page->param(username => $webvar{username}); 514 435 $sth = $ip_dbh->prepare("delete from users where username='$webvar{username}'"); 515 436 $sth->execute; 516 print "OK\n" if !$sth->err; 517 518 print qq(<hr><a href="admin.cgi?action=showusers">Back</a> to user listing\n); 437 $page->param(errmsg => $sth->errstr) if $sth->err; 519 438 520 439 } elsif ($webvar{action} eq 'emailnotice') { 521 print "<h4>Email notice management:</h4>\nClick the email addresses to edit that list."; 440 522 441 $sth = $ip_dbh->prepare("SELECT action,reciplist FROM notify"); 523 442 $sth->execute; 524 525 print "<table border=1>\n"; 443 my @spamlist; 526 444 while (my ($notice_code,$reciplist) = $sth->fetchrow_array() ) { 527 445 ##fixme: hairy mess, only a few things call mailNotify() anyway, so many possible notices won't work. 528 446 my $action_out = dispNoticeCode($notice_code); 529 print "<tr><td>$action_out</td>". 530 qq(<td><a href="admin.cgi?action=ednotice&code=$notice_code">$reciplist</a></td>). 531 qq(<td><a href="admin.cgi?action=delnotice&code=$notice_code">Delete</a></tr>\n); 532 } 533 print qq(<tr><td colspan=2>Known "special" codes:<br> 534 <ul style="margin-top: 0px; margin-bottom: 0px;"> 535 <li>swi: Notify if block being updated has SWIP flag set</li> 536 </ul></td></tr> 537 </table> 538 ); 539 540 # add new entries from this tangle: 541 print "<h4>Add new notification:</h4>\n". 542 "Note: Failure notices on most conditions are not yet supported.\n"; 543 544 print qq(<table border=1><form action=admin.cgi method="POST"> 545 <input type=hidden name=action value=addnotice> 546 <tr> 547 <td>Recipients</td><td colspan=3><textarea name=reciplist cols=50 rows=5></textarea></td></tr> 548 <tr><td>Action</td><td> 549 <table><tr> 550 <td><input type=radio name=msgaction value=a>Add 551 <input type=radio name=msgaction value=u>Update 552 <input type=radio name=msgaction value=d>Delete 553 <input type=radio name=msgaction value=n>New listitem</td> 554 </tr><tr> 555 <td> 556 <input type=radio name=msgaction value=s:>Special: <input name=special>(requires code changes) 557 </td></tr></table> 558 </td> 559 <td>Failure?</td><td><input type=checkbox name=onfail></td></tr> 560 <tr><td>Event/Allocation type:</td><td colspan=3> 561 <table> 562 <tr> 563 <td><input type=radio name=alloctype value=a>All allocations</td> 564 <td><input type=radio name=alloctype value=.i>All static IPs</td> 565 <td><input type=radio name=alloctype value=ci>New city</td> 566 <td><input type=radio name=alloctype value=no>New node</td> 567 </tr> 568 <tr> 569 ); 447 my %row = ( 448 action => $action_out, 449 code => $notice_code, 450 recips => $reciplist 451 ); 452 push @spamlist, \%row; 453 } 454 $page->param(spamlist => \@spamlist); 570 455 571 456 $sth = $ip_dbh->prepare("SELECT type,dispname FROM alloctypes WHERE listorder < 500 ". … … 573 458 $sth->execute; 574 459 my $i=0; 460 my @typelist; 575 461 while (my ($type,$disp) = $sth->fetchrow_array) { 576 print " <td><input type=radio name=alloctype value=$type>$disp</td>"; 577 $i++; 578 print " </tr>\n\t<tr>" 579 if ($i % 4 == 0); 580 } 581 582 print qq( </tr> 583 </table> 584 </tr> 585 <tr><td colspan=4 align=center><input type=submit value="Add notice"></td></tr> 586 </table> 587 </form> 588 ); 589 ## done spitting out add-new-spam-me-now table 462 my %row = ( 463 type => $type, 464 disptype => $disp, 465 # ahh, off-by-one counts, how we do love thee... NOT! 466 newrow => ($i+2 > $sth->rows ? 1 : (++$i % 4)), 467 ); 468 push @typelist, \%row; 469 } 470 $page->param(typelist => \@typelist); 590 471 591 472 } elsif ($webvar{action} eq 'addnotice') { 473 592 474 $webvar{alloctype} = $webvar{special} if $webvar{msgaction} eq 's:'; 593 475 if ($webvar{msgaction} && $webvar{alloctype} && $webvar{reciplist}) { 476 $page->param(cantry => 1); 594 477 $webvar{reciplist} =~ s/[\r\n]+/,/g; 595 478 $webvar{msgaction} = "f:$webvar{msgaction}" if $webvar{onfail}; 596 print "Adding notice to $webvar{reciplist} for ".dispNoticeCode($webvar{msgaction}.$webvar{alloctype}).":\n"; 479 $page->param(reciplist => $webvar{reciplist}); 480 $page->param(dispnotice => dispNoticeCode($webvar{msgaction}.$webvar{alloctype})); 597 481 $sth = $ip_dbh->prepare("INSERT INTO notify (action, reciplist) VALUES (?,?)"); 598 482 ##fixme: automagically merge reciplists iff action already exists 599 483 $sth->execute($webvar{msgaction}.$webvar{alloctype}, $webvar{reciplist}); 600 if ($sth->err) { 601 print "Failed: DB error: ".$sth->errstr."\n"; 602 } else { 603 print "OK!<br>\n" 604 } 605 } else { 606 print "Need to specify at least one recipient, an action, and an allocation type. ". 607 qq{("Special" content is considered an allocation type). Hit the Back button and try again.<br>\n}; 608 } 609 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 484 $page->param(addfailed => $sth->errstr) if $sth->err; 485 } 610 486 611 487 } elsif ($webvar{action} eq 'delnotice') { 612 print "Deleting notices on ".dispNoticeCode($webvar{code}.$webvar{alloctype}).":\n"; 488 489 $page->param(dispnotice => dispNoticeCode($webvar{code}.$webvar{alloctype})); 613 490 $sth = $ip_dbh->prepare("DELETE FROM notify WHERE action=?"); 614 491 $sth->execute($webvar{code}); 615 if ($sth->err) { 616 print "Failed: DB error: ".$sth->errstr."\n"; 617 } else { 618 print "OK!<br>\n" 619 } 620 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 492 $page->param(delfailed => $sth->errstr) if $sth->err; 621 493 622 494 } elsif ($webvar{action} eq 'ednotice') { 623 print "<h4>Editing recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; 495 496 $page->param(dispnotice => dispNoticeCode($webvar{code})); 497 $page->param(code => $webvar{code}); 624 498 $sth = $ip_dbh->prepare("SELECT reciplist FROM notify WHERE action=?"); 625 499 $sth->execute($webvar{code}); 626 500 my ($reciplist) = $sth->fetchrow_array; 627 501 $reciplist =~ s/,/\n/g; 628 print qq(<form action=admin.cgi method=POST><input type=hidden name=code value="$webvar{code}">\n). 629 qq(<input type=hidden name=action value="updnotice"><table border=1><tr><td>). 630 qq(<textarea cols="40" rows="5" name=reciplist>$reciplist</textarea></td><td><input type=submit value="Update">\n). 631 "</td></tr></table></form>\n"; 502 $page->param(reciplist => $reciplist); 503 632 504 } elsif ($webvar{action} eq 'updnotice') { 633 print "<h4>Updating recipient list for '".dispNoticeCode($webvar{code})."':</h4>\n"; 505 506 $page->param(dispnotice => dispNoticeCode($webvar{code})); 634 507 $sth = $ip_dbh->prepare("UPDATE notify SET reciplist=? WHERE action=?"); 635 508 $webvar{reciplist} =~ s/[\r\n]+/,/g; 636 509 $sth->execute($webvar{reciplist}, $webvar{code}); 637 if ($sth->err) { 638 print "Failed: DB error: ".$sth->errstr."\n"; 639 } else { 640 print "OK!<br>\n" 641 } 642 print qq(<a href="admin.cgi?action=emailnotice">Back to email notice list</a>\n); 510 $page->param(updfailed => $sth->errstr) if $sth->err; 511 643 512 } elsif ($webvar{action} ne '<NULL>') { 644 print "webvar{action} check failed: Don't know how to $webvar{action}"; 645 } 513 $page->param(dunno => $webvar{action}); 514 } 515 516 ERRJUMP: print "Content-type: text/html\n\n".$header->output; 517 print $page->output; 518 519 ##fixme: make me a footer param! 520 print qq(<hr><div><a href="$IPDB::webpath/">Back</a> to main interface</div>\n); 521 522 # We print the footer here, so we don't have to do it elsewhere. 523 my $footer = HTML::Template->new(filename => "footer.tmpl"); 524 # we're already in the admin tools, no need to provide a bottom link. maybe. 525 #$footer->param(adminlink => ($IPDBacl{$authuser} =~ /A/)); 526 527 print $footer->output; 528 529 $ip_dbh->disconnect; 530 531 exit; 532 646 533 647 534 # Hokay. This is a little different. We have a few specific functions here: … … 649 536 # -> Tweak individual DB fields 650 537 # 651 652 print qq(<hr><a href="$IPDB::webpath/">Back</a> to main interface</a>\n);653 654 printFooter;655 656 $ip_dbh->disconnect;657 658 exit;659 538 660 539 … … 671 550 672 551 673 # List free blocks in a /24 for arbitrary manual allocation674 sub showfree($) {675 my $cidr = new NetAddr::IP $_[0];676 print "Showing free blocks in $cidr<br>\n".677 "<table border=1>\n";678 $sth = $ip_dbh->prepare("select * from freeblocks where cidr <<= '$cidr' order by cidr");679 $sth->execute;680 while (my @data = $sth->fetchrow_array) {681 my $temp = new NetAddr::IP $data[0];682 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=assign>\n".683 qq(<td>$temp<input type=hidden name=allocfrom value="$temp"></td>\n).684 "<td>".685 (($temp->masklen == 30) ? '<input type=hidden name=masklen value=30>30'686 : "<select name=masklen><option>30</option>\n<option>29</option>\n") .687 (($temp->masklen < 29) ? "<option>28</option>\n" : '') .688 (($temp->masklen < 28) ? "<option>27</option>\n" : '') .689 (($temp->masklen < 27) ? "<option>26</option>\n" : '') .690 (($temp->masklen < 26) ? "<option>25</option>\n" : '') .691 (($temp->masklen < 25) ? "<option>24</option>\n" : '') .692 "</td>".693 qq(<td>$data[2]</td><td><input type=submit value="Allocate from here"></td>).694 "\n</form></tr>\n";695 }696 print "</table>\n";697 }698 699 700 552 # Show allocations to allow editing. 701 sub showAllocs($) { 702 my $cidr = new NetAddr::IP $_[0]; 703 print "Edit custID, allocation type, city for allocations in ". 704 "$cidr:\n<table border=1>"; 705 $sth = $ip_dbh->prepare("select * from allocations where cidr <<= '$cidr' order by cidr"); 706 $sth->execute; 707 while (my @data = $sth->fetchrow_array) { 708 print "<tr><form action=admin.cgi method=POST><input type=hidden name=action value=update>\n". 709 qq(<td>$data[0]<input type=hidden value="$data[0]" name=block></td>\n). 710 qq(<td><input name=custid value="$data[1]"></td>\n). 711 "<td><select name=alloctype>"; 712 553 sub showAllocs { 554 555 my $within = new NetAddr::IP $_[0]; 556 $page->param(within => $within); 557 558 $sth = $ip_dbh->prepare("select cidr,custid,type,city,description from allocations where cidr <<= '$within' order by cidr"); 559 $sth->execute; 560 my @blocklist; 561 while (my ($cidr,$custid,$type,$city,$desc) = $sth->fetchrow_array) { 562 my %row = ( 563 cidr => $cidr, 564 custid => $custid, 565 city => $city, 566 desc => $desc, 567 ); 568 569 ##fixme: don't wanna retrieve the whole type list *every time around the outer loop* 713 570 my $sth2 = $ip_dbh->prepare("select type,listname from alloctypes". 714 571 " where listorder < 500 and not (type like '_i') order by listorder"); 715 572 $sth2->execute; 716 while (my @types = $sth2->fetchrow_array) { 717 print "<option". (($data[2] eq $types[0]) ? ' selected' : '') . 718 " value='$types[0]'>$types[1]</option>\n"; 573 my @typelist; 574 while (my ($listtype,$dispname) = $sth2->fetchrow_array) { 575 my %subrow = ( 576 type => $listtype, 577 dispname => $dispname, 578 selected => ($listtype eq $type) 579 ); 580 push @typelist, \%subrow; 719 581 } 720 721 print qq(<td><input name=city value="$data[3]"></td>\n). 722 "<td>$data[4]</td><td>$data[5]</td>". 723 qq(<td><input type=submit value="Update"></td></form></tr>\n); 724 } 725 print "</table>\n"; 726 727 # notes 728 print "<hr><b>Notes:</b>\n". 729 "<ul>\n<li>Use the main interface to update description and notes fields\n". 730 "<li>Changing the allocation type here will NOT affect IP pool data.\n". 731 "</ul>\n"; 732 } 582 $row{typelist} = \@typelist; 583 push @blocklist, \%row; 584 } 585 $page->param(blocklist => \@blocklist); 586 } # end showAllocs() 733 587 734 588 735 589 # Stuff updates into DB 736 590 sub update { 737 eval { 738 # Relatively simple SQL transaction here. Note that we're deliberately NOT 739 # updating notes/desc here as it's available through the main interface. 740 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',". 741 "city='$webvar{city}',type='$webvar{alloctype}' where cidr='$webvar{block}'"); 742 $sth->execute; 743 $ip_dbh->commit; 744 }; 745 if ($@) { 746 carp "Transaction aborted because $@"; 747 eval { $ip_dbh->rollback; }; 748 syslog "err", "$authuser could not update block '$webvar{block}': '$@'"; 591 # Relatively simple SQL transaction here. Note that we're deliberately NOT 592 # updating notes/desc here as it's available through the main interface. 593 $sth = $ip_dbh->prepare("update allocations set custid='$webvar{custid}',". 594 "city=?,type='$webvar{alloctype}' where cidr='$webvar{block}'"); 595 $sth->execute($webvar{city}); 596 597 $page->param(block => $webvar{block}); 598 if ($sth->err) { 599 $page->param(updfailed => $sth->errstr); 600 syslog "err", "$authuser could not update block '$webvar{block}': '".$sth->errstr."'"; 749 601 } else { 750 # If we get here, the operation succeeded.751 602 syslog "notice", "$authuser updated $webvar{block}"; 752 print "Allocation $webvar{block} updated<hr>\n";753 603 } 754 604 # need to get /24 that block is part of … … 756 606 $bits[3] = "0/24"; 757 607 showAllocs((join ".", @bits)); 758 } 608 } # end update() 759 609 760 610 … … 764 614 sub showPool($) { 765 615 my $pool = new NetAddr::IP $_[0]; 766 print qq(Listing pool $pool:\n<table border=1>767 <form action=admin.cgi method=POST>768 <input type=hidden name=action value=updatepool>769 <tr><td align=right>Customer ID:</td><td><input name=custid></td></tr>770 <tr><td align=right>Customer location:</td><td><input name=city></td></tr>771 <tr><td align=right>Type:</td><td><select name=type><option selected>-</option>\n);772 616 773 617 $sth = $ip_dbh->prepare("select type,listname from alloctypes where type like '_i' order by listorder"); 774 618 $sth->execute; 775 while (my @data = $sth->fetchrow_array) { 776 print "<option value='$data[0]'>$data[1]</option>\n"; 777 } 778 779 print qq(</select></td></tr> 780 <tr><td align=right>Available?</td><td><input type=checkbox value=y></td></tr> 781 <tr><td align=right>Description/name:</td><td><input name=desc size=40></td></tr> 782 <tr><td align=right>Notes:</td><td><textarea name=notes rows=3 cols=40></textarea></td></tr> 783 <tr><td colspan=2 align=center><input type=submit value="Update"></td></tr> 784 ). 785 "</table>Update the following record:<table border=1>\n"; 786 $sth = $ip_dbh->prepare("select pool,ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); 787 $sth->execute; 788 while (my @data = $sth->fetchrow_array) { 789 print qq(<tr><td><input type=radio name=ip value="$data[1]">$data[1]</td>). 790 "<td>$data[2]</td><td>$data[3]</td><td>$data[4]</td>". 791 "<td>$data[5]</td><td>$data[6]</td><td>$data[7]</td></tr>\n"; 792 } 793 print "</form></table>\n"; 794 } 619 my @typelist; 620 while (my ($type,$dispname) = $sth->fetchrow_array) { 621 my %row = ( 622 type => $type, 623 dispname => $dispname 624 ); 625 push @typelist, \%row; 626 } 627 $page->param(typelist => \@typelist); 628 629 $sth = $ip_dbh->prepare("select ip,custid,city,type,available,description,notes from poolips where pool='$pool' order by ip"); 630 $sth->execute; 631 my @iplist; 632 while (my ($ip,$custid,$city,$type,$avail,$desc,$notes) = $sth->fetchrow_array) { 633 my %row = ( 634 ip => $ip, 635 custid => $custid, 636 city => $city, 637 type => $type, 638 avail => $avail, 639 desc => $desc, 640 notes => $notes 641 ); 642 push @iplist, \%row; 643 } 644 $page->param(iplist => \@iplist); 645 } # end showPool() 795 646 796 647
Note:
See TracChangeset
for help on using the changeset viewer.
