http://qs321.pair.com?node_id=44082
Category: Networking Code
Author/Contact Info mike dillon (mdillon)
Description:

works like regular whois, but will take a subdomain (or any string used as the domain part of a DNS RR for a subdomain of one of the legacy gTLDs) as input. Requires Net::DNS and Net::ParseWhois.

since Net::ParseWhois only works with the gTLDs COM, ORG, and NET, this code only works with those TLDs as well.

update: now looks up as many domains as are passed on the command line.

for example:

$ ./whois_domain.pl www.perlmonks.org www.maserith.com
Whois Server: whois.networksolutions.com

Registrar: NETWORK SOLUTIONS, INC.
Domain: PERLMONKS.ORG
Name: Blockstackers, Inc
Tag: PERLMONKS-DOM

Address:
        116 E.18th
        Holland, MI 49423

Country: US

Name Servers:
        n/a (n/a)

Contacts:
    ADMINISTRATIVE:
        Bates, Jeffrey  (JB18794)  hemos@SLASHDOT.ORG
        BlockStackers
        13268 Riley
        Holland, MI 49424
        616.994.0441
    BILLING:
        Bates, Jeffrey  (JB18794)  hemos@SLASHDOT.ORG
        BlockStackers
        13268 Riley
        Holland, MI 49424
        616.994.0441
    TECHNICAL:
        Bates, Jeffrey  (JB18794)  hemos@SLASHDOT.ORG
        BlockStackers
        13268 Riley
        Holland, MI 49424
        616.994.0441

Record created: n/a
Record updated: n/a
Record expires: n/a
============================================================================
Whois Server: whois.register.com

Registrar: REGISTER.COM, INC.
Domain: MASERITH.COM
Name: Maserith Information Systems, LLC
Tag: n/a

Address:
        Mikel Smith
        8018 SW Ashford St
        Tigard, OR 97224
        US
        Phone: 503-639-9806
        Email: granola@maserith.com

Country: US

Name Servers:
        NS1.DNSWIZ.COM (207.91.131.30)
        NS3.DNSWIZ.COM (216.119.149.100)
        NS2.DNSWIZ.COM (207.91.131.31)
        NS4.DNSWIZ.COM (216.119.149.101)

Contacts:
    ADMINISTRATIVE:
        Maserith Information Systesm LLC
        Mikel Smith
        8018 SW Ashford St
        Tigard, OR 97224
        US
        Phone: 503-639-9806
        Email: granola@maserith.com
    TECHNICAL:
        Maserith Information Systems, LLC
        Mikel Smith
        8018 SW Ashford St
        Tigard, OR 97224
        US
        Phone: 503-639-9806
        Email: granola@maserith.com
    ZONE:
        Maserith Information Systems, LLC
        Mikel Smith
        8018 SW Ashford St
        Tigard, OR 97224
        US
        Phone: 503-639-9806
        Email: granola@maserith.com

Record created: Sun, Jan 28, 1996
Record updated: Wed, Oct 18, 2000
Record expires: Mon, Jan 28, 2002

#!/usr/bin/perl -w

use strict;

use Net::DNS;

use Net::ParseWhois;

die "Usage: whois_domain.pl DOMAIN(S)\n" unless @ARGV;

while (@ARGV)
{
    my $domain = shift;

    my $soa_domain;

    FIND_SOA: {
        my $res = new Net::DNS::Resolver;

        my $q = $res->send($domain, "SOA");

        for my $sec (qw(answer authority))
        {
            my $meth = $q->can($sec) or next;

            for my $rec ($meth->($q))
            {
                next unless $rec->isa('Net::DNS::RR::SOA');
                
                $soa_domain = $rec->name;

                last FIND_SOA if $soa_domain;
            }
        }
    }

    #die "Couldn't find SOA for $domain\n" unless defined $soa_domain;
    $soa_domain ||= $domain;

    my $whois = new Net::ParseWhois::Domain($soa_domain);
    warn "Couldn't connect to Whois server$/", next unless $whois;
    warn "No Whois match for $soa_domain$/", next unless $whois->ok;

    # print out whois match
    print "Whois Server: ", $whois->whois_server, $/;
    print $/;

    print "Registrar: ", $whois->registrar, $/;
    print "Domain: ", $whois->domain, $/;
    print "Name: ", $whois->name, $/;
    print "Tag: ", $whois->tag, $/;
    print $/;

    print "Address:", $/;
    print "\t", $_, $/ for $whois->address;
    print $/;

    print "Country: ", $whois->country, $/;
    print $/;

    print "Name Servers:", $/;
    printf "\t%s (%s)$/", @$_ for @{$whois->servers};
    print $/;

    if (my $c = $whois->contacts)
    {
        print "Contacts:", $/;
        for my $t (sort keys %$c)
        {
            print " " x 4, $t, ":", $/;
            print "\t", $_, $/ for @{$c->{$t}};
        }
        print $/;
    }

    print "Record created: ", $whois->record_created, $/;
    print "Record updated: ", $whois->record_updated, $/;
    print "Record expires: ", $whois->record_expires, $/;

    print "=" x 76, $/ if @ARGV;
}

Back to Code Catacombs