#!/usr/local/bin/perl

use Socket;
use LWP;

# which port do we listen to
$PORT = 8880;

# debugging messages?
$debug = 0;

# Set up SIG vector
$SIG{'KILL'} = "SigHandler";
$SIG{'TERM'} = "SigHandler";
$SIG{'QUIT'} = "SigHandler";
$SIG{'HUP'} = "SigHandler";

# setup and open socket on port $PORT
#
($name, $aliases, $proto) = getprotobyname('tcp');
$thisport = pack('S n a4 x8', &AF_INET, $PORT, "\0\0\0\0");
socket(S, &PF_INET, &SOCK_STREAM, $proto);
setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, pack('i', 1));
bind(S, $thisport);
listen(S, 5);

for (;;) { # do forever

   # wait for connection
   if (!accept(NS, S)) {
      print STDERR "Accept failed: $!\n";
      exit 1;
   }

   # parse request info
   Get_Request(NS);

   # we can only handle GET requests
   if ($method ne "GET") {
      Error(NS, 400, "Bad Request");
      next;
   }

   if ($params eq '') {
      # no params means just send a new form
      Send_Form(NS);
   } else {
      # otherwise, process search request
      Process_Form(NS);
   }

   # and close
   close NS;
}

# dump an error message
sub Error {
   my ($fh, $code, $mesg) = @_;
   print $fh "HTTP/1.0 $code $mesg\n";
   print $fh "Content-type: text/html\n\n";
   print $fh "<HTML><HEAD><TITLE>Error Message</TITLE></HEAD>\n";
   print $fh "<BODY><H1>Error $code</H1>\n";
   print $fh "$mesg</BODY></HTML>\n";
   close($fh);
}

