source: branches/htmlform/cgi-bin/search.cgi@ 490

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

/branches/htmlform

Update search.cgi to use a few templates (see #3 - note search.cgi NOT completely
updated for HTML only in templates), remove search.cgi references to printError
from CommonWeb.pm (see #15, #26).

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