perm filename DQUERY.FAI[S,NET]6 blob sn#854524 filedate 1988-03-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE DQUERY  A B C P PDLEN DOMRTS PDL CRLF CMDBUF TYPE CLASS NAME QTYPE QCLASS TYPNAM TYPPTR NTYNMS CLSNAM NCLNMS DQUERY TOPLEV GETCMD NOTIPA GOTTYP GOTCLS SHOWRR SHOWR1 SHOWR2 SHOWDA SH.UNK SH.A SH.MX SH.DOM SH.WKS SH.HIN GTOKEN GTOKE1 DECOUT CPOPJ DECPUT DECPU1 TXTCPY HELP
C00012 ENDMK
C⊗;
	TITLE DQUERY ;⊗ A B C P PDLEN DOMRTS PDL CRLF CMDBUF TYPE CLASS NAME QTYPE QCLASS TYPNAM TYPPTR NTYNMS CLSNAM NCLNMS DQUERY TOPLEV GETCMD NOTIPA GOTTYP GOTCLS SHOWRR SHOWR1 SHOWR2 SHOWDA SH.UNK SH.A SH.MX SH.DOM SH.WKS SH.HIN GTOKEN GTOKE1 DECOUT CPOPJ DECPUT DECPU1 TXTCPY HELP

COMMENT ⊗ History (please record changes):

13 Sep 87  JJW	Initial implementation.
04 Oct 87  JJW	Changed syntax from <type> <class> <domain> to
		<domain> <type> <class>, with defaults.
24 Nov 87  JJW	Fixed "?" code broken by 04 Oct 87 change.  Added
		domain name to output text.
28 Jan 88  JJW	Added code to handle bracketed IP addresses.
13 Mar 88  JJW  Error records now described properly.

⊗ ;end of comment

A←11		;Try not to interfere with NETWRK's ACs
B←12
C←13
P←17
PDLEN←←40

DOMRTS←←1
.INSERT NETWRK.FAI[S,NET]

PDL:	BLOCK PDLEN
CRLF:	BYTE (7)15,12
CMDBUF:	BLOCK 40
TYPE:	BLOCK 2
CLASS:	BLOCK 2
NAME:	BLOCK 40
QTYPE:	BLOCK 1
QCLASS:	BLOCK 1

TYPNAM:	-1
	ASCII/A/
	ASCII/NS/
	ASCII/MD/
	ASCII/MF/
	ASCII/CNAME/
	ASCII/SOA/
	ASCII/MB/
	ASCII/MG/
	ASCII/MR/
	ASCII/NULL/
	ASCII/WKS/
TYPPTR:	ASCII/PTR/
	ASCII/HINFO/
	ASCII/MINFO/
	ASCII/MX/
NTYNMS←←.-TYPNAM

CLSNAM:	-1
	ASCII/IN/
	ASCII/CS/
	ASCII/CH/
NCLNMS←←.-CLSNAM

DQUERY:	RESET
	MOVE P,[IOWD PDLEN,PDL]
	SETZM DVERBOSE		;Type our own error msgs
	OUTSTR [ASCIZ/Type "?" for help
/]

TOPLEV:	OUTSTR [ASCIZ/
Dquery> /]

	;Get command line, copy to CMDBUF
	MOVE B,[POINT 7,CMDBUF]
GETCMD:	INCHWL A
	CAIN A,15
	JRST GETCMD
	CAIE A,12
	CAIN A,175
	MOVEI A,0
	IDPB A,B
	JUMPN A,GETCMD
	CAMN B,[POINT 7,CMDBUF,6]
	EXIT			;Null input line to exit
	IDPB A,B		;Add two more nulls in case
	IDPB A,B		;type and class not given

	;Check for leading "?" on command line
	MOVE B,[POINT 7,CMDBUF]
	ILDB A,B
	CAIN A,"?"
	JRST HELP

	;Extract name, type and class from CMDBUF
	MOVE B,[POINT 7,CMDBUF]
	MOVE C,[POINT 7,NAME]
	PUSHJ P,GTOKEN
	SETZM TYPE
	MOVE C,[POINT 7,TYPE]
	PUSHJ P,GTOKEN
	SETZM CLASS
	MOVE C,[POINT 7,CLASS]
	PUSHJ P,GTOKEN

	;Convert bracketed IP address [a.b.c.d] to d.c.b.a.IN-ADDR.ARPA
	MOVEI 0,NAME
	PUSHJ P,HSTNBR		;Try to parse a host number
	 JRST NOTIPA		;Not an IP address
	MOVE C,[POINT 7,NAME]	;Init byte ptr for new domain name
	LDB A,[POINT 8,1,35]	;Get 4th byte
	PUSHJ P,DECPUT		;Convert it to decimal ASCII
	LDB A,[POINT 8,1,27]	;Same for 3rd byte
	PUSHJ P,DECPUT
	LDB A,[POINT 8,1,19]	;Same for 2nd byte
	PUSHJ P,DECPUT
	LDB A,[POINT 8,1,11]	;Same for 1st byte
	PUSHJ P,DECPUT
	MOVE A,[POINT 7,[ASCII/IN-ADDR.ARPA/]]
	PUSHJ P,TXTCPY		;Finish new domain name
	SKIPN A,TYPE		;Was a type specified?
	MOVE A,TYPPTR		;No, make it a PTR query
	MOVEM A,TYPE

	;See if we recognize the type and class name
