;XX:<CHIVES.V1.SOURCE>GTDTST.MAC.41, 13-Mar-89 15:18:29, Edit by SRA
; Fix confusion about length of MX arg block and increase the length.
;XX:<CHIVES.V1.SOURCE>GTDTST.MAC.40,  3-Jan-89 18:51:01, Edit by SRA
; Fix NAME-FOR-ADDRESS function to use "#" token to indicate octal.
;XX:<CHIVES.V1.SOURCE>GTDTST.MAC.39, 14-Sep-88 18:34:39, Edit by SRA
; Get our IP address from GTDOM% instead of GTHST%, for MRC.
;XX:<CHIVES.WORK>GTDTST.MAC.12,  6-Sep-88 23:52:26, Edit by SRA
; Add OPSYS-FOR-NAME command.
;XX:<CHIVES.WORK>GTDTST.MAC.9,  4-Sep-88 15:16:41, Edit by SRA
; Handle GD%STA returns correctly.
;XX:<CHIVES.BETA.SOURCE>GTDTST.MAC.39,  2-Sep-88 19:13:45, Edit by SRA
; Add TOGGLE and LIST commands for flag twiddling.
;XX:<CHIVES.BETA.SOURCE>GTDTST.MAC.38, 12-Aug-88 23:21:31, Edit by SRA
; Add USE command.
;XX:<CHIVES.BETA.SOURCE>GTDTST.MAC.37, 13-Apr-88 06:17:37, Edit by SRA
; Add SELECT command.
;XX:<CHIVES.BETA.SOURCE>GTDTST.MAC.36, 13-Apr-88 05:03:35, Edit by SRA
; From MKL@NIC:
;  Add ADDRESS-FOR-NAME function.  Fix setting of PRFNET.
;[XX.LCS.MIT.EDU]XX:<SRA.WORK3>GTDTST.NEW.4, 22-Sep-87 02:06:35, Edit by SRA
; Set PRFADR/PRFNET at runtime.  Use COMND% in NAME-FOR-ADDRESS parsing.
;<CHIVES.SOURCE>GTDTST.MAC.27, 16-Sep-87 11:37:59, Edit by VAF
; Add NAME-FOR-ADDRESS function. Output addresses in dotted-decimal form.
; Print error message, if available.
;<CHIVES.SOURCE>GTDTST.MAC.1, 25-Aug-87 15:54:57, Edit by VAF
; Change for BBN monitor and use C.CS.CMU.EDU as address.
;[XX.LCS.MIT.EDU]XX:<SRA.WORK2>GTDTST.MAC.8, 31-Jul-87 16:49:18, Edit by SRA
; Hacked up version of HSTTST to test GTDOM.MAC

	TITLE GTDTST -- Test GTDOM% or .GTDOM as the case may be

	SEARCH MACSYM,MONSYM,CMD
	SALL
	.DIRECTIVE FLBLST
	.TEXT "GTDTST/SAVE"
	.TEXT "/SYMSEG:PSECT:NRCOD"
	.REQUIRE SYS:MACREL,SYS:CMD
	STDAC.

IFNDEF USRMOD,<USRMOD==1>

IFN USRMOD,<
	.REQUIRE UGTDOM
	EXTERN .GTDOM
	IF1 <
		SYN GTDOM%,JGTDOM
		OPDEF UGTDOM[PUSHJ 17,.GTDOM]
		PURGE GTDOM%
		DEFINE GTDOM% <XCT XGTDOM>
	>;IF1
>;IFN USRMOD

P==17				; stack pointer

HSTNML==^D255			; maximum number of characters in host name
HSTBFL==<HSTNML/5>+1		; length of host buffer
PDLLEN==^D200			; stack length
NMXHST==^D100			; how many MX relay hosts to allow
MXARGL==.GTDRD+NMXHST		; length of .GTDMX argblock

