#       whoisd - whois Internet daemon
#
# Copyright (c) 1993, 1994, 1995, 1996, 1997  The TERENA Association
# Copyright (c) 1998                              RIPE NCC
#
# All Rights Reserved
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of the author not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission.
#
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# $Id: whoisd.pl,v 2.37 2000/02/17 17:15:07 marek Exp $
#
#	$RCSfile: whoisd.pl,v $
#	$Revision: 2.37 $
#	$Author: marek $
#	$Date: 2000/02/17 17:15:07 $
#

#
# Usage:
#
# whoisd [-V] [-b] [-D] [-p port] [[WhoisOptions] SearchString]
#
# where:
#
# -D       - run as daemon instead of from inetd 
#            Note: -D should always be set, inetd functionality is untested
# -p port  - bind to port 'port'
# -V       - run in verbose mode
# -b       - run in debug mode
# 
# whoisd will not run as daemon if a SearchString is specified
# but instead perform a lookup for the SearchString
# WhoisOptions are the options that are used for the whois lookup,
# see 'whois' for more information on which options can be used.
#
#
# signals:
#
# *doesn't work (yet):*
#
# USR1 toggles the acceptance of network updates
# HUP  reread config file


use Socket;
#use POSIX qw/WNOHANG/;   # used by waitpid

require "dpr.pl";

require "flush.pl";

require "rconf.pl";

require "dbopen.pl";
require "dbclose.pl";
require "dbmatch.pl";
require "cldb.pl";

require "enread.pl";
require "enwrite.pl";
require "enkeys.pl";

require "misc.pl";
require "serial.pl";

require "syslog.pl";
require "template.pl";
require "whoisqry.pl";
require "processdata.pl";

require "read_attr.pl";
require "read_objs.pl";

require "refer.pl";

#
# If we get a SIGALRM, exit. Used in the read loop, to make sure people
# do not keep the connection open, and open and open ....

sub alarmhandler {

   &exitwhoisd(0,"% Timeout... Closing connection");
}

sub quithandler {

   &exitwhoisd(0,"% Server has been (administratively) shutdown... Closing connection\n% Please try again later");
}

$QUIT=0;

sub quitdaemonhandler {
   
   $QUIT=$_[0];
   
}

$NOUPDATES=0;

sub toggleupdates {

    $NOUPDATES=!$NOUPDATES;
    
    if ($NOUPDATES) {
       &syslog(AUDITLOG, "stopped network updates");
    }
    else {
       &syslog(AUDITLOG, "restarted network updates");
    }

}

sub justinterrupt { }

sub exitwhoisd {
   local($exitcode, $msg)=@_;
   
   local($*)=1;

   if( $msg ) {    
   	$msg=~ s/^\n+//;
   	$msg=~ s/\n+$//;

	# set up an alarm to interrupt blocking write on a half-closed socket
	$SIG{'ALRM'}='justinterrupt';
	alarm 15;
   
   	if ((!$opt_D) || (@ARGV)) {
   	   print STDOUT "\n", $msg, "\n\n\n" if ($msg);
   	}
   	else {
	   # those operations are short-circuited so the whole sequence stops
           # on alarm
	
   	   ( print NS "\n", $msg, "\n\n\n" )
	     && &flush(NS);

	   close(NS);
   	}
	if( $WHOISDSTAT ) {
	   my($WSTATFILE) = "$WHOISDSTAT.$$";
	   open WSTATFILE, ">>$WSTATFILE"
		&& print WSTATFILE $msg
		&& close WSTATFILE;
  	}
   }
   
   exit($exitcode);
   
}

#
# sometimes we need to exit earlier ...

sub exitonerror {
   local($msg) = @_;

   local($*)=1;
    
   $msg=~ s/^\n+//;
   $msg=~ s/\n+$//;
   $msg=~ s/\n/\n\% ERROR\: /g;

   &exitwhoisd(0, "\% ERROR: ".$msg);
   
}



#
# check for authorized access...
#

sub is_InHostList {
    local($rhost,*accesslist)=@_;

#    &dpr("called with: \$rhost = $rhost, \@accesslist = ",
#	 join(" ", @accesslist), "\n");

    foreach $updfrom (@accesslist) {

#	&dpr("checking $rhost=~ /", $updfrom, "/\n");
       
	if (($updfrom !~ /^\s*$/) &&
	    ($rhost =~ /^$updfrom$/)) {

#	    &dpr("update from: $rhost accepted, regular: $updfrom\n");
          
	    return 1;
       }
    }

#    &dpr("update from: $rhost rejected\n");
    
    return 0;
}

#
# Here is some guess work about what file to open....