NOTIPA:	MOVEI B,TY.ALL		;Default type
	SKIPE A,TYPE
	CAMN A,[ASCII/*/]
	JRST GOTTYP
	MOVSI B,-NTYNMS
	CAME A,TYPNAM(B)
	AOBJN B,.-1
	JUMPL B,GOTTYP
	OUTSTR [ASCIZ/Unrecognized type name: /]
	OUTSTR TYPE
	OUTSTR CRLF
	JRST TOPLEV

GOTTYP:	HRRZM B,QTYPE
	MOVEI B,CL.IN		;Default class
	SKIPN A,CLASS
	JRST GOTCLS
	MOVEI B,CL.ALL
	CAMN A,[ASCII/*/]
	JRST GOTCLS
	MOVSI B,-NCLNMS
	CAME A,CLSNAM(B)
	AOBJN B,.-1
	JUMPL B,GOTCLS
	OUTSTR [ASCIZ/Unrecognized class name: /]
	OUTSTR CLASS
	OUTSTR CRLF
	JRST TOPLEV

GOTCLS:	HRRZM B,QCLASS
	MOVEI 0,NAME		;Set up query
	MOVE 1,QTYPE
	MOVE 2,QCLASS
	PUSHJ P,GETDOM
	 JFCL			;Hard error
	 JFCL			;Soft error
	 JFCL			;Treat CNAME like ordinary response
SHOWRR:	OUTSTR @0		;Show domain name
	OUTCHR [" "]
	SETZ B,			;To end ASCIZ strings in A
	MOVE A,TYPNAM(1)
	OUTSTR A		;Show type
	OUTCHR [" "]
	MOVE A,CLSNAM(2)
	OUTSTR A		;Show class
	OUTCHR [" "]
	JUMPL 3,SHOWR1		;Jump if error record
	PUSHJ P,@SHOWDA(1)	;Show data
	OUTSTR CRLF
	JRST SHOWR2

SHOWR1:	HRRZ 3,3
	CAIL 3,DMENUM		;See if known error code
	JRST [	OUTSTR [ASCIZ/-- unknown error type --
/]
		JRST SHOWR2]
	OUTSTR [ASCIZ/-- /]
	OUTSTR @DMEMSG(3)
	OUTSTR [ASCIZ/ --
/]
SHOWR2:	PUSHJ P,GETDMA		;See if there's another RR
	 JRST TOPLEV		;No
	JRST SHOWRR		;Yes

SHOWDA:	SH.UNK
	SH.A			;TY.A
	SH.DOM			;TY.NS
	SH.DOM			;TY.MD (obsolete)
	SH.DOM			;TY.MF (obsolete)
	SH.DOM			;TY.CNAME
	SH.UNK			;TY.SOA
	SH.DOM			;TY.MB
	SH.DOM			;TY.MG
	SH.DOM			;TY.MR
	SH.UNK			;TY.NULL
	SH.WKS			;TY.WKS
	SH.DOM			;TY.PTR
	SH.HIN			;TY.HINFO
	SH.UNK			;TY.MINFO
	SH.MX			;TY.MX

SH.UNK:	POPJ P,

SH.A:	LDB A,[POINT 8,3,11]
	PUSHJ P,DECOUT
	OUTCHR ["."]
	LDB A,[POINT 8,3,19]
	PUSHJ P,DECOUT
	OUTCHR ["."]
	LDB A,[POINT 8,3,27]
	PUSHJ P,DECOUT
	OUTCHR ["."]
	LDB A,[POINT 8,3,35]
	JRST DECOUT

SH.MX:	MOVE A,MXPREF
	PUSHJ P,DECOUT
	OUTCHR [" "]
SH.DOM:	OUTSTR (3)
	POPJ P,

SH.WKS:	POPJ P,

SH.HIN:	OUTSTR (3)
	OUTCHR [" "]
	OUTSTR @OSNAME
	POPJ P,

;GTOKEN first skips spaces and tabs, then copies a token from command
;buffer to buffer pointed to by C.

GTOKEN:	ILDB A,B		;Get next char
	CAIE A," "
	CAIN A,11
	JRST GTOKEN		;Space or tab, skip it
GTOKE1:	CAIL A,"a"
	CAILE A,"z"
	CAIA
	SUBI A,"a"-"A"		;Uppercasify
	IDPB A,C
	JUMPE A,CPOPJ		;Return if end of token
	ILDB A,B		;Get next char
	CAIE A," "
	CAIN A,11
	MOVEI A,0		;Space or tab, end of token
	JRST GTOKE1

;Print a number in decimal on the TTY.
DECOUT:	IDIVI A,=10
	PUSH P,B
	JUMPE A,.+2
	PUSHJ P,DECOUT
	POP P,B
	ADDI B,"0"
	OUTCHR B
CPOPJ:	POPJ P,

;Append a decimal number to a string pointed to by C, followed by a ".".
DECPUT:	PUSHJ P,DECPU1
	MOVEI B,"."
	IDPB B,C
	POPJ P,

DECPU1:	IDIVI A,=10
	PUSH P,B
	JUMPE A,.+2
	PUSHJ P,DECPU1
	POP P,B
	ADDI B,"0"
	IDPB B,C
	POPJ P,

;Append a string pointed to by A to the string pointed to by C.
TXTCPY:	ILDB B,A
	IDPB B,C
	JUMPN B,TXTCPY
	POPJ P,

HELP:	OUTSTR [ASCIZ/Enter an input line of the form:  <domain name> <type> <class>
<type> can be the name of a record type, or "*" (the default) for all records.
<class> defaults to "IN" for Internet.

Type <return> to exit the program.
/]
	JRST TOPLEV

	END DQUERY