Google
 

Trailing-Edge - PDP-10 Archives - bb-ev83b-bm - tcpip-sources/hstnam.mac
There are 15 other files named hstnam.mac in the archive. Click here to see a list.
	TITLE HSTNAM TOPS-20 host name lookup routines
	SUBTTL Written by Mark Crispin - December 1982/December 1987

; Copyright (C) 1982, 1983, 1984, 1985, 1986, 1987 Mark Crispin
; All rights reserved.
;
;  This software, in source and binary form, is distributed free of charge.
; The binary form of this software may be incorporated into public-domain
; software and the source may be used for reference purposes.  Copies may
; be made of the source provided this copyright notice is included.  Wholesale
; copying of the routines in this software or usage of this software in a
; proprietary product without prior permission is prohibited.

;  This module is an attempt to provide a common and consistant host name/host
; address lookup interface for all network software.  For the most part, these
; modules have been designed like jsi.  They take their arguments in AC's in a
; fairly consistant manner.  Only the documented returned value AC's are
; changed; everything else is unaffected.  Note that in a failure return the
; returned value AC's are undefined; software should not be written to assume
; any side-effects of a failure as this may change from release to release.
;
;  The only real difference from a JSYS is that since these are subroutines
; invoked by CALL and use the stack any stack references (e.g. STKVAR) must be
; made absolute prior to using the routines.  For example, assuming FOOSTR is
; a string in a STKVAR:
;  Wrong:
;	MOVE A,[POINT 7,FOOSTR]
;	CALL $xxxxx
;  Right:
;	HRROI A,FOOSTR
;	CALL $xxxxx
;
;  In addition to the individual routines for each network, there are also
; global routines allowing name/address lookups for multiple networks.  In
; general, software should be written to use the global routines rather than
; a specific network's routine if there is any possibility that software will
; ever be used for more than one network.  The additional generality gained
; costs nothing but a minor bit of discipline on the part of the programmer
; and will save future programmers much grief.
;
;  One firm rule: absolutely NO software should do host lookups without going
; through this module.  In particular, no software should be written to access
; "host tables" (e.g. SYSTEM:HOSTSn.BIN).  Any software which knows about the
; format, or depends upon existance, of host tables is guaranteed to break
; without warning.
;
;  This module tries to be "internet" (not to be confused with Internet).  In
; order to provide a means of specifying an explicit name registry, top-level
; domains prefixed with an "#" are used.  These are relative domains, not to
; be confused with Internet domains which are absolute.  Eventually, absolute
; addressing will come into being, but at present that requires considerably
; more cooperation from the various networks than is presently forthcoming.
	SUBTTL Definitions

	SEARCH MACSYM,MONSYM	; system definitions
	SALL			; suppress macro expansions
	.DIRECTIVE FLBLST	; sane listings for ASCIZ, etc.

IFNDEF HSTNML,<HSTNML==^D64>	; length of a host name (64 required minimum)
 HSTNMW==<HSTNML/5>+1		; host name length in words

; AC definitions

A=:1				; JSYS, temporary AC's
B=:2
C=:3
D=:4
P=:17				; stack pointer
; Non-standard operating system definitions

IFNDEF PUPNM%,<
	OPDEF PUPNM% [JSYS 443]

PN%NAM==:1B0
PN%FLD==:1B1
PN%OCT==:1B2
>;IFNDEF PUPNM%

IFNDEF CHANM%,<
	OPDEF CHANM% [JSYS 460]

.CHNPH==:0			; return local site primary name and number
.CHNSN==:1			; Chaosnet name to number
.CHNNS==:2			; Chaosnet number to primary name
>;IFNDEF CHANM%

IFNDEF GTDOM%,<
	OPDEF GTDOM% [JSYS 765]

