#!/usr/local/bin/perl
#  *MUST* have the above line.  httpd cannot run this program without it!

#  Change this variable to your HARVEST_HOME
$ENV{'HARVEST_HOME'} = "/usr/local/harvest";

#  Set this to a location for BrokerQuery.log, or to /dev/null
#  $BQLOG = "/usr/local/etc/httpd/logs/BrokerQuery.log";
$BQLOG = "/dev/null";

$rcsid = 'BrokerQuery.pl,v 1.48 1996/02/01 06:32:43 duane Exp';
#######################################################################
#
#  BrokerQuery.pl - Customizable WWW Interface to the Harvest Broker
#
#  Usage: Called as a CGI proccess from httpd
#
#  Duane Wessels, University of Colorado - Boulder, January 1995
#
#######################################################################
#  Copyright (c) 1994, 1995.  All rights reserved.
#  
#    The Harvest software was developed by the Internet Research Task
#    Force Research Group on Resource Discovery (IRTF-RD):
#  
#          Mic Bowman of Transarc Corporation.
#          Peter Danzig of the University of Southern California.
#          Darren R. Hardy of the University of Colorado at Boulder.
#          Udi Manber of the University of Arizona.
#          Michael F. Schwartz of the University of Colorado at Boulder.
#          Duane Wessels of the University of Colorado at Boulder.
#  
#    This copyright notice applies to software in the Harvest
#    ``src/'' directory only.  Users should consult the individual
#    copyright notices in the ``components/'' subdirectories for
#    copyright information about other software bundled with the
#    Harvest source code distribution.
#  
#  TERMS OF USE
#    
#    The Harvest software may be used and re-distributed without
#    charge, provided that the software origin and research team are
#    cited in any use of the system.  Most commonly this is
#    accomplished by including a link to the Harvest Home Page
#    (http://harvest.cs.colorado.edu/) from the query page of any
#    Broker you deploy, as well as in the query result pages.  These
#    links are generated automatically by the standard Broker
#    software distribution.
#    
#    The Harvest software is provided ``as is'', without express or
#    implied warranty, and with no support nor obligation to assist
#    in its use, correction, modification or enhancement.  We assume
#    no liability with respect to the infringement of copyrights,
#    trade secrets, or any patents, and are not responsible for
#    consequential damages.  Proper use of the Harvest software is
#    entirely the responsibility of the user.
#  
#  DERIVATIVE WORKS
#  
#    Users may make derivative works from the Harvest software, subject 
#    to the following constraints:
#  
#      - You must include the above copyright notice and these 
#        accompanying paragraphs in all forms of derivative works, 
#        and any documentation and other materials related to such 
#        distribution and use acknowledge that the software was 
#        developed at the above institutions.
#  
#      - You must notify IRTF-RD regarding your distribution of 
#        the derivative work.
#  
#      - You must clearly notify users that your are distributing 
#        a modified version and not the original Harvest software.
#  
#      - Any derivative product is also subject to these copyright 
#        and use restrictions.
#  
#    Note that the Harvest software is NOT in the public domain.  We
#    retain copyright, as specified above.
#  
#  HISTORY OF FREE SOFTWARE STATUS
#  
#    Originally we required sites to license the software in cases
#    where they were going to build commercial products/services
#    around Harvest.  In June 1995 we changed this policy.  We now
#    allow people to use the core Harvest software (the code found in
#    the Harvest ``src/'' directory) for free.  We made this change
#    in the interest of encouraging the widest possible deployment of
#    the technology.  The Harvest software is really a reference
#    implementation of a set of protocols and formats, some of which
#    we intend to standardize.  We encourage commercial
#    re-implementations of code complying to this set of standards.  
#  
#  
$DIR = &mydir ($0);
@X = split ('/', $0); $MYNAME = pop @X;
$ENV{'TMPDIR'} = "/tmp" unless defined($ENV{'TMPDIR'});
$ENV{'HARVEST_HOME'}= "/usr/local/harvest" unless defined($ENV{'HARVEST_HOME'});
unshift(@INC, "$ENV{'HARVEST_HOME'}/lib");

&not_configured unless (-d $ENV{'HARVEST_HOME'});

require 'socket.ph';	# not sys/socket.ph, we use $HARVEST_HOME/lib/socket.ph
require 'ctime.pl';	# we use $HARVEST_HOME/lib/ctime.pl

