1 package Net::Whois::Raw;
3 require Net::Whois::Raw::Data;
6 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $OMIT_MSG $CHECK_FAIL
7 %notfound %strip $CACHE_DIR $CACHE_TIME $USE_CNAMES
15 @EXPORT = qw( whois whois_config ); ### It's bad manners to export lots.
16 @EXPORT_OK = qw( $OMIT_MSG $CHECK_FAIL $CACHE_DIR $CACHE_TIME $USE_CNAMES $TIMEOUT);
20 ($OMIT_MSG, $CHECK_FAIL, $CACHE_DIR, $CACHE_TIME, $USE_CNAMES, $TIMEOUT) = (0) x 6;
26 ($res, $srv) = query($dom);
28 $res = _whois($dom, uc($srv));
35 my @parnames = qw(OMIT_MSG CHECK_FAIL CACHE_DIR CACHE_TIME USE_CNAMES TIMEOUT);
36 foreach my $parname (@parnames) {
37 if (exists($par->{$parname})) {
38 eval('$'.$parname.'='.int($par->{$parname}));
46 if ($dom =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
49 my @alltlds = keys %Net::Whois::Raw::Data::servers;
50 @alltlds = sort { dlen($b) <=> dlen($a) } @alltlds;
51 foreach my $awailtld (@alltlds) {
52 $awailtld = lc $awailtld;
53 if ($dom =~ /(.+?)\.($awailtld)$/) {
59 my @tokens = split(/\./, $dom);
60 $tld = uc($tokens[-1]);
66 my $cname = "$tld.whois-servers.net";
67 my $srv = $Net::Whois::Raw::Data::servers{$tld} || $cname;
68 $srv = $cname if $USE_CNAMES && gethostbyname($cname);
70 $srv eq 'whois.crsnic.net' ||
71 $srv eq 'whois.publicinterestregistry.net' ||
72 $srv eq 'whois.nic.cc' ||
75 my $res = do_whois($dom, uc($srv), $flag, [], $tld);
76 wantarray ? ($res, $srv) : $res;
80 my ($dom) = @_; # receives 4 parameters, do NOT shift
81 return _whois(@_) unless $CACHE_DIR;
82 mkdir $CACHE_DIR, 0644;
83 if (-f "$CACHE_DIR/$dom") {
84 if (open(I, "$CACHE_DIR/$dom")) {
85 my $res = join("", <I>);
91 return $res unless $res;
92 return $res unless open(O, ">$CACHE_DIR/$dom");
97 return $res unless $CACHE_TIME;
100 foreach (glob("$CACHE_DIR/*.*")) {
101 my $atime = (stat($_))[8];
102 my $elapsed = $now - $atime;
103 unlink $_ if ($elapsed / 3600 > $CACHE_TIME);
109 my ($text, $srv) = @_;
110 return $text unless $CHECK_FAIL || $OMIT_MSG;
111 *notfound = \%Net::Whois::Raw::Data::notfound;
112 *strip = \%Net::Whois::Raw::Data::strip;
114 my $notfound = $notfound{lc($srv)};
115 my @strip = $strip{lc($srv)} ? @{$strip{lc($srv)}} : ();
117 MAIN: foreach (split(/\n/, $text)) {
118 return undef if $CHECK_FAIL && $notfound && /$notfound/;
120 foreach my $re (@strip) {
121 next MAIN if (/$re/);
126 local ($_) = join("\n", @lines, "");
128 if ($CHECK_FAIL > 1) {
129 return undef unless check_existance($_);
133 s/The Data.+(policy|connection)\.\n//is;
134 s/% NOTE:.+prohibited\.//is;
135 s/Disclaimer:.+\*\*\*\n?//is;
136 s/NeuLevel,.+A DOMAIN NAME\.//is;
137 s/For information about.+page=spec//is;
138 s/NOTICE: Access to.+this policy.//is;
139 s/The previous information.+completeness\.//s;
140 s/NOTICE AND TERMS OF USE:.*modify these terms at any time\.//s;
141 s/TERMS OF USE:.*?modify these terms at any time\.//s;
142 s/NOTICE:.*expiration for this registration\.//s;
144 s/By submitting a WHOIS query.+?DOMAIN AVAILABILITY.\n?//s;
145 s/Registration and WHOIS.+?its accuracy.\n?//s;
146 s/Disclaimer:.+?\*\*\*\n?//s;
147 s/The .COOP Registration .+ Information\.//s;
148 s/Whois Server Version \d+\.\d+.//is;
149 s/NeuStar,.+www.whois.us\.//is;
150 s/\n?Domain names in the \.com, .+ detailed information.\n?//s;
151 s/\n?The Registry database .+?Registrars\.\n//s;
152 s/\n?>>> Last update of .+? <<<\n?//;
159 my ($dom, $srv, $flag, $ary, $tld) = @_;
164 local $SIG{'ALRM'} = sub { die "Connection timeout to $srv" };
165 alarm $TIMEOUT if $TIMEOUT;
166 $sock = new IO::Socket::INET("$srv:43") || die "$srv: $!";
170 my $israce = $dom =~ /ra--/ || $dom =~ /bq--/;
171 my $whoisquery = $dom;
172 if ($srv eq 'WHOIS.MELBOURNEIT.COM' && $israce) {
173 $whoisquery .= ' race';
175 #warn "$srv: $whoisquery ($OMIT_MSG, $CHECK_FAIL, $CACHE_DIR, $CACHE_TIME, $USE_CNAMES, $TIMEOUT)\n";
176 print $sock "$whoisquery\r\n";
179 my $answer = join '', @lines;
182 $state ||= (/Registrar:/);
183 if ( $state && /Whois Server:\s*([A-Za-z0-9\-_\.]+)/ ) {
184 my $newsrv = uc("$1");
185 next if (($newsrv) eq uc($srv));
186 return undef if (grep {$_ eq $newsrv} @$ary);
187 my $whois = eval { _whois($dom, $newsrv, $flag, [@$ary, $srv]) };
188 if ($@ && !$whois || $whois && !check_existance($whois)) {
193 if (/^\s+Maintainer:\s+RIPE\b/ && $tld eq 'ARPA') {
194 my $newsrv = uc($Net::Whois::Raw::Data::servers{'RIPE'});
195 next if ($newsrv eq $srv);
196 return undef if (grep {$_ eq $newsrv} @$ary);
197 my $whois = eval { _whois($dom, $newsrv, $flag, [@$ary, $srv]) };
205 my $whois = join("", @lines);
207 if ($whois =~ /To single out one record, look it up with \"xxx\",/s) {
208 my $newsrv = uc('whois.networksolutions.com');
209 return _whois($dom, $newsrv, $flag, [@{$ary||[]}, $srv]);
217 my $dotcount = $str =~ tr/././;
218 return length($str) * (1 + $dotcount);
222 sub check_existance {
226 /is unavailable/is ||
227 /No entries found for the selected source/is ||
232 !/ your query returns "NOT FOUND"/ &&
233 !/Domain not found locally/ ||
235 /No Objects Found/s ||
236 /No domain records were found/s ||
238 /No entries found in the /s ||
239 /Unable to find any information for your query/s ||
240 /is not registered and may be available for registration/s;
245 # Preloaded methods go here.
247 # Autoload methods go after =cut, and are processed by the autosplit program.
251 # Below is the stub of documentation for your module. You better edit it!
255 Net::Whois::Raw - Perl extension for unparsed raw whois information
259 use Net::Whois::Raw qw( whois );
261 $s = whois('perl.com');
262 $s = whois('funet.fi');
263 $s = whois('yahoo.co.uk');
265 ### if you do "use Net::Whois::Raw qw( whois $OMIT_MSG $CHECK_FAIL
266 ### $CACHE_DIR $CACHE_TIME $USE_CNAMES $TIMEOUT );
267 ### you can use these:
269 $OMIT_MSG = 1; # This will attempt to strip several known copyright
270 messages and disclaimers sorted by servers.
271 Default is to give the whole response.
273 $OMIT_MSG = 2; # This will try some additional stripping rules
274 if none are known for the spcific server.
276 $CHECK_FAIL = 1; # This will return undef if the response matches
277 one of the known patterns for a failed search,
279 Default is to give the textual response.
281 $CHECK_FAIL = 2; # This will match against several more rules
282 if none are known for the specific server.
284 $CACHE_DIR = "/var/spool/pwhois/"; # Whois information will be
285 cached in this directory. Default is no cache.
287 $CACHE_TIME = 24; # Cache files will be cleared after not accessed
288 for a specific number of hours. Documents will not be
289 cleared if they keep get requested for, independent
290 of disk space. Default is not to clear the cache.
292 $USE_CNAMES = 1; # Use whois-servers.net to get the whois server
293 name when possible. Default is to use the
297 $TIMEOUT = 10; # Cancel the request if connection is not made within
298 a specific number of seconds.
300 Note: as of version 0.21, extra data will be loaded only if the
301 OMIT_MSG or CHECK_FAIL flags were used, in order to reduce memory usage.
305 Net::Whois::Raw queries NetworkSolutions and follows the Registrar: answer
306 for ORG, EDU, COM and NET domains.
307 For other TLDs it uses the whois-servers.net namespace.
308 (B<$TLD>.whois-servers.net).
310 Setting the variables $OMIT_MSG and $CHECK_FAIL will match the results
311 against a set of known patterns. The first flag will try to omit the
312 copyright message/disclaimer, the second will attempt to determine if
313 the search failed and return undef in such a case.
315 B<IMPORTANT>: these checks merely use pattern matching; they will work
316 on several servers but certainly not on all of them.
318 (This features were contributed by Walery Studennikov B<despair@sama.ru>)
322 Original author Ariel Brosh, B<schop@cpan.org>,
323 Inspired by jwhois.pl available on the net.
325 Since Ariel has passed away in September 2002:
327 Past maintainers Gabor Szabo, B<gabor@perl.org.il>,
328 Corris Randall B<corris@cpan.org>
330 Current Maintainer: Walery Studennikov B<despair@cpan.org>
334 Fixed regular expression to match hyphens. (Peter Chow,
335 B<peter@interq.or.jp>)
337 Added support for Tonga TLD. (.to) (Peter Chow, B<peter@interq.or.jp>)
339 Added support for reverse lookup of IP addresses via the ARIN registry. (Alex Withers B<awithers@gonzaga.edu>)
341 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>)
343 Added the pattern matching switches, (Walery Studennikov B<despair@sama.ru>)
345 Modified pattern matching, added cache. (Tony L. Svanstrom B<tony@svanstrom.org>)
349 See file "Changes" in the distribution
354 As NetworkSolutions got most of the domains of InterNic as legacy, we
355 start by querying their server, as this way one whois query would be
356 sufficient for many domains. Starting at whois.internic.net or
357 whois.crsnic.net will result in always two requests in any case.
361 Some users complained that the B<die> statements in the module make their
362 CGI scripts crash. Please consult the entries on B<eval> and
363 B<die> on L<perlfunc> about exception handling in Perl.
367 Copyright 2000-2002 Ariel Brosh.
368 Copyright 2003-2003 Gabor Szabo.
369 Copyright 2003-2003 Corris Randall.
370 Copyright 2003-2003 Walery Studennikov.
372 This package is free software. You may redistribute it or modify it under
373 the same terms as Perl itself.
375 I apologize for any misunderstandings caused by the lack of a clear
376 licence in previous versions.
378 =head1 COMMERCIAL SUPPORT
380 Not available anymore.
384 Notice that registrars forbid querying their whois servers as a part of
385 a search engine, or querying for a lot of domains by script.
386 Also, omitting the copyright information (that was requested by users of this
387 module) is forbidden by the registrars.
391 L<perl(1)>, L<Net::Whois>, L<whois>.