#!PERL

#       whoisd - whois Internet daemon
#
#	$RCSfile: whoisd.pl,v $
#	$Revision: 0.52 $
#	$Author: dfk $
#	$Date: 1995/02/26 09:23:15 $
#

$port = 43;

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

require "getopts.pl";
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.
#
# 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);

    $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);
	}
    }
    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);

    # This was meant as an optimization, but it will cause references from
    # the last object in a file to fail. Perhaps do something slightly
    # more clever at some stage.

    # return if (eof(db);


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

    foreach $i (0..$#playkeys) {
	next if $playkeys[$i] !~ /^\d+\/\d+$/;
	if ($opt_m || $opt_M) {
	    print NS "% This may take some time, server running at low priority\n" if !$slow_msg_print;
	    print NS "\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;
	}
	select(NS);
	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 $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, $nonintersect) = @_;
    local($j) = "";
    local($i);
    local(@playkeys) = @keys;

    # This is the same optimization as in lookupandprint()
    # return if eof(db);

    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);
        }
        local(@boe);
        foreach $tmp (split(/,/, $xsps)) {
            local($val);
            &getmspnxl($tmp, *val);
            @boe = (@boe, &cla2unikey($tmp));
        }
        splice(@playkeys, $i, 1, @boe);
    }

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

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

# This is already the new version of this sub for the split database

