#!/usr/bin/perl -w
# Copyright © 2000, 2001, 2002 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
# Created: 14-Feb-00.

require 5;
use diagnostics;
use strict;
use Socket;

my $progname = $0;
my $version = "0.0";

my $http_proxy = 0;
#my $url_base = "http://www.networksolutions.com/cgi-bin/whois/whois/?STRING=";
my $url_base = "http://www.netsol.com/cgi-bin/whois/whois" .
#               "?SearchType=all&STRING=";
                "?SearchType=do&STRING=";


# returns three values: the HTTP response line; the document headers;
# and the document body.
#
sub get_url {
    my ( $url ) = @_;

    my($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
    if (! ($url_proto && $url_proto =~ m/^http:$/i)) {
        die "not an HTTP URL: $url\n";
    }

    $path = "" unless $path;

    my($them,$port) = split(/:/, $serverstring);
    $port = 80 unless $port;

    my $them2 = $them;
    my $port2 = $port;
    if ($http_proxy) {
        $serverstring = $http_proxy if $http_proxy;
        ($them2,$port2) = split(/:/, $serverstring);
        $port2 = 80 unless $port2;
    }

    my ($remote, $iaddr, $paddr, $proto, $line);
    $remote = $them2;
    if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
    die unless $port2;
    $iaddr   = inet_aton($remote) || die;
    $paddr   = sockaddr_in($port2, $iaddr);


    my $head = "";
    my $body = "";

    $proto   = getprotobyname('tcp');
    die  "socket: $!\n" unless socket(S, PF_INET, SOCK_STREAM, $proto);
    die "connect: $!\n" unless connect(S, $paddr);

    select(S); $| = 1; select(STDOUT);

    print S ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
             "Host: $them\r\n" .
             "User-Agent: $progname/$version\r\n" .
             "\r\n");
    my $http = <S>;

    while (<S>) {
        $head .= $_;
        last if m@^[\r\n]@;
    }
    while (<S>) {
        $body .= $_;
    }

    close S;

    $http =~ s/\r\n/\n/gm;
    $head =~ s/\r\n/\n/gm;
    $body =~ s/\r\n/\n/gm;
    return ( $http, $head, $body );
}


sub whois {
    my ($target) = @_;
    print "$target:\n";
    $target =~ s/ /\+/g;

    my ($http, $head, $body);
    my $url = "$url_base$target";
    for (my $failsafe = 20; $failsafe > 0; $failsafe--) {
      ($http, $head, $body) = get_url ($url);

      if ($http =~ m@^HTTP/1.[0-9] 200@) {
        last;
      } elsif ($http =~ m@^HTTP/1.[0-9] 30[12]@ &&
               $head =~ m@^Location:\s*(.*)$@m) {
        $url = $1;
      } else {
        print STDERR "$progname: $http\n";
        exit 1;
      }
    }

    $body =~ s@(</?PRE\b)@\n$1@igs;
    my $result = "";
    my $in_pre = 0;
    foreach (split ('\n', $body)) {
        if (m@<PRE\b@i) { $in_pre = 1; }
        elsif (m@</PRE\b@i) { $in_pre = 0; }
        elsif ($in_pre) {
            s@<[^<>]+>@@g;
            s@&lt;@<@g;
            s@&gt;@>@g;
            s@&amp;@&@g;
            1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e; #untabify
            s@^@  @;
            s@\s+$@@g;
            $result .= "$_\n";
        }
    }
    $result =~ s/^\n+//s;
    $result =~ s/\n+$//s;
    print "$result\n\n";
}

foreach (@ARGV) { whois $_; }
exit 0;