Source Code 1992 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1649 < prev next >

Wrap

Internet Message Format | 1990-12-28 | 16.7 KB

From: yukngo@obelix.gaul.csd.uwo.ca (Cheung Yukngo) Newsgroups: alt.sources Subject: A domain name library in perl Message-ID: <YUKNGO.90Aug6204914@obelix.gaul.csd.uwo.ca> Date: 6 Aug 90 19:49:14 GMT 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@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@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@keys = keys(%reply1); Xforeach $key (@keys) { X print $key, ' :', $reply1{$key}, "\n"; X} Xprint "reply 2\n"; X@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@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@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@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@QR = ("query", "response"); X@OPCODE = ("QUERY", "IQUERY", "STATUS"); X@AA = ("Non-Authoritive", "Authoritive"); X@TC = ("Not Truncated", "Truncated"); X@RD = ("Don't recurse", "Do Recurse"); X@RA = ("No recursion", "Has recursion"); X@RCODE = ("No error", "Format error", "Server Failure", "Name error", X "Not implemented", "Refused"); X@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