$debug		= 0;
$hp_url		= 'UNKNOWN';
$brokers	= $ENV{'HARVEST_HOME'} . '/brokers/Brokers.cf';
$hostname_cmd	= 'hostname';
$hostname_cmd	= '/bin/hostname' if (-x '/bin/hostname');
$hostname_cmd	= '/usr/ucb/hostname' if (-x '/usr/ucb/hostname');

# ===== MAIN =================================================================

foreach $sig ('HUP', 'QUIT', 'TSTP', 'TERM', 'ABRT') {
	$SIG{$sig} = 'sigdie';
}
foreach $sig ('ALRM') {
	$SIG{$sig} = 'sigharddie';
}

&parse_config ("$DIR/lib/BrokerQuery.cf");
$CFG{'rcsid'} = $rcsid;

# Read the 'master config' as above.  The name of a specialized config
# can be embedded in an HTML form tag as
#
#  <INPUT TYPE="hidden" NAME="brokerqueryconfig" VALUE="foo.cf">
#

#  Send the MIME Header
print "Content-Type: ", &expand ($CFG{'ContentType'}), "\r\n\r\n";

# Parse the CGI request
#
%RQ = &get_request;
$debug = 1 if defined $RQ{'debug'};
foreach $key (keys %RQ) { $RQ{$key} =~ s/\n/ /g; }
&fatal ('NoQuery')	if (%RQ == ());
&fatal ('rcsid')	if ($RQ{'version'} ne "");
&dump_array (%RQ)	if ($debug);
#&dump_array (%ENV)	if ($debug);

# Parse a broker-specific config file
#
print "opening $DIR/lib/$RQ{'brokerqueryconfig'}\n" if ($debug);
&parse_config ("$DIR/lib/$RQ{'brokerqueryconfig'}")
	if ( -f "$DIR/lib/$RQ{'brokerqueryconfig'}" );

# EXTRACT QUERY OPTIONS
#
$lifetime	= $RQ{'lifetime'};
$userquery	= $RQ{'query'};
$userclass	= $RQ{'class'};
$caseflag	= $RQ{'caseflag'}   eq 'on' ? 1 : 0;
$wordflag	= $RQ{'wordflag'}   eq 'on' ? 1 : 0;
$csumflag	= $RQ{'csumflag'}   eq 'on' ? 1 : 0;
$opaqflag	= $RQ{'opaqueflag'} eq 'on' ? 1 : 0;
$descflag	= $RQ{'descflag'}   eq 'on' ? 1 : 0;
$maxresult	= $RQ{'maxresultflag'};
$maxfiles	= $RQ{'maxobjflag'};
$maxlines	= $RQ{'maxlineflag'};
$errors		= $RQ{'errorflag'};
$broker 	= $RQ{'broker'} || $RQ{'host'};
$verbflag	= $RQ{'verbflag'} eq "" ? 0 : 1;
$version	= $RQ{'version'} eq "" ? 0 : 1;
@atts		= split (/\s+/, $RQ{'attribute'});
$sort		= $RQ{'sort'};

foreach $a (@atts) {
	$attributes .= "#attribute $a ";
}

# SECURITY CHECKS AND TRANSLATION ON BROKER HOST,PORT
#
$errmsg = <<"EOF";
<TITLE>$broker not found</TITLE>
<PRE>
$MYNAME doesn't know anything about broker

    <B>$broker</B>

Either it is not in the allowed list, or perhaps
$brokers is not readable.
</PRE>
EOF
&fatal($errmsg)
	unless (@hostport = &get_host_port ($broker));

# HACKS FOR BROKEN LYNX BROWSER
#
$errors = 0 if ($errors eq 'None');
$errors = 1 if ($errors eq '1 Error');
$errors = 2 if ($errors eq '2 Errors');

# SET THE LIFETIME
#
$BQlife = $CFG{'Timeout'};
$BQlife = $lifetime + 300 if ($lifetime ne "");
alarm ($BQlife);

### # SANITY CHECKS
### #
### &fatal ('NoReplica')	if ($host eq "No Replicas");
### &fatal ('Misconfig')	if ($host eq "" || $port == 0);

# CHECK QUERY STRING FOR COMMON MISTAKES
#
$userquery =~ s/^\s+//;			# remove leading whitespace
$userquery =~ s/\s+$//;			# remove trailing whitespace
unless ( $userquery =~ /\s+and\s+/i || $userquery =~ /\s+or\s+/i
      || $userquery =~ /:\s+/  || $userquery =~ /"/) {
	@X = split (/\s+/, $userquery);
	for ($i=0; $i<=$#X; $i++) {
		$X[$i] = "\"$X[$i]\"" if ($X[$i] =~ /\W/);
	}
	$userquery = join (' AND ', @X);
}

