#!/usr/local/bin/jperl
#
# info2www - Gateway between GNU Info nodes and WWW
$id = '$Id: info2www,v 1.2 1994/07/28 15:39:38 lmdrsm Rel lmdrsm $';
#
# This is a script conforming to the CGI - Common Gateway Interface
#
# Author:	Roar Smith (lmdrsm@lmd.ericsson.se)
#
# Copyright:	This program is in the Public Domain.
#
# The original code (most of &info2html) was written by 
# Eelco van Asperen (evas@cs.few.eur.nl).
#
# TODO:
# -----
# * Present a list of choices when there is no exact match for the requested
#   Info file but multiple non-exact matches exist.
# 
# * Use Tag Table to find possible file and offset.
#
#

#----------------- CONFIGURATION -----------------------------------------------

#
# Set $DEBUG = 1; to debug what's happening
#
$DEBUG = 0;

#
# INFOPATH is the path of direcories in which to search for Info node files.
#
@INFOPATH =				
    ( "/usr/local/info", "/usr/share/info", "/usr/X11R6/info" );

#
# ALLOWPATH specifies whether info files with may be specified with path-names
# outside of those directories included in INFOPATH .
# It is a possible security hole to set this variable to a true value,
# because *any* file on the system could then be accessed through this gateway.
$ALLOWPATH = 0;

#
# ALIAS is a map of aliases - look for the alias if the node itself isn't found.
# The key (first entry) is the node filename, the value (second entry) is the
# alias. Both are basenames (i.e. no path!) with no capital letters.
# Note that the keys *must* be unique!
#
%ALIAS =
    (
     'emacs',	'lemacs',
     'g++',	'gcc',
     'c++',	'gcc',
     'gunzip',	'gzip',
     'zcat' ,	'gzip',
     'elisp',	'lispref'
     );

#
# URL of the icons used for indicating references and stuff:
# $INFO_ICON	- Icon at the top left of each document
# $UP_ICON	- Icon used in an "Up:"   hyperlink at the top
# $NEXT_ICON	- Icon used in a  "Next:" hyperlink at the top
# $PREV_ICON	- Icon used in a  "Prev:" hyperlink at the top
# $MENU_ICON	- Icon used in front of each menu label
#
# Set these to "" if you don't want them used.
#
$INFO_ICON =	"/docs/info2www/infodoc.gif";
$UP_ICON =	"/docs/info2www/up.gif";
$NEXT_ICON =	"/docs/info2www/next.gif";
$PREV_ICON =	"/docs/info2www/prev.gif";
$MENU_ICON =	"/docs/info2www/menu.gif";

#
# URL for documentation on info2www
#
# Set this to "" if you don't want it used.
#
$DOCREF =	"/docs/info2www/info2www.html";

#
# CACHE is the dbm(3) or ndbm(3) file for cacheing lookup information.
# Set this to "" if you don't want it used.
# The effective user of this script should have write permissions to
# the directory in which the dbm files reside.
#
$CACHE = "/var/adm/info2www_cache";

#
# These are the defines for file-locking with flock(2)
#
$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;

# Backgroud color
$BGCOLOR='BGCOLOR="#fff8dc"';

#----------------- MAIN --------------------------------------------------------
print "Content-type: text/html\n";  #-- Mime header for NCSA httpd
print "\n";
print "$id<BR>\n" if $DEBUG;

$pg = $0; $pg =~ s,^.*/([^/]*)$,$1,;
($version, $date) = ($id =~ m@,v\s+([0-9.]+)\s+([0-9/]+)@);

$script_name = $ENV{'SCRIPT_NAME'};
$server_name = $ENV{'SERVER_NAME'};
$request_method = $ENV{'REQUEST_METHOD'};
$prefix = $script_name . "?";	# prefix for HREF= entries

if ($request_method ne 'GET') {
    die "REQUEST_MODE 'GET' expected - got '$request_method'\n";
}

print "ARGV: ", join('+', @ARGV), "<BR>\n" if $DEBUG;
if ($#ARGV == -1) {
    $nodename = "(DIR)";
} else {
    $nodename = join('+', @ARGV);
    $nodename = &DeEscape($nodename);
}
print "nodename: ", $nodename, "<BR>\n" if $DEBUG;

&info2html($nodename);