DEFINE	ANNJE. <		;; Whether DEC likes it or not....
	..TAGF (ERJMP,)
>
DEFINE	ANJER.(%TG) <
	ERJMP	%TG
	 ..TAGF (JRST,)
%TG:!>

	EXT	<.GTDPN,.GTDMX>

IFN USRMOD,<

;; Variables, some fakes of monitor things

	.PSECT	NPVAR

MSGPAG:	BLOCK	1000

	.ENDPS

	.PSECT	NRVAR

SPIDTB::0			; Special PID table
FORKX::	0			; Fork index
FKSTA2::0			; Secondary FKSTAT
TODCLK::0			; Time of day
PRFADR::0			; Our primary address
PRFNET::0			; Net (subnet at MIT) of PRFADR
DEFADR::0			; Our default address
DEFNET::0			; Default (sub)net
GWTAB::	0			; Gateway table
NCTVT::	0			; NCT table
PDFKTB::-1			; PID fork table
LSTERR::0			; Last process error
	HSTSTS==:0		; Not relevant
	MAXGWA==:0		; Length of nonexistant gateway table

;BBN monitor versions need this, since NETNUM in ANAUNV references it.
INTCLS::EXP 4B6,4B6,4B6,4B6,6B6,6B6,7B6,7B6
	POINT 3,16,6
INTLNN::POINT 8,16,11
	POINT 8,16,11
	POINT 8,16,11
	POINT 8,16,11
	POINT 16,16,19
	POINT 16,16,19
	POINT 24,16,27
	POINT 32,16,35
INTNET::EXP 37700000000,37700000000,37700000000,37700000000
	EXP 37777600000,37777600000,37777777400,37777777777
INTHST::EXP 00077777777,00077777777,00077777777,00077777777
	EXP 00000177777,00000177777,00000000377,00000000000

MYPID:	0			; Not a monitor fakeout, just a variable
XGTDOM: UGTDOM			; Ditto

	.ENDPS

>;IFN USRMOD

	.PSECT	NRVAR
				; localish variables
HSTBUF:	BLOCK HSTBFL*<NMXHST+1>	; host name buffer (big enough for .GTDMX)
MXARGB:	BLOCK MXARGL		; argblock for MX lookup
PDL:	BLOCK PDLLEN		; stack
	CMDSTG			; CMD package storage

	.ENDPS

	.PSECT	NRCOD		; code area

KEYTAB:	NKEYS,,NKEYS		; keyword table
T	ADDRESS-FOR-NAME,.ADRNM
T	AUTHENTICATE-ADDRESS,.AUTH
T	LIST-FLAG-VALUES,.LIST
T	MX-INFO,.MX
T	NAME-FOR-ADDRESS,.NMADR
T	OPSYS-FOR-NAME,.OPSYS
T	PRIMARY-NAME-AND-ADDRESS,.PINFO
IFN USRMOD,<
T	SELECT-PID,.SELEC
>;IFN USRMOD
T	TOGGLE-FLAG,.TOGGL
IFN USRMOD,<
T	USE,.USE
>;IFN USRMOD
T	VALIDATE-NAME,.VALID
	NKEYS==.-KEYTAB-1

FLGTAB:	NFLGS,,NFLGS
T	EXACT-MATCH-ONLY,[GD%EMO]
T	LOCAL-DATA-ONLY,[GD%LDO]
T	MUST-BE-AUTHORITATIVE,[GD%MBA]
T	QCLASS-SPECIFIED,[GD%QCL]
T	RAISE-CASE,[GD%RAI]
T	RESOLVE-IN-BACKGROUND,[GD%RBK]
T	RETURN-STATUS-CODE,[GD%STA]
	NFLGS==.-FLGTAB-1

IFN USRMOD,<
USETAB:	NUSES,,NUSES
T	JSYS-MODE,[JGTDOM]
T	USER-MODE,[UGTDOM]
	NUSES==.-USETAB-1
