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