use IO::Socket;
$hostname = $ARGV[0];
$defdomain = ".oog.org"; # default domain if not present
@servers = qw(nameserver1 nameserver2 nameserver3); # name of the name
+ servers
foreach $server (@servers) {
&lookupaddress($hostname,$server); # populates %resul
+ts
}
%inv = reverse %results; # invert the result hash
if (scalar(keys %inv) > 1) { # see how many elements it has
print "There is a discrepancy between DNS servers:\n";
use Data::Dumper;
print Data::Dumper->Dump([\%results],["results"]),"\n";
}
sub lookupaddress{
my($hostname,$server) = @_;
my($qname,$rname,$header,$question,$lformat,@labels,$count);
local($position,$buf);
###
### Construct the packet header
###
$header = pack("n C2 n4",
++$id, # query id
1, # qr, opcode, aa, tc, rd fields (only rd set)
0, # rd, ra
1, # one question (qdcount)
0, # no answers (ancount)
0, # no ns records in authority section (nscount)
0); # no addtl rr's (arcount)
# if we do not have any separators in the name of the host,
# append the default domain
if (index($hostname,'.') == -1) {
$hostname .= $defdomain;
}
# construct the qname section of a packet (domain name in question
+)
for (split(/\./,$hostname)) {
$lformat .= "C a* ";
$labels[$count++]=length;
$labels[$count++]=$_;
}
###
### construct the packet question section
###
$question = pack($lformat."C n2",
@labels,
0, # end of labels
1, # qtype of A
1); # qclass of IN
###
### send the packet to the server and read the response
###
$sock = new IO::Socket::INET(PeerAddr => $server,
PeerPort => "domain",
Proto => "udp");
$sock->send($header.$question);
# we're using UDP, so we know the max packet size
$sock->recv($buf,512);
close($sock);
# get the size of the response, since we're going to have to keep
# track of where we are in the packet as we parse it (via $positio
+n)
$respsize = length($buf);
###
### unpack the header section
###
($id,
$qr_opcode_aa_tc_rd,
$rd_ra,
$qdcount,
$ancount,
$nscount,
$arcount) = unpack("n C2 n4",$buf);
if (!$ancount) {
warn "Unable to lookup data for $hostname from $server!\n";
return;
}
###
### unpack the question section
###
# question section starts 12 bytes in
($position,$qname) = &decompress(12);
($qtype,$qclass)=unpack('@'.$position.'n2',$buf);
# move us forward in the packet to end of question section
$position += 4;
###
### unpack all of the resource record sections
###
for ( ;$ancount;$ancount--){
($position,$rname) = &decompress($position);
($rtype,$rclass,$rttl,$rdlength)=
unpack('@'.$position.'n2 N n',$buf);
$position +=10;
# this next line could be changed to use a more sophisticated
# data structure, it currently picks the last rr returned
+
$results{$server}=
join('.',unpack('@'.$position.'C'.$rdlength,$buf));
$position +=$rdlength;
}
}
# handle domain information that is "compressed" as per RFC1035
# we take in the starting position of our packet parse and return
# the name we found (after dealing with the compressed format pointer)
# and the place we left off in the packet at the end of the name we fo
+und
sub decompress {
my($start) = $_[0];
my($domain,$i,$lenoct);
for ($i=$start;$i<=$respsize;) {
$lenoct=unpack('@'.$i.'C', $buf); # get the length of label
if (!$lenoct){ # 0 signals we are done with this sectio
+n
$i++;
last;
}
if ($lenoct == 192) { # we've been handed a pointer, so recurs
+e
$domain.=(&decompress((unpack('@'.$i.'n',$buf) & 1023)))[1
+];
$i+=2;
last
}
else { # otherwise, we have a plain label
$domain.=unpack('@'.++$i.'a'.$lenoct,$buf).'.';
$i += $lenoct;
}
}
return($i,$domain);
}
That looks perfect for what i need, but how would i actually set this up to print out the packet? I don't have enough networking knowledge to understand this to be honest. So if anyone can modify it for me, it would be greatly appreciated and save me ALOT of time. | 