if ($DOCREF) {
    print
	"<hr>\n",
	"<em>automatically generated by</em> ",
	"<A HREF=\"$DOCREF\"><strong>$pg</strong></A>",
	" <em>version $version</em>\n";
} else {
    print
	"<hr>\n",
	"<em>automatically generated by</em> ",
	"<strong>$pg</strong>",
	" <em>version $version</em>\n";
}
print "</BODY></HTML>\n";

exit(0);

#----------------- SUBROUTINES -------------------------------------------------

#------------------------------------------------------------
#                        ToPattern
#------------------------------------------------------------
# This procedure transforms a string in a search pattern,
# escaping the non standard characters.
#------------------------------------------------------------
sub ToPattern{
  local($Tag) = @_;
  local(@Temp);
  @Temp = split(/([^a-zA-Z0-9])/,$Tag);
  $Tag = "";
  for $x (@Temp){
    $x = ($x =~ /[^a-zA-Z0-9]/) ? '\\'.$x : $x;
    $Tag .= $x;
  }
  $Tag;
}

#---------------------------------------------------------
#                      Escape
#---------------------------------------------------------
#  This procedures escapes some special characeters. The
#  escape sequence follows the WWW guide for escaped
#  characters in URLs
#---------------------------------------------------------
sub Escape{
  local($Tag) = @_;
  $Tag =~ s/%/%25/g;		#  %
  $Tag =~ s/[ \n]+/%20/g;	#  space(s) and/or newline(s)
  $Tag =~ s/\+/%2B/g;		#  +
  return $Tag;
}

#----------------------------------------------------------
#                    DeEscape
#----------------------------------------------------------
sub DeEscape{
  local($Tag) = @_;
  $Tag =~ s/\\([][(){}|?*\\])/$1/g;
  return $Tag;
}    