sub whois {
    
    local(*sources, $searchstring) = @_;
    local($nonintersect) = 1;

    local(@keys) = &makekeys($searchstring);
    if ($#keys > 0) {
	$nonintersect = 0;
    }
	
    local(%nothing) = ();

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

    foreach (@sources) {
	%displayed = ();
	local(@searchdb) = ();
	local(*i) = 'currentdb';
	local($source) = $_;
	if ($TYPE{$source} eq "SPLIT") {

	    # Here is some guess work about what file to open....
	    # We can only do that if there is only one key.

	    if (!$keys[1]) {
		if ($keys[0] =~ /^\d+\/\d+/) {
		    @searchdb = ("in", "rt", "ir");
		} elsif ($keys[0] =~ /^as\d+$/) {
		    @searchdb = ("an", "pn");
		} elsif ($keys[0] =~ /^as\-/) {
		    @searchdb = ("am");
		}
	    }

	    if (!$searchdb[0]) {
		@searchdb = keys %OBJATSQ;
	    }
	    
	    if ($opt_T) {
		@searchdb = @onlysearch;
	    }

	    foreach $j (@searchdb) {
		$CUROBJTYPE = $j;
		next if !&dbopen(i, *nothing, 0, "$DBFILE{$source}.$j");
		&dbclopen(*nothing, 0, "$DBFILE{$source}.$j");
		if ($opt_F) {
		    &fastlookup(*i, *keys, $nonintersect);
		} else {
		    &lookupandprint(*i, *keys, $nonintersect);
		}
		&dbclose(*i);
		&dbclclose();
	    }
	    for ($j=0;$j<$recindex;$j++) {
		local(@refkeys) = &makekeys($refs[$j]);
		@searchdb = ("pn");
		foreach $j (@searchdb) {
		    next if !&dbopen(i, *nothing, 0, "$DBFILE{$source}.$j");
		    &dbclopen(*nothing, 0, "$DBFILE{$source}.$j");
		    &lookupandprint(*i, *refkeys);
		    &dbclose(*i);
		    &dbclclose();
		}
	    }
	    undef(@refs);
	    $recindex=0;
	} else {
	    &dbopen(i, *nothing, 0, $DBFILE{$source});
	    &dbclopen(*nothing, 0, $DBFILE{$source});
	    if ($opt_F) {
		&fastlookup(*i, *keys, $nonintersect);
	    } else {
		&lookupandprint(*i, *keys, $nonintersect);
	    }
	    for ($j=0;$j<$recindex;$j++) {
                local(@refkeys) = &makekeys($refs[$j]);
		&lookupandprint(*i, *refkeys);
	    }
	    &dbclose(*i);
	    &dbclclose();
	    undef(@refs);
            $recindex=0;
	}
    }
    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 = ();
    @onlysearch = ();
    $opt_a = 0;
    $opt_r = 0;
    $opt_F = 0;
    $opt_s = 0;
    $opt_L = 0;
    $opt_m = 0;
    $opt_M = 0;
    $opt_T = 0;

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

    if ($string =~ /^[hH][eE][lL][pP]\s*$/) {
	open (HELP, $HELP);
	while (<HELP>) {
	    print;
	}
	close(HELP);
	&syslog("QRYLOG","($$) [] 1 $name help");
	exit;
    }

    while ($string =~ /^-/) {
	if ($string =~ s/^-([arkFLmMS]+)\s*//) {
	    if (length($1) > 1) {
		foreach (split(/|/, $1)) {
		    eval "\$opt_$_ = 1;";
		}
	    } else {
		eval "\$opt_$1 = 1;";
	    }
	    next;
	}
	if ($string =~ s/^-U\s+(\S+)\s*//) {
	    $opt_U = $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+)\s*//) {
	    local($type) = $1;
	    $type = $ALIAS{$1} if $ALIAS{$1};
	    $type = $ATTR{$1} if $ATTR{$1};
	    if (!$OBJATSQ{$type}) {
		print "% Request for unknown object type \"$type\" ignored\n";
	    } else {
		@onlysearch = (@onlysearch, $type);
		$opt_T = 1;
	    }
	    next;
	}
	if ($string =~ s/^\-t\s+(\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;

    if ($debug) {
	for $fl ("d","a","s","k","r","F","t","S","T","M","m","L") {
	    if (eval "\$opt_$fl;") {
		if ($flags) {
		    $flags .= ":";
		}
		$flags .= "$fl";
	    }
	}
	print STDERR "($$) called with $flags\n";
    }
    return $string;
}


sub whoisupdate {
	local($name, $addr, $logstr) = @_;
	local($ent) = "";

	print STDERR "whoisupdate('$name', '$addr', '$logstr');\n" if $debug;
	print STDERR "$BINDIR/dbupdate will be used.\n" if $debug;

	if ($addr !~ /^193\.0\.0\.1[2345][0-9]/) {  # needs to go into config
		print NS "$NOMATCH\n";
		close(NS);
		exit(1);
	}
		
	while(<NS>) {
		last if /^\.\s*$/;
		if (/^\s*$/) {
			if ($ent =~ /\S+/) {
				&dowhoisupdate($name, $addr, $logstr, $ent);
				$ent = "";
			}
		}
		else {
			$ent .= $_;
		}
	}
}

sub dowhoisupdate {
	local($name, $addr, $logstr, $ent) = @_;

	$logstr =~ s/[^A-Za-z0-9]//g;  # no shell spoofing !

	print STDERR "dowhoisupdate('$name', '$addr', '$logstr');\n" if $debug;
	print STDERR "dowhoisupdate \$ent:\n$ent\n" if $debug;


	unlink("$TMPDIR/wupd.$$");
	open(ENT, ">$TMPDIR/wupd.$$") || &nsexit("open $TMPDIR/wupd.$$: $!");
	print ENT $ent;
	close(ENT);

	open(UPD, "$BINDIR/dbupdate -F -v -n 'NETWORK $addr $name $logstr' <$TMPDIR/wupd.$$|") || &nsexit("pipe $BINDIR/dbupdate: $!");
	while(<UPD>) {
		print NS $_;
	}
	close(UPD);
	unlink("$TMPDIR/wupd.$$");
}


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

	print NS "ERROR: $msg\n";
	close(NS);
	exit 1;
}

#
# 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,@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_U) {
		    alarm 60;
		    &whoisupdate($name, $rhost, $opt_U);
		    close(NS);
		}
		elsif (!$opt_t) {
		    &whois(*source, $string);
		    select(NS);
		    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","S","T","U","M","m","L") {
		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) {}
    
}
