home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-02-23 | 50.0 KB | 1,783 lines |
- TITLE HSTNAM TOPS-20 host name lookup routines
- SUBTTL Written by Mark Crispin - December 1982/September 1988
-
- ; Copyright (C) 1982, 1983, 1984, 1985, 1986, 1987, 1988 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
- $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 <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
-