# BUILD QUERY STRING
#
$query = "";
$query .= $userclass . " AND " if ($userclass ne "");
$query .= $userquery;

# BUILD BROKER QUERY
#
$bquery = "#USER ";
$bquery .= "#opaque "				if ($opaqflag);
$bquery .= "#desc "				if ($descflag);
$bquery .= "#index timeout $lifetime "		if ($lifetime ne "");
$bquery .= "#index error $errors "		if ($errors ne "");
$bquery .= "#index maxresult $maxresult "	if ($maxresult ne "");
$bquery .= "#index maxfiles $maxfiles "		if ($maxfiles ne "");
$bquery .= "#index maxlines $maxlines "		if ($maxlines ne "");
$bquery .= "#index case ";
$bquery .= $caseflag ? "insensitive " : "sensitive ";
$bquery .= "#index matchword "			if ($wordflag);
$bquery .= $attributes;
$bquery .= "#END ";
$bquery .= $query;

$simple_query = $1 if ($query =~ /^.*partial-text\s*:\s+"(.*)".*$/io);

# Call Init Function
#
eval $CFG{'InitFunction'} if (defined ($CFG{'InitFunction'}));

# DO THE QUERY
#
$html_query = &html_escape ($query);
print &expand ($CFG{'ResultHeader'});
$connected = 0;
while ($#hostport > $[) {
	$host = shift (@hostport);
	$port = shift (@hostport);
	if ($SOCK = &client_socket ($host, $port)) {
		$connected = 1;
		last;
	}
}
&broker_down ($host, $port) unless ($connected);

print "Sending <PRE> $bquery </PRE> to $host:$port<HR>\n" if ($debug);
&do_query ($SOCK, $bquery);
undef $hp_url if ($hp_url eq 'UNKNOWN');
print &expand ($CFG{'ResultTrailer'});

exit 0;		# END OF PROGRAM

# ===== SUBROUTINES ==========================================================


# broker_host_port:
#
# If given a name, return the corresponding (host,port) pair.
# If given a host:port string, make sure it is a valid broker.

sub get_host_port {
	local ($broker) = @_;
	local ($name,$host,$port);
	local ($pattern);
	local (@hostport) = ();

	if ($broker =~ /([^:]+):(\d+)/) {		# given host:port
		$host = $1;
		$port = $2;
		return ($host,$port) unless ( -r $brokers );
		$pattern = '\S+\s+' . $host . '\s+' . $port;
	}
	else {						# given a name
		return () unless ( -r $brokers );	# cant translate name
		$broker_re = $broker;
		$broker_re =~ s/\+/\\\+/;		# escape specials
		$broker_re =~ s/\?/\\\?/;
		$broker_re =~ s/\./\\\./;
		$broker_re =~ s/\*/\\\*/;
		$broker_re =~ s/\|/\\\|/;
		$broker_re =~ s/\(/\\\(/;
		$broker_re =~ s/\)/\\\)/;
		$broker_re =~ s/\[/\\\[/;
		$broker_re =~ s/\]/\\\]/;
		$broker_re =~ s/\{/\\\{/;
		$broker_re =~ s/\}/\\\}/;
		$broker_re =~ s/\\/\\\\/;
		$pattern = '^' . $broker_re . '\s+\S+\s+\d+';
	}

	open (brokers) 	|| &fatal ("$brokers: $!\n");
	while (<brokers>) {
		chop;
		s/#.*//;				# strip comments
		s/^\s+//;				# leading whitespace
		s/\s+$//;				# trailing whitespace
		next unless (/$pattern/io);
		($name,$host,$port) = split;		# found match
		push (@hostport, $host);		# add host to array
		push (@hostport, $port);		# add port to array
	}
	close broker;
	return (@hostport);				# not found
}


# do_query:

