#!/usr/local/bin/perl

# radbserver-ripewhois.pl 
#
# These are some routines from the RIPE whoisd.pl
# which implement a few things for their standard whois 
# queries to the server.
# 

@INC = ("/f/rrdb/dbase-beta/lib", @INC);

require "rconf.pl";
require "dbopen.pl";
require "dbclose.pl";
require "enread.pl";
require "enwrite.pl";
require "enkeys.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.
#
# This also does the classless indexes if a classless address is
# requested. The classless index will return db keys, so they will
# simply be added to the set of keys to look up.
 
sub makekeys {
 
    local($string) = @_;
    local(@keys) = ();
    local($i);

	print STDERR "($$) entering makekeys, string '$string'\n" if $opt_d;
 
    $string =~ s/^\s+//;
    $string =~ tr/A-Z/a-z/;
 
    @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);
		}
 
		# Remember: numbers possibly followed by dots and more numbers
		# are ALWAYS considered IP network numbers!!!!!
 
		if ($keys[$i] =~ /^\d+[\.\d\/]*$/) {
			local($p, $l) = split(/\//, $keys[$i]);
			if (!$l) {
				$keys[$i] = &quad2int($p)."/32";
			} else {
				$keys[$i] = &quad2int($p)."/$l";
			}
		}
		if (length($keys[$i]) < 2) {
			splice(@keys, $i, 1);
		}
    }
	print STDERR "($$) leaving makekeys ($#keys) @keys\n" if $opt_d;
    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, $nonintersect) = @_;
    local(%en) = ();
    local(@playkeys) = @keys;
    local(@matches) = ();
    local($save) = "";
    local($i);
 
    return if eof(db);
 	print STDERR "($$) in lookupandprint, nonintersect $nonintersect; keys ($#keys) @keys\n" if $opt_d;

    foreach $i (0..$#playkeys) {
    next if $playkeys[$i] !~ /^\d+\/\d+$/;
    if ($opt_m || $opt_M) {
        print "% This may take some time, server running at low priority\n" if !$slow_msg_print;
        print "\n" if !$slow_msg_print;
        $slow_msg_print = 1;
        system("/etc/renice 10 $$ > /dev/null 2>/dev/null");
        $xsps = &findmsps($playkeys[$i], $playkeys[$i], 1, $opt_m);
    } else {
        $xsps = &findlsps($playkeys[$i], $opt_L);
    }
    local(@boe);
    foreach $tmp (split(/,/, $xsps)) {
        local($val);
        &getmspnxl($tmp, *val);
        @boe = (@boe, &cla2unikey($tmp));
    }
    splice(@playkeys, $i, 1, @boe);
    }
 
    @matches = &dbmatch(*db, *playkeys, $nonintersect);
 
    if (($#matches < 0) && !defined($result)) {
    $result = 0;
    return;
    }
    for $j (0..$#matches) {
    if ($matches[$i] == -1) {
        $result = -1 if $result != 1;
        return;
    }
    if ($displayed{$matches[$j]}) {
        $result = 1;
        print STDERR "($$) left lookupandprint already seen\n" if $debug;
        next;
    }
    %en = &enread(db, $matches[$j]);
    local($m) = -1;
    if (($#playkeys > 0) && !$nonintersect) {
        foreach (@playkeys) {
        $save = $_;
        local(@tmp) = &enkeys(*en);
        @tmp = (@tmp, &enukey(*en));
        foreach (@tmp) {
            if ($save eq $_) {
            $m++;
            }
        }
        }
    } else {
        $m = $#playkeys;
    }
    if ($m == $#playkeys) {
        print "\n" if &enwrite(*en, 1, 0, !$opt_S);
        $displayed{$matches[$j]} = 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 $opt_d;
	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,1);
    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(%nothing) = ();
	local(@keys) = &makekeys($searchstring);

	print STDERR "($$) in whois: @keys\n" if $opt_d;

	foreach (@sources) {
		local(*i) = 'currentdb';
		&dbopen(i, *nothing, 0, $DBFILE{$_});
		&dbclopen(*nothing, 0, $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);
		&dbclclose();
	}
	print STDERR "($$) left whois\n" if $opt_d;
}

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

sub parse {

	local($string) = @_;

	# 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;
	}

	# force -a if we do not use -s. lpj
	$opt_a = 1 if (!$opt_s);

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

   	return $string;
}

##############################################################################################
# 
# TransKeys: map from external key to internal forms stored in the dbm files.
# 
# This extracted from the middle of huge block of codes in whoisd (or in.whosid).
# see the rlr comment in there.
# in.whoisid for 35: nonintersect '1', keys '587202560/32', xsps '587202560/8', playkeys '%1135.0.0.0/8      as237'.
#

sub TransKeys {
    local(*playkeys) = @_;
    local($i,$xsps);

	# print STDERR "\nEnter TransKeys: playkeys '@playkeys'." if $opt_d;

    foreach $i (0..$#playkeys) {
	    next if $playkeys[$i] !~ /^\d+\/\d+$/;
    	if ($opt_m || $opt_M) {
        	$xsps = &findmsps($playkeys[$i], $playkeys[$i], 1, $opt_m);
    	} else {
        	$xsps = &findlsps($playkeys[$i], $opt_L);
    	}
		print STDERR "\n    TransKeys xsps '$xsps'" if $opt_d;
    	local(@boe);
    	foreach $tmp (split(/,/, $xsps)) {
        	local($val);
        	&getmspnxl($tmp, *val);
        	@boe = (@boe, &cla2unikey($tmp));
    	}
    	splice(@playkeys, $i, 1, @boe);
    }
   	print STDERR "\nLeaving TransKeys:  xsps '$xsps', playkeys '@playkeys'." if $opt_d;
}