# parse incoming request
sub Get_Request {
   my $fh = $_[0];

   # first line is request
   # split it into parts
   #
   chomp ($lin = &readline($fh));
   print STDERR "Got: $lin\n" if ($debug);
   ($method, $pathbits, $protocol, $protoversion) = 
      ($lin =~ m#^([A-Z]*) (/.*) (\w*)/(\d*\.\d*)#);
   if ($pathbits =~ /(.*)\?(.*)/) {
      $path = $1;
      $params = $2;
   } else {
      $path = $pathbits;
      $params = '';
   }
   print STDERR "Path  = $path\n" if ($debug);
   print STDERR "Parms = $params\n" if ($debug);

   # all the rest are passed variables
   # save as environment vars 
   # so User-Agent becomes HTTP_USER_AGENT
   #
   do {
      chomp ($lin = &readline($fh));
      print STDERR "Got: $lin\n" if ($debug);
      my ($var, $val) = split /:\s/, $lin, 2;
      $var =~ tr/a-z/A-Z/;
      $var =~ s/\-/_/g;
      $var = "HTTP_".$var;
      $ENV{$var} = $val;
   } while ($lin ne "");  # stop when we hit blank line == end of inbound
}

# read a line of data from handle, one char at a time
# 
sub readline {
   my $fd = $_[0];
   my $ch;
   my $string = '';
   for (;;) {
      if (sysread($fd,$ch,1)) {
         $string .= $ch unless ($ch eq "\r");
         last if ($ch eq "\n");
      }
   }
   return $string;
}

# Interupt handler for shutting down
sub SigHandler {
   my $sig =$_[0];
   print STDERR  scalar(localtime()) ," - Caught signal SIG$sig.\n";
   exit 1;
}

# print a new search form page
sub Send_Form {
   my $fh = $_[0];

   print STDERR "Sending empty form\n" if ($debug);
   print $fh "HTTP/1.0 200 OK\n";
   print $fh "Content-type: text/html\n\n";
   print $fh "<HTML><HEAD>\n";
   print $fh "<TITLE>Low Bandwidth AltaVista Search Proxy</TITLE>\n";
   print $fh "</HEAD><BODY BGCOLOR=\"#FFFFFF\">\n";
   print $fh "<H1 ALIGN=CENTER><I>Low Bandwidth</I> AltaVista Search Proxy</H1>\n";
   PrintForm($fh,'');
   print $fh "</BODY></HTML>\n";
}

# print the form itself, including embedded query string, if provided
#
sub PrintForm {
   my ($fh,$qs) = @_;
   my $url = 'http://' . $ENV{HTTP_HOST} . $path;

   print $fh <<"EndFORM";
<CENTER><TABLE BORDER=1 CELLPADDING=3><TR BGCOLOR="#FFFFCC"><TD>
<FORM method=GET action="$url">
<P><I>Low Bandwidth</I>
<FONT SIZE=+2><A HREF="http://www.altavista.digital.com">
AltaVista</A></FONT> Search Engine<BR>
<INPUT TYPE=hidden NAME=pg VALUE=q>
<B>Search the Web
<INPUT TYPE=HIDDEN NAME=what VALUE=web>
<B> in </B><SELECT NAME=kl>
<OPTION VALUE=XX >any language
<OPTION VALUE=bg >Bulgarian
<OPTION VALUE=zh >Chinese
<OPTION VALUE=cz >Czech
<OPTION VALUE=da >Danish
<OPTION VALUE=nl >Dutch
<OPTION VALUE=en SELECTED>English
<OPTION VALUE=et >Estonian
<OPTION VALUE=fi >Finnish
<OPTION VALUE=fr >French
<OPTION VALUE=de >German
<OPTION VALUE=el >Greek
<OPTION VALUE=he >Hebrew
<OPTION VALUE=hu >Hungarian
<OPTION VALUE=is >Icelandic
<OPTION VALUE=it >Italian
<OPTION VALUE=ja >Japanese
<OPTION VALUE=ko >Korean
<OPTION VALUE=lv >Latvian
<OPTION VALUE=lt >Lithuanian
<OPTION VALUE=no >Norwegian
<OPTION VALUE=pl >Polish
<OPTION VALUE=pt >Portuguese
<OPTION VALUE=ro >Romanian
<OPTION VALUE=ru >Russian
<OPTION VALUE=es >Spanish
<OPTION VALUE=sv >Swedish
</SELECT>and display top
<SELECT NAME=count>
<OPTION VALUE=0>10
<OPTION VALUE=1>20
<OPTION VALUE=4 SELECTED>50
<OPTION VALUE=9>100
<OPTION VALUE=14>150
<OPTION VALUE=19>200
</SELECT> results</B><BR>
<INPUT TYPE=HIDDEN NAME=fmt VALUE=".">
<INPUT NAME=q size=55 maxlength=800 VALUE='$qs'>
<INPUT TYPE=submit VALUE="Submit">
</FORM></P>
</TD></TR></TABLE></CENTER>
EndFORM
}

# print new page, with pre-filled search form,
# then submit queries to AltaVista, parse results, and print to page
#
sub Process_Form {
   my $fh = $_[0];

   # need an agent to submit queries to AV
   my $ua = new LWP::UserAgent;
   $ua->agent($ENV{HTTP_USER_AGENT}); # set same as incoming ua

   # get repeat count for desired number of search results
   $query = $params;
   $query =~ s/count=(\d+)\&//;
   $ctmax = $1;  $ctmax = 4 if ($ctmax eq "");

   # clean query string, so we can show it in form
   ($rawq) = ($query =~ /\&q=([^\&]*)\&?/);
   $rawq =~ tr/+/ /;
   $rawq =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C",hex($1))/eg;

   # print page top, form
   print STDERR "Sending search results\n" if ($debug);
   print $fh "HTTP/1.0 200 OK\n";
   print $fh "Content-type: text/html\n\n";
   print $fh <<"EndHEAD";
<HTML>
   <HEAD><TITLE>AltaVista Search Results</TITLE></HEAD>
<BODY BGCOLOR=#FFFFFF>
<H1 ALIGN=CENTER><I>Low Bandwidth</I> AltaVista Search Results</H1>
EndHEAD
   PrintForm($fh,$rawq);

   # repeat AV query until we have all the results we want
   foreach $ct (0..$ctmax) {

      # parse our query into AV query
      my $lquery = $query;
      $lquery .= sprintf("\&navig%d0.x=5\&navig%d0.y=5",$ct,$ct) if ($ct>0);

      # send request
      my $req = new HTTP::Request
            GET => "http://www.altavista.digital.com/\?$lquery";
      my $res = $ua->request($req);
   
      if ($res->is_success) {  # query worked

         # read lines of results
         @lines = split(/\n/,$res->content);

         # parse out bits we want
         # this code will break if AV changes their results
         # format, so beware
 
         $printable=0;
         foreach $l (@lines) {

            # parse out count of results, if found on first query
            if (($ct == 0) && ($l =~ m#AltaVista found#i)) {
               $lbl = $l;
               $lbl =~ s/<[^>]*>//g;
               print $fh "<P><B>$lbl</B></P>\n";
            }

            # look for bits that signal start of useful results, start printing
            if (($l =~ m#<dl><dt>#i) && ($printable ==0)) {
               $printable++;
            }

            # look for bits that signal end of useful results, stop printing
            if (($printable == 1) && ($l =~ m#Result Pages:#i)) {
               $printable++;
               next;
            }

            # if we are printing, clean out unwanted tags and print
            if ($printable==1) {
               $found=1;
               $l =~ s#</?(table|tr|td|th|font)[^>]*>##ig;
               $l =~ s#<img[^>]*>##ig;
               print $fh "$l\n";
            }
         }

      } else { # query failed
         print $fh "<HR>Failed Query $ct!<HR>\n";
      }
   }

   # if we didn't recognize any results, say so
   print $fh "<H1 ALIGN=CENTER><I>No Documents Found</I></H1>\n"
       if (!$found);

   # and finish the page
   print $fh "</BODY></HTML>\n";
}
