#!/usr/bin/perl -w # # $Id: dnslookup.cgi,v 2.1 1997/10/22 21:18:56 skh Exp $ # # This script is a CGI interface to the domain name system. This version # of the script requires that you have the Net::DNS module from CPAN installed # and be running perl5.003 or higher. # # If you have suggestions or improvements feel free to send 'em to me. # # Kent Hamilton # Work: # Home: # URL: http://www2.hunter.com/~skh/ # $| = 0; use File::Basename; use Net::DNS; #################################### # Set your defaults here folks. #################################### $DEBUG = 0; $nameserver = "ns.hunter.com"; $lookuptype = "name_info"; $lookup = ""; $formurl = "/~skh/scripts/dnslookup.html"; $uparrowurl = "/~skh/images/up.gif"; # # Get our input from the HTML form.... # read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); foreach $pair (@pairs) { # Set this to the characters valid for your input. Try # not to use anything toooo nasty. (IE `.<>; etc) $ok_chars = "a-zA-Z0-9_\-\."; ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/<([^>]|\n)*>//g; $value =~ s///g; $value =~ s/`;/_/g; # Strip out everything not an allowed character (translate it to a '_'). $value =~ eval "tr/[$ok_chars]/_/c"; $FORM{$name} = $value; } # # Init our Resolver info. # If they entered a name server then use it. # my $res = new Net::DNS::Resolver; if ($FORM{'n_server'}) { my $nameserver = $FORM{'n_server'}; $res->nameservers($nameserver); } # # Some default values. # $lookup = $FORM{'lookup_val'}; $lookuptype = $FORM{'choice'}; $type ||= "A"; $class ||= "IN"; # # They didn't enter anything to search for so yell at 'em. # if ( $lookup eq "" ) { print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "DNS Lookup Error!\n"; print "\n"; print "\n"; print "




\n"; print "You must enter at least a name or IP address to search for.
\n"; print "



\n"; print "Return to the DNS Lookup form.\n"; print "\n"; exit; } # # Set the type of lookup to do. # Some of these get reset below but.... # if ($lookuptype eq 'name_info' ) { $type = "ANY"; $qstring = 'any information'; } elsif ($lookuptype eq 'ns_lookup') { $type = "NS"; $qstring = 'name server(s)'; } elsif ($lookuptype eq 'domain_list') { $type = "AXFR"; $qstring = 'a zone listing'; } elsif ($lookuptype eq 'soa') { $type = "SOA"; $qstring = 'the start of authority information'; } elsif ($lookuptype eq 'subnet_list') { $type = "AXFR"; $qstring = 'a subnet listing'; if ( $lookup =~ m/^\d+(\.\d+){0,3}$/ ) { $reverse = join ('.', reverse (split ('\.', $lookup ))) . '.in-addr.arpa'; $lookup = $reverse; } } elsif ($lookuptype eq 'mail_exch') { $type = "MX"; $qstring = 'the mail exchangers'; } else { $type = "ANY"; $qstring = 'any information'; } if ($DEBUG) { print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "DNS Lookup Debug!\n"; print "\n"; print "\n"; print "




\n"; print "lookup = $lookup
\n"; print "lookuptype = $lookuptype
\n"; print "nameserver = $nameserver
\n"; print "FORM('choice') = $FORM{'choice'}
\n"; print "FORM('n_server') = $FORM{'n_server'}
\n"; print "FORM('lookup_val') = $FORM{'lookup_val'}
\n"; } # # Do a zone transfer for either a forward or reverse zone. # if ($lookuptype eq "domain_list" || $lookuptype eq "subnet_list" ) { my @zone = $res->axfr($lookup, $class); if (defined(@zone) && @zone) { &html_header; &html_question($qstring, $lookup, $nameserver); print "\n"; foreach (@zone) { $_->print; print "
\n"; } &html_footer; } else { &html_header; &html_queryerr("Zone transfer failed: ", $res->errorstring); &html_footer; exit; } } else { # # This is the "anything else" case. # my $packet = $res->send($lookup, $type, $class); if (defined($packet)) { &html_header; &html_question( $qstring, $lookup, $nameserver); if (! $packet->header->aa) { print "


