source: branches/stable/cgi-bin/search.cgi@ 286

Last change on this file since 286 was 286, checked in by Kris Deugau, 19 years ago

/branches/stable

Merge changes from /trunk revisions:

234
237
254 (ipdb.css only)
261
279
284
285

This merges the new search system (234, 237, 254), cleans up
some display CSS (254, 279), cleans up some leftover code (r261),
and merges the "private data" code (284, 285 - note SWIP hacks conflict).

/trunk should now be almost identical to /branches/stable.

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