GD%LDO==:1B0			; local data only (no resolve)
GD%MBA==:1B1			; must be authoritative (don't use cache)
GD%RBK==:1B6			; resolve in background
GD%EMO==:1B12			; exact match only
GD%RAI==:1B13			; uppercase output name
GD%QCL==:1B14			; query class specified
GD%STA==:1B16			; want status code in AC1 for marginal success
  .GTDX0==:0			; total success
  .GTDXN==:1			; data not found in namespace (authoritative)
  .GTDXT==:2			; timeout, any flavor
  .GTDXF==:3			; namespace is corrupt

.GTDWT==:12			; resolver wait function
.GTDPN==:14			; get primary name and IP address
.GTDMX==:15			; get MX (mail relay) data
  .GTDLN==:0			; length of argblk (inclusive)
  .GTDTC==:1			; QTYPE (ignored for .GTDMX),,QCLASS
  .GTDBC==:2			; length of output string buffer
  .GTDNM==:3			; canonicalized name on return
  .GTDRD==:4			; returned data begins here
  .GTDML==:5			; minimum length of argblock (words)
.GTDAA==:16			; authenticate address
.GTDRR==:17			; get arbitrary RR (MIT formatted RRs)
.GTDVN==:20			; validate name for arbitrary QTYPE(s)
  .GTDV0==:1B19			; lowest allowable value
  .GTDVH==:.GTDV0+1		; validate host (A,MX,WKS,HINFO)
  .GTDVZ==:.GTDV0+2		; validate zone (SOA,NS)
>;IFNDEF GTDOM%

	.PSECT CODE		; enter pure CODE PSECT
	SUBTTL Protocol-independent routines

; $GTPRO - Get host address and find protocol supported by host
; Accepts:
;	A/ host name string
;	C/ pointer to protocol list or -1 to try all supported protocols
;	CALL $GTPRO
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B,
;			protocol address in C
;
;  The protocol list is in the form:
;	[ASCIZ/protocol1/],,data1
;	[ASCIZ/protocol2/],,data2
;		...
;	[ASCIZ/protocoln/],,datan
;	0			; end of table

$GTPRO::STKVAR <HSTPTR,PROPTR>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save pointer
	SKIPG C			; user want all known protocols?
	 MOVEI C,$PRTAB		; yes, use our internal table
	DO.
	  SKIPN B,(C)		; get protocol entry
	   RET			; end of list, return failure
	  MOVEM C,PROPTR	; save since TBLUK% clobbers C
	  HLROS B		; make string pointer to name
	  MOVEI A,$PRRTS	; our known table
	  TBLUK%		; see if can find entry in table
	   ERJMP R		; strange failure
	  MOVE C,PROPTR		; get back protocol pointer
	  IFXE. B,TL%NOM!TL%AMB	; found this protocol in table?
	    HRRZ B,(A)		; yes, get pointer to routines to call
	    HLRZ B,(B)		; get string/address routine
	    MOVE A,HSTPTR	; get pointer to host name
	    CALL (B)		; see if name known under this protocol
	    IFSKP. <RETSKP>	; return success
	  ENDIF.
	  AOJA C,TOP.		; not found here, bump pointer and try again
	ENDDO.

	ENDSV.
; $GTNAM - Get name of host given its protocol
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	C/ protocol list item pointer
;	CALL $GTNAM
; Returns +1: Failed
;	  +2: Success, updated pointer in A
;
;  For compatibility with the $GTPRO call and the possible convenience of
; applications programs, a negative argument ("try all protocols") is allowed
; in C.  However, this is only valid if B is also negative ("local host")
; since different networks have different addressing conventions.  If this is
; the case, $GTNAM becomes $GTLCL.

$GTNAM::IFL. C			; caller want to try all protocols?
	  JUMPL B,$GTLCL	; yes, use $GTLCL if local host desired
	  RET			; else fail, meaningless call
	ENDIF.
	SAVEAC <C>
	STKVAR <HSTPTR,HSTNUM>
	TXC A,.LHALF		; is destination pointer's LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save pointer
	MOVEM B,HSTNUM		; save host address
	MOVEI A,$PRRTS		; table of known protocols
	HLRO B,(C)		; protocol to look up
	TBLUK%			; see if can find entry in table
	 ERJMP R		; strange failure
	JXN B,TL%NOM!TL%AMB,R	; fail if protocol not found in table?
	HRRZ C,(A)		; get pointer to routines to call
	HRRZ C,(C)		; get canonicalize,,address/string routines
	HRRZ C,(C)		; get address/string routine
	MOVE A,HSTPTR		; get pointer to host name
	MOVE B,HSTNUM
	CALLRET (C)		; see if name known under this protocol

	ENDSV.
; $GTCAN - Get canonical name for host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	C/ pointer to protocol list
;	   or -1 to try all supported protocols
;	   or 0 to try all supported protocols w/o returning an address
;	CALL $GTCAN
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B
;			if appropriate, protocol address in C

$GTCAN::SKIPN C			; user want mail validation?
	 MOVEI C,$MATAB		; yes, use internal table
	SKIPG C			; user want all known protocols?
	 MOVEI C,$PRTAB		; yes, use our internal table
	CAIN C,$MATAB		; user wants host address returned?
	 SAVEAC <B>		; no - so leave argument untouched
	STKVAR <HSTPTR,DSTPTR,PROPTR>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save pointer
	TXC B,.LHALF		; is destination LH -1?
	TXCN B,.LHALF
	 HRLI B,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM B,DSTPTR		; save pointer
	DO.
	  SKIPN B,(C)		; get protocol entry
	   RET			; end of list, return failure
	  MOVEM C,PROPTR	; save since TBLUK% clobbers C
	  HLROS B		; make string pointer to name
	  MOVEI A,$PRRTS	; our known table
	  TBLUK%		; see if can find entry in table
	   ERJMP R		; strange failure
	  IFXE. B,TL%NOM!TL%AMB	; found this protocol in table?
	    HRRZ C,(A)		; yes, get pointer to routines to call
	    HRRZ C,(C)		; get canonicalize,,address/string routines
	    HLRZ C,(C)		; get canonicalize routine
	    MOVE A,HSTPTR	; get pointer to host name
	    MOVE B,DSTPTR	; and where to stash it
	    CALL (C)		; see if name known under this protocol
	  ANSKP.
	    MOVE C,PROPTR	; get back protocol pointer for return
	    RETSKP		; return success
	  ENDIF.
	  MOVE C,PROPTR		; get back protocol pointer
	  AOJA C,TOP.		; not found here, bump pointer and try again
	ENDDO.

	ENDSV.
; $GTLCL - Get name of local host
; Accepts:
;	A/ pointer to destination host string
;	CALL $GTLCL
; Returns +1: Failed (shouldn't happen)
;	  +2: Success, with updated pointer in A
;  $GTLCL will always return a name, even if there are no networks at
; all.  This means that any software that uses host names that is
; meaningful in a non-network environment (e.g. the mailer) must
; understand the local name as a special concept independent of $GTPRO.

$GTLCL::SAVEAC <B,C,D>
	STKVAR <HSTPTR,HSTNUM>
	TXC A,.LHALF		; is destination pointer's LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save pointer
	MOVEI D,$PRTAB		; our protocol table
	DO.
	  MOVEI A,$PRRTS	; look up protocol
	  SKIPN B,(D)		; get protocol entry
	   EXIT.		; end of list
	  HLROS B		; make string pointer to name
	  TBLUK%
	   ERJMP R		; strange failure
	  JXN B,TL%NOM!TL%AMB,R	; very strange if protocol not found
	  HRRZ C,(A)		; get pointer to routines to call
	  HRRZ C,(C)		; get canonicalize,,address/string routines
	  HRRZ C,(C)		; get address/string routine
	  MOVE A,HSTPTR		; pointer to destination string
	  SETO B,		; translate local host
	  CALL (C)		; see if we're known under this protocol
	  IFSKP. <RETSKP>	; we are, return success
	  AOJA D,TOP.		; try next protocol
	ENDDO.
	MOVE A,HSTPTR		; try a hostname file
	HRROI B,[ASCIZ/SYSTEM:HOSTNAME.TXT/]
	CALL $CPFIL
	IFSKP. <RETSKP>
	MOVE A,HSTPTR		; lose, this is the last resort
	HRROI B,[ASCIZ/TOPS-20/] ; default name string
	SETZ C,			; no limit
	SOUT%			; copy the string
	 ERJMP R		; can't fail
	RETSKP

	ENDSV.
	SUBTTL Protocol-specific routines

; Tables of known protocols

; TBLUK% format table when desired naming registry is given

DEFINE DN (NAME,ADRNAM,NAMADR,CANNAM) <
 [ASCIZ/'NAME'/],,['NAMADR',,['CANNAM',,'ADRNAM']]
>;DEFINE DN

$PRRTS::NPROTS,,NPROTS
	DN Chaos,$CHSNS,$CHSSN,$CHSCA	; Chaosnet
	DN DECnet,$DECNS,$DECSN,$DECCA	; DECnet
	DN Internet,$INTNS,$INTSN,$INTCA ; Internet A/MX/WKS/HINFO (no address)
	DN MX,$MXNS,$MXSN,$MXCA		; MX Internet
	DN Pup,$PUPNS,$PUPSN,$PUPCA	; Pup Ethernet
	DN Special,$SPCNS,$SPCSN,$SPCCA	; Special external network
	DN TCP,$GTHNS,$GTHSN,$GTHCA	; TCP/IP Internet
NPROTS==<.-$PRRTS>-1

;  $PRTAB and $MATAB are default protocol tables; they differ in that the
; address returned by $MATAB is undefined -- this is used by mail and any
; other application that merely want to validate the name.
;  The tables are in the default communication order.  The Special network
; is first so it overrides any other registries  This allows use of the
; Special network to do custom delivery to a defined host, and also prevents
; lossage when some random foreign host comes up with the same name.
;  Note: you should probably set up an appropriate HIGHER-LEVEL-DOMAIN.TXT
; file in at least the MAILS: directory so that a fully-qualified domain name
; appears in local mail.

DEFINE DP (NAME) <
 [ASCIZ/'NAME'/],,0
>;DEFINE DP

$PRTAB::DP Special
	DP MX
	DP TCP
	DP Pup
	DP Chaos
	DP DECnet
	0			; terminate for $GTPRO

$MATAB::DP Special
	DP Internet
	DP Pup
	DP Chaos
	DP DECnet
	0			; terminate for $GTPRO
	SUBTTL Protocol-specific routines - Internet

; $GTHNS - Translate Internet host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $GTHNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$GTHNS::SAVEAC <C,D>
	STKVAR <HSTPTR,HSTNUM>
	TXC A,.LHALF		; is string pointer LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save host pointer
	MOVEM B,HSTNUM		; save host address
	CAME B,[-1]		; want local address?
	IFSKP.
	  MOVX A,.GTHSZ		; yes, get local address so can output
	  CALL $GTHST		;  bracketed if unnamed local host
	   RET			; not on Internet
	  JUMPN A,R		; can't have indeterminate local address!
	  MOVEM D,HSTNUM	; set new host address
	ENDIF.
	MOVX A,.GTHNS		; number to name conversion
	MOVE B,HSTPTR		; destination pointer
	MOVE C,HSTNUM		; host address
	CALL $GTHST
	IFSKP.
	ANDE. A			; must be determinate
	  MOVEM C,HSTNUM	; return host address
	  MOVE A,B		; set up byte pointer for $ARDOM
	ELSE.
	  MOVE A,HSTPTR		; name unknown, output literal
	  MOVE B,HSTNUM
	  CALL $GTHWL
	ENDIF.
	HRROI B,[ASCIZ/Internet/] ; add Internet domain
	CALL $ARDOM		; add domain, leave pointer in A
	MOVE B,HSTNUM		; and host address
	RETSKP

	ENDSV.
; $GTHSN - Translate Internet host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $GTHSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$GTHSN::SAVEAC <C,D>		; preserve these
	STKVAR <HSTPTR,<HSTSTR,HSTNMW>>
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	MOVEM B,HSTPTR		; save pointer
	SETO B,			; back pointer up by one
	ADJBP B,HSTPTR
	MOVEM B,HSTPTR		; save updated pointer
	HRROI A,HSTSTR		; now remove Internet domain
	HRROI B,[ASCIZ/Internet/]
	CALL $RRDOM
	 RET
	HRROI A,HSTSTR		; prepare to read literal
	CALL $GTHRL
	IFNSK.
	  MOVX A,.GTHSN		; translate name to number
	  HRROI B,HSTSTR	; foreign host name
	  CALL $GTHST
	   RET
	  IFN. A		; indeterminate information?
	    MOVE B,$UKHST	; yes, return unknown address
	  ELSE.
	    MOVE B,C		; get host address in proper AC
	  ENDIF.
	ENDIF.
	MOVE A,HSTPTR		; get back updated pointer
	RETSKP

	ENDSV.

$UKHST::BYTE (4) 7 (8) 0,0,0,0	; the "unknown" Internet host address
; $GTHCA - Get canonical name for Internet host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $GTHCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

$GTHCA::SAVEAC <C,D>
	STKVAR <DSTPTR,<HSTSTR,HSTNMW>>
	MOVEM B,DSTPTR		; save destination pointer
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	HRROI A,HSTSTR		; now remove Internet domain
	HRROI B,[ASCIZ/Internet/]
	CALL $RRDOM
	 RET
	HRROI A,HSTSTR		; prepare to read literal
	CALL $GTHRL
	IFSKP.
	  MOVE A,DSTPTR		; get destination pointer
	  CALL $GTHNS		; translate to name for this address
	   RET			; shouldn't ever fail
	  RETSKP
	ENDIF.
	MOVX A,.GTDPN		; get primary name function
	HRROI B,HSTSTR		; source
	MOVE D,DSTPTR		; destination
	CALL $GTHST		; go get the poop
	 RET			; failed
	IFN. A
	  MOVE A,DSTPTR		; copy to canonical name
	  HRROI B,HSTSTR
	  SETZ C,
	  SOUT%
	  MOVE B,$UKHST		; host address is the unknown host
	ELSE.
	  MOVE A,D		; return destination pointer
	  HRROI B,[ASCIZ/Internet/]
	  CALL $ARDOM
	  MOVE B,C		; and host address
	ENDIF.
	RETSKP			; success

	ENDSV.
; $GTHWL - Write host literal
; Accepts:
;	A/ destination string pointer
;	B/ host address
;	CALL $GTHRL
; Returns +1: Always, updated pointer in A

$GTHWL::SAVEAC <B,C,D>
	STKVAR <HSTNUM>
	MOVEM B,HSTNUM
	MOVEI B,"["		; start bracketed number
	IDPB B,A
	LDB B,[POINT 8,HSTNUM,11] ; get first byte
	MOVX C,^D10		; output host parts in decimal
	NOUT%			; output it
	 ERJMP R
	MOVEI D,"."		; delimiting dot
	IDPB D,A		; add delimiting dot
	LDB B,[POINT 8,HSTNUM,19] ; get next byte
	NOUT%			; output it
	 ERJMP R
	IDPB D,A		; add delimiting dot
	LDB B,[POINT 8,HSTNUM,27] ; get next byte
	NOUT%			; output it
	 ERJMP R
	IDPB D,A		; add delimiting dot
	LDB B,[POINT 8,HSTNUM,35] ; get final byte
	NOUT%			; output it
	 ERJMP R
	MOVEI D,"]"		; terminate bracketed number
	IDPB D,A
	RET

	ENDSV.
; $GTHRL - Read host literal
; Accepts:
;	A/ host string pointer
;	CALL $GTHRL
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$GTHRL::SAVEAC <C>
	STKVAR <HSTNUM>
	TXC A,.LHALF		; is destination pointer's LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	ILDB B,A		; get opening character
	CAIE B,"#"		; moby number following?
	IFSKP.
	  MOVX C,^D10		; read number in decimal
	  NIN%			; do it
	   ERJMP R		; failed
	  LDB C,A		; get terminating byte
	  JUMPN C,R		; string has non-numeric text in it
	  RETSKP		; return success
	ENDIF.
	CAIE B,"["		; bracketed host following?
	 RET			; no, fail
	SETZM HSTNUM		; clear out existing crud in number
	MOVEI C,^D10		; in decimal
	NIN%			; input number
	 ERJMP R		; failed
	JXN B,<<MASKB 0,27>>,R	; disallow if not 8-bit number
	DPB B,[POINT 8,HSTNUM,11] ; store byte
	LDB B,A			; get terminating byte
	CAIE B,"."		; proper terminator?
	 RET			; return failure
	NIN%			; input number
	 ERJMP R		; failed
	JXN B,<<MASKB 0,27>>,R ; disallow if not 8-bit number
	DPB B,[POINT 8,HSTNUM,19] ; store byte
	LDB B,A			; get terminating byte
	CAIE B,"."		; proper terminator?
	 RET			; return failure
	NIN%			; input number
	 ERJMP R		; failed
	JXN B,<<MASKB 0,27>>,R	; disallow if not 8-bit number
	DPB B,[POINT 8,HSTNUM,27] ; store byte
	LDB B,A			; get terminating byte
	CAIE B,"."		; proper terminator?
	 RET			; return failure
	NIN%			; input number
	 ERJMP R		; failed
	JXN B,<<MASKB 0,27>>,R	; disallow if not 8-bit number
	DPB B,[POINT 8,HSTNUM,35] ; store final byte
	LDB B,A			; get terminating byte
	CAIE B,"]"		; proper terminator?
	 RET			; return failure
	ILDB B,A		; make sure tied off with null
	JUMPN B,R
	MOVE B,HSTNUM		; return host address
	RETSKP			; return success

	ENDSV.
; $GTHST - Jacket into GTDOM% and GTHST% jsi
; Accepts:
;	A/ function code
;	B-D/ function arguments
;	CALL $GTHST
; Returns +1: Failed
;	  +2: Success, A/ status, updated arguments in B-D

; Control flags

$GTDOK::-1			; non-zero => OK to do GTDOM% 
$GTHOK::-1			; non-zero => OK to do GTHST%
$GTMOK::0			; non-zero => mailer, indeterminate answer OK

$GTHST::CALL $DOGTD		; try the domain system first
	IFSKP.
	  CAIN A,.GTDXN		; failure?
	   RET			; yes, return that we have lost
	  RETSKP		; otherwise say we won
	ENDIF.
	CALLRET $DOGTH		; otherwise try the host table
; $DOGTD - Jacket into GTDOM% jsys
; Accepts:
;	A/ function code
;	B-D/ function arguments
;	CALL $DOGTD
; Returns +1: Failed, no AC's clobbered
;	  +2: Success, A/ status, updated arguments in B-D

$DOGTD::SKIPN $GTDOK		; is GTDOM% OK?
	 RET			; no, always fail
	STKVAR <<ACS,4>,STAT>
	DMOVEM A,ACS
	DMOVEM C,2+ACS
	TXO A,GD%STA		; want status on failure
	GTDOM%			; do the domain thing
	IFNJE.
	  CAIE A,.GTDX0		; total success?
	   CAIN A,.GTDXN	; or total failure?
	    RETSKP		; we have a definite answer
	  SKIPN $GTMOK		; is a "maybe" OK?
	ANSKP.
	  MOVEM A,STAT		; yes, save status code
	  DMOVE A,ACS		; see if host table can help us first
	  DMOVE C,2+ACS
	  CALL $DOGTH		; well, does it?
	   MOVE A,STAT		; if not, get the status code back
	ELSE.
	  DMOVE A,ACS		; domains have failed us, restore AC's
	  DMOVE C,2+ACS		;  so we can try the host table
	  RET	
	ENDIF.
	RETSKP

	ENDSV.
; $DOGTH - Jacket into GTHST% jsys
; Accepts:
;	A/ function code
;	B-D/ function arguments
;	CALL $DOGTH
; Returns +1: Failed
;	  +2: Success, A/ .GTDX0, updated arguments in B-D

$DOGTH::STKVAR <HSTPTR,DSTPTR,HSTADR>
	SKIPE $GTHOK		; OK to do GTHST%?
	 CAIN A,.GTDMX		; and a valid GTHST% function?
	  RET			; no, always fail
	CAIN A,.GTDPN		; primary name translation?
	IFSKP.
	  GTHST%		; no, do the simple thing
	   ERJMP R
	ELSE.
	  MOVEM D,DSTPTR	; save destination pointer
	  MOVX A,.GTHSN		; translate name to number
	  GTHST%
	   ERJMP R
	  MOVEM B,HSTPTR	; updated source pointer
	  MOVEM C,HSTADR	; host address
	  MOVX A,.GTHNS		; number to name conversion
	  MOVE B,DSTPTR		; destination pointer
	  GTHST%
	  IFNJE.
	    MOVEM B,DSTPTR	; updated destination pointer
	  ELSE.
	    MOVE A,DSTPTR	; name unknown, output literal
	    MOVE B,HSTADR	; host address
	    CALL $GTHWL
	    MOVEM A,DSTPTR	; updated destination pointer
	  ENDIF.
	  MOVE B,HSTPTR		; updated source pointer
	  MOVE C,HSTADR		; host address
	  MOVE D,DSTPTR		; updated destination pointer
	ENDIF.
	MOVX A,.GTDX0		; GTHST% success is always total success
	RETSKP

	ENDSV.
; $MXNS - Translate MX host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $MXNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$MXNS::	CAMN B,[-1]		; want local address?
	IFSKP.
	  TMSG <%HSTNAM: Meaningless call to $MXNS
>				; otherwise this is totally bogus!
	  RET
	ENDIF.
	CALLRET $GTHNS		; yes, perhaps somebody might want this
; $MXSN - Translate MX host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $MXSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$MXSN::	SAVEAC <A>
	STKVAR <<HSTSTR,HSTNMW>>
	HRROI B,HSTSTR		; set up destination as dummy
	CALLRET $MXCA		; enter canonicalization routine

	ENDSV.
; $MXCA - Get canonical name for MX host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $MXCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

MXBLEN==<2*HSTNMW>+1

$MXCA::	SAVEAC <C,D>
	STKVAR <DSTPTR,HSTADR,<HSTSTR,HSTNMW>,<HSTBUF,MXBLEN>,<ARGBLK,.GTDML>>
	MOVEM B,DSTPTR		; save destination pointer
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	HRROI A,HSTSTR		; now remove Internet domain
	HRROI B,[ASCIZ/Internet/]
	CALL $RRDOM
	 RET
	ILDB A,A		; sniff at first character
	CAIE A,"#"		; looks like a literal?
	 CAIN A,"["
	  RET			; yes, can't possibly be MX then!!
	MOVX A,.GTDML		; set up length of argument block
	MOVEM A,.GTDLN+ARGBLK
	SETZM .GTDTC+ARGBLK	; no special query type/class
	MOVX A,<MXBLEN*5>-1	; get length of our buffer
	MOVEM A,.GTDBC+ARGBLK
	SETZM .GTDNM+ARGBLK	; this gets returned
	SETZM .GTDRD+ARGBLK	; so does this
	MOVX A,.GTDMX		; want MX poop
	HRROI B,HSTSTR		; source pointer
	HRROI C,HSTBUF		; destination string buffer
	MOVEI D,ARGBLK		; argument block
	CALL $GTHST
	 RET
	MOVE B,$UKHST		; return the unknown host as default address
	MOVEM B,HSTADR
	IFN. A			; have determinate information?
	  MOVE A,DSTPTR		; indeterminate, just copy the argument
	  HRROI B,HSTSTR
	  SETZ C,
	  SOUT%
	ELSE.
	  MOVE A,DSTPTR		; copy to canonical name
	  MOVE B,.GTDNM+ARGBLK	; get pointer to canonical string
	  MOVX C,HSTNML+1	; up to this many characters
	  SETZ D,		; terminate on null
	  SOUT%
	   ERJMP R		; percolate failure up to caller
	  JUMPE C,R		; string too long if exhausted
	  MOVEM A,DSTPTR	; save updated pointer
	  MOVE A,.GTDRD+ARGBLK	; get pointer to relay
	  CALL $GTHSN		; get its address
	  IFNSK.
	    MOVE A,DSTPTR	; return the correct pointer
	  ELSE.
	    MOVEM B,HSTADR	; save host address
	    SETO A,		; I hate this behavior of SOUT%
	    ADJBP A,DSTPTR
	    HRROI B,[ASCIZ/Internet/]
	    CALL $ARDOM
	  ENDIF.
	ENDIF.
	MOVE B,HSTADR
	RETSKP

	ENDSV.
; $INTNS - Translate Internet mail host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $INTNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$INTNS::TMSG <%HSTNAM: Meaningless call to $INTNS
>				; totally bogus!
	RET
; $INTSN - Translate Internet mail host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $INTSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$INTSN::TMSG <%HSTNAM: Meaningless call to $INTSN
>				; totally bogus!
	RET
; $INTCA - Get canonical name for Internet mail host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $INTCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A

MXBLEN==<2*HSTNMW>+1

$INTCA::SAVEAC <B,C,D>
	TXC A,.LHALF		; is destination pointer's LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVE C,A
	ILDB C,C		; sniff at first character
	CAIE C,"#"		; looks like a literal?
	 CAIN A,"["
	IFNSK. <CALLRET $GTHCA>	; it is, use the physical routine
	STKVAR <DSTPTR,<HSTSTR,HSTNMW>>
	MOVEM B,DSTPTR		; save destination pointer
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	HRROI A,HSTSTR		; now remove Internet domain
	HRROI B,[ASCIZ/Internet/]
	CALL $RRDOM
	 RET
	MOVX A,.GTDVN		; validate name
	HRROI B,HSTSTR		; source pointer
	MOVX C,.GTDVH		; validate host
	MOVE D,DSTPTR		; destination designator
	CALL $GTHST
	 RET
	IFN. A			; have determinate information?
	  MOVE A,DSTPTR		; indeterminate, just copy the argument
	  HRROI B,HSTSTR
	  SETZ C,
	  SOUT%
	ELSE.
	  MOVE A,D		; determinate, put Internet after name
	  HRROI B,[ASCIZ/Internet/]
	  CALL $ARDOM
	ENDIF.
	RETSKP

	ENDSV.
	SUBTTL Protocol-specific routines - DECnet

; $DECNS - Translate DECnet host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $DECNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$DECNS::SAVEAC <C>
	STKVAR <HSTPTR,HSTNUM,<NODBLK,2>>
	TXC A,.LHALF		; is string pointer LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; save destination pointer
	MOVEM B,HSTNUM		; save host "number"
	CAME B,[-1]		; want local address?
	IFSKP.
	  MOVEM A,.NDNOD+NODBLK	; set up string pointer in NODE% block
	  MOVX A,.NDGLN		; get local node name function
	  MOVEI B,NODBLK	; pointer to destination name string
	  NODE%			; get local name
	   ERJMP R		; failed
	  MOVE A,HSTPTR		; now build host "number"
	  CALL $DECSN
	   RET			; NODE%, but no DECnet apparently
	  MOVEM A,HSTPTR	; set as updated host pointer
	  MOVEM B,HSTNUM	; save host "number"
	ELSE.
	  MOVE A,HSTPTR		; get destination string pointer
	  DO.
	    SETZ C,		; prepare for byte
	    ROTC B,6		; get a SIXBIT byte
	    JUMPE C,R		; imbedded space invalid
	    ADDI C,"A"-'A'	; convert to ASCII
	    IDPB C,A		; store in returned string
	    JUMPN B,TOP.	; get next byte
	  ENDDO.
	  MOVE C,A		; tie off string
	  IDPB B,C
	  EXCH A,HSTPTR		; update pointer
	  CALL $DECVY		; try to verify
	   RET
	ENDIF.
	MOVE A,HSTPTR		; return updated pointer
	HRROI B,[ASCIZ/DECnet/]	; add DECnet domain
	CALL $ARDMH
	MOVE B,HSTNUM		; and updated "number"
	RETSKP

	ENDSV.
; $DECSN - Translate DECnet host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $DECSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$DECSN::SAVEAC <C,D>
	STKVAR <HSTPTR,HSTNUM,<HSTSTR,HSTNMW>>
	MOVEM A,HSTPTR		; save host pointer
	HRROI A,HSTSTR		; copy string so we can muck with it
	MOVE B,HSTPTR		; get back host pointer
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	MOVEM B,HSTPTR		; save pointer
	SETO B,			; back pointer up by one
	ADJBP B,HSTPTR
	MOVEM B,HSTPTR		; save updated pointer
	HRROI A,HSTSTR		; now remove DECnet domain
	HRROI B,[ASCIZ/DECnet/]
	CALL $RRDMH
	 RET
	CALL $DECVY		; try to verify
	 RET
	SETZM HSTNUM		; now build host "number"
	MOVE B,[POINT 6,HSTNUM]
	DO.
	  ILDB C,A		; get byte of name
	  CAIG C," "		; has a sixbit representation?
	   EXIT.		; no, done
	  CAIL C,"`"		; lowercase?
	   SUBI C,"a"-"A"	; yes, convert to upper case
	  SUBI C,"A"-'A'	; convert to SIXBIT
	  IDPB C,B		; stash in string
	  TLNE B,770000		; at last byte?
	   LOOP.
	ENDDO.
	MOVE A,HSTPTR		; return updated pointer
	MOVE B,HSTNUM		; and updated "number"
	RETSKP

	ENDSV.
; $DECCA - Get canonical name for DECnet host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $DECCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

$DECCA::STKVAR <HSTPTR>
	MOVEM B,HSTPTR		; save destination pointer
	CALL $DECSN		; get host address
	 RET			; fails
	MOVE A,HSTPTR		; get destination pointer
	CALL $DECNS		; translate to canonical name
	 RET			; shouldn't ever fail
	RETSKP			; success

	ENDSV.
; $DECVY - Verify DECnet node name
; Accepts:
;	A/ pointer to node name string
; Returns +1: Failed
;	  +2: Success, name validated

$DECVY::SAVEAC <A,B>
	STKVAR <<DCNFIL,40>,DCNJFN,NODPTR,<NODBLK,2>>
	MOVEM A,NODPTR		; save pointer for later
	MOVEM A,.NDNOD+NODBLK	; and in NODE% block
	MOVX A,.NDVFY		; validate node name
	MOVEI B,NODBLK
	NODE%
	 ERJMP R		; syntax invalid
	JN ND%EXM,.NDFLG+NODBLK,RSKP ; validated name
	HRROI A,DCNFIL		; syntax valid, but name not, do extra test
	HRROI B,[ASCIZ/DCN:/]
	SETZ C,
	SOUT%
	MOVE B,NODPTR
	SOUT%
	HRROI B,[ASCIZ/-TASK-DCNVFY-TEST/] ; random task name
	SOUT%
	IDPB C,A		; tie off string with null
	MOVX A,GJ%SHT		; see if we can get that name
	HRROI B,DCNFIL
	GTJFN%
	 ERJMP R		; can't get name, no DECnet or something
	MOVEM A,DCNJFN		; save JFN for later
	MOVX B,OF%RD		; open for read
	OPENF%
	IFNJE.
	  CLOSF%		; won, flush the connection
	   ERJMP .+1
	ELSE.
	  EXCH A,DCNJFN		; get back the JFN, save error code
	  RLJFN%		; free it
	   ERJMP .+1		; ignore error here
	  MOVE A,DCNJFN		; get back error code
	  CAIE A,NSPX18		; was it "No path to node"?
	   RET			; no, no such node then
	ENDIF.
	RETSKP			; return success

	ENDSV.
	SUBTTL Protocol-specific routines - Pup

; $PUPNS - Translate Pup Ethernet host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $PUPNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$PUPNS::SAVEAC <C,D>
	STKVAR <HSTPTR,<PUPHSN,2>>
	MOVEM A,HSTPTR		; save host pointer
	CAME B,[-1]		; want local address?
	IFSKP.
	  MOVX A,SIXBIT/PUPROU/	; get GETAB% index of PUPROU table
	  SYSGT%		; B/ -items,,table number
	   ERJMP R		; shouldn't happen
	  JUMPE B,R		; fail if no such table
	  HLLZ C,B		; C/ AOBJN pointer through PUPROU
	  DO.
	    HRR A,B		; table number
	    HRL A,C		; index in table
	    GETAB%		; get table entry
	     ERJMP R		; shouldn't happen
	    IFXE. A,1B0		; network inaccessible?
	      JXN A,.RHALF,ENDLP. ; no, done if have local addr on this network
	    ENDIF.
	    AOBJN C,TOP.	; try next entry
	    RET			; unable to find our host address
	  ENDDO.
	  HRLI B,1(C)		; network # is 1+<PUPROU index>
	  HRR B,A		; host # is in RH of PUPROU entry
	ENDIF.
	MOVEM B,PUPHSN		; save host address argument
	SETZM 1+PUPHSN		; don't want port info
	MOVE A,HSTPTR		; destination string
	MOVX B,PN%FLD!PN%OCT!<FLD 1,.LHALF> ; no defaults, use octal if have to
	HRRI B,PUPHSN		; pointer to host address
	PUPNM%			; call incredibly hairy Pup JSYS
	 ERJMP R		; failed
	HRROI B,[ASCIZ/Pup/]	; add Pup domain
	CALL $ARDMH
	MOVE B,PUPHSN		; return host number too in case argument -1
	RETSKP

	ENDSV.
; $PUPSN - Translate Pup Ethernet host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $PUPSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$PUPSN::SAVEAC <C,D>
	STKVAR <HSTPTR,<HSTSTR,HSTNMW>,<PUPHSN,2>>
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	MOVEM B,HSTPTR		; save pointer
	SETO B,			; back pointer up by one
	ADJBP B,HSTPTR
	MOVEM B,HSTPTR		; save updated pointer
	HRROI A,HSTSTR		; now remove Pup domain
	HRROI B,[ASCIZ/Pup/]
	CALL $RRDMH
	 RET
	MOVX B,PN%NAM!<FLD 1,.LHALF> ; lookup name, return one word
	HRRI B,PUPHSN		; pointer to host address
	PUPNM%			; call incredibly hairy Pup JSYS
	 ERJMP R		; failed
	MOVE A,HSTPTR		; return updated pointer
	MOVE B,PUPHSN		; get host address
	RETSKP

	ENDSV.
; $PUPCA - Get canonical name for Pup host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $PUPCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

$PUPCA::STKVAR <HSTPTR>
	MOVEM B,HSTPTR		; save destination pointer
	CALL $PUPSN		; get host address
	 RET			; fails
	MOVE A,HSTPTR		; get destination pointer
	CALL $PUPNS		; translate to canonical name
	 RET			; shouldn't ever fail
	RETSKP			; success

	ENDSV.
	SUBTTL Protocol-specific routines - Chaosnet

; $CHSNS - Translate Chaosnet host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $CHSNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$CHSNS::SAVEAC <C>
	STKVAR <HSTPTR,HSTNUM>
	MOVEM A,HSTPTR		; save host pointer
	MOVEM B,HSTNUM		; save host number
	CAME B,[-1]		; want local address?
	IFSKP.
	  MOVX A,.CHNPH		; return primary name/address
	  MOVE B,HSTPTR		; pointer to string
	  CHANM%
	   ERJMP R		; failed
	  MOVEM A,HSTNUM	; set returned address
	ELSE.
	  MOVX A,.CHNNS		; return name for this address
	  MOVE B,HSTPTR
	  MOVE C,HSTNUM
	  CHANM%
	   ERJMP R		; failed
	ENDIF.
	MOVE A,B		; updated pointer from CHANM% returned in B
	HRROI B,[ASCIZ/Chaos/]	; add Chaos domain
	CALL $ARDMH
	MOVE B,HSTNUM		; return host number too in case argument -1
	RETSKP

	ENDSV.
; $CHSSN - Translate Chaosnet host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $CHSSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$CHSSN::SAVEAC <C,D>
	STKVAR <HSTPTR,<HSTSTR,HSTNMW>>
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	MOVEM B,HSTPTR		; save pointer
	SETO B,			; back pointer up by one
	ADJBP B,HSTPTR
	MOVEM B,HSTPTR		; save updated pointer
	HRROI A,HSTSTR		; now remove Chaos domain
	HRROI B,[ASCIZ/Chaos/]
	CALL $RRDMH
	 RET
	MOVX A,.CHNSN		; Chaosnet name to number
	HRROI B,HSTSTR		; foreign host name
	CHANM%
	 ERJMP R
	EXCH A,B		; want pointer in A, address in B
	RETSKP

	ENDSV.
; $CHSCA - Get canonical name for Chaosnet host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $CHSCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

$CHSCA::STKVAR <HSTPTR>
	MOVEM B,HSTPTR		; save destination pointer
	CALL $CHSSN		; get host address
	 RET			; fails
	MOVE A,HSTPTR		; get destination pointer
	CALL $CHSNS		; translate to canonical name
	 RET			; shouldn't ever fail
	RETSKP			; success

	ENDSV.
	SUBTTL Protocol-specific routines - "Special" network

; $SPCNS - Translate "Special" host address to host name
; Accepts:
;	A/ pointer to destination host string
;	B/ foreign host address
;	CALL $SPCNS
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$SPCNS::SAVEAC <C,D>
	STKVAR <HSTPTR,HSTNUM,<DIRSTR,20>,TOPDIR,NAMPTR>
	MOVEM A,HSTPTR		; save host pointer
	MOVEM B,HSTNUM		; save host number
	MOVX A,.LNSSY		; get root dir name of special hosts
	HRROI B,[ASCIZ/MAILS/]	; it is called MAILS:
	HRROI C,DIRSTR		; into DIRSTR
	LNMST%
	 ERJMP R		; no such name, no specials!
	MOVX A,RC%EMO		; require exact match
	HRROI B,DIRSTR		; of directory name
	RCDIR%			; see if such a directory exists
	 ERJMP R		; bogus name, barf
	JXN A,RC%NOM,R		; if no match, no special hosts
	MOVEM C,TOPDIR		; save directory number
	HRROI A,DIRSTR		; get canonical name string for MAILS:
	MOVE B,TOPDIR
	DIRST%
	 ERJMP R		; failed
	HRROI A,DIRSTR		; get name string for directory number
	MOVE B,HSTNUM		; get back desired address
	CAME B,[-1]		; want local address?
	IFSKP.
	  MOVE B,TOPDIR		; yes, get our address
	  MOVEM B,HSTNUM	; save for value return
	ENDIF.
	DIRST%			; get the name strig
	 ERJMP R		; failed
	LDB D,A			; get terminator for later
	SETZ B,			; flush terminating brocket
	DPB B,A
	DO.
	  SETO B,		; back up pointer one byte
	  ADJBP B,A
	  MOVE A,B		; update pointer to "host name"
	  LDB C,B		; see if found terminator
	  CAIE C,"["
	   CAIN C,"<"		; if at beginning then top level
	  IFSKP.
	    CAIE C,"."		; else try to find the dot
	     LOOP.		; didn't find it
	  ENDIF.
	ENDDO.
	MOVEM B,NAMPTR		; save name pointer
	MOVE A,HSTNUM		; see if local host
	CAMN A,TOPDIR		; if not we must make sure it's a subdir
	IFSKP.
	  DPB D,B		; stuff terminator
	  ILDB D,B		; get first byte of name
	  SETZ C,		; wipe it for test
	  DPB C,B
	  MOVX A,RC%EMO		; require exact match
	  HRROI B,DIRSTR	; of directory name
	  RCDIR%		; parse the name
	   ERJMP R		; bogus name, barf
	  JXN A,RC%NOM,R	; if no match, barf
	  CAME C,TOPDIR		; is superior the MAILS: directory?
	   RET			; no, lose
	  MOVE B,NAMPTR		; put first byte back again
	  IDPB D,B
	ENDIF.
	MOVE A,HSTPTR		; copy string
	MOVE B,NAMPTR
	SETZ C,			; no limit
	SOUT%
	 ERJMP R		; percolate failure up to caller
	MOVEM A,NAMPTR		; save current pointer in case SPCDOM fails
	MOVEI B,"."		; add domain delimiter
	IDPB B,A
	MOVE B,HSTNUM		; add any higher level domain name
	CALL $ASDOM
	 MOVE A,NAMPTR		; no higher level name
	HRROI B,[ASCIZ/Special/] ; add Special domain
	CALL $ARDOM
	MOVE B,HSTNUM		; return host number too in case argument -1
	RETSKP

	ENDSV.
; $SPCSN - Translate "Special" host name to host address
; Accepts:
;	A/ pointer to host string
;	CALL $SPCSN
; Returns +1: Failed
;	  +2: Success, updated pointer in A, host address in B

$SPCSN::SAVEAC <C,D>
	STKVAR <HSTPTR,<HSTSTR,HSTNMW>,<DIRSTR,HSTNMW>,HSTNUM,NAMPTR,DOMPTR>
	MOVE B,A		; copy string so we can muck with it
	HRROI A,HSTSTR		; into HSTSTR
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	MOVEM B,HSTPTR		; save pointer
	SETO B,			; back pointer up by one
	ADJBP B,HSTPTR
	MOVEM B,HSTPTR		; save updated pointer
	HRROI A,HSTSTR		; now remove Special domain
	HRROI B,[ASCIZ/Special/]
	CALL $RRDOM
	 RET
	SETZM DOMPTR		; no follow-up domain pointer
	DO.
	  ILDB B,A		; see if there's a domain delimiter
	  CAIE B,"."
	   JUMPN B,TOP.		; not yet, keep on going
	  JUMPE B,ENDLP.	; end of string?
	  SETZ B,		; no, tie off string here then
	  DPB B,A
	  MOVEM A,DOMPTR	; remember the pointer to the domain
	ENDDO.
	MOVX A,.LNSSY		; get root dir name of special hosts
	HRROI B,[ASCIZ/MAILS/]	; it is called MAILS:
	HRROI C,DIRSTR		; into DIRSTR
	LNMST%
	 ERJMP R		; no such name, no specials!
	MOVX A,RC%EMO		; require exact match
	HRROI B,DIRSTR		; of directory name
	RCDIR%			; see if such a directory exists
	 ERJMP R		; bogus name, barf
	JXN A,RC%NOM,R		; if no match, no special hosts
	MOVEM C,HSTNUM		; save directory number
	HRROI A,DIRSTR		; get canonical name string for MAILS:
	MOVE B,HSTNUM
	DIRST%
	 ERJMP R		; failed
	MOVEM A,NAMPTR		; save pointer for later
	LDB D,NAMPTR		; get terminator for later
	SETZ B,			; flush terminating brocket
	DPB B,NAMPTR
	DO.
	  SETO B,		; back up pointer one byte
	  ADJBP B,A
	  MOVE A,B		; update pointer to "host name"
	  LDB C,B		; see if found terminator
	  CAIE C,"["
	   CAIN C,"<"		; if at beginning then top level
	  IFSKP.
	    CAIE C,"."		; else try to find the dot
	     LOOP.		; didn't find it
	  ENDIF.
	ENDDO.
	HRROI B,HSTSTR		; see if it matches top directory
	STCMP%
	 ERJMP R
	IFN. A
	  MOVX B,"."		; it didn't, patch in subdir delimeter
	  DPB B,NAMPTR
	  MOVE A,NAMPTR
	  HRROI B,HSTSTR	; now patch in host name
	  SETZ C,
	  SOUT%
	  IDPB D,A		; add on directory delimiter
	  IDPB C,A		; and tie off with null
	  MOVX A,RC%EMO		; require exact match
	  HRROI B,DIRSTR	; of directory name
	  RCDIR%		; see if such a directory exists
	   ERJMP R		; bogus name, barf
	  JXN A,RC%NOM,R	; if no match, no such special host
	  MOVEM C,HSTNUM	; directory number of the "host"
	ENDIF.
	SKIPN DOMPTR		; did user give a domain?
	IFSKP.
	  HRROI A,DIRSTR	; yeah, one last check, get the
	  MOVE B,HSTNUM		;  correct higher-level name
	  CALL $ASDOM
	   RET			; there isn't any for this host!
	  MOVE A,DOMPTR		; compare user's string
	  HRROI B,DIRSTR	; with correct string
	  STCMP%
	   ERJMP R
	  JUMPN A,R		; fail if no match
	ENDIF.
	MOVE A,HSTPTR		; return updated pointer
	MOVE B,HSTNUM		; and "host number"
	RETSKP

	ENDSV.
; $SPCCA - Get canonical name for Special network host
; Accepts:
;	A/ host name string
;	B/ destination host name string
;	CALL $SPCCA
; Returns +1: Failed
;	  +2: Success, updated destination pointer in A, host address in B

$SPCCA::STKVAR <HSTPTR>
	MOVEM B,HSTPTR		; save destination pointer
	CALL $SPCSN		; get host address
	 RET			; fails
	MOVE A,HSTPTR		; get destination pointer
	CALL $SPCNS		; translate to canonical name
	 RET			; shouldn't ever fail
	RETSKP			; success

	ENDSV.
; $ASDOM - Copy higher-level domain name for Special network
; Accepts:
;	A/ pointer to destination string
;	B/ directory number
; Returns +1: No higher level name exists
;	  +2: Success, updated pointer in A

$ASDOM::SAVEAC <B,C>
	STKVAR <DSTPTR,<DOMTXT,HSTNMW>>
	MOVEM A,DSTPTR		; save destination pointer
	HRROI A,DOMTXT		; get directory name
	DIRST%
	 ERJMP R		; ??
	HRROI B,[ASCIZ/HIGHER-LEVEL-DOMAIN.TXT/]
	SETZ C,			; tack on file name
	SOUT%
	MOVE A,DSTPTR		; get destination again
	HRROI B,DOMTXT		; now copy file
	CALLRET $CPFIL

	ENDSV.
	SUBTTL Local domain management routines

; $ADDOM - Add top-level domain name
; Accepts:
;	A/ pointer to host string
;	B/ pointer to domain name string
;	CALL $ADDOM
; Returns +1: Always, updated pointer in A

$ADDOM::SAVEAC <B,C>
	MOVEI C,"."		; add domain delimiter
	IDPB C,A
	SETZ C,			; no limit
	SOUT%
	RET
; $RMDOM - Remove top-level domain name
; Accepts:
;	A/ pointer to host string
;	B/ pointer to domain name string
;	CALL $RMDOM
; Returns +1: Always

$RMDOM::SAVEAC <B>
	STKVAR <HSTPTR,DOMPTR,DOMNAM>
	SETZM DOMPTR		; initially no top-level domain pointer
	MOVEM B,DOMNAM
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	DO.
	  ILDB B,A		; get a byte from name
	  JUMPE B,ENDLP.	; if null, scan done
	  CAIE B,"."		; start of a domain segment?
	   LOOP.		; no
	  MOVEM A,DOMPTR	; yes, remember its pointer
	  MOVE B,DOMNAM		; see if top-level domain is the one we want
	  STCMP%
	  IFN. A		; name match?
	    MOVE A,DOMPTR	; no, keep on looking
	    LOOP.
	  ELSE.
	    SETZ A,		; yes, tie off string before top-level domain
	    DPB A,DOMPTR
	  ENDIF.
	ENDDO.
	MOVE A,HSTPTR
	RET

	ENDSV.
; $ARDOM - Add relative domain by type
; Accepts:
;	A/ pointer to host string
;	B/ pointer to domain type string
;	CALL $ARDOM
; Returns +1: Always, updated pointer in A

$ARDOM::SAVEAC <B>
	STKVAR <HSTPTR,<DOMSTR,HSTNMW>>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	HRROI A,DOMSTR		; get relative name
	CALL $MKREL
	 RET
	MOVE A,HSTPTR		; add the relative name
	HRROI B,DOMSTR
	CALLRET $ADDOM

	ENDSV.
; $ARDMH - Add relative and higher-level domain by type
; Accepts:
;	A/ pointer to host string
;	B/ pointer to domain type string
;	CALL $ARDMH
; Returns +1: Always, updated pointer in A

$ARDMH::SAVEAC <B>
	STKVAR <HSTPTR,DOMTYP,<DOMSTR,HSTNMW>>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	MOVEM B,DOMTYP		; save domain type
	HRROI A,DOMSTR		; make higher level name
	CALL $MKHLN
	IFSKP.
	  MOVE A,HSTPTR		; remove the higher level name
	  HRROI B,DOMSTR
	  CALL $ADDOM
	  MOVEM A,HSTPTR	; save pointer
	ENDIF.
	MOVE A,HSTPTR		; add the relative name
	MOVE B,DOMTYP
	CALLRET $ARDOM

	ENDSV.
; $RRDOM - Remove relative domain by type
; Accepts:
;	A/ pointer to host string
;	B/ pointer to relative domain type string
;	CALL $RRDOM
; Returns +1: Failed (probably some other relative domain)
;	  +2: Success, updated pointer in A

$RRDOM::SAVEAC <B>
	STKVAR <HSTPTR,DOMPTR,DOMNAM>
	SETZM DOMPTR		; initially no top-level domain pointer
	MOVEM B,DOMNAM
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	DO.
	  ILDB B,A		; get a byte from name
	  IFN. B		; if null, scan done
	    CAIN B,"."		; start of a domain segment?
	     MOVEM A,DOMPTR	; yes, remember its pointer
	    LOOP.
	  ENDIF.
	ENDDO.
	SKIPN B,DOMPTR		; have a domain?
	IFSKP.
	  ILDB A,B		; see if it's relative
	  CAIE A,"#"
	ANSKP.
	  MOVE A,DOMNAM		; see if domain matches
	  STCMP%
	   ERJMP R
	  JUMPN A,R		; no match
	  DPB A,DOMPTR		; matched, remove it
	ENDIF.
	MOVE A,HSTPTR		; return pointer
	RETSKP

	ENDSV.
; $RRDMH - Remove relative and higher-level domain by type
; Accepts:
;	A/ pointer to host string
;	B/ pointer to relative domain type string
;	CALL $RRDMH
; Returns +1: Failed (probably some other relative domain)
;	  +2: Success

$RRDMH::SAVEAC <B>
	STKVAR <HSTPTR,DOMNAM,<DOMSTR,HSTNMW>>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	MOVEM B,DOMNAM		; save domain type
	CALL $RRDOM
	 RET
	HRROI A,DOMSTR		; make higher level name
	MOVE B,DOMNAM
	CALL $MKHLN
	IFSKP.
	  MOVE A,HSTPTR		; remove the higher level name
	  HRROI B,DOMSTR
	  CALL $RMDOM
	ENDIF.
	MOVE A,HSTPTR
	RETSKP

	ENDSV.
; $MKHLN - Make a higher level domain name
; Accepts:
;	A/ pointer to destination string
;	B/ pointer to domain type string
;	CALL $MKHLN
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$MKHLN::SAVEAC <B,C,D>
	STKVAR <DSTPTR,DOMTYP>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,DSTPTR
	MOVEM B,DOMTYP
	HRROI B,[ASCIZ/MAIL:/]	; make MAIL:domaintype-HIGHER-LEVEL-DOMAIN.TXT
	SETZ C,
	SOUT%
	 ERJMP R
	MOVE B,DOMTYP
	SOUT%
	 ERJMP R
	HRROI B,[ASCIZ/-HIGHER-LEVEL-DOMAIN.TXT/]
	SOUT%
	 ERJMP R
	MOVE A,DSTPTR		; now get that file if it's there
	MOVE B,DSTPTR
	CALL $CPFIL		; get it
	 RET
	RETSKP

	ENDSV.
; $MKREL - Make a relative domain name
; Accepts:
;	A/ pointer to destination string
;	B/ pointer to domain type string
;	CALL $MKREL
; Returns +1: Failed
;	  +2: Success, updated pointer in A

$MKREL::SAVEAC <B,C,D>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVX C,"#"		; first prepend relative domain
	IDPB C,A
	MOVX C,HSTNML+1		; up to this many characters
	SETZ D,			; terminate on null
	SOUT%
	 ERJMP R		; percolate failure up to caller
	JUMPE C,R		; string too long if exhausted
	RETSKP
; $RMREL - Remove top-level relative domain names
; Accepts:
;	A/ pointer to host string
;	CALL $RMREL
; Returns +1: Always

$RMREL::SAVEAC <B>
	STKVAR <HSTPTR,DOMPTR>
	TXC A,.LHALF		; is source LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,HSTPTR		; set up pointer to return
	DO.
	  SETZM DOMPTR		; initially no top-level domain pointer
	  DO.
	    ILDB B,A		; get a byte from name
	    IFN. B		; if null, scan done
	      CAIN B,"."	; start of a domain segment?
	       MOVEM A,DOMPTR	; yes, remember its pointer
	      LOOP.
	    ENDIF.
	  ENDDO.
	  MOVE A,HSTPTR		; get host pointer for return or loopback
	  SKIPN B,DOMPTR	; get pointer to top-level domain
	  IFSKP.
	    ILDB B,B		; get first byte of domain name
	    CAIE B,"#"		; relative domain?
	  ANSKP.
	    SETZ B,		; yes, tie off string before top-level domain
	    DPB B,DOMPTR
	    LOOP.		; re-do to eliminate other relative domains
	  ENDIF.
	ENDDO.
	RET

	ENDSV.
; $CPFIL - Copy a file into a buffer
; Accepts:
;	A/ pointer to destination buffer
;	B/ pointer to file name
;	CALL $CPFIL
; Returns +1: Failed (e.g. no such file)
;	  +2: Success, with updated pointer in A

$CPFIL::SAVEAC <B,C,D>
	STKVAR <TMPJFN,<TMPBUF,HSTNMW>,DSTPTR>
	TXC A,.LHALF		; is string pointer LH -1?
	TXCN A,.LHALF
	 HRLI A,(<POINT 7,>)	; yes, set up byte pointer
	MOVEM A,DSTPTR		; save destination pointer
	MOVX A,GJ%SHT!GJ%OLD	; try for the local hostname file
	GTJFN%			; find system file with our name
	 ERJMP R
	MOVEM A,TMPJFN		; save JFN in case OPENF% failure
	MOVX B,<<FLD 7,OF%BSZ>!OF%RD!OF%PDT> ; open in 7-bit ASCII and
	OPENF%			;  don't mangle the FDB
	IFJER.
	  MOVE A,TMPJFN		; get back JFN we got
	  RLJFN%		; free it
	   ERJMP R		; not interested in errors here
	  RET
	ENDIF.
	HRROI B,TMPBUF		; read in string
	MOVX C,HSTNML		; up to this many characters
	MOVX D,.CHLFD		; terminate on a linefeed
	SIN%
	 ERJMP .+1
	CLOSF%			; close off file
	 ERJMP .+1
	MOVEI A,TMPBUF		; now process string a bit
	HRLI A,(<POINT 7,>)
	DO.
	  ILDB B,A		; get byte from string read in
	  CAIE B,.CHLFD		; LF terminates
	   CAIN B,.CHCRT	; CR terminates
	    SETZ B,
	  CAIE B,.CHTAB		; TAB terminates
	   CAIN B,.CHSPC	; space terminates
	    SETZ B,
	  IDPB B,DSTPTR		; return byte to user
	  JUMPN B,TOP.		; if null, done
	ENDDO.
	SETO A,			; back over the null
	ADJBP A,DSTPTR		; return updated pointer
	RETSKP

	ENDSV.
	END