source: trunk/cgi-bin/search.cgi@ 471

Last change on this file since 471 was 455, checked in by Kris Deugau, 14 years ago

/trunk

Remove reference to legacy oldcustid field - leftovers from a
billing system transition. See #26.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 17.3 KB
RevLine 
[197]1#!/usr/bin/perl
2# ipdb/cgi-bin/search.cgi
3# Started splitting search functions (quick and otherwise) from
4# main IPDB interface 03/11/2005
5###
6# SVN revision info
7# $Date: 2010-07-30 19:40:36 +0000 (Fri, 30 Jul 2010) $
8# SVN revision $Rev: 455 $
9# Last update by $Author: kdeugau $
10###
[417]11# Copyright 2005-2010 - Kris Deugau
[197]12
13use strict;
14use warnings;
15use CGI::Carp qw(fatalsToBrowser);
16use DBI;
17use CommonWeb qw(:ALL);
18use POSIX qw(ceil);
19use NetAddr::IP;
20
[417]21# don't remove! required for GNU/FHS-ish install from tarball
22##uselib##
[197]23
[417]24use MyIPDB;
25
[439]26# Don't formally need a username or syslog here. syslog left active for debugging.
27use Sys::Syslog;
28openlog "IPDBsearch","pid","$IPDB::syslog_facility";
29
30# ... but we do *use* the username on ACLs now.
31# Collect the username from HTTP auth. If undefined, we're in
32# a test environment, or called without a username.
33my $authuser;
34if (!defined($ENV{'REMOTE_USER'})) {
35 $authuser = '__temptest';
36} else {
37 $authuser = $ENV{'REMOTE_USER'};
38}
39
[197]40# Why not a global DB handle? (And a global statement handle, as well...)
41# Use the connectDB function, otherwise we end up confusing ourselves
42my $ip_dbh;
43my $sth;
44my $errstr;
45($ip_dbh,$errstr) = connectDB_My;
46if (!$ip_dbh) {
47 printAndExit("Failed to connect to database: $errstr\n");
48}
49checkDBSanity($ip_dbh);
50initIPDBGlobals($ip_dbh);
51
52# Global variables
[351]53my $RESULTS_PER_PAGE = 25;
[197]54my %webvar = parse_post();
55cleanInput(\%webvar);
56
[370]57if (defined($webvar{rpp})) {
58 ($RESULTS_PER_PAGE) = ($webvar{rpp} =~ /(\d+)/);
59}
60
[197]61if (!defined($webvar{stype})) {
62 $webvar{stype} = "<NULL>"; #shuts up the warnings.
63}
64
[439]65# Headerize! Make sure we replace the $$EXTRA0$$ bit as needed.
66printHeader('', ($IPDBacl{$authuser} =~ /a/ ?
67 '<td align=right><a href="/ip/cgi-bin/main.cgi?action=assign">Add new assignment</a></td>' : ''
68 ));
[197]69
70if ($webvar{stype} eq 'q') {
71 # Quick search.
72
73 if (!$webvar{input}) {
74 # No search term. Display everything.
75 viewBy('all', '');
76 } else {
77 # Search term entered. Display matches.
78 # We should really sanitize $webvar{input}, no?
79 my $searchfor;
80 # Chew up leading and trailing whitespace
81 $webvar{input} =~ s/^\s+//;
82 $webvar{input} =~ s/\s+$//;
[285]83 if ($webvar{input} =~ /^\d+$/) {
84 # All-digits, new custID
85 $searchfor = "cust";
86 } elsif ($webvar{input} =~ /^[\d\.]+(\/\d{1,3})?$/) {
[201]87 # IP addresses should only have numbers, digits, and maybe a slash+netmask
[197]88 $searchfor = "ipblock";
89 } else {
90 # Anything else.
91 $searchfor = "desc";
92 }
93 viewBy($searchfor, $webvar{input});
94 }
95
96} elsif ($webvar{stype} eq 'c') {
97 # Complex search.
98
[201]99 # Several major cases, and a whole raft of individual cases.
100 # -> Show all types means we do not need to limit records retrieved by type
101 # -> Show all cities means we do not need to limit records retrieved by city
102 # Individual cases are for the CIDR/IP, CustID, Description, Notes, and individual type
103 # requests.
104
[207]105 my $sqlconcat;
106 if ($webvar{which} eq 'all') {
107 # Must match *all* specified criteria. ## use INTERSECT or EXCEPT
108 $sqlconcat = "INTERSECT";
109 } elsif ($webvar{which} eq 'any') {
110 # Match on any specified criteria ## use UNION
111 $sqlconcat = "UNION";
112 } 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";
116 }
[197]117
[202]118# We actually construct a monster SQL statement for all criteria.
119# Iff something has been entered, it will be used as a filter.
[208]120# Iff something has NOT been entered, we still include it but in
121# such a way that it does not actually filter anything out.
[201]122
[207]123 # Columns actually returned. Slightly better than hardcoding it
124 # in each (sub)select
125 my $cols = "cidr,custid,type,city,description";
[201]126
[207]127 # First chunk of SQL. Filter on custid, description, and notes as necessary.
[351]128 my $sql = "(select $cols from searchme where".
129 " $webvar{custexclude} (custid ilike '%$webvar{custid}%'".
[201]130 " $sqlconcat (select $cols from searchme where $webvar{descexclude} description ilike '%$webvar{desc}%')".
131 " $sqlconcat (select $cols from searchme where $webvar{notesexclude} notes ilike '%$webvar{notes}%')";
132
[207]133 # If we're not supposed to search for all types, search for the selected types.
134 if ($webvar{alltypes} ne 'on') {
135 $sql .= " $sqlconcat (select $cols from searchme where $webvar{typeexclude} type in (";
136 foreach my $key (keys %webvar) {
137 $sql .= "'$1'," if $key =~ /type\[(..)\]/;
138 }
139 chop $sql;
140 $sql .= "))";
[201]141 }
142
[207]143 # If we're not supposed to search for all cities, search for the selected cities.
144 # This could be vastly improved with proper foreign keys in the database.
145 if ($webvar{allcities} ne 'on') {
146 $sql .= " $sqlconcat (select $cols from searchme where $webvar{cityexclude} city in (";
147 $sth = $ip_dbh->prepare("select city from cities where id=?");
148 foreach my $key (keys %webvar) {
149 if ($key =~ /city\[(\d+)\]/) {
150 $sth->execute($1);
151 my $city;
152 $sth->bind_columns(\$city);
153 $sth->fetch;
154 $city =~ s/'/''/;
155 $sql .= "'$city',";
156 }
[201]157 }
[207]158 chop $sql;
159 $sql .= "))";
[201]160 }
161
[207]162 ## CIDR query options.
163 $webvar{cidr} =~ s/\s+//; # Hates the nasty spaceseseses we does.
[351]164 if ($webvar{cidr} eq '') { # We has a blank CIDR. Ignore it.
[285]165 } elsif ($webvar{cidr} =~ /\//) {
[427]166 # 192.168.179/26 should show all /26 subnets in 192.168.179
[207]167 my ($net,$maskbits) = split /\//, $webvar{cidr};
168 if ($webvar{cidr} =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
169 # /0->/9 are silly to worry about right now. I don't think
170 # we'll be getting a class A anytime soon. <g>
171 $sql .= " $sqlconcat (select $cols from searchme where ".
[351]172 "$webvar{cidrexclude} cidr<<='$webvar{cidr}')";
[207]173 } else {
174 # Partial match; beginning of subnet and maskbits are provided
175 # Show any blocks with the leading octet(s) and that masklength
[351]176 # Need some more magic for bare /nn searches:
177 my $condition = ($net eq '' ?
178 "masklen(cidr)=$maskbits" : "text(cidr) like '$net%' and masklen(cidr)=$maskbits");
[207]179 $sql .= " $sqlconcat (select $cols from searchme where $webvar{cidrexclude} ".
[351]180 "($condition))";
[207]181 }
182 } elsif ($webvar{cidr} =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
183 # Specific IP address match. Will show either a single netblock,
184 # or a static pool plus an IP.
185 $sql .= " $sqlconcat (select $cols from searchme where $webvar{cidrexclude} ".
186 "cidr >>= '$webvar{cidr}')";
187 } elsif ($webvar{cidr} =~ /^\d{1,3}(\.(\d{1,3}(\.(\d{1,3}\.?)?)?)?)?$/) {
188 # Leading octets in CIDR
189 $sql .= " $sqlconcat (select $cols from searchme where $webvar{cidrexclude} ".
190 "text(cidr) like '$webvar{cidr}%')";
191 } else {
192 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
193 printAndExit("Invalid netblock query.");
194 } # done with CIDR query options.
[201]195
[207]196 # Find the offset for multipage results
197 my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
[201]198
[207]199 # Find out how many rows the "core" query will return.
200 my $count = countRows($sql);
[201]201
[207]202 if ($count == 0) {
203 printError "No matches found. Try eliminating one of the criteria,".
204 " or making one or more criteria more general.";
205 } else {
206 # Add the limit/offset clauses
[370]207 $sql .= " order by cidr";
208 $sql .= " limit $RESULTS_PER_PAGE offset $offset" if $RESULTS_PER_PAGE != 0;
[207]209 # And tell the user.
210 print "<div class=heading>Searching...............</div>\n";
211 queryResults($sql, $webvar{page}, $count);
212 }
[201]213
[397]214} elsif ($webvar{stype} eq 'n') {
215 # Node search.
216
217 my $sql = "SELECT cidr,custid,type,city,description FROM searchme".
218 " WHERE cidr IN (SELECT block FROM noderef WHERE node_id=$webvar{node})";
219
220 # Find the offset for multipage results
221 my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
222
223 # Find out how many rows the "core" query will return.
224 my $count = countRows($sql);
225
226 if ($count == 0) {
227 printError "No customers currently listed as connected through this node.";
228 } else {
229 # Add the limit/offset clauses
230 $sql .= " order by cidr";
231 $sql .= " limit $RESULTS_PER_PAGE offset $offset" if $RESULTS_PER_PAGE != 0;
232 # And tell the user.
233 print "<div class=heading>Searching...............</div>\n";
234 queryResults($sql, $webvar{page}, $count);
235 }
236
[207]237} else { # how script was called. General case is to show the search criteria page.
[201]238
[197]239 # Display search page. We have to do this here, because otherwise
240 # we can't retrieve data from the database for the types and cities. >:(
241 my $html;
242 open HTML,"<../compsearch.html";
243 $html = join('',<HTML>);
244 close HTML;
245
246# Generate table of types
247 my $typetable = "<table class=regular cellspacing=0>\n<tr>";
248 $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ".
249 "order by listorder");
250 $sth->execute;
251 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";
264
265# Generate table of cities
266 my $citytable = "<table class=regular cellspacing=0>\n<tr>";
267 $sth = $ip_dbh->prepare("select id,city from cities order by city");
268 $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;
287}
288
289# Shut down and clean up.
290finish($ip_dbh);
291printFooter;
292# We shouldn't need to directly execute any code below here; it's all subroutines.
293exit 0;
294
[207]295
296# viewBy()
297# The quick search
298# Takes a category descriptor and a query string
299# Creates appropriate SQL to run the search and display the results
300# with queryResults()
[197]301sub viewBy($$) {
302 my ($category,$query) = @_;
303
304 # Local variables
305 my $sql;
306
307 # Calculate start point for LIMIT clause
308 my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
309
310# Possible cases:
[207]311# 1) Partial IP/subnet. Treated as "octet-prefix".
312# 2a) CIDR subnet. Exact match.
313# 2b) CIDR netmask. YMMV but it should be octet-prefix-with-netmask
314# (ie, all matches with the octet prefix *AND* that netmask)
315# 3) Customer ID. "Match-any-segment"
316# 4) Description. "Match-any-segment"
[197]317# 5) Invalid data which might be interpretable as an IP or something, but
318# which probably shouldn't be for reasons of sanity.
319
[371]320 my $cols = "cidr,custid,type,city,description";
321
[197]322 if ($category eq 'all') {
323
324 print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
[371]325 $sql = "select $cols from searchme";
[202]326 my $count = countRows($sql);
[197]327 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
328 queryResults($sql, $webvar{page}, $count);
329
330 } elsif ($category eq 'cust') {
331
332 print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
333
334 # Query for a customer ID. Note that we can't restrict to "numeric-only"
335 # as we have non-numeric custIDs in the legacy data. :/
[455]336 $sql = "select $cols from searchme where custid ilike '%$query%' or description like '%$query%'";
[202]337 my $count = countRows($sql);
[197]338 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
339 queryResults($sql, $webvar{page}, $count);
340
341 } elsif ($category eq 'desc') {
342
343 print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
344 # Query based on description (includes "name" from old DB).
[371]345 $sql = "select $cols from searchme where description ilike '%$query%'".
[285]346 " or custid ilike '%$query%'";
[202]347 my $count = countRows($sql);
[197]348 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
349 queryResults($sql, $webvar{page}, $count);
350
351 } elsif ($category =~ /ipblock/) {
352
353 # Query is for a partial IP, a CIDR block in some form, or a flat IP.
354 print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);
355
356 $query =~ s/\s+//g;
357 if ($query =~ /\//) {
[427]358 # 192.168.179/26 should show all /26 subnets in 192.168.179
[197]359 my ($net,$maskbits) = split /\//, $query;
360 if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
361 # /0->/9 are silly to worry about right now. I don't think
362 # we'll be getting a class A anytime soon. <g>
[371]363 $sql = "select $cols from searchme where cidr='$query'";
[197]364 queryResults($sql, $webvar{page}, 1);
365 } else {
[289]366 #print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
[197]367 # Partial match; beginning of subnet and maskbits are provided
[371]368 $sql = "select $cols from searchme where text(cidr) like '$net%' and ".
[197]369 "text(cidr) like '%$maskbits'";
[202]370 my $count = countRows($sql);
[197]371 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
372 queryResults($sql, $webvar{page}, $count);
373 }
374 } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
375 # Specific IP address match
[289]376 #print "4-octet pattern found; finding netblock containing IP $query<br>\n";
[197]377 my ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/);
378 my $sfor = new NetAddr::IP $query;
[371]379 $sth = $ip_dbh->prepare("select $cols from searchme where text(cidr) like '$net%'");
[197]380 $sth->execute;
381 while (my @data = $sth->fetchrow_array()) {
382 my $cidr = new NetAddr::IP $data[0];
383 if ($cidr->contains($sfor)) {
[371]384 queryResults("select $cols from searchme where cidr='$cidr'", $webvar{page}, 1);
[197]385 }
386 }
[202]387 } elsif ($query =~ /^(\d{1,3}\.){1,3}\d{1,3}\.?$/) {
[289]388 #print "Finding matches with leading octet(s) $query<br>\n";
[371]389 $sql = "select $cols from searchme where text(cidr) like '$query%'";
[202]390 my $count = countRows($sql);
[197]391 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
392 queryResults($sql, $webvar{page}, $count);
393 } else {
394 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
395 printError("Invalid query.");
396 }
397 } else {
398 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
399 printError("Invalid searchfor.");
400 }
401} # viewBy
402
403
404# args are: a reference to an array with the row to be printed and the
405# class(stylesheet) to use for formatting.
406# if ommitting the class - call the sub as &printRow(\@array)
407sub printRow {
408 my ($rowRef,$class) = @_;
409
410 if (!$class) {
411 print "<tr>\n";
412 } else {
413 print "<tr class=\"$class\">\n";
414 }
415
416ELEMENT: foreach my $element (@$rowRef) {
417 if (!defined($element)) {
418 print "<td></td>\n";
419 next ELEMENT;
420 }
421 $element =~ s|\n|</br>|g;
422 print "<td>$element</td>\n";
423 }
424 print "</tr>";
425} # printRow
426
427
[207]428# queryResults()
429# Display search queries based on the passed SQL.
430# Takes SQL, page number (for multipage search results), and a total count.
[197]431sub queryResults($$$) {
432 my ($sql, $pageNo, $rowCount) = @_;
433 my $offset = 0;
434 $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);
435
436 my $sth = $ip_dbh->prepare($sql);
437 $sth->execute();
438
439 startTable('Allocation','CustID','Type','City','Description/Name');
440 my $count = 0;
441
442 while (my @data = $sth->fetchrow_array) {
[202]443
[197]444 # cidr,custid,type,city,description,notes
[202]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>),
[197]448 $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
449 # Allow listing of pool if desired/required.
450 if ($data[2] =~ /^.[pd]$/) {
451 $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
452 "&pool=$data[0]\">List IPs</a>";
453 }
454 printRow(\@row, 'color1', 1) if ($count%2==0);
455 printRow(\@row, 'color2', 1) if ($count%2!=0);
456 $count++;
457 }
458
459 # Have to think on this call, it's primarily to clean up unfetched rows from a select.
460 # In this context it's probably a good idea.
461 $sth->finish();
462
463 my $upper = $offset+$count;
[202]464 print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: ".($offset+1)." - $upper</i></td></tr>\n";
[197]465 print "</table></center>\n";
466
467 # print the page thing..
[370]468 if ($RESULTS_PER_PAGE > 0 && $rowCount > $RESULTS_PER_PAGE) {
[197]469 my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
470 print qq(<div class="center"> Page: );
471 for (my $i = 1; $i <= $pages; $i++) {
472 if ($i == $pageNo) {
473 print "<b>$i&nbsp;</b>\n";
474 } else {
[202]475 print qq(<a href="/ip/cgi-bin/search.cgi?page=$i&stype=$webvar{stype}&);
476 if ($webvar{stype} eq 'c') {
477 print "cidr=$webvar{cidr}&custid=$webvar{custid}&desc=$webvar{desc}&".
478 "notes=$webvar{notes}&which=$webvar{which}&alltypes=$webvar{alltypes}&".
479 "allcities=$webvar{allcities}&";
480 foreach my $key (keys %webvar) {
[351]481 if ($key =~ /^(?:type|city)\[/ || $key =~ /exclude$/) {
[202]482 print "$key=$webvar{$key}&";
483 }
484 }
485 } else {
486 print "input=$webvar{input}&";
487 }
488 print qq(">$i</a>&nbsp;\n);
[197]489 }
490 }
491 print "</div>";
492 }
493} # queryResults
494
495
496# Prints table headings. Accepts any number of arguments;
497# each argument is a table heading.
498sub startTable {
499 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
500
501 foreach(@_) {
502 print qq(<td class="heading">$_</td>);
503 }
504 print "</tr>\n";
505} # startTable
506
507
[202]508# Return count of rows to be returned in a "real" query
509# with the passed SQL statement
[197]510sub countRows($) {
[202]511 # Note that the "as foo" is required
512 my $sth = $ip_dbh->prepare("select count(*) from ($_[0]) as foo");
[197]513 $sth->execute();
514 my @a = $sth->fetchrow_array();
515 $sth->finish();
516 return $a[0];
517}
Note: See TracBrowser for help on using the repository browser.