>;IFN USRMOD

EV:	JRST	START
	JRST	START
ENTVEC==<.-EV,,EV>
	

START:	RESET%
	SETZ F,
	MOVE P,[IOWD PDLLEN,PDL]
IFN USRMOD,<
	CALL GETPID
>;IFN USRMOD
	CALL CMDINI
IFN USRMOD,<
	MOVX 1,.GTHSZ
	JGTDOM
	 EJSHLT
	MOVEM 4,PRFADR
	MOVEM 4,DEFADR
	TXNN 4,1B4
	 TXZ 4,<BYTE(8)000,377,377,377>
	TXNN 4,1B5
	 TXZ 4,<BYTE(8)000,000,377,377>
	TXZ  4,<BYTE(8)000,000,000,377>
	MOVEM 4,PRFNET
	MOVEM 4,DEFNET
>;IFN USRMOD
	DO.			; <
	  PROMPT (GTDTST>)
	  MOVEI 1,[FLDDB. .CMKEY,,KEYTAB,,,[FLDDB. .CMCFM]]
	  CALL RFIELD
	  LOAD 3,CM%FNC,(3)
	  CAIN 3,.CMCFM
	   EXIT.
	  HRRZ 2,(2)
	  CALL (2)
	  LOOP.
	ENDDO.
	MOVE 1,[.PRAST,,.FHSLF]
	MOVEI 2,[2,,0]
	MOVEI 3,1
	PRARG%
	 ERJMP .+1
	HALTF%
	JRST START

