diff options
Diffstat (limited to 'install/5.005/Net-Whois-Raw/lib/Net/Whois/Raw.pm')
-rw-r--r-- | install/5.005/Net-Whois-Raw/lib/Net/Whois/Raw.pm | 393 |
1 files changed, 393 insertions, 0 deletions
diff --git a/install/5.005/Net-Whois-Raw/lib/Net/Whois/Raw.pm b/install/5.005/Net-Whois-Raw/lib/Net/Whois/Raw.pm new file mode 100644 index 000000000..04db67184 --- /dev/null +++ b/install/5.005/Net-Whois-Raw/lib/Net/Whois/Raw.pm @@ -0,0 +1,393 @@ +package Net::Whois::Raw; + +require Net::Whois::Raw::Data; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $OMIT_MSG $CHECK_FAIL + %notfound %strip $CACHE_DIR $CACHE_TIME $USE_CNAMES + $TIMEOUT); +use IO::Socket; + +require Exporter; + +@ISA = qw(Exporter); + +@EXPORT = qw( whois whois_config ); ### It's bad manners to export lots. +@EXPORT_OK = qw( $OMIT_MSG $CHECK_FAIL $CACHE_DIR $CACHE_TIME $USE_CNAMES $TIMEOUT); + +$VERSION = '0.31'; + +($OMIT_MSG, $CHECK_FAIL, $CACHE_DIR, $CACHE_TIME, $USE_CNAMES, $TIMEOUT) = (0) x 6; + +sub whois { + my ($dom, $srv) = @_; + my $res; + unless ($srv) { + ($res, $srv) = query($dom); + } else { + $res = _whois($dom, uc($srv)); + } + finish($res, $srv); +} + +sub whois_config { + my ($par) = @_; + my @parnames = qw(OMIT_MSG CHECK_FAIL CACHE_DIR CACHE_TIME USE_CNAMES TIMEOUT); + foreach my $parname (@parnames) { + if (exists($par->{$parname})) { + eval('$'.$parname.'='.int($par->{$parname})); + } + } +} + +sub query { + my $dom = shift; + my $tld; + if ($dom =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) { + $tld = "IP"; + } else { + my @alltlds = keys %Net::Whois::Raw::Data::servers; + @alltlds = sort { dlen($b) <=> dlen($a) } @alltlds; + foreach my $awailtld (@alltlds) { + $awailtld = lc $awailtld; + if ($dom =~ /(.+?)\.($awailtld)$/) { + $tld = uc $2; + last; + } + } + unless ($tld) { + my @tokens = split(/\./, $dom); + $tld = uc($tokens[-1]); + } + } + + + $dom =~ s/.NS$//i; + my $cname = "$tld.whois-servers.net"; + my $srv = $Net::Whois::Raw::Data::servers{$tld} || $cname; + $srv = $cname if $USE_CNAMES && gethostbyname($cname); + my $flag = ( + $srv eq 'whois.crsnic.net' || + $srv eq 'whois.publicinterestregistry.net' || + $srv eq 'whois.nic.cc' || + $tld eq 'ARPA' + ); + my $res = do_whois($dom, uc($srv), $flag, [], $tld); + wantarray ? ($res, $srv) : $res; +} + +sub do_whois { + my ($dom) = @_; # receives 4 parameters, do NOT shift + return _whois(@_) unless $CACHE_DIR; + mkdir $CACHE_DIR, 0644; + if (-f "$CACHE_DIR/$dom") { + if (open(I, "$CACHE_DIR/$dom")) { + my $res = join("", <I>); + close(I); + return $res; + } + } + my $res = _whois(@_); + return $res unless $res; + return $res unless open(O, ">$CACHE_DIR/$dom"); + print O $res; + close(O); + + + return $res unless $CACHE_TIME; + + my $now = time; + foreach (glob("$CACHE_DIR/*.*")) { + my $atime = (stat($_))[8]; + my $elapsed = $now - $atime; + unlink $_ if ($elapsed / 3600 > $CACHE_TIME); + } + $res; +} + +sub finish { + my ($text, $srv) = @_; + return $text unless $CHECK_FAIL || $OMIT_MSG; + *notfound = \%Net::Whois::Raw::Data::notfound; + *strip = \%Net::Whois::Raw::Data::strip; + + my $notfound = $notfound{lc($srv)}; + my @strip = $strip{lc($srv)} ? @{$strip{lc($srv)}} : (); + my @lines; + MAIN: foreach (split(/\n/, $text)) { + return undef if $CHECK_FAIL && $notfound && /$notfound/; + if ($OMIT_MSG) { + foreach my $re (@strip) { + next MAIN if (/$re/); + } + } + push(@lines, $_); + } + local ($_) = join("\n", @lines, ""); + + if ($CHECK_FAIL > 1) { + return undef unless check_existance($_); + } + + if ($OMIT_MSG > 1) { + s/The Data.+(policy|connection)\.\n//is; + s/% NOTE:.+prohibited\.//is; + s/Disclaimer:.+\*\*\*\n?//is; + s/NeuLevel,.+A DOMAIN NAME\.//is; + s/For information about.+page=spec//is; + s/NOTICE: Access to.+this policy.//is; + s/The previous information.+completeness\.//s; + s/NOTICE AND TERMS OF USE:.*modify these terms at any time\.//s; + s/TERMS OF USE:.*?modify these terms at any time\.//s; + s/NOTICE:.*expiration for this registration\.//s; + + s/By submitting a WHOIS query.+?DOMAIN AVAILABILITY.\n?//s; + s/Registration and WHOIS.+?its accuracy.\n?//s; + s/Disclaimer:.+?\*\*\*\n?//s; + s/The .COOP Registration .+ Information\.//s; + s/Whois Server Version \d+\.\d+.//is; + s/NeuStar,.+www.whois.us\.//is; + s/\n?Domain names in the \.com, .+ detailed information.\n?//s; + s/\n?The Registry database .+?Registrars\.\n//s; + s/\n?>>> Last update of .+? <<<\n?//; + s/% .+?\n//gs; + } + $_; +} + +sub _whois { + my ($dom, $srv, $flag, $ary, $tld) = @_; + my $state; + + my $sock; + eval { + local $SIG{'ALRM'} = sub { die "Connection timeout to $srv" }; + alarm $TIMEOUT if $TIMEOUT; + $sock = new IO::Socket::INET("$srv:43") || die "$srv: $!"; + }; + alarm 0; + die $@ if $@; + my $israce = $dom =~ /ra--/ || $dom =~ /bq--/; + my $whoisquery = $dom; + if ($srv eq 'WHOIS.MELBOURNEIT.COM' && $israce) { + $whoisquery .= ' race'; + } + #warn "$srv: $whoisquery ($OMIT_MSG, $CHECK_FAIL, $CACHE_DIR, $CACHE_TIME, $USE_CNAMES, $TIMEOUT)\n"; + print $sock "$whoisquery\r\n"; + my @lines = <$sock>; + close($sock); + my $answer = join '', @lines; + if ($flag) { + foreach (@lines) { + $state ||= (/Registrar:/); + if ( $state && /Whois Server:\s*([A-Za-z0-9\-_\.]+)/ ) { + my $newsrv = uc("$1"); + next if (($newsrv) eq uc($srv)); + return undef if (grep {$_ eq $newsrv} @$ary); + my $whois = eval { _whois($dom, $newsrv, $flag, [@$ary, $srv]) }; + if ($@ && !$whois || $whois && !check_existance($whois)) { + return $answer; + } + return $whois; + } + if (/^\s+Maintainer:\s+RIPE\b/ && $tld eq 'ARPA') { + my $newsrv = uc($Net::Whois::Raw::Data::servers{'RIPE'}); + next if ($newsrv eq $srv); + return undef if (grep {$_ eq $newsrv} @$ary); + my $whois = eval { _whois($dom, $newsrv, $flag, [@$ary, $srv]) }; + if ($@ && !$whois) { + return $answer; + } + return $whois; + } + } + } + my $whois = join("", @lines); + + if ($whois =~ /To single out one record, look it up with \"xxx\",/s) { + my $newsrv = uc('whois.networksolutions.com'); + return _whois($dom, $newsrv, $flag, [@{$ary||[]}, $srv]); + } + + return $whois; +} + +sub dlen { + my ($str) = @_; + my $dotcount = $str =~ tr/././; + return length($str) * (1 + $dotcount); +} + + +sub check_existance { + $_ = $_[0]; + + return undef if + /is unavailable/is || + /No entries found for the selected source/is || + /Not found:/s || + /No match\./s || + /is available/is || + /Not found/is && + !/ your query returns "NOT FOUND"/ && + !/Domain not found locally/ || + /No match for/is || + /No Objects Found/s || + /No domain records were found/s || + /No such domain/s || + /No entries found in the /s || + /Unable to find any information for your query/s || + /is not registered and may be available for registration/s; + return 1; +} + + +# Preloaded methods go here. + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; +__END__ +# Below is the stub of documentation for your module. You better edit it! + +=head1 NAME + +Net::Whois::Raw - Perl extension for unparsed raw whois information + +=head1 SYNOPSIS + + use Net::Whois::Raw qw( whois ); + + $s = whois('perl.com'); + $s = whois('funet.fi'); + $s = whois('yahoo.co.uk'); + + ### if you do "use Net::Whois::Raw qw( whois $OMIT_MSG $CHECK_FAIL + ### $CACHE_DIR $CACHE_TIME $USE_CNAMES $TIMEOUT ); + ### you can use these: + + $OMIT_MSG = 1; # This will attempt to strip several known copyright + messages and disclaimers sorted by servers. + Default is to give the whole response. + + $OMIT_MSG = 2; # This will try some additional stripping rules + if none are known for the spcific server. + + $CHECK_FAIL = 1; # This will return undef if the response matches + one of the known patterns for a failed search, + sorted by servers. + Default is to give the textual response. + + $CHECK_FAIL = 2; # This will match against several more rules + if none are known for the specific server. + + $CACHE_DIR = "/var/spool/pwhois/"; # Whois information will be + cached in this directory. Default is no cache. + + $CACHE_TIME = 24; # Cache files will be cleared after not accessed + for a specific number of hours. Documents will not be + cleared if they keep get requested for, independent + of disk space. Default is not to clear the cache. + + $USE_CNAMES = 1; # Use whois-servers.net to get the whois server + name when possible. Default is to use the + hardcoded defaults. + + + $TIMEOUT = 10; # Cancel the request if connection is not made within + a specific number of seconds. + + Note: as of version 0.21, extra data will be loaded only if the + OMIT_MSG or CHECK_FAIL flags were used, in order to reduce memory usage. + +=head1 DESCRIPTION + +Net::Whois::Raw queries NetworkSolutions and follows the Registrar: answer +for ORG, EDU, COM and NET domains. +For other TLDs it uses the whois-servers.net namespace. +(B<$TLD>.whois-servers.net). + +Setting the variables $OMIT_MSG and $CHECK_FAIL will match the results +against a set of known patterns. The first flag will try to omit the +copyright message/disclaimer, the second will attempt to determine if +the search failed and return undef in such a case. + +B<IMPORTANT>: these checks merely use pattern matching; they will work +on several servers but certainly not on all of them. + +(This features were contributed by Walery Studennikov B<despair@sama.ru>) + +=head1 AUTHOR + +Original author Ariel Brosh, B<schop@cpan.org>, +Inspired by jwhois.pl available on the net. + +Since Ariel has passed away in September 2002: + +Past maintainers Gabor Szabo, B<gabor@perl.org.il>, +Corris Randall B<corris@cpan.org> + +Current Maintainer: Walery Studennikov B<despair@cpan.org> + +=head1 CREDITS + +Fixed regular expression to match hyphens. (Peter Chow, +B<peter@interq.or.jp>) + +Added support for Tonga TLD. (.to) (Peter Chow, B<peter@interq.or.jp>) + +Added support for reverse lookup of IP addresses via the ARIN registry. (Alex Withers B<awithers@gonzaga.edu>) + +This will work now for RIPE addresses as well, according to a redirection from ARIN. (Philip Hands B<phil@uk.alcove.com>, Trevor Peirce B<trev@digitalcon.ca>) + +Added the pattern matching switches, (Walery Studennikov B<despair@sama.ru>) + +Modified pattern matching, added cache. (Tony L. Svanstrom B<tony@svanstrom.org>) + +=head1 CHANGES + +See file "Changes" in the distribution + + +=head1 CLARIFICATION + +As NetworkSolutions got most of the domains of InterNic as legacy, we +start by querying their server, as this way one whois query would be +sufficient for many domains. Starting at whois.internic.net or +whois.crsnic.net will result in always two requests in any case. + +=head1 NOTE + +Some users complained that the B<die> statements in the module make their +CGI scripts crash. Please consult the entries on B<eval> and +B<die> on L<perlfunc> about exception handling in Perl. + +=head1 COPYRIGHT + +Copyright 2000-2002 Ariel Brosh. +Copyright 2003-2003 Gabor Szabo. +Copyright 2003-2003 Corris Randall. +Copyright 2003-2003 Walery Studennikov. + +This package is free software. You may redistribute it or modify it under +the same terms as Perl itself. + +I apologize for any misunderstandings caused by the lack of a clear +licence in previous versions. + +=head1 COMMERCIAL SUPPORT + +Not available anymore. + +=head1 LEGAL + +Notice that registrars forbid querying their whois servers as a part of +a search engine, or querying for a lot of domains by script. +Also, omitting the copyright information (that was requested by users of this +module) is forbidden by the registrars. + +=head1 SEE ALSO + +L<perl(1)>, L<Net::Whois>, L<whois>. + +=cut |