A domain name library in perl
Cheung Yukngo
yukngo at obelix.gaul.csd.uwo.ca
Tue Aug 7 05:49:14 AEST 1990
A few months ago I wrote a program called pns and posted it in
comp.lang.perl. I then realised that the program could be a lot more
useful as a library. So, this is the library version of pns. The
documentation is very bad (as usual) but you probably need to read
RFC1035 which contains all the information about domain name service
if you ask more than just IP addresses from hostnames.
Please let me know if you find a bug.
clipper at csd.uwo.ca
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# nslib.doc
# nslib.perl
#
if test -f 'nslib.doc'
then
echo shar: will not over-write existing file "'nslib.doc'"
else
echo x - 'nslib.doc'
sed 's/^X//' >'nslib.doc' << 'SHAR_EOF'
X# Copyright 1990 Khun Yee Fung <clipper at csd.uwo.ca>
X#
X# Permission to use, copy, modify, and distribute, this software and its
X# documentation for any purpose is hereby granted without fee, provided that
X# the above copyright notice appear in all copies and that both that
X# copyright notice and this permission notice appear in supporting
X# documentation, and that the name of the copyright holders be used in
X# advertising or publicity pertaining to distribution of the software with
X# specific, written prior permission, and that no fee is charged for further
X# distribution of this software, or any modifications thereof. The copyright
X# holder make no representations about the suitability of this software for
X# any purpose. It is provided "as is" without express or implied warranty.
X#
X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR
X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE,
X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
X# PERFORMANCE OF THIS SOFTWARE.
X
Xnslib is a library for Perl providing domain name client services. If
Xyou find any errors, please let me know.
X
XPlease give the name server you use in the line marked by # *** in the
Xpackage.
X
XThe library consists of three subroutines callable from the main
Xprogram. The first one is called nsinit(). This subroutine initialises
Xthe server connection. The second one is called nsend(). This should
Xbe used to shut down the server connection. The third one is called
Xnsquery().
X
Xnsinit()
X
X Parameter - optional one parameter to give the server address. The
X IP address of the server should be known by the machine you are
X using (either its IP address is in /etc/hosts or it is given by its
X IP address).
X
X Error codes:
X 255 - More than one paramter
X 254 - nsinit can't find the IP address of the server
X 253 - can't use socket
X 252 - can't use connect
X
Xnsend()
X
X shut down the server. No error code.
X
Xnsquery()
X
X Parameters: exactly two parameters
X option - the type of query required. These include
X Address - returns the IP address
X Name server - the name server for the host given
X Mail destination - no idea what this is used for
X Mail forwarder - ditto
X Canonical name - returns the canonical name for the host name given
X Zone of authority - no idea
X Mailbox - dunno
X Mail group - dunno
X Mail rename - dunno
X Null - apparently nothing
X Services - well known services provided by the host given
X Domain name - return the host name given an IP address
X Host info - CPU and OS of the host
X Mailbox info - beats me
X Mail exchange - for the mail wizard
X Text - dunno
X Transfer of zone - no idea
X Mail record - dunno
X Mail agent - no idea
X Everything - returns everything the name server knows about the host
X
X If you are more curious than me, read RFC1035 for the full
X information. I actually implemented this program using the
X information there but just too lazy to fill in the infotmation I
X never care to know. If you are interested, feel free to fill in
X the information and send me a copy too.
X
X Hostname: The second parameter. This should either be a hostname
X or a IP address, depending whether the name server is expecting a
X hostname or a IP address. If you want to know the IP address of
X tut.cis.ohio-state.edu, for example, you should give
X "tut.cis.ohio-state.edu" as the hostname. But if you want to know
X the hostname of 128.64.18.60, you should give "128.64.18.60". Yes,
X the program will reverse the IP address and add "in-addr.arpa" for
X you.
X
X Output: nsquery returns an ASSOCIATE ARRAY. So be prepared to catch
X an associative array. The possible keys for the array are the same
X as the options for nsquery with the following additional keys:
X Error - 0 if nothing is wrong. Else, error.
X 251 - parameter number is not 2
X 250 - no such option
X 1 - format error
X 2 - server failure
X 3 - name error
X 4 - not implemented
X 5 - refused
X Message - the string version of Error.
X AA - whether the answer is authoritative
X QR - what kind of query it was
X Truncation - whether the answer has been truncated or not
X Recursion desired - yes for this program
X Recursion available - whether the name server has recursion
X Address - the value of this key contains all the hosts with IP
X addresses found in the query. The hostnames will be used as keys
X to store the IP addresses.
X
X Examples:
X &nsquery('Host info', 'tut.cis.ohio-state.edu');
X &nsquery('Domain name', '129.100.11.2');
X
X
XWarning: I assume $[ to be 0. It is also the first time I used
Xpackage, I have no idea whether I used it right or wrong. You must
Xalso initialise the $server variable in nslib.perl. I don't want to
Xinclude the domain name server we use.
X
XWish list:
X 1. Some sort of documentation for the library (want to take a shot
X at this?)
X 2. Multiple queries at the same time.
X
XExample program:
X#!/u3/thesis/clipper/pl/perl
X
Xdo 'nslib.perl || die "Can't do nslib.perl";
X
Xif(&nsinit() != 0) {
X print "Can't open server\n";
X exit(1);
X}
X%reply1 = &nsquery('Host info', 'tut.cis.ohio-state.edu');
X%reply2 = &nsquery('Domain name', '129.100.11.2');
X&nsend();
Xprint "reply 1\n";
X at keys = keys(%reply1);
Xforeach $key (@keys) {
X print $key, ' :', $reply1{$key}, "\n";
X}
Xprint "reply 2\n";
X at keys = keys(%reply2);
Xforeach $key (@keys) {
X print $key, ' ', $reply2{$key}, "\n";
X}
SHAR_EOF
if test 5791 -ne "`wc -c < 'nslib.doc'`"
then
echo shar: error transmitting "'nslib.doc'" '(should have been 5791 characters)'
fi
fi
if test -f 'nslib.perl'
then
echo shar: will not over-write existing file "'nslib.perl'"
else
echo x - 'nslib.perl'
sed 's/^X//' >'nslib.perl' << 'SHAR_EOF'
X#!/u3/thesis/clipper/pl/perl
X# Copyright 1990 by Khun Yee Fung <clipper at csd.uwo.ca>
X# See nslib.doc for warranty information
X# $Source: /u3/thesis/clipper/pl/RCS/pns,v $
X# $Id: pns,v 1.3 90/05/12 16:29:58 clipper Exp $
X
Xpackage domainname;
X
X$sockaddr = 'S n a4 x8';
X$port = 53;
X%question = ('Address', 1, 'Name server', 2, 'Mail destination', 3,
X 'Mail forwarder', 4, 'Canonical name', 5, 'Zone of authority',
X 6, 'Mailbox', 7, 'Mail group', 8, 'Mail rename', 9, 'Null', 10,
X 'Services', 11, 'Domain name', 12, 'Host info', 13,
X 'Mailbox info', 14, 'Mail exchange', 15, 'Text', 16,
X 'Transfer of zone', 252, 'Mail record', 253, 'Mail agent', 254,
X 'Everything', 255);
X at question = ('', 'Address', 'Name server', 'Mail destination',
X 'Mail forwarder', 'Canonical name', 'Zone of authority',
X 'Mailbox', 'Mail group', 'Mail rename', 'Null', 'Services',
X 'Domain name', 'Host info', 'Mailbox info', 'Mail exchange',
X 'Text');
X
X at bits = (0x8000, 0x4000, 0x2000, 0x1000, 0x0800, 0x0400, 0x0200, 0x0100,
X 0x0080, 0x0040, 0x0020, 0x0010, 0x0008, 0x0004, 0x0002, 0x0001);
X$PORTS[5] = "RJE"; $PORTS[7] = "ECHO"; $PORTS[9] = "DISCARD";
X$PORTS[11] = "USERS"; $PORTS[13] = "DAYTIME"; $PORTS[17] = "QUOTE";
X$PORTS[19] = "CHARGEN"; $PORTS[20] = "FTP-DATA"; $PORTS[21] = "FTP";
X$PORTS[23] = "TELNET"; $PORTS[25] = "SMTP"; $PORTS[27] = "NSW-FE";
X$PORTS[29] = "MSG-ICP"; $PORTS[31] = "MSG-AUTH"; $PORTS[33] = "DSP";
X$PORTS[37] = "TIME"; $PORTS[39] = "RLP"; $PORTS[41] = "GRAPHICS";
X$PORTS[42] = "NAMESERVER"; $PORTS[43] = "NICNAME"; $PORTS[44] = "MPM-FLAGS";
X$PORTS[45] = "MPM"; $PORTS[46] = "MPM-SND"; $PORTS[47] = "NI-FTP";
X$PORTS[49] = "LOGIN"; $PORTS[51] = "LA-MAINT"; $PORTS[53] = "DOMAIN";
X$PORTS[55] = "ISI-GL"; $PORTS[61] = "NI-MAIL"; $PORTS[63] = "VIA-FTP";
X$PORTS[65] = "TACACS-DS"; $PORTS[67] = "BOOTPS"; $PORTS[68] = "BOOTPC";
X$PORTS[69] = "TFTP"; $PORTS[71] = "NETRJS-1"; $PORTS[72] = "NETRJS-2";
X$PORTS[73] = "NETRJS-3"; $PORTS[64] = "NETRJS-4"; $PORTS[79] = "FINGER";
X$PORTS[81] = "HOSTS-NS"; $PORTS[83] = "MIT-ML-DEV"; $PORTS[85] = "MIT-ML-DEV";
X$PORTS[89] = "SU-MIT-TG"; $PORTS[91] = "MIT-DOV"; $PORTS[93] = "DCP";
X$PORTS[95] = "SUPDUP"; $PORTS[97] = "SWIFT-RVF"; $PORTS[98] = "TACNEWS";
X$PORTS[99] = "METAGRAM"; $PORTS[101] = "HOSTNAME"; $PORTS[102] = "ISO-TSAP";
X$PORTS[103] = "X400"; $PORTS[104] = "X400-SND"; $PORTS[105] = "CSNET-NS";
X$PORTS[107] = "RTELNET"; $PORTS[109] = "POP2"; $PORTS[111] = "SUNRPC";
X$PORTS[113] = "AUTH"; $PORTS[115] = "SFTP"; $PORTS[117] = "UUCP-PATH";
X$PORTS[119] = "NNTP"; $PORTS[121] = "ERPC"; $PORTS[123] = "NTP";
X$PORTS[125] = "LOCUS-MAP"; $PORTS[127] = "LOCUS-CON"; $PORTS[129] = "PWDGEN";
X$PORTS[130] = "CISCO-FNA"; $PORTS[131] = "CISCO-TNA";
X$PORTS[132] = "CISCO-SYS"; $PORTS[133] = "STATSRV"; $PORTS[134] = "INGRES-NET";
X$PORTS[135] = "LOC-SRV"; $PORTS[136] = "PROFILE"; $PORTS[137] = "NETBIOS-NS";
X$PORTS[138] = "NETBIOS-DGM"; $PORTS[139] = "NETBIOS-SSN";
X$PORTS[140] = "EMFIS-DATA"; $PORTS[141] = "EMFIS-CNTL"; $PORTS[142] = "BL-IDM";
X
X at QR = ("query", "response");
X at OPCODE = ("QUERY", "IQUERY", "STATUS");
X at AA = ("Non-Authoritive", "Authoritive");
X at TC = ("Not Truncated", "Truncated");
X at RD = ("Don't recurse", "Do Recurse");
X at RA = ("No recursion", "Has recursion");
X at RCODE = ("No error", "Format error", "Server Failure", "Name error",
X "Not implemented", "Refused");
X at PROTOCOL = ("", "ICMP", "IGMP", "GGP", "", "ST", "TCP", "UCL", "EGP",
X "IGP", "BBN-RCC-MON", "NVP-II", "PUP", "ARGUS", "EMCON", "XNET", "CHAOS",
X "UDP", "MUX", "DCN-MEAS", "HMP", "PRM", "XNS-IDP", "TRUNK1", "TRUNK2",
X "LEAF1", "LEAF2", "RDP", "IRTP", "ISO-TP4", "NETBLT", "MFE-NSP", "MERIT-INP",
X "SEP");
X$PROTOCOL[62] = "CFTP"; $PROTOCOL[64] = "SAT-EXPAK";
X$PROTOCOL[65] = "MIT-SUBNET"; $PROTOCOL[66] = "RVD"; $PROTOCOL[67] = "IPPC";
X$PROTOCOL[69] = "SAT-MON"; $PROTOCOL[71] = "IPCV";
X$PROTOCOL[76] = "BR-SAT-MON"; $PROTOCOL[78] = "WB-MON";
X$PROTOCOL[79] = "WB-EXPAK";
X
Xsub main'nsinit {
X if ($#_ == $[) {
X $server = $_[0];
X }
X elsif ($#_ > $[) {
X return 255;
X }
X else {
X # *** Give the name server you use
X $server = 'ria';
X }
X if ($server =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
X $saddr = pack("CCCC", $1, $2, $3, $4);
X }
X elsif (!(($name, $dummy, $type, $len, $saddr) = gethostbyname($server))) {
X return 254;
X }
X
X $sin = pack($sockaddr, 2, $port, $saddr);
X
X socket(SERVER, 2, 1, 0) || return 253;
X connect(SERVER, $sin) || return 252;
X
X select(SERVER); $| = 1; select(STDOUT);
X 0;
X}
X
Xsub main'nsquery {
X undef(%reply);
X if ($#_ != 1) {
X return (("Error", 251, "Message", "parameter size should be 2"));
X }
X local($hostname) = $_[1];
X if(($question = $question{$_[0]}) eq '') {
X return (("Error", 250, "Message", "No such option"));
X }
X $len = 17;
X @names = split('\.', $hostname);
X if ($question == 12) {
X @names = reverse(@names);
X push(@names, ("in-addr", "arpa"));
X }
X foreach $arg (@names) {
X $len += 1 + length($arg);
X }
X print SERVER pack('S', $len);
X print SERVER pack('S6', 319, 256, 1, 0, 0, 0);
X foreach $arg (@names) {
X print SERVER pack('C', length($arg));
X print SERVER $arg;
X }
X print SERVER pack('C', 0);
X print SERVER pack('S2', $question, 1);
X
X read(SERVER, $len, 2);
X read(SERVER, $response, unpack('S', $len));
X @shead = unpack('S6', $response);
X $reply{'Error'} = $shead[1] & 0x000F;
X $reply{'Message'} = $RCODE[$shead[1] & 0x000F];
X $reply{'AA'} = $AA[($shead[1] & 0x0400) >> 10];
X $reply{'QR'} = $QR[($shead[1] & 0x8000) >> 15];
X $reply{'Truncation'} = $TC[($shead[1] & 0x0200) >> 9];
X $reply{'Recursion desired'} = $RD[($shead[1] & 0x0100) >> 8];
X $reply{'Recursion available'} = $RA[($shead[1] & 0x0080) >> 7];
X
X $in = 12;
X $ans = $shead[2];
X while ($ans > 0) {
X &label();
X $in += 4;
X $ans--;
X }
X
X foreach $index ((3, 4, 5)) {
X $ans = $shead[$index];
X while ($ans > 0) {
X $label = &label();
X $type = substr($response, $in, 2); $in += 8;
X $rdlength = substr($response, $in, 2); $in += 2;
X $rdata = substr($response, $in, unpack('n', $rdlength));
X &process($label);
X }
X continue {
X $ans--;
X }
X }
X %reply;
X}
X
X
Xsub label {
X $qname = "";
X $c = substr($response, $in, 1); $in++;
X $offset = $in;
X $forward = 1;
X loop: while ($c ne "\000") {
X $cc = ord($c);
X if (($cc & 0xc0) == 0xc0) {
X if ($forward) {
X $forward = 0;
X $in = $offset + 1;
X }
X $offset = ($cc - 192) * 256 + ord(substr($response, $offset, 1));
X }
X else {
X $qname = $qname . substr($response, $offset, $cc) . ".";
X $offset += $cc;
X }
X $c = substr($response, $offset, 1); $offset++;
X }
X if ($forward) {
X $in = $offset;
X }
X chop($qname);
X $qname =~ y/A-Z/a-z/;
X $qname;
X}
X
Xsub process {
X local($label) = $_[0];
X local($RR);
X $RR = unpack('S', $type);
X if ($RR == 1) {
X @host = unpack('C4', $rdata);
X if($reply{'Address'} eq '') {
X $reply{'Address'} = $label;
X }
X else {
X $reply{'Address'} = $reply{'Address'} . ' ' . $label;
X }
X $reply{$label} = "$host[0].$host[1].$host[2].$host[3]";
X $in += 4;
X }
X elsif ($RR == 6) {
X $serial = substr($response, $in, 4); $in += 4;
X $refresh = substr($response, $in, 4); $in += 4;
X $retry = substr($response, $in, 4); $in += 4;
X $expire = substr($response, $in, 4); $in += 4;
X $minimum = substr($response, $in, 4); $in += 4;
X $reply{'Zone of authority'} = &label() . " " . &label() .
X " " . unpack('N', $serial) . " " . unpack('N', $refresh) .
X " " . unpack('N', $retry) . " " . unpack('N', $expire) .
X " " . unpack('N', $minimum);
X }
X elsif ($RR == 10) {
X $in += unpack('n', $rdlength);
X $reply{'Null'} = 'Nothing';
X }
X elsif ($RR == 11) {
X $limit = $in + unpack('n', $rdlength);
X $ip = substr($response, $in, 4); $in += 4;
X $protocol = substr($response, $in, 1); $in++;
X $bitmap = substr($response, $in, $limit - $in);
X $in = $limit;
X $result = "$PROTOCOL[ord($protocol)] ";
X $result .= &ipaddr($ip) . " ";
X $result .= &protocols();
X $reply{'Services'} = $result;
X }
X elsif ($RR ==13) {
X $len = substr($response, $in, 1); $in++;
X $CPU = substr($response, $in, ord($len)); $in += ord($len);
X $len = substr($response, $in, 1); $in++;
X $OS = substr($response, $in, ord($len)); $in += ord($len);
X $reply{'Host info'} = "$CPU $OS";
X }
X elsif ($RR == 15) {
X $prefer = unpack("n", substr($response, $in, 2)); $in += 2;
X $reply{'Mail exchange'} = "$prefer" . &label();
X }
X elsif ($RR == 16) {
X $limit = $in + unpack('n', $rdlength);
X $string = '';
X while ($in < $limit) {
X $len = substr($response, $in, 1); $in++;
X $string .= substr($response, $in, ord($len)); $in += ord($len);
X }
X $reply{'Text'} = $string;
X }
X else {
X $lab = &label();
X if ($reply{$question[$RR]} eq '') {
X $reply{$question[$RR]} = $lab;
X }
X else {
X $reply{$question[$RR]} .= ' ' . $lab;
X }
X }
X}
X
Xsub ipaddr {
X local(@host) = unpack('C4', $_[0]);
X "$host[0].$host[1].$host[2].$host[3]";
X}
X
Xsub protocols {
X local($i, $j, $k, $result);
X $k = length($bitmap);
X @portsnum = unpack('n10', $bitmap);
X for ($i = 0; $i <= $k; $i++) {
X for ($j = 0; $j < 16; $j++) {
X if (($portsnum[$i] & $bits[$j]) != 0) {
X $result .= "$PORTS[$i * 16 + $j] ";
X }
X }
X }
X $result;
X}
X
Xsub main'nsend {
X close SERVER;
X}
SHAR_EOF
if test 9328 -ne "`wc -c < 'nslib.perl'`"
then
echo shar: error transmitting "'nslib.perl'" '(should have been 9328 characters)'
fi
fi
echo Done
exit 0
More information about the Alt.sources
mailing list