#!/usr/bin/perl -w
use strict;
print "Content-type: text/html\n\n";
print "\<HTML\>\
\<HEAD\>\
\<TITLE\>Dig\ II\<\/TITLE\>\
\<\/HEAD\>\
\<BODY\>\
\<SCRIPT\ type\=\"text\/javascript\"\ src\=\"\.\.\/\.\.\/pagetop\.js\"\>\<\/SCRIPT\>\
\<B\>Connected\:\ An\ Internet\ Encyclopedia\<\/B\>\
\<BR\>\
\<EM\>Dig\ II\<\/EM\>\<BR\>\
\<HR\>\<CENTER\>\
\<B\>Up\:\<\/B\>\
\<A\ HREF\=\"\.\.\/\.\.\/index\.htm\"\>Connected\:\ An\ Internet\ Encyclopedia\<\/A\>\<BR\>\
\<B\>Up\:\<\/B\>\
\<A\ HREF\=\"\.\.\/index\.htm\"\>Programmed\ Instruction\ Course\<\/A\>\<BR\>\
\<B\>Up\:\<\/B\>\
\<A\ HREF\=\"index\.htm\"\>Section\ 2\ \-\ Domain\ Naming\<\/A\>\<BR\>\
\<\/CENTER\>\
\<B\>Prev\:\<\/B\>\ \<A\ HREF\=\"12\.htm\"\>Dig\ I\<\/A\>\<BR\>\
\<B\>Next\:\<\/B\>\ \<A\ HREF\=\"14\.htm\"\>Zones\<\/A\>\<BR\>\
\<HR\>\<P\>\
\<H3\>Dig\ II\<\/H3\>\<P\>\
";
print "\<TITLE\>";
print "Dig\ II";
print "\<\/TITLE\>";
print "\
\
Try\ out\ Dig\ with\ the\ Web\ form\ below\.\
Use\ some\ of\ the\ demonstration\ queries\,\ and\
then\ make\ up\ some\ of\ your\ own\.\ \ Lookup\ the\ IP\ address\ of\ your\
local\ host\.\ \ Track\ how\ this\ information\ is\ obtained\ by\
disabling\ recursion\ and\ demanding\ authoritative\ answers\
\(Dig\ options\ ";
print "\<TT\>";
print "\+norecurse";
print "\<\/TT\>";
print "\ and\ ";
print "\<TT\>";
print "\+aa";
print "\<\/TT\>";
print "\)\,\ which\ renders\
caches\ effectively\ invisible\.\
";
print "\<P\>";
print "\<HR\>";
print "\
";
print "\<P\>";
print "\
Dig\,\ the\ domain\ information\ grouper\,\ is\ a\ tool\ that\ sends\ DNS\ queries\
to\ servers\ and\ prints\ the\ replies\.\ \ I\ think\ most\ network";
print "\ engineers\
find\ it\ more\ useful\ than\ ";
print "\<A\ HREF\=\"\.\.\/\.\.\/Topics\/37\.htm\"\>";
print "nslookup";
print "\<\/A\>";
print "\,\
which\ has\ now\ be\ depricated\ by\ ";
print "\<A\ HREF\=\"http\:\/\/www\.isc\.org\/\"\>";
print "ISC";
print "\<\/A\>";
print "\,\ anyway\.\
\
";
print "\<P\>";
print "\
The\ Web\ form\ below\ uses\ a\ Perl\ script\ to\ make\ DNS\ queries\.\
It\'s\ output\ is\ similar\ to\ Dig\,\ but\ not\ identical\,\ since\ it\'s\ purely\
Perl\-based\,\ so\ that\ it\ works\ on\ Windows\ systems\ that\ don\'t\ have\ Dig\.\
If\ it\ doesn\'t\ work\,\ try\ the\
";
print "\<A\ HREF\=\"http\:\/\/www\.freesoft\.org\/CIE\/Topics\/35\.htm\"\>";
print "original\ version";
print "\<\/A\>";
print "\
at\ ";
print "\<TT\>";
print "freesoft\.org";
print "\<\/TT\>";
print "\.\ Dig\ is\ available\ as\ part\ of";
print "\ the\
";
print "\<A\ HREF\=\"http\:\/\/www\.isc\.org\/isc\/bind\.html\"\>";
print "Bind";
print "\<\/A\>";
print "\ distribution\.\
\
";


use Net::DNS;

my $buffer = "";
my @pairs;
my %FORM;
my %Class;
my %Type;
my $Recursion = "";
my $AuthAnswer = "";
my @dig_cmd = ();
my $pid;