Non-authoritative answer

\n"; } $anscount = $packet->header->ancount; if ( $anscount gt 0 ) { flush; @answer = $packet->answer; print "

\n"; print "\n"; print ""; print "\n"; foreach $rr ( @answer ) { &print_record( $rr ); } print "
Search String"; print "Result Type"; print "Result Data"; print "
"; print "

"; } else { &html_noresponse; exit; } &html_footer; } else { &html_header; &html_queryerr("Query failed: ", $res->errorstring); &html_footer; exit; } } exit; sub html_header { print "Content-type: text/html\n\n"; print "\n\n"; print "Domain Name Server Query Results\n"; print ""; print "\n\n\n"; print "
"; print "

Domain Name Server Query Results

\n"; print "
"; print "

\n"; print ""; } sub html_footer { print "

\n

\n

\n"; print ""; print " Return to the DNS Form\n"; print "

\n\n\n"; } sub html_question { my $qstring = shift; my $lookup = shift; my $nameserver = shift; print "
\n"; print "The question you asked was:
\n"; printf "Lookup %s for %s at %s.
\n", $qstring, $lookup, $nameserver; print "


\n"; } sub html_queryerr { my $errstr = shift; my $resstr = shift; printf ""; printf "
\n"; printf "
%s %s
\n", $errstr, $resstr; printf "

\n
\n

\n"; printf ""; printf " Return to the DNS Form\n"; printf "

\n\n\n"; exit; } sub html_noresponse { print ""; print "

\n"; print "
No results were returned for this query
\n"; print "

\n
\n

\n"; print ""; print " Return to the DNS Form\n"; print "

\n\n\n"; exit; } sub print_record { my $rr = shift; if ( $rr->type eq "MX" ) { print "\n"; &print_mx($rr); print "\n"; } elsif ( $rr->type eq "SOA") { print "\n"; &print_soa($rr); print "\n"; } elsif ( $rr->type eq "NS") { print "\n"; &print_ns($rr); print "\n"; } elsif ( $rr->type eq "HINFO") { print "\n"; &print_hinfo($rr); print "\n"; } else { print "\n"; &print_any($rr); print "\n"; } } sub print_soa { my $soa = shift; printf "\n"; printf "\n"; printf ""; printf ""; printf "",$soa->mname; printf "\n"; printf ""; printf ""; printf "",$soa->rname; printf "\n"; printf ""; printf "\n"; printf "",$soa->serial; printf "\n"; printf ""; printf "\n"; printf "",$soa->refresh; printf "\n"; printf ""; printf "\n"; printf "",$soa->retry; printf "\n"; printf ""; printf "\n"; printf "",$soa->expire; printf "\n"; printf ""; printf "\n"; printf "",$soa->minimum; printf "\n"; } sub print_mx { my $mx = shift; printf "\n"; printf "\n", $mx->name; printf "\n", $mx->type; printf "\n", $mx->preference; printf "\n", $mx->exchange; printf "\n"; } sub print_ns { my $ns = shift; printf "\n"; printf "\n", $ns->name; printf "\n", $ns->type; printf "\n", $ns->nsdname; printf "\n"; } sub print_hinfo { my $hinfo = shift; printf "\n"; printf "\n", $hinfo->name; printf "\n", $hinfo->type; printf "\n", $hinfo->cpu; printf "\n", $hinfo->os; printf "\n"; } sub print_any { my $rr = shift; printf "\n"; printf "\n", $rr->name; printf "\n", $rr->type; printf "\n", $rr->rdatastr; printf "\n"; }
Authoritative Server:%s
Responsible Person:%s
Zone Serial Number:%s
Refresh Interval:%s
Retry Interval:%s
Expire Interval:%s
Minimum Time to Live:%s
%s%s%s%s
%s%s%s
%s%sCPU: %sO/S: %s
%s%s%s