TITLE HSTNAM TOPS-20 host name lookup routines SUBTTL Written by Mark Crispin - December 1982/February 2002 ; Mark Crispin's Free-Fork License ; ; HSTNAM TOPS-20 host name lookup routines ; Copyright 2002 Mark Crispin ; ; This Mark Crispin Distribution (code and documentation) is made ; available to the open source community as a public service by Mark ; Crispin. Contact Mark Crispin at mrc@panda.com for information on ; other licensing arrangements (e.g. for use in proprietary ; applications). ; ; Under this license, this Distribution may be modified and the original ; version and modified versions may be copied, distributed, publicly ; displayed and performed provided that the following conditions are ; met: ; ; (1) modified versions are distributed with source code and ; documentation and with permission for others to use any code and ; documentation (whether in original or modified versions) as granted ; under this license; ; ; (2) if modified, the source code, documentation, and user run-time ; elements should be clearly labeled by placing an identifier of origin ; (such as a name, initial, or other tag) after the version number; ; ; (3) users, modifiers, distributors, and others coming into possession ; or using the Distribution in original or modified form accept the ; entire risk as to the possession, use, and performance of the ; Distribution; ; ; (4) this copyright management information (software identifier and ; version number, copyright notice and license) shall be retained in all ; versions of the Distribution; ; ; (5) Mark Crispin may make modifications to the Distribution that are ; substantially similar to modified versions of the Distribution, and ; may make, use, sell, copy, distribute, publicly display, and perform ; such modifications, including making such modifications available ; under this or other licenses, without obligation or restriction; ; ; (6) modifications incorporating code, libraries, and/or documentation ; subject to any other open source license may be made, and the ; resulting work may be distributed under the terms of such open source ; license if required by that open source license, but doing so will not ; affect this Distribution, other modifications made under this license ; or modifications made under other Mark Crispin licensing arrangements; ; ; (7) no permission is granted to distribute, publicly display, or ; publicly perform modifications to the Distribution made using ; proprietary materials that cannot be released in source format under ; conditions of this license; ; ; (8) the name of Mark Crispin may not be used in advertising or ; publicity pertaining to Distribution of the software without specific, ; prior written permission. ; ; This software is made available "as is", and ; ; MARK CRISPIN DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, WITH ; REGARD TO THIS SOFTWARE, INCLUDING WITHOUT LIMITATION ALL IMPLIED ; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, ; AND IN NO EVENT SHALL MARK CRISPIN BE LIABLE FOR ANY SPECIAL, INDIRECT ; OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS ; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, TORT ; (INCLUDING NEGLIGENCE) OR STRICT LIABILITY, ARISING OUT OF OR IN ; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ; 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, ; length of a host name (64 required minimum) HSTNMW==+1 ; host name length in words ; AC definitions A=:1 ; JSYS, temporary AC's B=:2 C=:3 D=:4 E=:5 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 TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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. ; 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 STKVAR TXC A,.LHALF ; is destination pointer's LH -1? TXCN A,.LHALF HRLI A,() ; 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 TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; yes, set up byte pointer MOVEM A,HSTPTR ; save pointer TXC B,.LHALF ; is destination LH -1? TXCN B,.LHALF HRLI B,() ; 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 STKVAR TXC A,.LHALF ; is destination pointer's LH -1? TXCN A,.LHALF HRLI A,() ; 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. ; 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. 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 STKVAR TXC A,.LHALF ; is string pointer LH -1? TXCN A,.LHALF HRLI A,() ; 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 ; preserve these STKVAR > 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 STKVAR > 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 STKVAR 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 STKVAR TXC A,.LHALF ; is destination pointer's LH -1? TXCN A,.LHALF HRLI A,() ; 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,<>,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,<>,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,<>,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,<>,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 <,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 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. ; 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 STKVAR <> 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 RLYMAX==^D10 ; maximum relays GTDLEN==.GTDML+RLYMAX ; size of GTDOM% block MXBLEN==RLYMAX* ; relay buffer $MXCA:: SAVEAC STKVAR ,,> 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!! MOVSI A,ARGBLK ; make sure empty argument block HRRI A,1+ARGBLK SETZM ARGBLK BLT A,GTDLEN+ARGBLK MOVX A,GTDLEN ; set up length of argument block MOVEM A,.GTDLN+ARGBLK SETZM .GTDTC+ARGBLK ; no special query type/class MOVX A,-1 ; get length of our buffer MOVEM A,.GTDBC+ARGBLK 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 MOVEI E,.GTDRD+ARGBLK ; scan relay list for local host DO. SKIPN A,(E) ; get next relay IFSKP. MOVX A,.GTDAA ; see if this is a valid name for us MOVE B,(E) SETO C, ; on any of my addresses CALL $GTHST AOJA E,TOP. ; not valid, consider next relay ENDIF. ENDDO. SKIPN A,(E) ; use selected relay MOVE A,.GTDRD+ARGBLK ; none found, get pointer to first relay CALL $GTHSN ; get address of selected relay 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 TXC A,.LHALF ; is destination pointer's LH -1? TXCN A,.LHALF HRLI A,() ; yes, set up byte pointer MOVE C,A ILDB C,C ; sniff at first character CAIE C,"#" ; looks like a literal? CAIN C,"[" IFNSK. ; it is, use the physical routine STKVAR > 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 STKVAR > TXC A,.LHALF ; is string pointer LH -1? TXCN A,.LHALF HRLI A,() ; 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 STKVAR > 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 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 STKVAR <,DCNJFN,NODPTR,> 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 STKVAR > 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+ 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! ; 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 STKVAR ,> 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! ; 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 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 STKVAR 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 STKVAR > 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 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 STKVAR ,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 STKVAR ,,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 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 STKVAR > 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 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 SETZM DOMPTR ; initially no top-level domain pointer MOVEM B,DOMNAM TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 > TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 > TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 SETZM DOMPTR ; initially no top-level domain pointer MOVEM B,DOMNAM TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 > TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 STKVAR TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 TXC A,.LHALF ; is source LH -1? TXCN A,.LHALF HRLI A,() ; 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 STKVAR ,DSTPTR> TXC A,.LHALF ; is string pointer LH -1? TXCN A,.LHALF HRLI A,() ; 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,<!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,() 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