ripe whois -s dbname question

Rick Riolo <rlr at merit.edu> writes
 * laurant,
 * could you please hack it again, eg, so that if -s comes in
 * it respects that (rather than just assuming -a)?
 * thanks!
 *  - r

Perhaps if you tell each other what you do you might avoid these
miscommunications ;-) 

Actually, your query did lead me to another bug in whoisd, which has
effect on the -a behaviour (which simply does not work properly due to
some other fix I made). Below is the whoisd.pl with the fix (if you
are still using it). Simply drop in the src dir, and make install one
dir up, and restart.

Cheers,

-Marten

#!PERL

#       whoisd - whois Internet daemon
#
#	$RCSfile: whoisd.pl,v $
#	$Revision: 0.36 $
#	$Author: marten $
#	$Date: 1994/03/24 20:03:45 $
#

@INC = ("LIBDIR", @INC);

require "rconf.pl";
require "dbopen.pl";
require "dbclose.pl";
require "enread.pl";
require "enwrite.pl";
require "enkeys.pl";
require "enukey.pl";
require "getopt.pl";
require "misc.pl";
require "dbmatch.pl";
require "syslog.pl";
require "template.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 {

    print NS "Timeout... Closing connection\n";
    close(NS);
    exit;
}

#
# makekeys - converts a whitespace seperated string of keys into
#		an array. Trailing zeros in netnumbers are removed.
#

sub makekeys {

    local($string) = @_;
    local(@keys) = ();
    local($i);

    $string =~ s/^\s+//;
    $string =~ tr/A-Z/a-z/;
    $string =~ s/(\.0)*\.0\s+/ /;
    $string =~ s/(\.0)*\.0\s*$//;
    @keys = split(/\s+/, $string);

    # remove keys shorter than 2 chars, since the indexing does not use
    # them either ;-)

    foreach $i (0..$#keys) {
	if (length($keys[$i]) < 2) {
	    splice(@keys, $i, 1);
	}
    }

    return @keys;
}

#
# 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):
#	-1 - toomany hits (if result != 1 yet)
#	 0 - no match (if $result was not defined yet)
#	 1 - OK, something was output (always)

sub lookupandprint {

    local(*db, *keys) = @_;
    local(%en) = ();
    local(@matches) = ();
    local($save) = "";

    print STDERR "($$) in lookupandprint\n" if $debug;

    @matches = &dbmatch(*i, @keys);
    if (($#matches < 0) && !defined($result)) {
	$result = 0;
	return;
    }
    for $j (0..$#matches) {
	if ($matches[$i] == -1) {
	    $result = -1 if $result != 1;
	    return;
	}
	%en = &enread(i, $matches[$j]);
	local($m) = -1;
	if ($#keys > 0) {
	    foreach (@keys) {
		$save = $_;
		foreach (&enkeys(*en)) {
		    if ($save eq $_) {
			$m++;
		    }
		}
	    } 
	} else {
	    $m = $#keys;
	}
	if ($m == $#keys) {
	    local($uniqkey) = &enukey(*en);
	    if ($displayed{$uniqkey}) {
		$result = 1;
		print STDERR "($$) left lookupandprint already seen\n" if $debug;
		return;
	    }
	    &enwrite(*en, 1);
	    print "\n";
	    $displayed{$uniqkey} = 1;
	    $result = 1;
	    $type = &entype(*en);
	    if ($RECUR{$type} && !$opt_r) {
		local(@tmp) = split(/[\s\t]+/, $RECUR{$type});
		foreach (@tmp) {
		    local(@r) = split(/\n/, $en{$_});
		    for ($k=0;$k<=$#r;$k++) {
			if (!$refd{$r[$k]}) {
			    $refs[$recindex++] = $r[$k];
			    $refd{$r[$k]} = 1;
			}
		    }
		}
	    }
	}
    }
    print STDERR "($$) left lookupandprint\n" if $debug;
    return;
}

# fastlookup - small routine to do fast lookups, always non-recursive
# it basically just reads from a file, and outputs as fast as it can
# without interpreting the data.

sub fastlookup {

    local(*db, *keys) = @_;
    local($j) = "";

    @matches = &dbmatch(*db, @keys);
    foreach $j (@matches) {
	$result = 1;
	seek(db, $j, 0);
	while (<db>) {
	    print;
	    last if /^\s*$/;
	}
	print "\n" if eof;
    }
}

#
# 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(*sources, $searchstring) = @_;

    local(@keys) = &makekeys($searchstring);

    print STDERR "($$) in whois\n" if $debug;

    foreach (@sources) {
	%displayed = ();
	local(*i) = 'currentdb';
	&dbopen(i, $DBFILE{$_});
	if ($opt_F) {
	    &fastlookup(*i, *keys);
	} else {
	    &lookupandprint(*i, *keys);
	}
	for ($j=0;$j<$recindex;$j++) {
	    local(@refkeys) = &makekeys($refs[$j]);
	    &lookupandprint(*i, *refkeys);
	}
	undef(@refs);
	$recindex=0;
	&dbclose(*i);
    }
    print STDERR "($$) left whois\n" if $debug;
}			

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