if (exists $ENV{'CONTENT_LENGTH'}) {

    # Get the input
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

    # Split the name-value pairs
    @pairs = split(/&/, $buffer);

    foreach my $pair (@pairs)
    {
        my ($name, $value) = split(/=/, $pair);

        # Un-Webify plus signs and %-encoding
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        # Stop people from using subshells to execute commands
        # Not a big deal when using sendmail, but very important
        # when using UCB mail (aka mailx).
        # $value =~ s/~!/ ~!/g; 
        # Uncomment for debugging purposes
        # print "Setting $name to $value<P>";

        $FORM{$name} = $value;
    }

} else {

    $FORM{'NAME'} = "www.freesoft.org";
    $FORM{'CLASS'} = "IN";
    $FORM{'TYPE'} = "A";
    $FORM{'RECURSION'} = "on";
    $FORM{'AAONLY'} = "off";
    $FORM{'NAMESERVER'} = "localhost";
}

$Class{'IN'} = ""; 
$Class{'ANY'} = ""; 

$Type{'A'} = "";
$Type{'ANY'} = "";
$Type{'MX'} = "";
$Type{'NS'} = "";
$Type{'SOA'} = "";
$Type{'HINFO'} = "";

$Class{$FORM{'CLASS'}}="SELECTED";
$Type{$FORM{'TYPE'}}="SELECTED";

$Recursion="CHECKED" if ("$FORM{RECURSION}" eq "on");
$AuthAnswer="CHECKED" if ("$FORM{AAONLY}" eq "on");

print "<FORM METHOD=\"POST\" ACTION=\"13.cgi\">
<TABLE>
<TR><TD><B>Domain Name:</B><TD><INPUT NAME=\"NAME\" VALUE=\"$FORM{'NAME'}\">
<TD><B>Class:</B><TD><SELECT NAME=\"CLASS\">
  <OPTION VALUE=\"IN\" $Class{'IN'}>Internet (IN)
  <OPTION VALUE=\"ANY\" $Class{'ANY'}>Any (ANY)
</SELECT>
<TR><TD><B>Nameserver:</B><TD><INPUT NAME=\"NAMESERVER\" VALUE=\"$FORM{'NAMESERVER'}\">
<TD><B>Type:</B><TD><SELECT NAME=\"TYPE\">
  <OPTION VALUE=\"A\" $Type{'A'}>Network Address (A)
  <OPTION VALUE=\"ANY\" $Type{'ANY'}>Any (ANY)
  <OPTION VALUE=\"MX\" $Type{'MX'}>Mail Exchanger (MX)
  <OPTION VALUE=\"NS\" $Type{'NS'}>Name Server (NS)
  <OPTION VALUE=\"SOA\" $Type{'SOA'}>Start of Authority (SOA)
  <OPTION VALUE=\"HINFO\" $Type{'HINFO'}>Host Information (HINFO)
</SELECT>
<TR><TD COLSPAN=4><CENTER>
  <INPUT TYPE=\"CHECKBOX\" NAME=\"RECURSION\" $Recursion><B>Recursion Enabled</B>
  <INPUT TYPE=\"CHECKBOX\" NAME=\"AAONLY\" $AuthAnswer><B>Authoritative Answer Only</A>
</CENTER>
<TR><TD COLSPAN=4><CENTER>
  <INPUT TYPE=\"SUBMIT\" VALUE=\"Query Name Server\">
</CENTER>
</TABLE>
</FORM>
<P>\n";

my $resolver = new Net::DNS::Resolver;
$resolver->nameservers($FORM{NAMESERVER});
# if you turn in debugging, you don't have to print the response
# since it prints itself
$resolver->debug(1);

push(@dig_cmd, "dig");

if ("$FORM{RECURSION}" ne "on") {
    $resolver->recurse(0);
    push(@dig_cmd, "+norecurse");
}

if ("$FORM{AAONLY}" eq "on") {
    push(@dig_cmd, "+aa");
}

push(@dig_cmd, "\@$FORM{NAMESERVER}", $FORM{NAME}, $FORM{TYPE}, $FORM{CLASS});

$| = 1;

print "<B>\$ @dig_cmd</B><P>\n";
print "<PRE>\n";

my $packet = $resolver->query($FORM{NAME}, $FORM{TYPE}, $FORM{CLASS});

print ";; query status: ", $resolver->errorstring, "\n";

print "</PRE>\n";


print "\
";
print "\<P\>\<HR\>\
\<CENTER\>\<B\>Next\:\<\/B\>\ \<A\ HREF\=\"14\.htm\"\>Zones\<\/A\>\<\/CENTER\>\<HR\>\
\<B\>Connected\:\ An\ Internet\ Encyclopedia\<\/B\>\
\<BR\>\
\<EM\>Dig\ II\<\/EM\>\
\<\/BODY\>\
\<\/HTML\>\
";