#---------------------------------------------------------------------------
#
#                    info2html
#
#---------------------------------------------------------------------------
sub info2html {
    local($nodename) = @_;
    local($next_img, $prev_img, $up_img);
    local($cachefound);

    # Nodename looks like one of these:
    # (file)label	- Both file and label of the Info node given
    # (file)		- Label defaults to "Top"
    # 			- File defaults to "DIR", Label defaults to "Top"

    $matches = 0;
    $blank = 0;

    if ($nodename =~ /^\(([^\)]*)\)(.+)$/) {
	($file, $node) = ($1, $2);
    } elsif ($nodename =~ /^\(([^\)]*)\)$/) {
	($file, $node) = ($1, "Top");
    } elsif (!$nodename) {
	($file, $node) = ("DIR", "Top");
    } else {
	print "Malformed node name: $nodename\n";
	return(0);
    }

    $target = $node;
    $target =~ y/A-Z/a-z/;
    $target =~ s/%20/ /g;
    $target =~ s/&lt\;/</g;
    $target =~ s/&gt\;/>/g;
    $target = &ToPattern($target);
    $file =~ s/&lt\;/</g;
    $file =~ s/&gt\;/>/g;

    print "nodename: $nodename\nfile: $file\ntarget: $target\n" if $DEBUG;

    $info_img = "<IMG SRC=\"$INFO_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $INFO_ICON;
    $next_img = "<IMG SRC=\"$NEXT_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $NEXT_ICON;
    $prev_img = "<IMG SRC=\"$PREV_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $PREV_ICON;
    $up_img = "<IMG SRC=\"$UP_ICON\" ALT=\"\" ALIGN=BOTTOM> " if $UP_ICON;

    $nfiles = 0;
    $cachefound = 0;
    if ($CACHE) {
	$cachefound = &TryCache("($file)$target");
    }

    if (!$cachefound) {
	print "<BR> FindFile...\n" if $DEBUG;
	($directory, $basefile) = &FindFile($file);
	if (!$directory) {
	    &error("Couldn't find Info file \"$file\".");
	    return(0);
	}
	&OpenFile($basefile) || return(0);
    }
    
    $active = 0;
    $seenMenu = 0;
    $indirect = 0;
    $inentry = 0;
    $lastblank = 0;
    
  FileLoop:
    for (; $nfiles > 0; ) {

	local($handle) = "FH_$nfiles";
	print "<BR> --now reading from $handle--\n" if $DEBUG;
	if ($basefile) {
	    $h_file = $basefile;
	} elsif ($realfile{$handle}) {
	    $h_file = $realfile{$handle};
	    $h_file =~ s,.*/([^/])$,$1,;
	    $h_file =~ s,.*/(.*)-[0-9]+$,$1,;
	}
	while (<$handle>) {
	    chop;
	    s/&/&amp\;/g;
	    s/</&lt\;/g;
	    s/>/&gt\;/g;
	    #study;			# Doesn't seem to help or hurt!
	    /^[\037\f]/ && do {
		&EndMenu();
		&EndListing();
		if ($active) {
		    close($handle);
		    print "<BR> Closed file $handle\n" if $DEBUG;
		    return(1);
		}
		$active = 0;
		$seenMenu = 0;
		$indirect = 0;
		$inentry = 0 if $inentry;
		$inentry++;
		$pos = tell() - length($_) - 1;
		next;
	    };

	    next if ($inentry == 0);

	    $lastblank = $blank; $blank = 0;
	    /^$/ && do {
		if ($active) {
		    print "\n";
		} elsif ($menu == 0) {
		    print;
		}
		$blank = 1;
		next;
	    };

	    ($inentry == 1) && do  {
		# top line:
		# File: info,  Node: Add,  Up: Top,  Prev: Expert,  Next: Menus 
		/^tag table:/i && do {
		    # we don't use the tag table
		    $inentry = 0;
		    next;
		};
		/^indirect:/i && do {
		    # this entry is a list of filenames to include:
		    #
		    #	gcc.info-1: 1131
		    #	gcc.info-2: 49880
		    #	gcc.info-3: 99426
		    $inentry++;
		    $indirect++;
		    next;
		};

		#
		# Parse the header line. If one of the fields
		#	Node: Up: Next: Previous: File:
		# is found, then a variable 'h_node' is set for
		# the field 'node:', 'h_next' for 'next:', etc.
		#
		undef $h_node;
		undef $h_file;
		undef $h_next;
		undef $h_prev;
		undef $h_up;

		/\bfile: *([^ ,\t]*)/i && do {
		    $h_file = $1;
		};
		/\bnode: *([^,\t]*)/i && do {
		    $h_node = $1;
		    $h_node =~ s/\s+$//; # delete trailing spaces
		};
		/\bup: *([^,\t]*)/i && do {
		    $h_up = $1;
		    $h_up =~ s/\s+$//; # delete trailing spaces
		};
		/\bprevious: *([^,\t]*)/i && do {
		    $h_prev = $1;
		    $h_prev =~ s/\s+$//; # delete trailing spaces
		};
		/\bprev: *([^,\t]*)/i && do {
		    $h_prev = $1;
		    $h_prev =~ s/\s+$//; # delete trailing spaces
		};
		/\bnext: *([^,\t]*)/i && do {
		    $h_next = $1;
		    $h_next =~ s/\s+$//; # delete trailing spaces
		};
		
		print "--h_node: $h_node--<p>\n" if $DEBUG;
		$n = 0;

		if ($h_node =~ m/^$target$/i) {
		    $active = 1;
		    $matches++;
		    if ($CACHE && !$cachefound) {
			&UpdateCache("($file)$target",
				     $pos, $realfile{$handle});
		    }
		    print
			"<HTML>\n",
			"<HEAD>",
			"<TITLE>",
			"Info Node: ($h_file)$h_node",
			"</TITLE></HEAD>\n",
			"<BODY $BGCOLOR><H1>$info_img($h_file)$h_node</H1>\n",
			"<HR>\n";
		    if (defined $h_next) {
			print
			    "Next: ",
			    "<B>",
			    &make_anchor($h_next, "$next_img$h_next"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		    if (defined $h_prev) {
			print
			    "Prev: ",
			    "<B>",
			    &make_anchor($h_prev, "$prev_img$h_prev"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		    if (defined $h_up) {
			print
			    "Up: ",
			    "<B>", &make_anchor($h_up, "$up_img$h_up"),
			    "</B><TT>  </TT>";
			$n++;
		    }
		}

		print "\n<HR>\n" if $n;
		$inentry++;
		&StartListing();
		next;
	    };

	    ($inentry == 2) && $indirect && do  {
		# each line of this entry consists of two fields,
		# a filename and an offset, separated by a colon.
		# For example:
		#	texinfo-1: 1077
		local(@F) = split(/:/);
		print "#include $F[0]<p>\n" if $DEBUG;
		# should save: $inentry $indirect
		$save_inentry[$nfiles] = $inentry;
		$save_indirect[$nfiles] = $indirect;
		$inentry = 0;
		$indirect = 0;
		&OpenFile($F[0]) || return(0);
		next FileLoop;
	    };

	    next if $active == 0;

	    if (($end) = /^\*\s+Menu:(.*)$/) {
		# start of a menu:
		$seenMenu = 1;
		&EndListing();
		print "$end";
		&StartMenu();
		next;
	    };

	    /^\*/ && do {
		#---- SAMPLE LINES: -----------------------------------------
		# * Sample::.		Sample info.
		#
		# * Info: (info).	Documentation browsing system.
		# 
		# * Bison: (bison/bison)
		# 		A Parser generator in the same style as yacc.
		# * Random: (Random) Random    Random Number Generator
		#------------------------------------------------------------

		if ($menu == 0 && $seenMenu) { &EndListing(); &StartMenu(); };

		# * foo::
		/^\*\s+([^:]+)::/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor($1, $1, $MENU_ICON),
			"<DD>";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# * foo: (bar)beer OR (bar)
		/^\*\s+([^:]+):\s+\(([^\) \t\n]+)\)([^\t\n\.,]*)/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor("($2)$3",$1, $MENU_ICON),
			"<DD>";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# * foo: beer.
		/^\*\s+([^:]+):\s+([^\t,\n\.]+)/ && do {
		    $rest_of_line = $';
		    print
			"<DT>", &make_anchor($2, $1, $MENU_ICON),
			"<DD>", $2, ". ";
		    $rest_of_line =~ s/^[\s\.]+//;
		    print $rest_of_line, "\n";
		    next;
		};

		# no match: ignore silently
	    };

	    $menu && $lastblank && do {
		&EndMenu();
		&StartListing();
	    };

	    $menu && do {
		s/^\s+//;
	    };

	    /\*note/i && do {
		# cross reference entry:
		# "*note nodename::."
		# "*note Cross-reference-name: nodename."
		local($n) = 0;
		while (1) {
		    # *note \nfoo... (reference split over newline)
		    if (/\*note\s*$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }
		    # *note foo\nbar... (reference split over newline)
		    if (/\*note\s+[^:\.]+$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }
		    # *note foo: bar\nbleh... (reference split over newline)
		    if (/\*note\s+[^:\.]+:\s+[^:\.\t]+$/i) {
			$_ .= "\n" . <$handle>;	# Merge with next line
			chop;
		    }

		    # *note foo:
		    if (/\*note(\s+)([^:\.]+)::/i) {
			s//\@\@\@NOTE\@\@\@/;	# insert unique (I hope) marker
			local($spc, $ref, $lbl) = ($1, $2, $2);
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note/;
			$n++;
			next;
		    }

		    # * foo: (bar)beer OR (bar)
		    if (/\*note(\s+)([^:]+):\s+\(([^\) \t\n]+)\)([^\t\.,]*)(.?)/i) {
			s//\@\@\@NOTE\@\@\@/;	# insert unique (I hope) marker
			local($spc, $ref, $lbl) = ($1, "($3)$4", "$2$5");
			local($nl) = ($ref =~ /\n/) ? "\n" : "";
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note$nl/;
			$n++;
			next;
		    }

		    # * foo: beer.
		    if (/\*note(\s+)([^:]+):\s+([^\t,\.]+)(.?)/i) {
			s//\@\@\@NOTE\@\@\@/;	# insert unique (I hope) marker
			local($spc, $ref, $lbl) = ($1, $3, "$2$4");
			local($nl) = ($ref =~ /\n/) ? "\n" : "";
			local($note) = "<B>Note:</B>$spc";
			$note .= &make_anchor($ref, $lbl);
			s/\@\@\@NOTE\@\@\@/$note$nl/;
			$n++;
			next;
		    }

		    last;
		}
#		if ($n > 0) {
#		    local($l) = $listing;
#		    &EndListing() if $l;
#		    print "$_\n";
#		    &StartListing() if $l;
#		    next;
#		}
	    };

	    print "$_\n";
	}
	&EndMenu();

	# clear status variables;
	$active = 0;
	$seenMenu = 0;
	$indirect = 0;
	$inentry = 0;
	$lastblank = 0;

	print "--end of file $handle--<P>\n" if $DEBUG;
	close($handle);
	print "<BR> Closed file $handle\n" if $DEBUG;
	$nfiles--;
	$inentry = $save_inentry[$nfiles];
	$indirect = $save_indirect[$nfiles];
	print "--inentry: $inentry--indirect: $indirect--<p>\n" if $DEBUG;
	last if $matches;
    }
    if (!$matches) {
	&error("Couldn't find target: \"$target\" in file \"$file\".");
	if ($cachefound) {
	    &UpdateCache("($file)$target");
	}
    }
    return $matches;
}

#---------------------------------------------------------------------------

sub make_anchor {
    local($ref, $label, $icon) = @_;
    local($node_file, $node_name, $img, $href);

    print "--make_anchor($ref, $label)<BR>\n" if $DEBUG;
    # (foo)bar
    if ($ref =~ m/\(([^\)]+)\)\s*([^\t,\.]*)/) {
	$node_file = $1;
	$node_name = $2;
    } elsif ($file =~ /^dir$/i) {
	print "--(DIR) node - Menu \"@_\" means \"($ref)\"<BR>\n" if $DEBUG;
	$node_file = $ref;
	$node_name = "";
    } else {
	$node_file = $h_file;
	$node_name = $ref;
    }
    $node_name =~ s/[ ]*$//;

    if ($node_name ne "") {
	$href = &Escape("$prefix($node_file)$node_name");
    } else {
	$href = &Escape("$prefix($node_file)");
    }
    if ($icon) {
	$img = "<IMG SRC=\"$icon\" ALT=\"\*\"> ";
    }
    return "$img<A HREF=\"$href\">$label</A>";
}

