dupuy@cs.columbia.edu (Alexander Dupuy) (01/25/91)
Before I go and re-invent the wheel, has anyone written something which either implements DNS resolver functionality in perl, or provides access to low-level libresolv.a routines (not just gethostby*, etc.) using the usersub extension mechanism? I know about Marion Hakanson's DNS library, but it only reads zone files, and I want to generate queries to the network. @alex -- -- inet: dupuy@cs.columbia.edu uucp: ...!rutgers!cs.columbia.edu!dupuy
marc@athena.mit.edu (Marc Horowitz) (01/29/91)
I have an implementation of DNS in perl. It's major drawback is that
I never got around to implementing routines to print the answers in
useful ways. I also have some gross kludges 'cause perl doesn't have
real multi dimensional arrays (you can't do nested foreach's
meaningfully on $foo{$a,$b}). And it should be a package. In
general, it's something I just hacked up, and never really finished.
Cleaning it up shouldn't be too hard, I don't think. It should be
better than starting from scratch. Well, here it is, whatever it's
worth. One request: If you hack on it, send me back the changes so I
can use them, too.
Marc
P.S. The test queries at the end are Hesiod queries. If you don't
know what Hesiod is, don't worry. This should work fine for normal IN
queries.
--snip--
#!/mit/watchmaker/@sys/perl
# $Id: bind.pl,v 1.3 90/06/07 02:50:06 marc Exp Locker: marc $
# hack! hack! This is to confuse the byte order stuff in arpa/nameser.h
# nothing here depends on it anyway.
sub vax {1;}
# This all probably belongs in a package. Tomorrow.
do 'sys/socket.h' || die "can\'t do sys/socket.h: $@";
do 'arpa/nameser.h' || die "can\'t do arpa/nameser.h: $@";
# who? me? kludge?
undef &vax;
# This is gross, but at least it's portable.
@qtype[&T_A] = "A";
@qtype[&T_NS] = "NS";
@qtype[&T_MD] = "MD";
@qtype[&T_MF] = "MF";
@qtype[&T_CNAME] = "CNAME";
@qtype[&T_SOA] = "SOA";
@qtype[&T_MB] = "MB";
@qtype[&T_MG] = "MG";
@qtype[&T_MR] = "MR";
@qtype[&T_NULL] = "NULL";
@qtype[&T_WKS] = "WKS";
@qtype[&T_PTR] = "PTR";
@qtype[&T_HINFO] = "HINFO";
@qtype[&T_MINFO] = "MINFO";
@qtype[&T_MX] = "MX";
@qtype[&T_TXT] = "TXT";
@qtype[&T_UINFO] = "UINFO";
@qtype[&T_UID] = "UID";
@qtype[&T_GID] = "GID";
@qtype[&T_UNSPEC] = "UNSPEC";
@qtype[&T_UNSPECA] = "UNSPECA";
@qtype[&T_AXFR] = "AXFR";
@qtype[&T_MAILB] = "MAILB";
@qtype[&T_MAILA] = "MAILA";
@qtype[&T_ANY] = "ANY";
@qclass[&C_IN] = "IN";
@qclass[&C_CHAOS] = "CHAOS";
@qclass[&C_HS] = "HS";
@qclass[&C_ANY] = "ANY";
sub qtype_strtonum {
local($num) = eval("&T_$_[0];");
if ($@ == "") {
return($num);
} else {
return(-1);
}
}
sub qclass_strtonum {
local($num) = eval("&C_$_[0];");
if ($@ == "") {
return($num);
} else {
return(-1);
}
}
sub qtype_numtostr {
local($str) = @qtype[$_[0]];
if (defined($str)) {
return($str);
} else {
return("$_[0]");
}
}
sub qclass_numtostr {
local($str) = @qclass[$_[0]];
if (defined($str)) {
return($str);
} else {
return("$_[0]");
}
}
sub res_init { # @_ = ($nameserver)
local($saddr,$port,$sin,$sock,$fd);
if ($_[0] =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
$saddr = pack("CCCC", $1, $2, $3, $4);
} else {
# $saddr = ((gethostbyname($_[0]))[4] || return(undefined));
$saddr = (gethostbyname($_[0]))[4];
}
# lossage in /etc/services. hardcode for now.
#$port = (getservbyname("nameserver","tcp"))[2];
$port = 53;
$sin = pack("S n a4 x8",&AF_INET,$port,$saddr);
socket(NS, &AF_INET, &SOCK_STREAM, &PF_UNSPEC) || die "socket: $!";
connect(NS, $sin) || die "connect: $!";
$fd = select(NS); $| = 1; # set nonbufferred
select($fd);
}
sub res_mkquery { # @_ = ($name,$type,$class,$id)
local($question);
$question = pack("n6",$_[3],0x0100,1,0,0,0); # header
$question .= &unparse_name($_[0]);
$question .= pack("n n",&qtype_strtonum($_[1]), # query
&qclass_strtonum($_[2]));
}
sub unparse_name {
local($label,$labellen,$str);
$str = "";
foreach $label (split(/\./,$_[0])) {
$labellen = length($label);
$str .= pack("Ca$labellen",$labellen,$label);
}
$str .= pack("C",0); # root octet
}
sub res_send { # @_ = ($socket,$query)
local($fd,$packet) = ($_[0],pack("n",length($_[1])).$_[1]);
print $fd $packet;
&get_response($_[0]);
}
# response format:
# [0] = id
# [1] = authoritative
# [2] = recursion available
# [3] = query name
# [4] = query class
# [5] = query type
# [6] = start of answers
# [7] = end of answers
# [8] = start of authority records
# [9] = end of authority records
# [10] = start of add'l records
# [11] = end of add'l records
# [12] ... resource records (in multiples of 5)
sub get_response { # @_ = ($socket)
local($len,$response,@resp);
read($_[0],$len,2);
read($_[0],$response,unpack("n",$len));
@ptr = ($response,0);
$header = &next_chars(12,@ptr);
($id,$bits,$qdcount,$ancount,$nscount,$adcount) = unpack("n6",$header);
$auth = ($bits >> 10) & 0x01;
$recurse = ($bits >> 8) & 0x01;
$rrs = $ancount+$nscount+$adcount;
@resp = ($id,$auth,$recurse); # [0..2]
push(@resp,&parse_name(@ptr)); # QNAME [3]
push(@resp,&qtype_numtostr(&next_netshort(@ptr))); # QTYPE [4]
push(@resp,&qclass_numtostr(&next_netshort(@ptr))); # QCLASS[5]
push(@resp,12); # [6]
push(@resp,@resp[$#resp]+5*$ancount-1); # [7]
push(@resp,@resp[$#resp]+1); # [8]
push(@resp,@resp[$#resp]+5*$nscount-1); # [9]
push(@resp,@resp[$#resp]+1); # [10]
push(@resp,@resp[$#resp]+5*$adcount-1); # [11]
for ($i = 0 ; $i < $rrs ; $i++) {
@resp = (@resp,&parse_rrbits(@ptr));
}
return(@resp);
}
sub parse_name {
local($name,$ch,$ptr,@temp) = ("",substr($_[0],$_[1],1));
while (ord($ch = substr($_[0],$_[1],1)) != 0) {
# Message compression (RFC1035 4.1.4)
if (ord($ch) >= 0xc0) {
$ptr = &next_netshort(@_) & 0x3fff;
@temp=($_[0],$ptr);
$name .= "".&parse_name(@temp);
return($name);
}
$name .= &next_str(@_).".";
}
&next_chars(1,@_); # move past \0
if ($name eq "") { $name = ".."; }
chop($name); # remove trailing "."
return($name);
}
sub parse_rrbits {
local(@rrec,$name,$rdlen);
@rrec = ();
$name = &parse_name(@_);
# if NAME is an odd number of bytes, eat an extra byte
if (($name == "") || (length($name)%1 == 1)) {&next_chars(1,$_[0]);}
@rrec = ($name); # NAME
push(@rrec,&qtype_numtostr(&next_netshort(@_))); # TYPE
push(@rrec,&qclass_numtostr(&next_netshort(@_))); # CLASS
push(@rrec,&next_netlong(@_)); # TTL (integer)
$rdlen = &next_netshort(@_);
push(@rrec,&next_chars($rdlen,@_)); # RDATA
@rrec;
}
sub next_netshort {unpack("n",&next_chars(2,@_));}
sub next_netlong {unpack("N",&next_chars(4,@_));}
# strips the first character-string from the argument, and returns it as a
# perl string
sub next_str {
local($cslen);
$cslen = unpack("C",&next_chars(1,@_));
&next_chars($cslen,@_);
}
# takes returns the first $_[0] chars at position $_[2] in string $_[1]
# and increments $_[2]
sub next_chars {
local($len,$str) = (length($_[1]),$_[1]);
$_[2] += $_[0];
substr($_[1],$_[2]-$_[0],$_[0]);
}
# ah! something coherent.
#$ns = "16.129.224.205";
$ns = "127.0.0.1";
$nsport = &res_init($ns);
@qs = ("marc.passwd","marc.filsys","marc.grplist","beeblebrox.cluster",
"zephyr.sloc");
#@qs = ("marc.filsys");
foreach $q (@qs) {
$query = &res_mkquery($q.".ns.athena.mit.edu.","ANY","ANY",0);
@response = &res_send($nsport,$query);
@answers = @response[$response[6]..$response[7]];
foreach $ans (@answers) { print "$ans\n"; }
}
--snip--