source: branches/new-search-20050223/cgi-bin/search.cgi@ 201

Last change on this file since 201 was 201, checked in by Kris Deugau, 20 years ago

/branches/new-search-20050223

Functional multi-component search, minus detail on include/exclude.
Also missing details of IP address search code.

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author
File size: 13.9 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: 2005-03-17 23:02:08 +0000 (Thu, 17 Mar 2005) $
8# SVN revision $Rev: 201 $
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 = 50;
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 print "Quick Search &lt;zip>\n";
52
53 if (!$webvar{input}) {
54 # No search term. Display everything.
55 viewBy('all', '');
56 } else {
57 # Search term entered. Display matches.
58 # We should really sanitize $webvar{input}, no?
59 # need to munge up data for $webvar{searchfor}, rather than breaking things here.
60 my $searchfor;
61 # Chew up leading and trailing whitespace
62 $webvar{input} =~ s/^\s+//;
63 $webvar{input} =~ s/\s+$//;
[201]64 if ($webvar{input} =~ /^[\d\.]+(\/\d{2})?$/) {
65 # IP addresses should only have numbers, digits, and maybe a slash+netmask
[197]66 $searchfor = "ipblock";
67 } elsif ($webvar{input} =~ /^\d+$/) {
68 # All-digits, new custID
69 $searchfor = "cust";
70 } else {
71 # Anything else.
72 $searchfor = "desc";
73 }
74 viewBy($searchfor, $webvar{input});
75 }
76
77} elsif ($webvar{stype} eq 'c') {
78 # Complex search.
79 print "Complex Search...............\n";
80
[201]81 # Several major cases, and a whole raft of individual cases.
82 # -> Show all types means we do not need to limit records retrieved by type
83 # -> Show all cities means we do not need to limit records retrieved by city
84 # Individual cases are for the CIDR/IP, CustID, Description, Notes, and individual type
85 # requests.
86
87my $sql = "SELECT cidr,custid,type,city,description FROM searchme";
88
89my $sqlconcat;
90if ($webvar{which} eq 'all') {
91 # Must match *all* specified criteria. ## use INTERSECT or EXCEPT
92$sqlconcat = "INTERSECT";
93# $sqlconcat = "and";
94} elsif ($webvar{which} eq 'any') {
95 # Match on any specified criteria ## use UNION
96$sqlconcat = "UNION";
97# $sqlconcat="or";
98} else {
99 # We can't get here. PTHBTT!
100 printAndExit "PTHBTT!! Your search has been rejected due to Microsoft excuse #4432: Not enough mana";
[197]101}
102
[201]103# Cases:
104# -> No search terms. Display everything.
105# -> One or more terms (cidr/custid/desc/notes)
106
107# -> Type/city restrictions
108
109my $cols = "cidr,custid,type,city,description";
110
111$sql = "(select $cols from searchme where $webvar{custexclude} custid ilike '%$webvar{custid}%')".
112 " $sqlconcat (select $cols from searchme where $webvar{descexclude} description ilike '%$webvar{desc}%')".
113 " $sqlconcat (select $cols from searchme where $webvar{notesexclude} notes ilike '%$webvar{notes}%')";
114
115if ($webvar{alltypes} ne 'on') {
116 $sql .= " $sqlconcat (select $cols from searchme where $webvar{typeexclude} type in (";
117 foreach my $key (keys %webvar) {
118 $sql .= "'$1'," if $key =~ /type\[(..)\]/;
119 }
120 chop $sql;
121 $sql .= "))";
122}
123
124if ($webvar{allcities} ne 'on') {
125 $sql .= " $sqlconcat (select $cols from searchme where $webvar{cityexclude} city in (";
126 $sth = $ip_dbh->prepare("select city from cities where id=?");
127 foreach my $key (keys %webvar) {
128 if ($key =~ /city\[(\d+)\]/) {
129 $sth->execute($1);
130 my $city;
131 $sth->bind_columns(\$city);
132 $sth->fetch;
133 $city =~ s/'/''/;
134 $sql .= "'$city',";
135 }
136 }
137 chop $sql;
138 $sql .= "))";
139}
140
141
142# gotta find a way to search cleanly...
143
144#if (!(!$webvar{cidr} && !$webvar{custid} && !$webvar{desc} && !$webvar{notes} &&
145# $webvar{alltypes} && $webvar{allcities})) {
146# $sql .= " INTERSECT ";
147#}
148#
149#$sql .=
150# ($webvar{custid} eq '' ? '' : "SELECT cidr,custid,type,city,description FROM searchme WHERE custid LIKE '%$webvar{custid}%'").
151# ($webvar{desc} eq '' ? '' : " $sqlconcat SELECT cidr,custid,type,city,description FROM searchme WHERE description like '%$webvar{desc}%'").
152# ($webvar{notes} eq '' ? '' : " $sqlconcat SELECT cidr,custid,type,city,description FROM searchme WHERE notes like '%$webvar{notes}%'").
153#"";
154
155print $sql."\n";
156
157$sth = $ip_dbh->prepare($sql);
158$sth->execute;
159
160print "<table border=1>\n";
161while (my @data = $sth->fetchrow_array) {
162 print "<tr><td>$data[0]</td><td>$data[1]</td><td>$data[2]</td><td>$data[3]</td><td>$data[4]</td></tr>\n";
163}
164
165#print "<pre>\n";
166#foreach my $key (keys %webvar) {
167# print "key: $key value: -'$webvar{$key}'-\n";
168#}
169#print "</pre>\n";
170
[197]171} else {
172 # Display search page. We have to do this here, because otherwise
173 # we can't retrieve data from the database for the types and cities. >:(
174 my $html;
175 open HTML,"<../compsearch.html";
176 $html = join('',<HTML>);
177 close HTML;
178
179# Generate table of types
180 my $typetable = "<table class=regular cellspacing=0>\n<tr>";
181 $sth = $ip_dbh->prepare("select type,dispname from alloctypes where listorder <500 ".
182 "order by listorder");
183 $sth->execute;
184 my $i=0;
185 while (my @data = $sth->fetchrow_array) {
186 $typetable .= "<td><input type=checkbox name=type[$data[0]]>$data[1]</td>";
187 $i++;
188 $typetable .= "</tr>\n<tr>"
189 if ($i % 4 == 0);
190 }
191 if ($i %4 == 0) {
192 $typetable =~ s/<tr>$//;
193 } else {
194 $typetable .= "</tr>\n";
195 }
196 $typetable .= "</table>\n";
197
198# Generate table of cities
199 my $citytable = "<table class=regular cellspacing=0>\n<tr>";
200 $sth = $ip_dbh->prepare("select id,city from cities order by city");
201 $sth->execute;
202 my $i=0;
203 while (my @data = $sth->fetchrow_array) {
204 $citytable .= "<td><input type=checkbox name=city[$data[0]]>$data[1]</td>";
205 $i++;
206 $citytable .= "</tr>\n<tr>"
207 if ($i % 5 == 0);
208 }
209 if ($i %5 == 0) {
210 $citytable =~ s/<tr>$//;
211 } else {
212 $citytable .= "</tr>\n";
213 }
214 $citytable .= "</table>\n";
215
216
217 $html =~ s/\$\$TYPELIST\$\$/$typetable/;
218 $html =~ s/\$\$CITYLIST\$\$/$citytable/;
219
220 print $html;
221}
222
223# # This is unpossible!
224# print "This is UnPossible! You can't get here!\n";
225
226# Shut down and clean up.
227finish($ip_dbh);
228printFooter;
229# We shouldn't need to directly execute any code below here; it's all subroutines.
230exit 0;
231
232sub viewBy($$) {
233 my ($category,$query) = @_;
234
235 # Local variables
236 my $sql;
237
238#print "<pre>\n";
239
240#print "start querysub: query '$query'\n";
241# this may happen with more than one subcategory. Unlikely, but possible.
242
243 # Calculate start point for LIMIT clause
244 my $offset = ($webvar{page}-1)*$RESULTS_PER_PAGE;
245
246# Possible cases:
247# 1) Partial IP/subnet. Treated as "first-three-octets-match" in old IPDB,
248# I should be able to handle it similarly here.
249# 2a) CIDR subnet. Treated more or less as such in old IPDB.
250# 2b) CIDR netmask. Not sure how it's treated.
251# 3) Customer ID. Not handled in old IPDB
252# 4) Description.
253# 5) Invalid data which might be interpretable as an IP or something, but
254# which probably shouldn't be for reasons of sanity.
255
256 if ($category eq 'all') {
257
258 print qq(<div class="heading">Showing all netblock and static-IP allocations</div><br>\n);
259 $sql = "select * from searchme";
260 my $count = countRows("select count(*) from ($sql) foo");
261 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
262 queryResults($sql, $webvar{page}, $count);
263
264 } elsif ($category eq 'cust') {
265
266 print qq(<div class="heading">Searching for Customer IDs containing '$query'</div><br>\n);
267
268 # Query for a customer ID. Note that we can't restrict to "numeric-only"
269 # as we have non-numeric custIDs in the legacy data. :/
270 $sql = "select * from searchme where custid ilike '%$query%'";
271 my $count = countRows("select count(*) from ($sql) foo");
272 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
273 queryResults($sql, $webvar{page}, $count);
274
275 } elsif ($category eq 'desc') {
276
277 print qq(<div class="heading">Searching for descriptions containing '$query'</div><br>\n);
278 # Query based on description (includes "name" from old DB).
279 $sql = "select * from searchme where description ilike '%$query%'";
280 my $count = countRows("select count(*) from ($sql) foo");
281 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
282 queryResults($sql, $webvar{page}, $count);
283
284 } elsif ($category =~ /ipblock/) {
285
286 # Query is for a partial IP, a CIDR block in some form, or a flat IP.
287 print qq(<div class="heading">Searching for IP-based matches on '$query'</div><br>\n);
288
289 $query =~ s/\s+//g;
290 if ($query =~ /\//) {
291 # 209.91.179/26 should show all /26 subnets in 209.91.179
292 my ($net,$maskbits) = split /\//, $query;
293 if ($query =~ /^(\d{1,3}\.){3}\d{1,3}\/\d{2}$/) {
294 # /0->/9 are silly to worry about right now. I don't think
295 # we'll be getting a class A anytime soon. <g>
296 $sql = "select * from searchme where cidr='$query'";
297 queryResults($sql, $webvar{page}, 1);
298 } else {
299 print "Finding all blocks with netmask /$maskbits, leading octet(s) $net<br>\n";
300 # Partial match; beginning of subnet and maskbits are provided
301 $sql = "select * from searchme where text(cidr) like '$net%' and ".
302 "text(cidr) like '%$maskbits'";
303 my $count = countRows("select count(*) from ($sql) foo");
304 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
305 queryResults($sql, $webvar{page}, $count);
306 }
307 } elsif ($query =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
308 # Specific IP address match
309 print "4-octet pattern found; finding netblock containing IP $query<br>\n";
310 my ($net,$ip) = ($query =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})/);
311 my $sfor = new NetAddr::IP $query;
312 $sth = $ip_dbh->prepare("select * from searchme where text(cidr) like '$net%'");
313 $sth->execute;
314 while (my @data = $sth->fetchrow_array()) {
315 my $cidr = new NetAddr::IP $data[0];
316 if ($cidr->contains($sfor)) {
317 queryResults("select * from searchme where cidr='$cidr'", $webvar{page}, 1);
318 }
319 }
320 } elsif ($query =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/) {
321 print "Finding matches where the first three octets are $query<br>\n";
322 $sql = "select * from searchme where text(cidr) like '$query%'";
323 my $count = countRows("select count(*) from ($sql) foo");
324 $sql .= " order by cidr limit $RESULTS_PER_PAGE offset $offset";
325 queryResults($sql, $webvar{page}, $count);
326 } else {
327 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
328 printError("Invalid query.");
329 }
330 } else {
331 # This shouldn't happen, but if it does, whoever gets it deserves what they get...
332 printError("Invalid searchfor.");
333 }
334} # viewBy
335
336
337# args are: a reference to an array with the row to be printed and the
338# class(stylesheet) to use for formatting.
339# if ommitting the class - call the sub as &printRow(\@array)
340sub printRow {
341 my ($rowRef,$class) = @_;
342
343 if (!$class) {
344 print "<tr>\n";
345 } else {
346 print "<tr class=\"$class\">\n";
347 }
348
349ELEMENT: foreach my $element (@$rowRef) {
350 if (!defined($element)) {
351 print "<td></td>\n";
352 next ELEMENT;
353 }
354 $element =~ s|\n|</br>|g;
355 print "<td>$element</td>\n";
356 }
357 print "</tr>";
358} # printRow
359
360
361# Display certain types of search query. Note that this can't be
362# cleanly reused much of anywhere else as the data isn't neatly tabulated.
363# This is tied to the search sub tightly enough I may just gut it and provide
364# more appropriate tables directly as needed.
365sub queryResults($$$) {
366 my ($sql, $pageNo, $rowCount) = @_;
367 my $offset = 0;
368 $offset = $1 if($sql =~ m/.*limit\s+(.*),.*/);
369
370 my $sth = $ip_dbh->prepare($sql);
371 $sth->execute();
372
373 startTable('Allocation','CustID','Type','City','Description/Name');
374 my $count = 0;
375
376 while (my @data = $sth->fetchrow_array) {
377 # cidr,custid,type,city,description,notes
378 # Fix up types from pools (which are single-char)
379 # Fixing the database would be... painful. :(
380##fixme LEGACY CODE
381 if ($data[2] =~ /^[cdsmw]$/) {
382 $data[2] .= 'i';
383 }
384 my @row = (qq(<a href="/ip/cgi-bin/main.cgi?action=edit&block=$data[0]">$data[0]</a>),
385 $data[1], $disp_alloctypes{$data[2]}, $data[3], $data[4]);
386 # Allow listing of pool if desired/required.
387 if ($data[2] =~ /^.[pd]$/) {
388 $row[0] .= ' &nbsp; <a href="/ip/cgi-bin/main.cgi?action=listpool'.
389 "&pool=$data[0]\">List IPs</a>";
390 }
391 printRow(\@row, 'color1', 1) if ($count%2==0);
392 printRow(\@row, 'color2', 1) if ($count%2!=0);
393 $count++;
394 }
395
396 # Have to think on this call, it's primarily to clean up unfetched rows from a select.
397 # In this context it's probably a good idea.
398 $sth->finish();
399
400 my $upper = $offset+$count;
401 print "<tr><td colspan=10 bgcolor=white class=regular>Records found: $rowCount<br><i>Displaying: $offset - $upper</i></td></tr>\n";
402 print "</table></center>\n";
403
404 # print the page thing..
405 if ($rowCount > $RESULTS_PER_PAGE) {
406 my $pages = ceil($rowCount/$RESULTS_PER_PAGE);
407 print qq(<div class="center"> Page: );
408 for (my $i = 1; $i <= $pages; $i++) {
409 if ($i == $pageNo) {
410 print "<b>$i&nbsp;</b>\n";
411 } else {
412 print qq(<a href="/ip/cgi-bin/main.cgi?page=$i&input=$webvar{input}&action=search&searchfor=$webvar{searchfor}">$i</a>&nbsp;\n);
413 }
414 }
415 print "</div>";
416 }
417} # queryResults
418
419
420# Prints table headings. Accepts any number of arguments;
421# each argument is a table heading.
422sub startTable {
423 print qq(<center><table width="98%" cellspacing="0" class="center"><tr>);
424
425 foreach(@_) {
426 print qq(<td class="heading">$_</td>);
427 }
428 print "</tr>\n";
429} # startTable
430
431
432# Return first element of passed SQL query
433sub countRows($) {
434 my $sth = $ip_dbh->prepare($_[0]);
435 $sth->execute();
436 my @a = $sth->fetchrow_array();
437 $sth->finish();
438 return $a[0];
439}
440
Note: See TracBrowser for help on using the repository browser.