TITLE HSTNAM TOPS-20 host name lookup routines

TITLE HSTNAM TOPS-20 host name lookup routines
SUBTTL Written by Mark Crispin - December 1982/March 1990

; Copyright (C) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990 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

PN%NAM==:1B0
PN%FLD==:1B1
PN%OCT==:1B2

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

>;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 ; 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
$GTFOK::0 ; non-zero => finger, don't block on .GTHNS

$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
SKIPE $GTFOK ; don't want blocking on address to name?
CAIE A,.GTHNS ; yes, is this address to name?
IFSKP.
TXO A,GD%RBK ; resolve in background
GTDOM% ; give resolver a kick
ERJMP .+1
DMOVE A,ACS ; restore the AC's
DMOVE C,2+ACS
TXO A,GD%LDO ; note we want to use local data only
ENDIF.
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 <FUNC,HSTPTR,DSTPTR,HSTADR>
SKIPN $GTHOK ; OK to do GTHST%?
RET ; no, always fail
CAIL A,.GTDPN ; one of the new functions?
TXO A,GD%STA ; yes, return status code in A
MOVEM A,FUNC ; note function code
GTHST% ; try the montior
IFNJE.
CAME A,FUNC ; won, did it return something?
RETSKP ; must be a new monitor
ELSE.
HRRZ A,FUNC ; get back function code
CAIE A,.GTDVN ; validate name?
CAIN A,.GTDPN ; or primary name translation?
IFSKP. <RET> ; no, give up
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 C,"["
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 
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 
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 
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 
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 
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 
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