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

Last change on this file since 838 was 621, checked in by Kris Deugau, 10 years ago

/branches/stable

Brown-paper-bag fix for patch in r620; forgot to include the SQL update,
forgot to include the new field in the column selection, and got the logic
sense for whether to show the "edit block" or "allocate free IP" link
inverted. *sigh*

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