sub do_query {
	local ($S, $bquery) = @_;
	local ($nobjects) = 0;
	local ($nopaquelines) = 0;

	alarm(1600);	# after 30 minutes just kill it, CERN httpd won't do it
	print $S $bquery;
	@T = <$S>;
	close ($S)	|| &fatal ("socket: $!\n");

	$/="\n";
	print &expand ($CFG{'ResultSetBegin'});

	while ($_ = shift(@T)) {
		chop $_;
		next if (/^$/o);
		print "|$_|\n" if ($debug);

		next if (/^200/o);

		if (/^126 -/o || /^120 -/o || /^103 -/o || /^111 -/o) {
			@OBJ[++$#OBJ] = $_ . "\n";
			last if (/^103 -/o || /^111 -/o);
		} else {
			@OBJ[$#OBJ] .= $_ . "\n";
		}
	}

	@OBJ = sort bynml @OBJ if ($sort eq 'by-NML');

	while (($curobj || ($curobj = shift(@OBJ))) && (($_, $curobj) = split(/\n/, $curobj, 2))) {

		# 124 - The description line of the match
		if (/^124 - (\d+)/o) {
			$n = $1;
			next if ($n == 0);
			$desc = &html_escape (substr($curobj, 0, $n));
			$curobj = substr($curobj, $n);  # delete the data
			next;
		}

		# 127 - Attribute request
		if (/^127 - ([^\s]+) (\d+)/o) {
			$att    = $1;
			$n      = $2;
			next if ($n == 0);
			$SOIF{$att} = &html_escape (substr($curobj, 0, $n));
			$curobj = substr($curobj, $n);  # delete the data
			next;
		}

		# 122 - Opaque data
		if (/^122 - (.*)$/o) {
			$_ = &html_escape ($1);
			eval $CFG{'MatchedLineSub'};
                        $opaque .= $_ . "\n" if (/\S/);
			$nopaquelines++;
                        next;
		}

		# 101 - message to the user
		if (/^101 - (.*)$/o) {
			$usermsg = $1;
			#print &expand ($CFG{'UserMessage'});
			next;
		}

		# 103 - end of broker results
		# 111 - Error Message that ends Broker Results
		if (/^103 - (.*)$/o || /^111 - (.*)$/o) {
			print &expand ($CFG{'ResultSetEnd'});
			$msg = $1;
			if ($msg =~ /PARSE ERROR/o) {
				print &expand ($CFG{'ParseError'});
			} elsif ($msg =~ /heavily loaded/o) {
				print &expand ($CFG{'BrokerLoad'});
			} elsif ($msg =~ /(\d+) Returned Object/o) {
				$nreturned = $1;
				print &expand ($CFG{'EndBrokerResults'});
				print &expand ($CFG{'EmptySetWarning'})
					if ($nreturned == 0);
				print &expand ($CFG{'TruncateWarning'})
					if ($nopaquelines >= $maxresult);
			} else {
				print &expand ($CFG{'FailBrokerResults'});
			}
			last;
		}

		# 120 - The URL of the match
		if (/^120 - (.*)$/o) {
			$url = $1;
			$url =~ /^([^:]+):\/*([^\/]+)(.*)$/o;
			$A = $1;
			$H = $2;
			$P = $3;
			@X = split ('/', $P);
			$F = pop (@X);
			$D = join ("/", @X, "");
			$F = $url if ($url =~ /\/$/o);
			if ($A eq 'news') {
				$F = $H;
				$H = $P = $D = undef;
			}
			$objectnum = sprintf ($CFG{'ObjectNumPrintf'},
				++$nobjects);
			#print &expand ($CFG{'PrintUrl'});
			next;
		}

		# content summary URL
		if (/^125 - (.*)$/o) {
			$cs_url = $1;
			$cs_url =~ /^([^:]+):\/*([^\/]+)(.*)$/o;
			$cs_a = $1;
			$cs_h = $2;
			$cs_p = $3;
			@X    = split ('/', $cs_p);
			$cs_f = pop (@X);
			$cs_d = join ("/", @X, "");
			$cs_f = $cs_url if ($cs_url =~ /\/$/o);
			next;
		}

		# Broker homepage URL
		if (/^126 - (.*)$/o) {
			$hp_url = $1;
			next;
		}

		# 130 - Object Ends, start a new one
		if (/^130/o) {
			eval $CFG{'PerObjectFunction'}
				if (defined ($CFG{'PerObjectFunction'}));
			$attributes = '';
			foreach $k (sort keys %SOIF) {
				$att = $k;
				$val = $SOIF{$k};
				$attributes .= &expand($CFG{'FormatAttribute'});
			}
			print &expand ($CFG{'PrintObject'});
			$opaque	= "";
			$url	= "";
			$cs_url	= "";
			$desc	= "";
			next;
		}

		# 200 - broker protocol version, ignore
		if (/^200/o) {
			next;
		}

	}

}

sub fatal {
	local ($key) = shift;
	local ($msg) = defined ($CFG{$key}) ? &expand ($CFG{$key}) : $key;
	chop (local ($now) = &ctime (time));
	print STDOUT "$msg";
	if (open(BQLOG, ">>$BQLOG")) {
		printf BQLOG ("[%s] BrokerQuery: %s", $now, $msg);
		close BQLOG;
	}
	unlink("$ENV{'TMPDIR'}/BrokerQuery.$$");
	exit(1);
}

# Perform simple variable substitution.  See Wall & Schwartz
# 'Programming Perl' book, p 217.
#
sub expand2 {
	$_ = shift;
	s/"/\\"/g;
	eval qq/"$_"/;
}

# Gross regexp's to do some ifdef-type substitutions
#
# Use: 
#       <?foo>abcxyz</?foo>     becomes       abcxyz
#       <?>abcxyz</?>           is deleted
#
# so the user can conditionally include a section of text by
# enclosing it in <?$var>...</?$var>.  The section will be
# included if $var is not the null string.  If a newline 
# follows </?> the newline is removed.
#
# NOTE: this is still buggy.
#
sub expand {
        $_ = &expand2 (shift);
        s/<\?>\n*.*\n*<\/\?>\n?//g;		# delete all
        s/<\?([^>]+)>\n*(.*)\n*<\/\?\1>/$2/g;	# delete markers
        $_;
}


sub html_escape {
	$_ = shift;
	s/\&/\&amp;/g;		# do ampersand first!
	s/</\&lt;/g;
	s/>/\&gt;/g;
	s/\&amp;(\w+;)/\&\1/g;	# try putting some HTML back   &Circ;
	s/\&amp;(#\d+;)/\&\1/g;	# try putting some HTML back   &#38;
	$_;
}


sub parse_config {
	local ($CF)	= shift;
	local ($out)	= 1;
	undef (local ($key));
	undef (local ($val));

	open (CF) || &fatal ("$CF: $!\n");

	while (<CF>) {
		next if (/^#/o);
		if ($out && /<(\w+)>/o) {
			$key = $1;
			$val = "";
			$out = 0;
			next;
		}
		if (!$out && /<\/$key>/) {
			#eval ("\$$key=$val");
			print "setting $key...\n" if ($debug);
			#print "to $val\n";
			chop ($CFG{$key} = $val);
			undef ($val);
			undef ($key);
			$out = 1;
			next;
		}
		chop, chop if (/[^\\]\\$/o);	# chop newline if esc'd
		$val .= $_ if (!$out && defined ($val));
	}
	close CF;
	1;
}
	
sub client_socket {
	local ($host, $port) = @_;
	local ($sockaddr) = 'S n a4 x8';
	local ($name, $aliases, $proto) = getprotobyname('tcp');
	local ($connected) = 0;
	
	# Lookup addresses for remote hostname
	#
	local($w,$x,$y,$z,@thataddrs) = gethostbyname($host);
	&fatal("Unknown Host: $host\n") unless (@thataddrs);

	# bind local socket to INADDR_ANY
	#
	local ($thissock) = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
	&fatal("socket: $!\n") unless
		socket (SOCK, &AF_INET, &SOCK_STREAM, $proto);
	&fatal("bind: $!\n") unless
		bind (SOCK, $thissock);

	# Try all addresses
	#
	foreach $thataddr (@thataddrs) {
		local ($that) = pack($sockaddr, &AF_INET, $port, $thataddr);
		@IP = unpack('C4', $thataddr);
		printf ("Trying connection to %d.%d.%d.%d<BR>\n", @IP)
			if ($debug);
		if (connect (SOCK, $that)) {
			$connected = 1;
			printf ("Connected to %d.%d.%d.%d!<BR>\n", @IP)
				if ($debug);
			last;
		}
	}
	return () unless ($connected);

	# Set socket to flush-after-write and return it
	#
	select (SOCK); $| = 1;
	select (STDOUT);
	return (SOCK);
}

sub sigharddie {
	unlink("$ENV{'TMPDIR'}/BrokerQuery.$$");
	kill ('KILL', $$);
}

sub sigdie {
	local ($sig) = @_;
	&fatal ('sigdie');
}

sub dump_array {
	local (%A) =  @_;
	local ($key);
        print "<PRE>\n";
        foreach $key ( sort keys %A) {
                print "$key=$A{$key}\n";
        }
        print "</PRE>\n";
	1;
}

sub mydir {
	@D = split ('/', shift);
	pop @D;
	@D = (".") if (@D == ());
	join ('/', @D);
}

sub broker_down {
	local($host, $port) = @_;
	print STDOUT <<EOM;
<p>
Sorry, but the Broker on
<STRONG>$host, port $port</STRONG>
is currently unavailable.  Please try again later.
<p>
EOM
	&fatal("$host:$port: $!\n");
}

sub not_configured {
	print <<"EOM";
Content-type: text/html\r\n\r\n

<TITLE>BrokerQuery.pl.cgi not properly installed</TITLE>
<STRONG>WARNING:</STRONG> You have not installed the WWW interface
to the Harvest Broker correctly.  The \$HARVEST_HOME directory
<PRE><STRONG>        $ENV{'HARVEST_HOME'}</STRONG></PRE> does not exist.
<P>
Please refer to the current
<A HREF="http://harvest.cs.colorado.edu/harvest/INSTRUCTIONS.html">installation
instructions</A>.
EOM
	exit 0;
}

######################################################################
# Below is cgi.pl...
#
# &get_request;
# $area=$rqpairs{'area'};
# $title=$rqpairs{'title'};
# $name=$rqpairs{'name'};
# $msg = $rqpairs{'message'};
# $date = &get_date;
# chop($thishost = `hostname`);
# 
# # Check for blank title and URL
# #
# &failure ("Blank title")     	if ($title eq "");
# &failure ("Blank name")     	if ($name  eq "");
# &failure ("Empty message")   	if ($msg   eq "");
# &failure ("Empty subject area") if ($area  eq "");


# The CGI_HANDLERS deal with basic CGI POST or GET method request
# elements such as those delivered by an HTTPD form, i.e. a url
# encoded line of "=" separated key=value pairs separated by &'s

# Routines:
# get_request:	reads the request and returns both the raw and
#               processed version.
# url_decode:	URL decodes a string or array of strings
# html_header:	Transmits a HTML header back to the caller
# html_trailer: Transmits a HTML trailer back to the caller

# Author:
# 	James Tappin: sjt@xun8.sr.bham.ac.uk
#	School of Physics & Space Research University of Birmingham
#	Feb 1993.		

# Copyright & Disclaimer.
#	This set of routines may be freely distributed, modified and
#	used, provided this copyright & disclaimer remains intact.
#	This package is used at your own risk, if it does what you
#	want, good; if it doesn't, modify it or use something else--but
#	don't blame me. Support level = negligable (i.e. mail bugs but
#	not requests for extensions)

# Usage:
#	needs a 'require "cgi_handlers.pl";' line in the main script
#
#	&get_request;    will get the request and decode it into an
#			 indexed array %rqpairs, the raw request is in
#			 $request
#
#	... = &url_decode(LIST); will return a URL decoded version of
#			         the contents of LIST
#
#	&html_header(TITLE); 	will write to standard output an HTML
#				header (including the content-type
#				field) giving the document the title
#				specified by TITLE.
#
#	&html_trailer;		Writes a trailer to the html document
#				with the name of the script generating
#				it and the date (in UT).

sub get_request {

    # Subroutine get_request reads the POST or GET form request from STDIN
    # into the variable  $request, and then splits it into its
    # name=value pairs in the associative array %rqpairs.
    # The number of bytes is given in the environment variable
    # CONTENT_LENGTH which is automatically set by the request generator.

    # Encoded HEX values and spaces are decoded in the values at this
    # stage.

    # $request will contain the RAW request. N.B. spaces and other
    # special characters are not handler in the name field.

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
    } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
	$request = $ENV{'QUERY_STRING'};
    }

    @F = split(/[&=]/, $request);
    &url_decode(@F);
}

sub url_decode {
#	Decode a URL encoded string or array of strings 
#		+ -> space
#		%xx -> character xx

    foreach (@_) {
	tr/+/ /;
	s/%(..)/pack("c",hex($1))/ge;
    }
    #@_;

    # This gross stuff handles multiply defined attributes.  For example:
    #    foo=abc&foo=xyz
    # comes back as
    #    $RQ{'foo'} eq 'abc xyz'
    # Otherwise, the previous method just gave us one or the other.    -DW
    # 
    local ($k, $v);
    local (%Y);
    while (($k=shift @_) ne '' && ($v=shift @_) ne '') {
        $Y{$k} = defined $Y{$k} ? join (' ', $Y{$k}, $v) : $v;
    }
    %Y; 
}

# sort the objects by number of matched lines
#
sub bynml {
	split(/\n/, $b) <=> split(/\n/, $a);	# number of lines in object
}