sub parse {

    local($string) = @_;

    print STDERR "($$) got in parse\n" if $debug;

    # Reset all command line arguments, except -k

    @source = ();
    $opt_a = 0;
    $opt_r = 0;
    $opt_F = 0;
    $opt_s = 0;

    $string =~ s/^\s+//;

    if ($string =~ /^help/) {
	open (HELP, $HELP);
	while (<HELP>) {
	    print;
	}
	close(HELP);
	exit;
    }

    while ($string =~ /^-/) {
	if ($string =~ s/^-([arkF])\s*//) {
	    eval "\$opt_$1 = 1;";
	    next;
	}
	if ($string =~ s/^-(s)\s+(\S+)\s+//) {
	    local($src) = $2;
	    $src =~ tr/a-z/A-Z/;
	    @source = (@source, $src);
	    $opt_s = 1;
	    next;
	}
	if ($string =~ s/^-V(..[0-9]+[0-9\.]*)\s*//) {
	    $opt_V = $1;
	    next;
	}
	if ($string =~ s/^\-t\s+(\S+)//)  {
	    local($type) = $1;
	    $type = $ALIAS{$1} if $ALIAS{$1};
	    $type = $ATTR{$1} if $ATTR{$1};
	    if (!$OBJATSQ{$type}) {
		print "No template available for object \"$type\"\n";
		$result = 1;
		$opt_t = 1;
		return $type;
	    }
	    &Template($type);
	    $opt_t = 1;
	    $result = 0;
	    return $type;
	}
	last;
    }

    if ($opt_a) {
	@source = split(/\s+/, $ALLLOOK);
    }
    elsif (!$source[0]) {
	@source = split(/\s+/, $DEFLOOK);
    }

    print STDERR "($$) left parse\n" if $debug;
    return $string;
}



#
# Main program
#

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

$conffile=$ENV{"RIPEDBCNF"};
$conffile= "DEFCONFIG" unless $conffile;
&rconf($conffile);

# If there are command line options, other than -d (for debug)
# do not run as daemon, but process the command line and exit.


if (($ARGV[0] ne "-d") && ($#ARGV>=0)) {
    local($cmdline) = "";
    for $i (0..$#ARGV) {
	$cmdline .= $ARGV[$i]." ";
    }
    $string = &parse($cmdline);
    &whois(*source, $string);
    exit;
} else {
    if ($ARGV[0] eq "-d") {
	print STDERR "($$) running in debug mode\n";
	$debug = 1;
    } else {
	# detach from tty
	exit 0 if (fork() > 0);
	if (open(FILE, "/dev/tty")) {
	    if (!ioctl(FILE,(0x20000000|(ord('t')<<8)|113),0)) {   
		print STDERR "ioctl: $!\n" if ($debug);
	    }
	    close(FILE);
	}
	close(0) if -t;
    }
}

$port = 43 unless $port;

print STDERR "($$) running on port $port\n" if ($debug);

$AF_INET = 2;
$SOCK_STREAM = 1;
$SOL_SOCKET = 0xffff;
$SO_REUSEADDR = 0x0004;

$sockaddr = 'S n a4 x8';

($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {
    ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");

select(NS); $| = 1; select(STDOUT);

socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(S, $SOL_SOCKET, $SO_REUSEADDR, 1) || die "setsockopt: $!";

while (!bind(S, $this)) {
    if ($bindcount >= 20) {
	print STDERR "whoisd: bind() failed 20 times, giving up\n";
	&syslog("ERRLOG", "whoisd cannot bind() for 20 times, giving up");
	exit 1;
    } else {
	print STDERR "-- bind: $!, trying again\n" if ($debug);
	$bindcount++;
	sleep 5;
    }
}

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

listen(S,5) || die "listen: $!";

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

# Set up the alarm handler

$SIG{'ALRM'} = 'alarmhandler';

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

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

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

for (;;) {
    ($addr = accept(NS,S)) || die $!;

    if (($child = fork()) == 0) {
	($af,$port,$inetaddr) = unpack($sockaddr,$addr);
	@inetaddr = unpack('C4', $inetaddr);

	$rhost = "$inetaddr[0].$inetaddr[1].$inetaddr[2].$inetaddr[3]";

	print STDERR "($$) fork connection [$rhost]\n" if $debug;

	local($name,$alias,$at,$len, at addr)=gethostbyaddr($inetaddr,$af);
	if ($name eq "") {
	    $name = $rhost;
	}		

	# Set alarm to timeout after people did not send anything
	# in 60 seconds

	alarm 60;

	while(<NS>) {

	    $result = 0;

	    # Got something, reset alarm;

	    alarm 0;

	    chop;

	    # we want at least some alphanumeric stuff ...
	    if (/\w+/) {
		select(NS);
		$string = &parse($_);
		print STDERR "($$) lookup $string\n" if $debug;
		if (!$opt_t) {
		    &whois(*source, $string);
		    print $NOMATCH,"\n" if $result == 0;
		    print $TOOMANY,"\n" if $result == -1;
		    select(STDOUT);
		    if ($opt_k) {
			print NS "\n";
			alarm 60;
		    }
		    else {
			close(NS);
		    }
		} else {
		    close(NS);
		}
	    }
	    # got something completely non-alphanumeric
	    else {
		select(NS);
		$string = $_;
		print STDERR "($$) lookup $string\n" if $debug;
		print "Cannot lookup non-alphanumeric keys\n";
		print "Connection closed\n";
		$result = 0;
		select(STDOUT);
		close(NS);
	    }

	    # Log this query

	    $flags = "";
	    for $fl ("d", "a", "s", "k", "r", "F", "t") {
		if (eval "\$opt_$fl;") {
		    if ($flags) {
			$flags .= ":";
		    }
		    $flags .= "$fl";
		}
	    }
	    if ($opt_V) {
		if ($flags) {
		    $flags .= ":";
		}
		$flags .= "V$opt_V";
	    }
	    &syslog("QRYLOG","($$) [$flags] $result $name $string");
	    
	}
	close(NS);

	print STDERR "($$) exit connection [$rhost]\n" if $debug;
	exit;
    }
    while (waitpid(-1, 1) > 0) {}
    
}



-------- Logged at  Thu Mar 24 21:11:44 MET 1994  ---------