Fixes for whoisd.pl
- Date: Thu, 17 Nov 1994 14:43:19 +0100
Folks,
whoisd.pl had some problems when interacting with the tools. Also some
other little things are fixed.
Also new versions for syntax.pl and cldb.pl are coming up. Please
replace/intergate versions you may have. Please note these modules are
for the *new* database software....
-Marten
#!PERL
# whoisd - whois Internet daemon
#
# $RCSfile: whoisd.pl,v $
# $Revision: 0.43 $
# $Author: marten $
# $Date: 1994/11/16 15:57:40 $
#
@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);
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;
}
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;
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);
while (<db>) {
print;
last if /^\s*$/;
}
print "\n" if eof(db);
}
}
#
# 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", "ir", "rt");
} elsif ($keys[0] =~ /^as\d+$/) {
@searchdb = ("an");
} 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 =~ /^help/) {
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/^-(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;
}
#
# 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_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","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) {}
}