sub StartMenu {
    print "\n<DL COMPACT>" if $active;
    $menu = 1;
}

sub EndMenu {
    if ($menu) {
	print "</DL>\n" if $active;
	$menu = 0;
    }
}

sub StartListing {
    print "<PRE>\n" if $active;
    $listing++;
}

sub EndListing {
    if ($listing) {
	print "</PRE>\n" if $active;
	$listing--;
    }
}

sub FindFile {
    local($filename) = @_;
    local($dir, $fil);
    print "<BR> ", "FindFile: '$filename'\n" if $DEBUG;
    
    ($dir, $fil) = &FindFileNoAlias($filename);
    if ($dir) {
	return $dir, $fil;
    }
    # Try a possible alias...
    $fil = $filename;
    $fil =~ s/[-\.]info(\.gz)?$//;
    $fil =~ tr/A-Z/a-z/;
    $filename = $ALIAS{$fil};
    print "<BR> ", "\$", "ALIAS{", $fil, "} = ", $filename, "\n" if $DEBUG;
    if ($filename) {
	print "<BR> Trying with the alias \"$filename\"...\n" if $DEBUG;
	return &FindFileNoAlias($filename);
    } else {
	# Bummer - no alias
	return;
    }
}
   
sub FindFileNoAlias {
    local($filename) = @_;
    local($altfilename) = $filename;
    local(@filelist) = ();
    local($dir, $fil);
    local($regex, $altregex);

    if ($filename =~ /\.info$/) {
	$altfilename =~ s/\.info$//;
    } elsif ($filename =~ /-info$/) {
	$altfilename =~ s/-info$/.info/;
    } else {
	$altfilename =~ s/$/.info/;
    }
    print "<BR> FindFileNoAlias: '$filename', Alt='$altfilename'\n" if $DEBUG;

    $regex = &ToPattern($filename);
    $altregex = &ToPattern($altfilename);

    # Try absolute match for $filename...
    if ($filename =~ /\//) {
	($dir, $fil) = ($filename =~ m,(.*)/([^/]*),);
	if ($ALLOWPATH || grep($_ eq $dir, @INFOPATH)) {
	    print "<BR> Trying absolute match for \"$filename\"...\n" if $DEBUG;
	    if (-e "$filename" || -e "$filename.gz") {
		return $dir, $fil;
	    }
	    print "<BR> Trying absolute match for \"$altfilename\"...\n"
		if $DEBUG;
	    if (-e "$altfilename" || -e "$filename.gz") {
		($dir, $fil) = ($altfilename =~ m,(.*)/([^/]*),);
		return $dir, $fil;
	    }
	    $file =~ s,^.*/([^/]*)$,$1,;
	    $filename =~ s,^.*/([^/]*)$,$1,;
	    $altfilename =~ s,^.*/([^/]*)$,$1,;
	    print "<BR> Stripped path from filename: $filename\n" if $DEBUG;
	} elsif (!$ALLOWPATH) {
	    print "<BR> Warning: Absolute path-names not allowed!\n" if $DEBUG;
	    $file =~ s,^.*/([^/]*)$,$1,;
	    $filename =~ s,^.*/([^/]*)$,$1,;
	    $altfilename =~ s,^.*/([^/]*)$,$1,;
	    print "<BR> Stripped path from filename: $filename\n" if $DEBUG;
	}
    }

    # Try exact match for $filename in all directories...
    print "<BR> Trying exact match for \"$filename\"...\n" if $DEBUG;
    foreach (@INFOPATH) {
	if (-e "$_/$filename" || -e "$_/$filename.gz") {
	    return $_, $filename;
	}
    }
    # Try exact match for $altfilename in all directories...
    print "<BR> Trying exact match for \"$altfilename\"...\n" if $DEBUG;
    foreach (@INFOPATH) {
	if (-e "$_/$altfilename" || -e "$_/$altfilename.gz") {
	    return $_, $altfilename;
	}
    }
    # Try caseless match for $filename in all directories...
    print "<BR> Trying caseless match for \"$filename\"...\n" if $DEBUG;
    @filelist = ();
    foreach (@INFOPATH) {
	$dir = $_;
	opendir(DIR, $dir);
	push (@filelist,
	      sort grep(s/^/$dir\//, grep(/^$regex$/i, readdir(DIR))));
	closedir(DIR);
    }
    if ($#filelist > 0) {
	# Multiple matches...present list or just return one item?
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    } elsif ($#filelist == 0) {
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    }
    # Try caseless match for $altfilename in all directories...
    print "<BR> Trying caseless match for \"$altfilename\"...\n" if $DEBUG;
    @filelist = ();
    foreach (@INFOPATH) {
	$dir = $_;
	opendir(DIR, $dir);
	push (@filelist,
	      sort grep(s/^/$dir\//, grep(/^$altregex$/i, readdir(DIR))));
	closedir(DIR);
    }
    if ($#filelist > 0) {
	# Multiple matches...present list or just return one item?
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    } elsif ($#filelist == 0) {
	($dir, $fil) = ($filelist[0] =~ m,(.*)/([^/]*),);
	return $dir, $fil;
    }
    # Bummer - no matches at all
    return;
}

sub OpenFile {
    local($filename) = @_;
    local($alternate, $handle);

    $nfiles++;
    $handle = "FH_$nfiles";
    if ($filename =~ /\//) {
	($directory, $filename) = ($filename =~ m,(.*)/([^/]*),);
    }
    $realfile{$handle} = "$directory/$filename";
    $success = 0;
    print
	"<P>Trying to open file ",
	"\"$filename\" in directory \"$directory\" ...\n" if $DEBUG;
    if (open($handle, "$directory/$filename") ||
	open($handle, "zcat $directory/${filename}.gz|")) {
	print "<P>Opened file \"$directory/$filename\"\n" if $DEBUG;
	return(1);
    } else {
	print "<P>Could not open file",
	"\"$filename\" in directory \"$directory\".\n" if "$DEBUG";
	return(0);
    }
}

sub TryCache {
    local($cachekey) = @_;
    local($handle, $line, $h_node);
    local($cachevalue, $cachepos, $cachefile, $cachedir, $newkey);
    print "<BR> Trying cached entry for \"$cachekey\"...\n" if $DEBUG;
    if ($CACHE && &LockCache()) {
	if (dbmopen(%cache, $CACHE, 0644)) {
	    $cachevalue = $cache{$cachekey};
	    dbmclose(%cache);
	    &UnLockCache();
	} else {
	    $CACHE = "";
	    &UnLockCache();
	    return(0);
	}
    } else {
	$CACHE = "";
	return(0);
    }
    if (!$cachevalue) {
	if ($cachekey =~ m,\(.*/.*\).*,) {
	    $newkey = $cachekey;
	    $newkey =~ s,^\(.*/([^/\)]*)\),($1),;
	    return(&TryCache($newkey));
	} else {
	    return(0);
	}
    }
    print "<BR> Cached entry found: " if $DEBUG;
    ($cachepos, $cachefile) = split("\0", $cachevalue);
    print "$cachepos in \"$cachefile\"\n" if $DEBUG;
    if ($cachefile =~ /\//) {
	$cachedir = $cachefile;
	$cachedir =~ s,(.*)/[^/]*$,$1,;
	if (!$ALLOWPATH && !grep($_ eq $cachedir, @INFOPATH)) {
	    print "<BR> Warning: Absolute path-names not allowed!\n" if $DEBUG;
	    &UpdateCache($cachekey);
	    return(0);
	}
    }
    if (!&OpenFile($cachefile)) {
	&UpdateCache($cachekey);
	return(0);
    }
    $handle = "FH_$nfiles";
    print "<BR> --now reading from $handle--\n" if $DEBUG;
    if (!seek($handle, $cachepos, 0)) {
	close($handle);
	&UpdateCache($cachekey);
	return(0);
    }
    print "<BR> Position: $cachepos\n" if $DEBUG;
    if ($line = <$handle>) {
	chop($line);
	$line =~ s/&/&amp\;/g;
	$line =~ s/</&lt\;/g;
	$line =~ s/>/&gt\;/g;
	print("<BR> line: &lt;", $line, "&gt;\n") if $DEBUG;
	if ($line =~ /^[\037\f]/) {
	    print "<BR> Found node-start\n" if $DEBUG;
	    if ($line = <$handle>) {
		chop($line);
		$line =~ s/&/&amp\;/g;
		$line =~ s/</&lt\;/g;
		$line =~ s/>/&gt\;/g;
		print("<BR> line: &lt;", $line, "&gt;\n") if $DEBUG;
		if ($line =~ /\bnode: *([^,\t]*)/i) {
		    $h_node = $1;
		    $h_node =~ s/\s+$//; # delete trailing spaces
		    if ($h_node =~ m/^$target$/i) {
			print "<BR> Found the node!\n" if $DEBUG;
			seek($handle, $cachepos, 0);
			print("<BR>", tell, "\n") if $DEBUG;
			return(1);
		    }
		}
	    }
	}
    }
    &UpdateCache($cachekey);
    close($handle);
    return(0);
}

sub UpdateCache {
    local($key, $pos, $file) = @_;
    local($value);
    if ($CACHE && &LockCache()) {
	if (dbmopen(%cache, $CACHE, 0644)) {
	    if ($pos && $file) {
		$cache{$key} = join("\0", $pos, $file);
		print "<BR> cache{$key} set to: $pos in \"$file\"\n" if $DEBUG;
	    } else {
		delete $cache{$key};
		print "<BR> cache{$key} deleted\n" if $DEBUG;
	    }
	    dbmclose(%cache);
	    &UnLockCache();
	    return(1);
	} else {
	    $CACHE = "";
	    &UnLockCache();
	    return(0);
	}
    } else {
	$CACHE = "";
	return(0);
    }
}

sub LockCache {
    local($file) = $CACHE . ".lock";
    if (!open(LOCKFILE, ">$file")) {
	print "<BR> Couldn't open CACHE lockfile \"$file\"\n" if $DEBUG;
	print "<BR> Reason: $!\n" if $DEBUG;
	return(0);
    }
    if (!flock(LOCKFILE, $LOCK_EX)) {
	print "<BR> Couldn't lock CACHE lockfile \"$file\"\n" if $DEBUG;
	print "<BR> Reason: $!\n" if $DEBUG;
	close(LOCKFILE);
	return(0);
    }
    print "<BR> Locked CACHE lockfile \"$file\"\n" if $DEBUG;
    return(1);
}

sub UnLockCache {
    local($file) = $CACHE . ".lock";
    if (!flock(LOCKFILE, $LOCK_UN)) {
	print "<BR> Couldn't unlock CACHE lockfile \"$file\"\n" if $DEBUG;
	print "<BR> Reason: $!\n" if $DEBUG;
	close(LOCKFILE);
	return(0);
    }
    close(LOCKFILE);
    print "<BR> Unlocked CACHE lockfile \"$file\"\n" if $DEBUG;
    return(1);
}

sub error {
    local($reason) = @_;

    print 
"<TITLE>Lookup Error</TITLE>
<H1>Lookup Error</H1>
Can't retrieve your request - $reason\n";

    return(0);
}

#---------------------------------------------------------------------------