sub findsplitdbs {

    local(*keys, @preselection)=@_;
    local(@searchdb)=();

    &dpr("called with \@keys = ", join(" ", @keys), 
	 "\@preselection = ", join(" ", @preselection), "\n");

    @preselection = grep($CLASSLESSDBS{$_}, @preselection) 
	if (scalar(grep(/^$VALIDPREFIXKEY$/o, @keys)) == scalar(@keys));
    
    # and now we are going to do something really smart...
    # and trickey things
             
    local(@upperkeys)=@keys;
    grep(tr/a-z/A-Z/, @upperkeys);
    
    # see comment below why we need this

    local(@tmpkeys,@tmpupperkeys);
    local($tmp);
                
    foreach $j (@preselection) {

       # we need to do this since we might have changed 
       # the @keys by the grep's and calling routines
                   
       @tmpkeys=@keys;
       @tmpupperkeys=@upperkeys;   
                   
       if ($j eq "rt") {
           next if (grep($_ !~ /^$VALIDIP4PREFIXKEY$/o, @tmpkeys));
           push(@searchdb, $j);
       }
       elsif ($j eq "in") {
	   next if (grep(!(/^$VALIDIP4PREFIXKEY$/o || (&isnetname($_))), 
			 @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "i6") {
	   next if (!(grep(/^$VALIDIP6PREFIXKEY$/, @tmpkeys) ||
                     grep(&isnetname($_), @tmpupperkeys))) ;
	   push(@searchdb, $j);
       }
       elsif ($j eq "ir") {
	   next if (grep(!(/^$VALIDIP4PREFIXKEY$/o || &isdomname($_)), 
			 @tmpkeys));
	   push(@searchdb, $j);
       }            
       elsif ($j eq "an") {
	   next if (grep(!&isasnum($_), @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "am") {
	   next if (grep(!&isasmacro($_), @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "cm") {
	   next if (grep(!&iscommunity($_), @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "dn") {
	   next if (grep(!&isdomname($_), @tmpkeys));
	   push(@searchdb, $j);
       }
       elsif ($j =~ /^pn|ro$/) {
	   next if (grep(!(&isname($_) || &isnichandle($_) || &isemail($_)), 
			 @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "mt") {
	   next if (grep(!&ismaintainer($_), @tmpupperkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "dp") {
	   next if (grep(!&isdomname($_), @tmpkeys));
	   push(@searchdb, $j);
       }
       elsif ($j eq "li") {
	   next if (grep(!&islimerick($_), @tmpupperkeys));
	   push(@searchdb, $j);
       }
       else {
	   # this should NOT happen - we examined all valid object types above!
	   # anyway to preserve the "logic" of the old code let's do it
	   push(@searchdb, $j);
       }
    } # end of loop foreach @preselection
    &dpr("\@searchdb = (", join(" ", @searchdb), ")\n");
    return @searchdb;
}

sub referenceorder {

    # used as a comparison routine when sorting 

    # check if we are actually referenced once ?
    
    if (($ALLPOINTSTO!~ /(^| )$a( |$)/) && ($ALLPOINTSTO!~ /(^| )$b( |$)/)) {
       
       return $ATTL{$a} cmp $ATTL{$b};
       
    }
    
    return -1 if ($ALLPOINTSTO!~ /(^| )$a( |$)/);
    return  1 if ($ALLPOINTSTO!~ /(^| )$b( |$)/);
        
    local($order)=0;
    
    local($pointstoa)=join(" ", " ", @POINTSTO{split(/ /, $RECUR{$a})}, " ");
    local($pointstob)=join(" ", " ", @POINTSTO{split(/ /, $RECUR{$b})}, " ");
    $pointstoa=~ s/ $a//g;
    $pointstob=~ s/ $b//g;
    
    # &dpr("$a - $b = $pointstoa - $pointstob\n");
    
    # check if we reference others ?
    
    return $ATTL{$a} cmp $ATTL{$b} 
	if (($pointstoa =~ /^ +$/) && ($pointstob =~ /^ +$/));

    return  1 if  ($pointstoa=~ /^ +$/);
    return -1 if  ($pointstob=~ /^ +$/);

    $order-- if ($pointstoa=~ / $b /);
    $order++ if ($pointstob=~ / $a /);
    
    return $ATTL{$a} cmp $ATTL{$b} if ($order==0);
    return $order;
}


#
# lookupandprint - will find all matches for all keys, and will output
#                the objects found, if they indeed match all the keys.
#                will also generate an array with keys that should be
#                looked up recursively because they are referenced in
#                the printed objects
#
# Exit codes (set in $result):
#         0 - no match (if $result was not defined yet)
#         1 - OK, something was output (always)

sub lookupandprint {

    local($output, *db, *keys, *references, 
	  $types, *result, $options, $name, $rhost) = @_;

    local(*chopped_keys);

    @chopped_keys = @keys;

    &dpr("called with:",
	 "\$output = $output, \$db = $db, \@db = ", join(" ", @db),
	 "\nkeys: ", join("*", @keys), " options: $options ",
	 "\nreferences keys: ", join(" ", keys %references),
	 "\nreferences values: ", join(" ", values %references), "\n");
	 
    # it makes the code easier if we call with empty lists...
    return 0 if (!@keys);
    
    local(%entry)=();
    local($printed)=0;
    local(@offsets) = ();
    
    local($i,$key,$offset,$attribute,$newtype,@object);
    
    &dpr("keys: ", join(",",@keys), " options: $options types: $types ",
         "result: $result fast: ",$options & $FASTOPTION,
         " nonrecursive: ",$options & $NONRECURSIVEOPTION,"\n");

    # Check if we are looking for domains (checks the filename in the db 
    # typeglob, so it doesn't work for non-split databases)

    my(@file_name_parts) = split /\./,$db[1];
    my($look_domain) = ($file_name_parts[-1] eq "dn") ? 1 : 0;
        
    my($OPTS) = $INTERSECTIONOPTION | 
	        ($options & ($ALLLESSSPECIFICOPTION | 
			     $MORESPECIFICOPTION | 
			     $ALLMORESPECIFICOPTION | 
			     $EXACTMATCHOPTION));

    # if we don't have a match and we were looking for a domain object drop a
    # piece of the domain name and try again

    if ($look_domain) {
	for (;;) {
	    last if (!$chopped_keys[0]);
	    @offsets = &dbmatch(*db, *chopped_keys, $types, $OPTS);
	    last if (@offsets);
	    my($drop, $keep) = split(/\./, $chopped_keys[0], 2);
	    $chopped_keys[0] = $keep;
	}
    }
    else {
	@offsets = &dbmatch(*db, *keys, $types, $OPTS);
    }

    foreach $offset (sort { $a <=> $b } @offsets ) {

	&dpr("offset: ", $offset, " keys: ", join("*", @keys), "\n");
	my($key) = join("\t", $offset, $db[1]);
	next if ($DISPLAYED{$key});
	$DISPLAYED{$key}=1;
	my($referred_query);
	$referred_query = 0;

	alarm $KEEPOPEN if (!$commandline);

	if ($options & $FASTOPTION) {
	    # enable paragraph mode
	    local($/) = "";
	    seek($db, $offset, 0);
	    @object=split(/\n+/, scalar(<db>));
	    foreach (@object) {
		if ((/^ *\*?([^\*\s][^\:\s]*) *\:/) && ($OBJATSQ{$ATTR{$1}})) {
		    $newtype=$ATTR{$1};
		    last;
		}
	    }
	    if (($newtype) && ($types =~ /\b$newtype\b/)) {
		print $output "\n", join("\n", @object), "\n";
		$printed=1;
	    }
	}
	else {
	    $newtype=&enread($db, *entry, $offset);

	    &dpr("$newtype - $types\n");
	    &dpr("\%entry = " . join("*", %entry) . "\n");
	    if ($types=~ /\b$newtype\b/) {
		# If object is of type domain, check if it has a refer attribute
		my($refscalar, $refarray, $refhash) = 
		    &has_refer($name, $rhost, $keys[0], %entry);

		if ($$refscalar) {
		    $referred_query = 1;
		    print $output join("\n", @$refarray), "\n";
		    if (%$refhash) {
			local(%referral) = %$refhash;
			&enwrite($output, *referral, 1, 0, 
				 !($options & $NOSYNTACTICSUGAR));
		    }
		}
		else {
		    $referred_query = 0;
		    if ($chopped_keys[0] ne $keys[0]) {
			$DISPLAYED{$key} = 0;
			$printed = 0;
			last;	# exit loop over offsets
		    }
		    &enwrite($output, *entry, 1, 0, 
			     !($options & $NOSYNTACTICSUGAR));
		}
		$printed=1;
#		&dpr("offset from enwrite: $offset\n");
	    }
	}
	if (($RECUR{$newtype}) && 
	    (!($options & $NONRECURSIVEOPTION)) &&
	    (!$referred_query)) {
	    foreach $attribute (split(/ /, $RECUR{$newtype})) {
		foreach (split(/ /, $POINTSTO{$attribute})) {
		    #print STDERR "attr: $attribute ent: $entry{$attribute} pointto: $_\n";
		    if ($references{$_}) {
			$references{$_}=join("\n", $references{$_}, $entry{$attribute}) if (($_) && ($entry{$attribute}));
		    }
		    else {
			$references{$_}=$entry{$attribute} if (($_) && ($entry{$attribute}));
		    }
		}
	    }
	}
    }
    $result=1 if ($printed);
    return $printed;
}


# Error and help message for "-t" and "-v" options to whois

sub templaerror {
	my($templatypes, $output) = @_;

	  print $output "\n% $templatypes are available for these objects:\n\n";
	  foreach $object (sort keys (%OBJATSQ)) {
		printf $output "%%\t\t$ATTL{$object}\n"; 
		}
	} # End of sub templaerror


sub verbose_error {
    my($output) = @_;

    print $output "\nUse\n";
    print $output "\nwhois -v <object-type>\n";
    print $output "\nto obtain detailed information about RIPE database objects\n";
    print $output "where <object-type> is one of\n\n";
    
    foreach $object (sort keys (%OBJATSQ)) {
	printf $output "$ATTL{$object}\n\n";
	printf $output "$obj_descs{$ATTL{$object}}\n\n\n";
    } # End of foreach statement
    
    printf $output "\n\nFurther information may be found at:\n\n";
    printf $output "<http://www.ripe.net/docs/ripe-157.html>\n";
    printf $output "<ftp://ftp.ripe.net/ripe/docs/ripe-157.ps>\n";
    printf $output "<ftp://ftp.ripe.net/ripe/docs/ripe-157.txt>\n";

} # End of verbose_error


#
# whois - main lookup loop. will output all objects found for all sources
#                requested. will also process the recursive lookups generated
#                by lookupandprint()
#

sub whois {

    local($input, $output, $searchstring, $name, $rhost) = @_;

    &dpr("called with: \$input = $input, \$output = $output, ",
	 "\$searchstring = $searchstring, \$name = $name, \$rhost = $rhost\n");
    
    if ($opt_t) {
       
	$opt_t = $ATTR{$opt_t} if $ATTR{$opt_t};
#	&dpr("whois -t $opt_t\n");
	
	alarm $KEEPOPEN if (!$commandline);
       
	if ($OBJATSQ{$opt_t}) {
	    &Template($output, $opt_t);
	}
	elsif ($opt_t =~ /^all$/i) {
	    &templaerror("Templates", $output);
	}
	else 	{
	    print $output "\n% No template available for object \"$opt_t\"\n";
	    &templaerror("Templates", $output);
	}
	return 1;
    }

    if ($opt_v) {
       
	$opt_v = $ATTR{$opt_v} if $ATTR{$opt_v};
#	&dpr("whois -v $opt_v\n");
	
	alarm $KEEPOPEN if (!$commandline);
       
	if ($OBJATSQ{$opt_v}) {
	    &Verbose($output,$opt_v);
	}
	elsif ($opt_v =~ /^all$/i) {
	    &verbose_error($output);
	}
	else {
	    print $output 
		"\n% No verbose template available for object \"$opt_v\"\n";
	    &verbose_error($output);
	}
	return 1;
    }
    elsif ($opt_g) {

#	&dpr("whois -g $opt_g\n");
       
        if ($opt_D) {
            &dogetserials($output,$opt_g,$name,$rhost);      
            return 1;
        }
        else {
	    &exitonerror(
		"***This server is not able to provide updates***\n".
		"***please contact \<$HUMAILBOX\> for more information***");
        }
    }

    elsif ($searchstring=~ /^\s*(\bHELP\b|\bHOWTO\b)\s*$/i) {
#	&dpr("help requested - $1\n");
	open (HELP, $WHOISHELP);
	alarm $KEEPOPEN if (!$commandline);
	print $output <HELP>, "\n";
	close(HELP);
	return 1;
    }

    elsif ($searchstring=~ /^\s*(AUTO[\-\s]*DBM(HELP)?)\s*$/i) {
#	&dpr("auto-dbm help requested - $1\n");
	open (HELP, $AUTODBMHELP);
	alarm $KEEPOPEN if (!$commandline);
	print $output <HELP>, "\n";
	close(HELP);
	return 1;
    }

    elsif ($opt_U) {
#        &dpr("whois -U $opt_U\n");
	&whoisupdate($input, $output, $name, $rhost, $opt_U);
	return 1;
    }

    else { 

	# finally having a real query
	local(%dummyentry)=();
	local($result)=0;
	local($whoisdb)='whoisdb';
	local(%whoisdb,@whoisdb);
	
	local(%references)=();
	local(@references)=();
	local(@splitdbs)=();
	
	local($source,$types);
	local(%doubles,@splitdbs,@sources,@searchdb,@keys);
	local(@longreferences,@longkeys);
	
	# global var for the objects that have already been shown
	%DISPLAYED=();
	
	if ($opt_a) {
	    @sources=split(/ /, $ALLLOOK);
	}
	elsif ($opt_s) {
	    @sources=split(/\,/, $opt_s);
	}
	else {
	    @sources=split(/ /, $DEFLOOK);
	}
	
	&dpr("whois - sources: ", join(",",@sources), "\n");
	
	if ($opt_i) {
	    
	    local(%done)=();
	    local(@tmp,@pointsto,$db);
	    
	    &dpr("opt_T: $opt_T opt_i: $opt_i\n");
	    
	    if ($opt_T) {
		@tmp=split(/ /, $opt_T);
	    }
	    else {
		@tmp=keys %OBJATSQ;
	    }
          
#	    &dpr("opt_T: $opt_T opt_i: $opt_i tmp:",join(" ",@tmp),"\n");
          
	    @splitdbs=();
	    @pointsto=split(/ /, $opt_i);
          
	    foreach $db (@tmp) {
		next if ($done{$db});
		$done{$db}++;
		
		push(@splitdbs, $db) 
		    if (grep($OBJATSQ{$db}=~ /\b$_\b/ ,@pointsto));
	    }
#	    &dpr("splitdbs: ", join(" ", @splitdbs), "\n");
	}
	else {
	    
	    @splitdbs=&findsplitdbs(*keys);
	    @keys=&makekeys($searchstring, "", *longkeys);
	    
	    &dpr("whois - searchstring: -$searchstring- keys: ",
		 join("*", @keys), " longkeys: ", join("*", @longkeys), "\n");
	    
	    return 0 if (!@keys);
          
	    if ($opt_T) {
		@splitdbs=&findsplitdbs(*keys, split(/ /, $opt_T));
	    }
	    else {
		@splitdbs=&findsplitdbs(*keys, keys %OBJATSQ);
	    }
	    return 0 if (!@splitdbs);
	}
       
	$opt_T=join(" ", @splitdbs);
       
	local(%files)=();
       
	foreach $source (@sources) {

	    # we might have different sources in one dbfile
	    # so skip the source if we already did this dbfile

	    next if ($files{$source} eq $DBFILE{$source});
	    
	    $files{$source}=$DBFILE{$source};

	    if ($SPLIT{$source}) {
		@searchdb=@splitdbs;
	    }
	    else {
		@searchdb=($source);
	    }

#	    &dpr("\@searchdb = (", join(" ", @searchdb), ")\n");

	    my(@sorted) = sort referenceorder @searchdb;

#	    &dpr("\@sorted = (", join(" ", @sorted), ")\n");

	    # Go through all the db files for a given source
	    while($j = shift @sorted) {
             
		$dbfile=$DBFILE{$source};
		$dbfile.=".".$j if ($SPLIT{$source});    
             
		if ($opt_i) {

		    my(@tmp, $tmp);
		    @tmp = split(/ /, $opt_i);

		    if ($SPLIT{$source}) {
			@tmp = grep($OBJATSQ{$j} =~ /\b$_\b/, @tmp);
		    }
		    else {
			@tmp = grep($ALLPOINTSTOATTR =~ /\b$_\b/, @tmp);
		    }
		    $tmp = join(" ", @tmp);
		    @keys = &makekeys($searchstring, $tmp, *longkeys);
		}
		# For partial databases (not having all types of objects
		next if ((!@keys) || 
			 (!&dbopen(*whoisdb, *dummyentry, 0, $dbfile)));

		&dbclopen(*dummyentry, 0, $dbfile) if ($CLASSLESSDBS{$j});
            
#		&dpr("whois - search $dbfile\n");
		# For inverse lookups
		if ($opt_i) {

		    my(@tmp) = split(/ /, $opt_i);

		    if ($SPLIT{$source}) {

			foreach (grep($OBJATSQ{$j}=~ /\b$_\b/, @tmp)) {
			    @keys=&makekeys($searchstring, $_, *longkeys);
			    &lookupandprint(
				$output,
				*whoisdb,
				*longkeys,
				*references,
				$opt_T,
				*result,
				$opt_F | $opt_L | $opt_m | $opt_M |
				$opt_r | $opt_S | $EXACTMATCHOPTION,
				$name, $rhost)

			    || 

			    &lookupandprint(
				$output,
				*whoisdb,
				*keys,
				*references,
				$opt_T,
				*result,
				$opt_F | $opt_L | $opt_m | $opt_M |
				$opt_r | $opt_S | $EXACTMATCHOPTION,
				$name, $rhost);
			}
		    }
		    else {
			# For the normal (not inverse) lookups
			foreach (grep($ALLPOINTSTOATTR=~ /\b$_\b/, @tmp)) {
			    @keys=&makekeys($searchstring, $_, *longkeys);
			    &lookupandprint(
				$output, 
				*whoisdb, 
				*longkeys,
				*references, 
				$opt_T, 
				*result, 
				$opt_F | $opt_L | $opt_m | $opt_M | 
				$opt_r | $opt_S | $EXACTMATCHOPTION,
				$name, $rhost) 

			    ||
				
			    &lookupandprint(
				$output, 
				*whoisdb, 
				*keys, 
				*references, 
				$opt_T, 
				*result, 
				$opt_F | $opt_L | $opt_m | $opt_M | 
				$opt_r | $opt_S | $EXACTMATCHOPTION,
				$name, $rhost);
			}
		    }
		}
		else {
		    
		    &lookupandprint
			($output, 
			 *whoisdb, 
			 *longkeys, 
			 *references, 
			 $opt_T, 
			 *result, 
			 $opt_F | $opt_L | $opt_m | $opt_M | 
			 $opt_r | $opt_S | $EXACTMATCHOPTION,
			 $name, $rhost) 

		    ||
			
		    &lookupandprint
			($output, 
			 *whoisdb, 
			 *keys, 
			 *references, 
			 $opt_T, 
			 *result, 
			 $opt_F | $opt_L | $opt_m | $opt_M | 
			 $opt_r | $opt_S | $EXACTMATCHOPTION,
			 $name, $rhost);
		}
             
#		&dpr("whois - references: ", 
#                    join(" ", %references), 
#                    " result: $result\n");
             
		if (($SPLIT{$source}) && ($references{$j})) {

#		    &dpr("whois - recursion: ", $references{$j}, "\n");
          
		    @references=();
		    %doubles=();
                   
		    foreach (split(/\n+/, delete($references{$j}))) {
			next if ($doubles{$_});
			$doubles{$_}++;
                   
#			&dpr("lookup reference: ", $_, "\n");
                   
			@references=&makekeys($_, "", *longreferences);

			my(@srch) = &findsplitdbs(*references, keys %OBJATSQ);

#			&dpr(join(" ", @srch), "\n");
                   
			if (grep($j eq $_, @srch)) {
			    &lookupandprint
				($output, 
				 *whoisdb, 
				 *longreferences, 
				 *references, 
				 $j, 
				 *result, 
				 $opt_F | $opt_L | $opt_m | $opt_M | 
				 $NONRECURSIVEOPTION | $opt_S | 
				 $EXACTMATCHOPTION,
				 $name, $rhost) 

			     ||
				
			     &lookupandprint
				 ($output, 
				  *whoisdb, 
				  *references, 
				  *references, 
				  $j, 
				  *result, 
				  $opt_F | $opt_L | $opt_m | $opt_M | 
				  $NONRECURSIVEOPTION | $opt_S | 
				  $EXACTMATCHOPTION,
				  $name, $rhost)
			}
		    }
		}

		if ($SPLIT{$source}) {
                
		    &flush($output);
                
		    &dbclclose() if ($CLASSLESSDBS{$j});
		    &dbclose(*whoisdb);  
		}
	    }
          
	    if (%references) {
          
		# without the extra array (@types) the number of iterations
		# is cut short with the last value being '1'.
		# this is probably something to do with the deletion
		# of the entries of %references and the passing by type glob

		local(@types) = keys %references;
		
		foreach $type (@types) {
		    %doubles = ();
		    if ($SPLIT{$source}) {
			$dbfile = $DBFILE{$source}.".".$type;
			next if (!&dbopen(*whoisdb, *dummyentry, 0, $dbfile));
			&dbclopen(*dummyentry, 0, $dbfile) 
			    if ($CLASSLESSDBS{$type});
		    }
		    foreach (split(/\n+/, delete($references{$type}))) {
			next if ($doubles{$_});
			$doubles{$_}++;
			@references = &makekeys($_, "", *longreferences);
			&lookupandprint
			    ($output, 
			     *whoisdb, 
			     *longreferences, 
			     *references, 
			     $type, 
			     *result, 
			     $opt_F | $opt_L | $opt_m | $opt_M | 
			     $NONRECURSIVEOPTION | $opt_S | 
			     $EXACTMATCHOPTION,
			     $name, $rhost) 

			||
			    
			&lookupandprint
			    ($output, 
			     *whoisdb, 
			     *references, 
			     *references, 
			     $type, 
			     *result, 
			     $opt_F | $opt_L | $opt_m | $opt_M | 
			     $NONRECURSIVEOPTION | $opt_S | 
			     $EXACTMATCHOPTION,
			     $name, $rhost)
                   
		    }
		    if ($SPLIT{$source}) {
                   
			&flush($output);
                
			&dbclclose() if ($CLASSLESSDBS{$type});
			&dbclose(*whoisdb);
		    }
		}
	    }
	    if (!$SPLIT{$source}) {
          
		&flush($output);
          
		&dbclclose() if ($CLASSLESSDBS{$source});
		&dbclose(*whoisdb);
	    }
	}   
	return $result;
    }
    
#    &dpr("left whois\n");
}

sub clearflags {

    $opt_a=0;
    $opt_g="";
    $opt_i="";
    $opt_F=0;
    $opt_L=0;
    $opt_m=0;
    $opt_M=0;
    $opt_r=0;
    $opt_R=0;
    $opt_s="";
    $opt_S=0;
    $opt_t="";
    $opt_T="";
    $opt_v="";
    $opt_Type=0;
    $opt_U="";
    $opt_Version="";

    $log_opt_g="";
    $log_opt_i="";
    $log_opt_s="";
    $log_opt_t="";
    $log_opt_v="";
    $log_opt_T="";
    $log_opt_U="";
    $log_opt_V="";

}

sub getflags {

    if( $QRYLOGFLAGS ) {
	return getfullflags(@_);
    } else {
	return getshortflags(@_);
    }
}

sub getshortflags {
    
    local(@flags)=();
    
    push(@flags, "a") if ($opt_a);
    push(@flags, "g") if ($opt_g);
    push(@flags, "i") if ($opt_i);
    push(@flags, "F") if ($opt_F);
    push(@flags, "k") if ($opt_k);
    push(@flags, "L") if ($opt_L);
    push(@flags, "m") if ($opt_m);
    push(@flags, "M") if ($opt_M);
    push(@flags, "r") if ($opt_r);
    push(@flags, "R") if ($opt_R);
    push(@flags, "s") if ($opt_s);
    push(@flags, "S") if ($opt_S);
    push(@flags, "t") if ($opt_t);
    push(@flags, "v") if ($opt_v);
    push(@flags, "T") if ($opt_Type);
    push(@flags, "U") if ($opt_U);
    push(@flags, "V".$opt_Version) if ($opt_Version);
    
    return join("\:", @flags);

}
     
sub getfullflags {

    my @flags = ();

    push(@flags, "a") if ($opt_a);
    push(@flags, "g=$log_opt_g") if ($log_opt_g);
    push(@flags, "i=$log_opt_i") if ($log_opt_i);
    push(@flags, "F") if ($opt_F);
    push(@flags, "k") if ($opt_k);
    push(@flags, "L") if ($opt_L);
    push(@flags, "m") if ($opt_m);
    push(@flags, "M") if ($opt_M);
    push(@flags, "r") if ($opt_r);
    push(@flags, "R") if ($opt_R);
    push(@flags, "s=$log_opt_s") if ($log_opt_s);
    push(@flags, "S") if ($opt_S);
    push(@flags, "t=$log_opt_t") if ($log_opt_t);
    push(@flags, "v=$log_opt_v") if ($log_opt_v);
    push(@flags, "T=$log_opt_T") if ($opt_Type);
    push(@flags, "U=$log_opt_U") if ($log_opt_U);
    push(@flags, "V=$log_opt_V") if ($opt_Version);

    return join("\:", @flags);

}

                        
#
# parse - parses the command line string for special options and sets
#                appropriate variables

sub parse {
    local($string)=@_;

#    &dpr("input string: $string\n");

    # Reset all command line arguments, except -k

    &clearflags();
    
    $string=~ s/\s+/ /g;
    $string=~ s/^ //;
    $string=~ s/ $//;
    
    while ($string=~ /^-/) {

# match all options with arguments

        if ($string =~ s/^\-g *(\S+) *//) {
            $opt_g = $1;
	    $log_opt_g = $opt_g;
            next;
        }
        
        if ($string =~ s/^\-i *(\S+) *//) {
	    if ($opt_i) {
		$opt_i = join(" ", $opt_i, split(/\,/, $1));
	    }
	    else {
		$opt_i = join(" ", split(/\,/, $1));
	    }
	    $log_opt_i = 
		join(",", map {$ATTR{$_} ? $ATTR{$_} : $_} 
		              split(/ /, $opt_i));
	    next;
        }
         
        if ($string =~ s/^\-U *(\S+) +(\S+) *//) {
	    $opt_U = $1." ".$2;
	    $log_opt_U = $opt_U;
	    next;
        }
                
# Patch from David replaced this, 961010, AMRM.
#
#        if ($string =~ s/^\-(s) +(\S+) *//) {
#            local($src) = $2;
#
#            $src=~ tr/a-z/A-Z/;
#            $src=join(",", split(/\,+/, $src));
#            
#            if ($opt_s) {
#               $opt_s=join(",",$opt_s,$src);
#            }
#            else {
#               $opt_s=$src;
#            }
#            
#            next;
#        }

	 if ($string =~ s/^\-s *(\S+) *//) {
            local($src)=$1;

            $src=~ tr/a-z/A-Z/;
            
            local(@requestedsources)=split(/\,+/, $src);
            local(@acceptedsources)=grep($DBFILE{$_}, @requestedsources);
            
            if (scalar(@requestedsources)!=scalar(@acceptedsources)) {
               
               local(@notacceptedsources)=grep(!$DBFILE{$_}, @requestedsources);
               local($availablesources);
               ($availablesources=$ALLLOOK) =~ s/ /\,/g;
               
               alarm $KEEPOPEN if (!$commandline);
               print $output "\n% Ignored \"".join(",",@notacceptedsources)."\",
% Choose sources from: \"".$availablesources."\"\n";  
               &flush($output);
               
            }
            
            if ($opt_s) {
               $opt_s=join(",",$opt_s,@acceptedsources) if (@acceptedsources);
            }
            else {
               $opt_s=join(",", @acceptedsources) if (@acceptedsources);
            }

	    if ($log_opt_s) {
		$log_opt_s = join(",", $log_opt_s, @requestedsources);
	    }
	    else {
		$log_opt_s = join(",", @requestedsources);
	    }
            
            next;
        }
            
        
       #if ($string =~ s/^\-V *([a-zA-Z]+\d+[\d\.]*) *//) {
        if ($string =~ s/^\-V *(\S*) *//) {
            $opt_Version=$1;
	    $log_opt_V = $opt_Version;
            # now, if the string contains a comma, then the part
            # after the comma is the IP address of the real client,
            # whose query is forwarded (referred) to us
            ($remoteversion, $clientIP) = split(',', $opt_Version);
            if (($clientIP) && ($rhost) && !&is_InHostList($rhost, *AUTHORIZEDFORREFERRAL)) {
              local($FROMHOST)=$rhost;
              if ($DENYACCESSTXT !~ /^\s*$/) {
                  &ReplaceGlobalVars(*DENYREFERRALTXT);
                  print $output "\n", $DENYREFERRALTXT;
                  &flush($output);
              }
              print $output "\n\n";
              &syslog("QRYLOG", "($$) [] 0 ("
                    . scalar (time - $startime)
                    . "s) $logstr *DENIED* referral $query");
              $result = 0;
              &exitwhoisd(0, "");
            }elsif(($clientIP) && &is_InHostList($clientIP, *DENYWHOISACCESS)) {
              local($FROMHOST)=$rhost;
              if ($DENYACCESSTXT !~ /^\s*$/) {
                  &ReplaceGlobalVars(*DENYACCESSTHRUREFERRALTXT);
                  print $output "\n", $DENYACCESSTHRUREFERRALTXT;
                  &flush($output);
              }
              print $output "\n\n";
              &syslog("QRYLOG", "($$) [] 0 ("
                    . scalar (time - $startime)
                    . "s) $logstr *DENIED* $query");
              $result = 0;
              &exitwhoisd(0, "");
            }

            next;
        }
        
        if ($string =~ s/^\-T *(\S+) *//) {
           
           local($type);
           local(@onlysearch)=();
	   local(@allgiven) = ();
           
           foreach $type (split(/\,+/,$1)) {
            
              $type=$ATTR{$type} if $ATTR{$type};
	      push(@allgiven, $type);

              if ($OBJATSQ{$type}) {
              
                 push(@onlysearch, $type);
                 
              }
              else {
# Patch from David replaced the following, 961010, AMRM.                 
#                 alarm $KEEPOPEN;
#                 print $output "\n% Request for unknown object type \"$ATTL{$type}\" ignored";  
#                 &flush($output);
             	   
		  $type=$ATTL{$type} if ($ATTL{$type});
		  alarm $KEEPOPEN if (!$commandline);
		  print $output "\n% Request for unknown object type \"$type\" ignored\n";
		  &flush($output);

              }
              
           }
           
           if ($opt_T) {
	       $opt_T=join(" ", $opt_T, @onlysearch);
           }
           else {
	       $opt_T=join(" ", @onlysearch);
           }
           
	   if ($log_opt_T) {
	       $log_opt_T = join(",", $log_opt_T, @allgiven);
	   }
	   else {
	       $log_opt_T = join(",", @allgiven);
	   }

           $opt_Type=1;
           
           next;
           
        }
        
        if ($string =~ s/^\-t *(\S+) *//)  {
            $opt_t=$1;
            $log_opt_t = $opt_t;
            next;
            
        }
        
        if ($string =~ s/^\-v *(\S+) *//)  {
            $opt_v=$1;
            $log_opt_v = $opt_v;
            next;
            
        }

# match all options without arguments (we have to do this after 
# matching options with arguments because otherwise this will eat some
# (acrkFLmMS) letters from argument with no intervening space after the
# option character)

       if ($string=~ s/^\-(\S*[acrkFLmMSR]+\S*) *//) {
          
          local($option)=$1;
          
          $opt_a=1 if ($option=~ s/a//g);

	  ### $opt_c not set - but have to accept and ignore it
	  ### nicely for backward compatibility (aaargh!...)
	  if ($option=~ s/c//g) {};

          $opt_r=$NONRECURSIVEOPTION if ($option=~ s/r//g);
          $opt_k=1 if ($option=~ s/k//g);
          $opt_F=$FASTOPTION if ($option=~ s/F//g);
          $opt_L=$ALLLESSSPECIFICOPTION if ($option=~ s/L//g);
          $opt_m=$MORESPECIFICOPTION if ($option=~ s/m//g);
          $opt_M=$ALLMORESPECIFICOPTION if ($option=~ s/M//g);
          $opt_S=$NOSYNTACTICSUGAR if ($option=~ s/S//g);
          $opt_R=$NONREFERRALOPTION if ($option=~ s/R//g);
          
          $string="-".$option." ".$string if ($option!~ /^ *$/);
          
          next;
          
        }

        last;
    }
	
#    &dpr("flags parsed: ", &getflags(), "\n");
#    &dpr("flags values:",
#	 ($opt_g)?"opt_g: $opt_g":"", 
#	 ($opt_i)?"opt_i: $opt_i":"",
#         ($opt_U)?"opt_U: $opt_U":"",
#	 ($opt_s)?"opt_s: $opt_s":"",
#	 ($opt_T)?"opt_T: $opt_T":"",
#	 ($opt_t)?"opt_t: $opt_t":"",
#	 ($opt_v)?"opt_v: $opt_v":"",
#	 ($opt_Version)?"opt_Version: $opt_Version":"", "\n");

    if (!$LOWPRIORITY) {
       
       $LOWPRIORITY=1;
#       &dpr("\$LOWPRIORITY = $LOWPRIORITY\n");
       
       if ((!$opt_F) && (($opt_k) || ($opt_m) || ($opt_M))) {
           
          alarm $KEEPOPEN if (!$commandline);
          print $output "\n% Server is running at low priority for -M, -m and -k queries\n";
          &flush($output);
          
       }
    
       if (($opt_k) || ($opt_m) || ($opt_M) || ($opt_g) || ($opt_U)) {
	 &lower_priority();
#	 &dpr("Priority lowered\n");
       }
    }
    
#    &dpr("left parse, searchstring: $string\n");
#    print STDERR "($$) left parse, searchstring: $string\n" if $opt_V;

    if ($opt_i) {
       
       # print STDERR "opti: $opt_i\n";
       
       local($type);
       
       local(%allobjects)=();
       local(%allattributes)=();
       
       foreach $type (split(/ /, $opt_i)) {
       
          if ($ATTR{$type}) {
             $type=$ATTR{$type};
             if ($OBJATSQ{$type}) {
                $allobjects{$type}=1;
             }
             elsif ($POINTSTO{$type}) {
                $allattributes{$type}=1;
             }
             else {
                alarm $KEEPOPEN if (!$commandline);
                print $output "\n% ignored attribute \"$ATTL{$type}\" since it is not indexed as a reference\n";  
                &flush($output);
             }
          }
          else {
             alarm $KEEPOPEN if (!$commandline);
             print $output "\n% unknown attribute type \"$type\" ignored\n";  
             &flush($output);
          }

       } # end foreach $type  
       
       if (%allobjects) {
          
          local($attribute);
          local(%objecthasreference)=();
          
          foreach $attribute (keys %ATTR) {
             
             foreach (keys %allobjects) {
                if ($POINTSTO{$attribute}=~ /(^| )$_( |$)/) {
                   $allattributes{$attribute}=1;
                   $objecthasreference{$_}=1;   
                }
             }
          }
          
          foreach (keys %allobjects) {
             
             if (!$objecthasreference{$_}) {
                alarm $KEEPOPEN if (!$commandline);
                print $output "\n% ignored \"$ATTL{$_}\" since it is not indexed as a reference by other objects\n";  
                &flush($output);
             }
          }
       } # end if (%allobjects)
          
       $opt_i = join(" ", keys %allattributes);

#       &dpr("processed opt_i: $opt_i\n") if ($opt_i);
       # print STDERR "opti: $opt_i\n";
       
       if ($opt_i=~ /^\s*$/) {
          $name.="(".$rhost.")" if ($name ne $rhost);
          &syslog("QRYLOG","($$) [".&getflags()."] 0 (" 
		. scalar (time - $startime)  
		. "s) $name no valid attributes specified for -i query");
          &exitwhoisd(0, "% no valid attributes specified for -i query");  
       }
       
    }

    &dpr("whoisd called with flags:".&getflags()."\n");
    &dpr("string returned: $string\n");
    
    return $string;
    
}


sub whoisupdate {
    my($input, $output, $name, $rhost, $logstr) = @_;
    my($is_update_allowed) = 0;
    my($password, @tmp);
    
#    &dpr("name:'$name',ip:'$rhost',log:'$logstr' \n");

    alarm $KEEPOPEN if (!$commandline);
    
    @tmp = split(/ /, $logstr);
    $password = $tmp[0];

    if ($name eq "" && $rhost eq "") {
	$is_update_allowed = 
	    (crypt($password, $OVERRIDECRYPTEDPW) eq $OVERRIDECRYPTEDPW);
    }
    else {
	$is_update_allowed = &is_InHostList($rhost,*WHOISUPDFROM);
    }

    if ($is_update_allowed) {
	
	local($line);
	local($ent)="";
	
#	&dpr("whoisupdate accepted\n");
	
	while ((! -e $UPDATELOCK) && 
	       ($line=<$input>) && 
	       ($line!~ /^\s*\.\s*$/)) {
	    
	    alarm $KEEPOPEN if (!$commandline);
	    
	    if ($line=~ /^\s*$/) {
		
		if ($ent=~ /\S+/) {
		    
#		    &dpr("whoisupdate got entry\n");
		    
		    alarm 0;

		    local($OLDTIME)=&MakeRegular($TIME);
		    
		    ($DATE,$TIME)=&getYYYYMMDDandHHMMSS();
		    
		    if (!$FROMHOST) {
			
			#
			# no shell spoofing
			
			$logstr =~ s/[^\w\.\-\s]//g;
			
			$FROMHOST=$name;
			$FROMHOST.="(".$rhost.")" if ($name!~ /^\d+\.\d+\.\d+\.\d+$/);
			
			# print STDERR "update from: ", $FROMHOST, "\n";
			
			$logstr=~ s/^\s+//;
			$logstr=~ s/\s+$//;
			$logstr=~ s/\s+/\@/;
			$NETWORKUPDATE=$FROMHOST." ".$logstr;
			
			&ReplaceGlobalVars(*FWNETWORKTXT);
			&ReplaceGlobalVars(*NOTINETWORKTXT);
			
		    }
		    else {
			$FWNETWORKTXT=~ s/$OLDTIME/$TIME/;
			$NOTINETWORKTXT=~ s/$OLDTIME/$TIME/;
		    }
		    
		    $opt_A=0;
		    $opt_m="";
		    $opt_M=0;
		    $opt_T=0;
		    $opt_v=1;
		    
		    &dbupdate($ent, $output);
		    &flush($output);
		    
		    alarm $KEEPOPEN if (!$commandline);
		    
		    $ent="";
		}
	    }
	    else {
#		&dpr("whoisupdate got line: $line\n");
		$ent.=$line;
	    }
	}
	
	if (-e $UPDATELOCK) {
	    alarm $KEEPOPEN if (!$commandline);
	    print $output "\n% Network updates are temporarely disabled, please try again later\n";
	}
	
	# give a chance to the client to close the connection before we do...
	
	sleep 1;
	
    }
    else {
	
	&syslog("AUDITLOG", "Network update authorization failure: $name ($rhost) $logstr");
	&exitonerror("***You are not authorized to do network updates***");
	
    }
    
}


sub GetVersionOne {
    local($output, $version, $source, $from, $to)=@_;

    local($i)=$from;
          
    alarm $KEEPOPEN if (!$commandline);      
    print $output "\n\%START Version: $version $source $from-$to\n\n";
    
    $i=$from;
    
    local($basename)=$LOGFILE{"SERIALDIR"}.$source.".";   
    local($oldbasename)=$LOGFILE{"OLDSERIALDIR"}.$source.".";   
    
    # print STDERR "base: $basename oldbase: $oldbasename from: $i to: $to\n";
       
    while ($i<=$to) {
       
       if (-f $basename.$i) {
          open(INP,"<".$basename.$i);
       }
       else {
          open(INP,"<".$oldbasename.$i);
       }
       
       &lock(INP);
       @input=<INP>;
       &unlock(INP); close(INP);
       
       alarm $KEEPOPEN if (!$commandline);
       print $output @input, "\n";
       
       $i++;
    }
    
    alarm $KEEPOPEN if (!$commandline);   
    print $output "\%END ", $source, "\n";
} 

sub dogetserials {
    local($output,$option,$name,$rhost)=@_;
    
#    &dpr("string: $string name: $name rhost: $rhost access: ",join(" ", @GETUPDATESFROM),"\n");
#    print STDERR "($$) dogetserials - string: $string name: $name rhost: $rhost access: ",join(" ", @GETUPDATESFROM),"\n" if $opt_V;
        
    if (&is_InHostList($rhost,*GETUPDATESFROM)) {
   
       if ($option=~ /^([\w\.\-]+)\:(\d+)\:(\d+)\-(\S+)$/) {
          local($source)=$1;
          local($version)=$2;
          local($from)=$3;
          local($to)=$4;
               
          local($i);
               
          local($first)=&getoldestserial($source);
          local($last)=&getcurrentserial($source);
               
#	  &dpr("from: $from to: $to first: $first last: $last\n");
#          print STDERR "from: $from to: $to first: $first last: $last\n" if $opt_V;
          
          if ($from=~ /^LAST$/i) {
             $from=$last;
          }
          
          if ($to=~ /^LAST$/i) {
             $to=$last;
             if ($from==scalar($to+1)) {
                &syslog("QRYLOG","($$) [g] 0 ("
			. scalar (time - $startime)
			. "s) $name ($rhost) $option");
                &exitwhoisd(0, "% Warning (1): There are no newer updates available");  
             }
          }
               
          if (($to<$first) || ($from>$to)) {
          
             &syslog("QRYLOG","($$) [g] 0 ("
			. scalar (time - $startime)
			. "s) $name ($rhost) -g syntax error 2: $first-$last, $option");
             &exitonerror("2: Invalid range: $from-$to don\'t exist\n");
          }
               
          if ($to>$last) {
             local($range)=++$last;
          
             &syslog("QRYLOG","($$) [g] 0 ("
			. scalar (time - $startime)
			. "s) $name ($rhost) -g syntax error 3: $first-$last, $option");
             &exitonerror("3: Invalid range: serial(s) $range-$to don\'t exist\n");
          }
       
          if ($from<$first) {
             local($range)=--$first;
          
             &syslog("QRYLOG","($$) [g] 0 ("
		. scalar (time - $startime)
		. "s) $name ($rhost) -g syntax error 4: $first-$last, $option");
             &exitonerror("4: Invalid range: serial(s) $from-$first don\'t exist\n");
          }
       
          if ($version==1) {
             &GetVersionOne($output,1,$source,$from,$to);
          }
          else {
             
             #
             # I am sorry but we currently only support version 1 ...
             
             &GetVersionOne($output,$UPDATEVERSION,$source,$from,$to);
          
          }  
          
          return 1;
          
       }
       else {
          &syslog("QRYLOG","($$) [g] 0 ("
		. scalar (time - $startime)
		. "s) $name ($rhost) syntax error 1: $option");
          &exitonerror("1: Syntax error in -g argument: $option\n");
       }
    }
    else {
       &syslog("AUDITLOG", "Get serial updates authorization failure: $name ($rhost) $option");
       &syslog("QRYLOG","($$) [g] 0 ("
		. scalar (time - $startime)
		. "s) $name ($rhost) authorization failure for query $option");
       &exitonerror("***You are not authorized to get updates***\n***please contact \<$HUMAILBOX\> for more information***");
    }
    
}


sub dowhoislookup {

   local($input, $output, $name, $rhost)=@_;
   
   local($result,$query);
   local($logstr)=$name;

   $startime = time;

   if (@ARGV) {
      $logstr="direct whoisd query";
   }
   elsif (!$opt_D) {
      $logstr="inetd daemon query";
   }
   elsif ($name!=$rhost) {
      $logstr.="(".$rhost.")";
   }
   
   for (;;) {

    # start counting time for each query if -k is used
    # otherwise just use the already initialised $startime

      if ($opt_k)
	{ $startime = time; }

      $result=0;
      

      $!="";
      
      if ((@ARGV) && (!$opt_k)) {
         $query=join(" ", @ARGV);
      }
      else {
      my($trunclen);
         alarm $KEEPOPEN if (!$commandline);
         $query=<$input>;
      # truncate to 255 chars
        $trunclen = length($query);
        $trunclen = 255 if $trunclen > 255;
        substr( $query, $trunclen ) = "";
      }

#      &dpr("query: -$query- errorcode: -$!-\n");
      
      alarm $KEEPOPEN if (!$commandline);
    
      if ($REPLYBANNER!~ /^\s*$/) {
         print $output "\n", $REPLYBANNER;
         &flush($output);
         alarm $KEEPOPEN if (!$commandline);
      }
      
      # check for denied access

      if (($rhost) && &is_InHostList($rhost, *DENYWHOISACCESS)) {
	  local($FROMHOST)=$rhost;
	  sleep 3;
	  if ($DENYACCESSTXT !~ /^\s*$/) {
	      &ReplaceGlobalVars(*DENYACCESSTXT);
	      print $output "\n", $DENYACCESSTXT;
	      &flush($output);
	  }
	  print $output "\n\n";
	  close($output);
	  &syslog("QRYLOG", "($$) [] 0 ("
		. scalar (time - $startime)
		. "s) $logstr *DENIED* $query");
	  $result = 0;
	  last;
      }
      
      ($query)=&parse($query);
      
      local($flags)=&getflags();
            
      alarm $KEEPOPEN if (!$commandline);
      
      #
      # quit if we have an empty query for the second time
      #
      # (connection is probably closed)
         
      if (($LOWPRIORITY) && ($opt_k) && ($query=~ /^\s*$/)) {
            
         print $output "\n\n";
         close($output);
         last;
      }
      elsif( $QUERYLOOPLIMIT
	&& $querycounter{$query}++ > $QUERYLOOPLIMIT ) {

	   print $output $QUERYLOOPTXT if $QUERYLOOPTXT !~ /^\s*$/;
	   close($output);

	   &syslog("AUDITLOG", "LOOPLIMIT exceeded, connection closed");
	   last;
      }
      else {
	# perform the query
	# OK, so we finally do this query - unless there is none :-)
	# if none of -t -v -g -U was used, then this is an error.

	# isempty ?
	if( ! (($opt_t) || ($opt_v) || ($opt_g) || ($opt_U))) {

	    if ($query=~ /^\s*$/) {
         	$result=0;
         	print $output "\n\% No search key specified\n";
	    }
	    elsif ($query !~ /\w/) {
		 #
		 # we want at least some alphanumeric stuff ...
         
		 $result=0;
		 print $output "\n\% Cannot lookup non-alphanumeric keys\n";
	    }
        }#isempty
      
#      &dpr("whoisd lookup: $query\n");

	#
	# keep a record of what the process is doing

      if( $WHOISDSTAT ) {
	my($timenow) = time();
	my($elapsed) = $timenow - $startime;
	$querycounter++;

	$WSTATFILE = "$WHOISDSTAT.$$";
	if( ! open WSTATFILE, ">$WSTATFILE" ) {
	    &syslog("ERRLOG", "whoisd cannot open $WSTATFILE: $!");
	    # do not try again
	    $WHOISDSTAT = "" ;
	}
	else {
	
      	local($fullflags) = &getfullflags();

	    print WSTATFILE 
"remote_host:\t$rhost
queries_made:\t$querycounter
starttime:   \t$startime
timenow:     \t$timenow
elapsed:     \t$elapsed
query:       \t$query
flags:       \t$fullflags\n";

	    close WSTATFILE;
	} #if open Wstatfile

      } #if WHOISDSTAT

	#################################

    	#     &dpr("calling \&whois($input, $output, $query, $name, $rhost)\n");
        ($result)=&whois($input, $output, $query, $name, $rhost);
	#     &dpr("whois returned $result\n");

	# reset the timer
        alarm $KEEPOPEN if (!$commandline);
	
        print $output "\n", $NOMATCH if ($result==0);

      } #else perform query
      
      #
      # close connection and do logging afterwards to gain more speed
      
      if (!$opt_k) {
         alarm $KEEPOPEN if (!$commandline);
         print $output "\n\n";
         close($output);
      }
      
      #
      # Log this query

      &syslog("QRYLOG","($$) [$flags] $result (" . scalar (time - $startime) 
         	. "s) $logstr - $query");

#      &dpr("[$flags] $result $logstr - $query\n");
      #      
      # stop querying unless keep_connection_open is specified
      
      last if (!$opt_k);
      
      alarm $KEEPOPEN if (!$commandline);
      print $output "\n\n";
      &flush($output);
      
   }
   
   if( $WHOISDSTAT ) { unlink $WSTATFILE }

   return $result;

}

#
# Main program

local($arg);

while ($arg=shift(@ARGV)) {
   
   if ($arg eq "-D") {
      $opt_D=1;
   }
   elsif ($arg eq "-V") {
      $opt_V=1;
   }
   elsif ($arg eq "-b") {
      $opt_b=1;
   }
   elsif ($arg eq "-p") {
      $opt_p=shift(@ARGV);
      die "wrong/no argument specified for \"-p\" switch\n" if ($opt_p=~ /^\s*$/);
   }
   else {
      unshift(@ARGV, $arg);
      last;
   }
   
}


#
# Read config file from RIPEDBCNF, or set to default.

$conffile=$ENV{"RIPEDBCNF"};
#&dpr("\$conffile is $conffile\n");

$conffile= $RIPEConfig{DEFCONFIG} unless $conffile;
#&dpr("\$conffile is $conffile\n");

&rconf($conffile);

$result=0;
$commandline = 0;

#&dpr("whoisd daemon ($$) - running in debug mode\n");

# If there are other command line options,
# do not run as daemon, but process the command line and exit.

if ((@ARGV) || (!$opt_D)) {

   #
   # setup alarm handler
   
   $SIG{'ALRM'} = 'alarmhandler';

   $commandline = 1;

   &dowhoislookup(STDIN, STDOUT, "", "");
   
   exit 0;
   
} 

#
# we are running in daemon mode now

#
# what port do we connect to and which protocol do we use ???

local($port,$proto);

if ($opt_p) {
   ($port,$proto)=&getwhoisportandproto($opt_p);
}
else {
   ($port,$proto)=&getwhoisportandproto(defined($BINDPORT) ? $BINDPORT : "");
}

#&dpr("whoisd daemon ($$) - will connect to port: $port with protocol: $proto\n");

socket(S, PF_INET, SOCK_STREAM, $proto) || &fatalerror("socket: $!");

#
# || &fatalerror("setsockopt: $!"); commented out.
#
# didn't work for perl4 & ( BSDI || Linux )
#

setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1); # || &fatalerror("setsockopt: $!");

my($bindaddr);

if (defined($BINDADDR)) {
  $bindaddr = inet_aton($BINDADDR);
}
$bindaddr = INADDR_ANY unless defined($bindaddr);

while (!bind(S, sockaddr_in ($port, $bindaddr))) {
  # max number of times to try the bind
  my $MAX = 2;

  # number of seconds to wait between tries
  my $WAIT = 7;

    if ($bindcount>=$MAX) {
       print STDERR "whoisd: bind() failed $MAX times, giving up\n";
       &syslog("ERRLOG", "whoisd cannot bind() for $MAX times, giving up");
       exit 1;
    }
    else {
#	&dpr("whoisd daemon ($$) - bind: $!, trying again after $WAIT seconds\n");
       $bindcount++;
       sleep $WAIT;
    }

}

&syslog("ERRLOG", "whoisd ($$) needed $bindcount binds before succeeding") 
    if ($bindcount);

listen(S, 50) || &fatalerror("listen: $!");

#
# we can now change our UID, eUID, GID & eGID
#

#&dpr("whoisd daemon ($$) - changing (UID,GID) from: ($>,$)) to: ($UID,$GID)\n");

#$(=$GID;
$)=$GID;

&fatalerror("Couldn\'t change GID from $) to $GID") if ($)!=$GID);

#$<=$UID;
$>=$UID;

&fatalerror("Couldn\'t change UID from $> to $UID") if ($>!=$UID);

#&dpr("whoisd daemon ($$) - changed (UID,GID) to: ($>,$))\n");

$oldhandle=select(S); $| = 1; select($oldhandle);

# Now we're sure we can run 
# detatch unless we're running verbose mode

if (!$opt_V) {
   
   # 
   # detach from tty

   exit 0 if (fork()>0);

#   if (open(FILE, "/dev/tty")) {
#   
#      if (!ioctl(FILE,(0x20000000|(ord('t')<<8)|113),0)) { # TIOCNOTTY
#         print STDERR "whoisd daemon ($$) - ioctl: $!\n" if ($opt_V);
#      }
#   
#      close(FILE);
#   
#   }

   close(STDIN) if (-t STDIN);

# This is more modern and much more portable way to do detach from
# controlling terminal. If you don't have setsid() (i.e. you're not
# POSIX compliant), re-enable the commented lines above, check your
# TIOCNOTTY #define in your system header files and comment out two
# lines below:					//snabb 981019

   use POSIX;
   POSIX::setsid();
}

# make sure we fork before writing the the pid file ;-)

# We have come this far, let's write the PID to $PIDFILE, useful for
# killing and stuff.

if (open(PID, ">$LOCKDIR$PIDFILE.$port")) {
   print PID "$$\n";
   close(PID);
}
else {
   &syslog("ERRLOG", "cannot write to $LOCKDIR$PIDFILE.$port: $!");
}



$SIG{'INT'}='quitdaemonhandler';
$SIG{'KILL'}='quitdaemonhandler';
$SIG{'TERM'}='quitdaemonhandler';
#$SIG{'HUP'} = sub { &rconf($conffile) };

&ReplaceGlobalVars(*REPLYBANNER);
&ReplaceGlobalVars(*NOMATCH);

#
# Main waiting loop, wait for connection, and fork of child to process
# the incoming request

#sub REAPER {
#    while (waitpid(-1,WNOHANG)) { ; }
#    $SIG{CHLD} = \&REAPER;  # still loathe sysV
#}
#$SIG{CHLD} = \&REAPER;

# reap children when they are done.

use POSIX ":sys_wait_h";

# put limit on loop as sometimes it doesn't stop
#  - I think it is a bug in perl5.003_7
$SIG{CHLD}=sub { my $count=0; while (waitpid(-1,WNOHANG) && $count++<10) {} };

for (;!$QUIT;) {
    
    $! = ""; # Clear any previous error codes
    $address=accept(NS,S);
    last if ($QUIT);
    next if ( $! =~ /interrupted system call/i );
    &fatalerror("accept failed: $!") if( ! defined( $address ));
     
    #
    # fork as safely as possible (see Camel book, fork)
    
    FORK: {
    
       if (($child=fork())) {
        
          #
          # here is the parent process
       
#          while (waitpid(-1, WNOHANG)>0) {};   # reap any dead children
      
       }
       elsif (defined($child)) {
          
          #
          # this is the child process
          
	 # close accepting socket
	 close S;

          #
          # exit as cleanly as possible when we do a shutdown
        
          $SIG{'INT'}='quithandler';
          $SIG{'KILL'}='quithandler';
          $SIG{'TERM'}='quithandler';
#	  $SIG{'HUP'} = sub { &rconf($conffile) };

          #
          # setup alarm handler
        
          $SIG{'ALRM'} = 'alarmhandler';
        
          #
          # Set alarm to timeout after people did not send anything
        
          alarm $KEEPOPEN if (!$commandline);
        
          local($port,$inetaddr) = sockaddr_in ($address);
          local($rhost)=inet_ntoa ($inetaddr);

          local($name)=gethostbyaddr($inetaddr,PF_INET);
        
          #
          # address might not have been reverse delegated...
        
          $name=$rhost if ($name=~ /^\s*$/);

#	 &dpr("($$) child connection $name ($rhost)\n");
#          print STDERR "($$) child connection $name ($rhost)\n" if $opt_V;

          &dowhoislookup(NS, NS, $name, $rhost);
        
#	 &dpr("($$) exit connection [$rhost]\n");
#          print STDERR "($$) exit connection [$rhost]\n" if $opt_V;
        
          exit 0;
          
       }
       elsif ($!=~ /No\s+more\s+process/i || $! =~ /memory/i) {
       
          #
          # looks like a recoverable fork error, let's try again
          
          sleep 5;
          
          redo FORK;
       
       }
       else {
          
          &fatalerror("Could not fork: $!") if (!$QUIT);
          
       }
        
    }
    
}

&syslog(AUDITLOG, "whois daemon ($$) killed by signal ($QUIT)") if ($QUIT);

unlink("$LOCKDIR$PIDFILE.$port");

exit 0;

