#! /usr/local/bin/perl -T # Perl implementation of Bob Crispen's PHP swish-e search available # at # Copyright 2003 Greg Bacon. # Very simple search using swish-e (see http://swish-e.org/) # copyright 2003 by Bob Crispen # May be distributed without restriction for any purpose. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. use warnings; use strict; my @warnings; BEGIN { $SIG{__WARN__} = sub { push @warnings, @_ }; print <<'EOHeader'; Content-type: text/html Search results
EOHeader $SIG{__DIE__} = sub { print "

Error!

\n", map { "
$_
\n" } @_; }; } use CGI qw/ :standard /; use HTML::Entities; # keep the taint checker happy $ENV{PATH} = "/bin:/usr/bin:/usr/local/bin"; # ----------------------- Configuration ------------------------ # Directory where you keep the databases and # indexes that swish-e generates my $db_dir = "/path/to/index/"; # swish-e executable my $swishe = "/path/to/bin/swish-e"; # -------------------- End of Configuration -------------------- sub drop_privs { my @temp = ($>, $)); my $orig_uid = $<; my $orig_gid = $(; # set effective user and group id to real $> = $<; $) = $(; # Drop privileges $< = $orig_uid; $( = $orig_gid; # Make sure privs are really gone ($>, $)) = @temp; die "FATAL: can't drop privileges" unless $< == $> && $( eq $); } sub search { my $str = shift; my $db = shift; return unless $str && $db; my $database = $db_dir . $db; my $pid = open SWISHE, "-|"; unless (defined $pid) { warn "failed fork: $!"; return; } my @results; if ($pid) { # parent while () { chomp; # swish-e output is four TAB-separated fields, so # we assume lines with three TABs are from swish-e # and all other non-blank lines are warnings if (/\t.*\t.*\t/) { push @results, [split /\t/, $_, 4]; } else { push @warnings, $_ if /\S/; } } close SWISHE or warn $! ? "Error closing $swishe pipe: $!" : "Exit status $? from $swishe"; } else { # child local $SIG{__WARN__} = sub { print @_ }; local $SIG{__DIE__} = sub { print @_; exit 1 }; # 2>&1 open STDERR, ">&STDOUT" or warn "WARNING: dup STDOUT: $!"; drop_privs; # Do the search no warnings; exec $swishe, '-H', 0, '-d', '\t', '-w', $str, '-f', $database or die "FATAL: exec $swishe: $!"; exit 1; } my $searchfor = encode_entities $str; if (@results) { print "Search results for $searchfor:\n", "
    \n"; for (@results) { my($score,$url,$title,$len) = @$_; print qq{
  • $title [$score]
    • \n}; } print "
\n"; } else { print("Sorry, $searchfor not found\n"); } } ## main # URL of this page my $me = url -full => 1; # Get arguments from call # "str" -- String to search for # "db" -- swish-e Database name (e.g., "site.index") my $str = param "str"; my $db = param "db"; # This script is probably called from a form similar to the one # below. If you call it without arguments, all it'll do is print # the form. my @results = search $str, $db; # Print a new form so they can continue searching print startform, "
\n", hidden(db => $db), textfield(-name => 'str', -size => 20), submit('Search'), "
\n", end_form, "\n"; if (@warnings) { my $messages = @warnings == 1 ? "message" : "messages"; print <

Warnings

Warning $messages:
    EOWarningsHead for (@warnings) { print "
  • $_
    • \n"; } print "
\n"; } print < EOFooter