IFN USRMOD,<

	OPDEF EJSRET[JUMP 16,JSERR0##]

DEFINE	DEFPID(NAME) <
	[ASCIZ NAME],,0
	IRPC NAME,<UNBRK. "NAME">
>

BRINI.	KEYB0.,KEYB1.,KEYB2.,KEYB3.

PIDTAB:	PIDLEN,,PIDLEN
 DEFPID	RESOLVER-DEBUG
 DEFPID	[SYSTEM]RESOLVER
PIDLEN==.-1-PIDTAB

PIDBRK:	EXP	W0.,W1.,W2.,W3.
	PURGE	W0.,W1.,W2.,W3.
	PURGE	DEFPID

.SELECT:NOISE	(which resolver to talk to)
	MOVEI	T1,[FLDDB. .CMCFM,CM%SDH,,<confirm to use system PID table>,,[
		    FLDDB. .CMQST,CM%SDH,,<PID name in double quotes>,,[
		    FLDBK. .CMKEY,,PIDTAB,,,PIDBRK]]]
	CALL	RFIELD
	LOAD	T3,CM%FNC,(T3)
	CAIN	T3,.CMCFM
	 JRST	SYSRSV			; Get system resolver if confirmed
	CONFRM				; Otherwise have to handle string
	CAIE T3,.CMKEY			; Keyword?
	 SKIPA T2,[POINT 7,ATMBUF]	; No, from atom buffer
	  HLRO T2,(T2)			; Yes, from keyword table
	SKIPA
GETPID:  HRROI T2,[ASCIZ "RESOLVER-DEBUG"]
	STKVAR <<PDB,.IPCFP+1>,<PACKET,ATMBLN+2>,PIDNAM>
	MOVEM T2,PIDNAM			; Save pointer to name
	HRROI T1,2+PACKET		; Copy to packet buffer
	DMOVE T3,[EXP .IPCIW,0]		; Packet header:
	DMOVEM T3,PACKET		; get named PID from [SYSTEM]INFO
	SETZ T3,			; Append name we want
	SOUT%
	 EJSHLT
	IBP T1				; Skip over null byte
	MOVEI T1,1(T1)			; End of packet
	SUBI T1,PACKET			; Length of packet
	HRLI T1,PACKET
	MOVSM T1,.IPCFP+PDB		; Save packet descriptor
	SKIPE T1,MYPID			; Do we have a PID?
	 TDZA T2,T2			; Yes, use it
	 MOVX T2,IP%CPD			; No, create one
	MOVEM T1,.IPCFS+PDB		; Sender PID
	MOVEM T2,.IPCFL+PDB		; Flags
	SETZM .IPCFR+PDB		; Receiver is [SYSTEM]INFO
	MOVEI T1,.IPCFP+1		; How much PDB
	MOVEI T2,PDB			; Where PDB is
	MSEND%				; Send message to INFO
	 EJSRET				; Lost
	MOVE T1,.IPCFS+PDB		; Get our PID
	SKIPN MYPID			; Did we just create it?
	 MOVEM T1,MYPID			; Yeah, save it for posterity
	MOVEM T1,.IPCFR+PDB		; Is now receiver's PID
	SETZM .IPCFS+PDB		; Expecting message from INFO
	SETZM .IPCFL+PDB		; No flags
	HRLI T1,4			; How much message we expect
	HRRI T1,PACKET			; Where to put it
	MOVEM T1,.IPCFP+PDB		; Save pointer
	MOVEI T1,.IPCFP+1		; How much PDB
	MOVEI T2,PDB			; Where it is
	MRECV%				; Get answer from INFO
	 EJSRET
	LOAD T1,IP%CFE,.IPCFL+PDB	; Get error code
	IFE. T1				; Did we win?
	  MOVE T1,1+PACKET		; Yes, get resolver's PID
	  MOVEM T1,SPIDTB		; Save it
	ELSE.
	  TMSG <% [SYSTEM]INFO barfed looking for ">
	  MOVE T1,PIDNAM
	  PSOUT%
	  TMSG <"
>
	ENDIF.
	RET
	ENDSV.

SYSRSV:	SAVEAC <Q1,Q2,Q3>		; Make argblock in Qx acs
	MOVX Q1,.MURSP			; Find PID of resolver
	MOVX Q2,.SPRSV			; System PID table slot number
	DMOVE T1,[EXP 3,Q1]		; Three word argblock in Qx ACs
	MUTIL%				; Look up the PID
	 EJSRET				; Fatal error (for now, anyway)
	MOVEM Q3,SPIDTB			; Save the PID
	RET

.USE:	NOISE (version of GTDOM)
	MOVEI 1,[FLDDB. .CMKEY,,USETAB]
	CALL CFIELD			; Get new instruction to use
	HRRZ 2,(2)
	MOVE 2,(2)
	MOVEM 2,XGTDOM
	RET

>;IFN USRMOD

.TOGGL:	NOISE (flag)
	MOVEI 1,[FLDDB. .CMKEY,,FLGTAB]
	CALL CFIELD
	HRRZ 2,(2)
	XOR F,(2)
	RET

.LIST:	CONFRM
	MOVX 5,<-NFLGS,,FLGTAB+1>
	DO.
	  MOVX 1,"+"
	  MOVE 2,(5)
	  TDNN F,(2)
	   MOVX 1,"-"
	  PBOUT%
	  HLRO 1,2
	  PSOUT%
	  TMSG <
>
	  AOBJN 5,TOP.
	ENDDO.
	RET

.NMADR:	NOISE (for address)
	CALL GETADR
	CONFRM
	MOVE 5,2			; The address we want checked
	MOVEI 1,.GTHNS			; Want address to name lookup
	IOR 1,F				; Get any flags user set
	HRROI 2,HSTBUF			; Where to put the name
	MOVE 3,5			; And the address
	GTDOM%				; Do the translation
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	MOVE 4,5			; Get back the address
	TMSG <[OK]
Address: >
	CALL ADROUT
	TMSG <
Official name: >
	HRROI 1,HSTBUF
	PSOUT%
	TMSG <
>
	RET

GETADR:	SAVEAC <1,3,4,5>
	MOVEI 1,[FLDDB. .CMNUM,CM%SDH,5+5,<Dotted IP address>,,[
		 FLDDB. .CMTOK,,<-1,,[ASCIZ "#"]>]]
	SETZ 5,
	CALL RFIELD
	LOAD 3,CM%FNC,(3)
	CAIE 3,.CMNUM
	IFSKP.
	  MOVEI 4,3
	  DO.
	    SKIPL 2
	     CAILE 2,377
	      JRST BADNUM
	    IOR 5,2
	  JUMPE 4,ENDLP.
	    LSH 5,8
	    MOVEI 1,[FLDDB. .CMTOK,CM%SDH,<POINT 7,[ASCIZ "."]>]
	    CALL RFIELD
	    MOVEI 1,[FLDDB. .CMNUM,CM%SDH,5+5,<Dotted IP address>]
	    CALL RFIELD
	    SOJA 4,TOP.
	  ENDDO.
	  MOVE 2,5
	ELSE.
	  MOVEI 1,[FLDDB. .CMNUM,,4+4]
	  CALL RFIELD
	  JXN 2,<740000,,0>,BADNUM
	ENDIF.
	RET

BADNUM:	TMSG <?Invalid numeric value in address
>
	JRST CMDER1			; Handle as a parse error

;ADROUT - Print address in 4 in octal and dotted-octet form.

ADROUT:	MOVEI 1,.PRIOU
	MOVE 2,4
	MOVEI 3,^D8
	NOUT%				; First, print it in octal
	 TRN
	TMSG < (>
	MOVEI 1,.PRIOU
	MOVEI 3,^D10
	LDB 2,[POINT 8,4,^D11]		;First octet
	NOUT%
	 TRN
	MOVEI 2,"."
	BOUT%
	LDB 2,[POINT 8,4,^D19]		;Second octet
	NOUT%
	 TRN
	MOVEI 2,"."
	BOUT%
	LDB 2,[POINT 8,4,^D27]		;Third octet
	NOUT%
	 TRN
	MOVEI 2,"."
	BOUT%
	LDB 2,[POINT 8,4,^D35]		;Fourth octet
	NOUT%
	 TRN
	MOVEI 1,")"
	PBOUT%
	RET

;$FAIL - Common routine to handle GTDOM% failure. Print error and return.

$FAIL:	IFXN. F,GD%STA
	  CAIL 1,600000
	ANSKP.
	  MOVE 2,1
          TMSG <[Failed with status code]
Status code:	0>
	  MOVX 1,.PRIOU
	  MOVX 3,8
	  NOUT%
	   EJSHLT
IFN USRMOD,<
	  HLRZ 1,XGTDOM
	  CAIN 1,(JSYS)
	  IFSKP.
	    HRRZ 4,LSTERR
	  ELSE.
>;IFN USRMOD
	    MOVX 1,.FHSLF
	    GETER%
	    HRRZ 4,2
IFN USRMOD,<
	  ENDIF.
>;IFN USRMOD
	ELSE.
	  MOVE 4,1
          TMSG <[Failed]>
	ENDIF.
	TMSG <
Error code:     >
	MOVX 1,.PRIOU
	MOVE 2,4
	MOVX 3,8
	NOUT%
	 EJSHLT
	TMSG < = >
	MOVEI 1,.PRIOU
	MOVSI 2,.FHSLF
	HRR 2,4
	SETZ 3,
	ERSTR%
	 JFCL
	IFSKP.
	  TMSG <
>
	  RET
	ELSE.
	  TMSG <?
>
	  RET
	ENDIF.


.PINFO:	NOISE (for name)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTDPN
	IOR 1,F
	HRROI 2,ATMBUF
	HRROI 4,HSTBUF
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	MOVE 4,3
	TMSG <[OK]
Original name:   >
        HRROI 1,ATMBUF
        PSOUT%
        TMSG <
Canonical name:  >
        HRROI 1,HSTBUF
        PSOUT%
        TMSG <
Primary Address: >
	CALL ADROUT
	TMSG <
>
	RET


.OPSYS:	NOISE (for name)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTDOS
	IOR 1,F
	HRROI 2,ATMBUF
	HRROI 3,HSTBUF
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	MOVE 4,3
	TMSG <[OK]
Original name:   >
        HRROI 1,ATMBUF
        PSOUT%
        TMSG <
Opsys string:    >
        HRROI 1,HSTBUF
        PSOUT%
	TMSG <
>
	RET

.ADRNM:	NOISE (of host)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTHSN
	IOR 1,F
	HRROI 2,ATMBUF
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	MOVE 4,3
	TMSG <[OK]
Original name:   >
        HRROI 1,ATMBUF
        PSOUT%
        TMSG <
Primary Address: >
	CALL ADROUT
	TMSG <
>
	RET


.AUTH:	STKVAR <HSTADR>
	NOISE (host address)
	CALL GETADR
	MOVEM 2,HSTADR
	NOISE (for name)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTDAA
	IOR 1,F
	HRROI 2,ATMBUF
	MOVE  3,HSTADR
	HRROI 4,HSTBUF
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	TMSG <[OK]
>
	RET


.VALID:	NOISE (catagory)
	MOVEI 1,[FLDDB. .CMKEY,,CATTAB]
	CALL RFIELD
	HRRZ 4,(2)
	NOISE (for name)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTDVN
	IOR 1,F
	HRROI 2,ATMBUF
	MOVE  3,4
	HRROI 4,HSTBUF
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	TMSG <[OK]
Original name:   >
        HRROI 1,ATMBUF
        PSOUT%
        TMSG <
Canonical name:  >
        HRROI 1,HSTBUF
        PSOUT%
	TMSG <
>
	RET

CATTAB:	NCATS,,NCATS
T	HOST,.GTDVH
T	ZONE,.GTDVZ
NCATS==.-1-CATTAB



.MX:	NOISE (for name)
	MOVEI 1,[FLDDB. .CMTXT]
	CALL CFIELD
	MOVEI 1,.GTDMX
	IOR 1,F
	HRROI 2,ATMBUF
	HRROI 3,HSTBUF
	MOVEI 4,MXARGB
	DMOVE 5,[EXP MXARGL,HSTNML]
	MOVEM 5,MXARGB+.GTDLN
	MOVEM 6,MXARGB+.GTDBC
	GTDOM%
	 JRST $FAIL
	TXNE F,GD%STA
	 JUMPN 1,$FAIL
	MOVE 4,3
	TMSG <[OK]
Original name:   >
        HRROI 1,ATMBUF
        PSOUT%
        TMSG <
Canonical name:  >
        HRROI 1,HSTBUF
        PSOUT%
        TMSG <
Relays:
>
	MOVN 5,MXARGB+.GTDLN
	MOVSI 5,.GTDRD(5)
	DO.
	  MOVX 1,.PRIOU
	  HRRZ 2,5
	  MOVX 3,FLD(4,NO%COL)!NO%LFL!FLD(12,NO%RDX)
	  NOUT%
	   EJSHLT
	  TMSG <    >
	  MOVE 1,MXARGB+.GTDRD(5)
	  PSOUT%
	   EJSHLT
	  TMSG <
>
	  AOBJN 5,TOP.    
	ENDDO.
	RET

;; Various fake monitor routines

IFN USRMOD,<

GWYLUK::TDZA	1,1		; Find IP route (zero indicates failure)
ASGPGS::XMOVEI	1,MSGPAG	; Get page address
PDWTCK::AOS	(P)		; Skip returns
PDWTCL::			; Non-skip returns
NETCHK::
HSTHSH::
CHKIQ::
FNDNCT::
.NETNM::
RELPGS::RET			; NOPs, all

>;IFN USRMOD

...LIT:	LIT

	END <ENTVEC>