home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / pine / imap-3.0 / mapser / hstnam.mac next >
Encoding:
Text File  |  1990-02-23  |  50.0 KB  |  1,783 lines

  1.     TITLE HSTNAM TOPS-20 host name lookup routines
  2.     SUBTTL Written by Mark Crispin - December 1982/September 1988
  3.  
  4. ; Copyright (C) 1982, 1983, 1984, 1985, 1986, 1987, 1988 Mark Crispin
  5. ; All rights reserved.
  6. ;
  7. ;  This software, in source and binary form, is distributed free of charge.
  8. ; The binary form of this software may be incorporated into public-domain
  9. ; software and the source may be used for reference purposes.  Copies may
  10. ; be made of the source provided this copyright notice is included.  Wholesale
  11. ; copying of the routines in this software or usage of this software in a
  12. ; proprietary product without prior permission is prohibited.
  13.  
  14. ;  This module is an attempt to provide a common and consistant host name/host
  15. ; address lookup interface for all network software.  For the most part, these
  16. ; modules have been designed like jsi.  They take their arguments in AC's in a
  17. ; fairly consistant manner.  Only the documented returned value AC's are
  18. ; changed; everything else is unaffected.  Note that in a failure return the
  19. ; returned value AC's are undefined; software should not be written to assume
  20. ; any side-effects of a failure as this may change from release to release.
  21. ;
  22. ;  The only real difference from a JSYS is that since these are subroutines
  23. ; invoked by CALL and use the stack any stack references (e.g. STKVAR) must be
  24. ; made absolute prior to using the routines.  For example, assuming FOOSTR is
  25. ; a string in a STKVAR:
  26. ;  Wrong:
  27. ;    MOVE A,[POINT 7,FOOSTR]
  28. ;    CALL $xxxxx
  29. ;  Right:
  30. ;    HRROI A,FOOSTR
  31. ;    CALL $xxxxx
  32. ;
  33. ;  In addition to the individual routines for each network, there are also
  34. ; global routines allowing name/address lookups for multiple networks.  In
  35. ; general, software should be written to use the global routines rather than
  36. ; a specific network's routine if there is any possibility that software will
  37. ; ever be used for more than one network.  The additional generality gained
  38. ; costs nothing but a minor bit of discipline on the part of the programmer
  39. ; and will save future programmers much grief.
  40. ;
  41. ;  One firm rule: absolutely NO software should do host lookups without going
  42. ; through this module.  In particular, no software should be written to access
  43. ; "host tables" (e.g. SYSTEM:HOSTSn.BIN).  Any software which knows about the
  44. ; format, or depends upon existance, of host tables is guaranteed to break
  45. ; without warning.
  46. ;
  47. ;  This module tries to be "internet" (not to be confused with Internet).  In
  48. ; order to provide a means of specifying an explicit name registry, top-level
  49. ; domains prefixed with an "#" are used.  These are relative domains, not to
  50. ; be confused with Internet domains which are absolute.  Eventually, absolute
  51. ; addressing will come into being, but at present that requires considerably
  52. ; more cooperation from the various networks than is presently forthcoming.
  53.     SUBTTL Definitions
  54.  
  55.     SEARCH MACSYM,MONSYM    ; system definitions
  56.     SALL            ; suppress macro expansions
  57.     .DIRECTIVE FLBLST    ; sane listings for ASCIZ, etc.
  58.  
  59. IFNDEF HSTNML,<HSTNML==^D64>    ; length of a host name (64 required minimum)
  60.  HSTNMW==<HSTNML/5>+1        ; host name length in words
  61.  
  62. ; AC definitions
  63.  
  64. A=:1                ; JSYS, temporary AC's
  65. B=:2
  66. C=:3
  67. D=:4
  68. P=:17                ; stack pointer
  69.  
  70. ; Non-standard operating system definitions
  71.  
  72. IFNDEF PUPNM%,<
  73.     OPDEF PUPNM% [JSYS 443]
  74.  
  75. PN%NAM==:1B0
  76. PN%FLD==:1B1
  77. PN%OCT==:1B2
  78. >;IFNDEF PUPNM%
  79.  
  80. IFNDEF CHANM%,<
  81.     OPDEF CHANM% [JSYS 460]
  82.  
  83. .CHNPH==:0            ; return local site primary name and number
  84. .CHNSN==:1            ; Chaosnet name to number
  85. .CHNNS==:2            ; Chaosnet number to primary name
  86. >;IFNDEF CHANM%
  87.  
  88. IFNDEF GTDOM%,<
  89.     OPDEF GTDOM% [JSYS 765]
  90.  
  91. GD%LDO==:1B0            ; local data only (no resolve)
  92. GD%MBA==:1B1            ; must be authoritative (don't use cache)
  93. GD%RBK==:1B6            ; resolve in background
  94. GD%EMO==:1B12            ; exact match only
  95. GD%RAI==:1B13            ; uppercase output name
  96. GD%QCL==:1B14            ; query class specified
  97. GD%STA==:1B16            ; want status code in AC1 for marginal success
  98.   .GTDX0==:0            ; total success
  99.   .GTDXN==:1            ; data not found in namespace (authoritative)
  100.   .GTDXT==:2            ; timeout, any flavor
  101.   .GTDXF==:3            ; namespace is corrupt
  102.  
  103. .GTDWT==:12            ; resolver wait function
  104. .GTDPN==:14            ; get primary name and IP address
  105. .GTDMX==:15            ; get MX (mail relay) data
  106.   .GTDLN==:0            ; length of argblk (inclusive)
  107.   .GTDTC==:1            ; QTYPE (ignored for .GTDMX),,QCLASS
  108.   .GTDBC==:2            ; length of output string buffer
  109.   .GTDNM==:3            ; canonicalized name on return
  110.   .GTDRD==:4            ; returned data begins here
  111.   .GTDML==:5            ; minimum length of argblock (words)
  112. .GTDAA==:16            ; authenticate address
  113. .GTDRR==:17            ; get arbitrary RR (MIT formatted RRs)
  114. .GTDVN==:20            ; validate name for arbitrary QTYPE(s)
  115.   .GTDV0==:1B19            ; lowest allowable value
  116.   .GTDVH==:.GTDV0+1        ; validate host (A,MX,WKS,HINFO)
  117.   .GTDVZ==:.GTDV0+2        ; validate zone (SOA,NS)
  118. >;IFNDEF GTDOM%
  119.  
  120.     .PSECT CODE        ; enter pure CODE PSECT
  121.     SUBTTL Protocol-independent routines
  122.  
  123. ; $GTPRO - Get host address and find protocol supported by host
  124. ; Accepts:
  125. ;    A/ host name string
  126. ;    C/ pointer to protocol list or -1 to try all supported protocols
  127. ;    CALL $GTPRO
  128. ; Returns +1: Failed
  129. ;      +2: Success, updated pointer in A, host address in B,
  130. ;            protocol address in C
  131. ;
  132. ;  The protocol list is in the form:
  133. ;    [ASCIZ/protocol1/],,data1
  134. ;    [ASCIZ/protocol2/],,data2
  135. ;        ...
  136. ;    [ASCIZ/protocoln/],,datan
  137. ;    0            ; end of table
  138.  
  139. $GTPRO::STKVAR <HSTPTR,PROPTR>
  140.     TXC A,.LHALF        ; is source LH -1?
  141.     TXCN A,.LHALF
  142.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  143.     MOVEM A,HSTPTR        ; save pointer
  144.     SKIPG C            ; user want all known protocols?
  145.      MOVEI C,$PRTAB        ; yes, use our internal table
  146.     DO.
  147.       SKIPN B,(C)        ; get protocol entry
  148.        RET            ; end of list, return failure
  149.       MOVEM C,PROPTR    ; save since TBLUK% clobbers C
  150.       HLROS B        ; make string pointer to name
  151.       MOVEI A,$PRRTS    ; our known table
  152.       TBLUK%        ; see if can find entry in table
  153.        ERJMP R        ; strange failure
  154.       MOVE C,PROPTR        ; get back protocol pointer
  155.       IFXE. B,TL%NOM!TL%AMB    ; found this protocol in table?
  156.         HRRZ B,(A)        ; yes, get pointer to routines to call
  157.         HLRZ B,(B)        ; get string/address routine
  158.         MOVE A,HSTPTR    ; get pointer to host name
  159.         CALL (B)        ; see if name known under this protocol
  160.         IFSKP. <RETSKP>    ; return success
  161.       ENDIF.
  162.       AOJA C,TOP.        ; not found here, bump pointer and try again
  163.     ENDDO.
  164.  
  165.     ENDSV.
  166.  
  167. ; $GTNAM - Get name of host given its protocol
  168. ; Accepts:
  169. ;    A/ pointer to destination host string
  170. ;    B/ foreign host address
  171. ;    C/ protocol list item pointer
  172. ;    CALL $GTNAM
  173. ; Returns +1: Failed
  174. ;      +2: Success, updated pointer in A
  175. ;
  176. ;  For compatibility with the $GTPRO call and the possible convenience of
  177. ; applications programs, a negative argument ("try all protocols") is allowed
  178. ; in C.  However, this is only valid if B is also negative ("local host")
  179. ; since different networks have different addressing conventions.  If this is
  180. ; the case, $GTNAM becomes $GTLCL.
  181.  
  182. $GTNAM::IFL. C            ; caller want to try all protocols?
  183.       JUMPL B,$GTLCL    ; yes, use $GTLCL if local host desired
  184.       RET            ; else fail, meaningless call
  185.     ENDIF.
  186.     SAVEAC <C>
  187.     STKVAR <HSTPTR,HSTNUM>
  188.     TXC A,.LHALF        ; is destination pointer's LH -1?
  189.     TXCN A,.LHALF
  190.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  191.     MOVEM A,HSTPTR        ; save pointer
  192.     MOVEM B,HSTNUM        ; save host address
  193.     MOVEI A,$PRRTS        ; table of known protocols
  194.     HLRO B,(C)        ; protocol to look up
  195.     TBLUK%            ; see if can find entry in table
  196.      ERJMP R        ; strange failure
  197.     JXN B,TL%NOM!TL%AMB,R    ; fail if protocol not found in table?
  198.     HRRZ C,(A)        ; get pointer to routines to call
  199.     HRRZ C,(C)        ; get canonicalize,,address/string routines
  200.     HRRZ C,(C)        ; get address/string routine
  201.     MOVE A,HSTPTR        ; get pointer to host name
  202.     MOVE B,HSTNUM
  203.     CALLRET (C)        ; see if name known under this protocol
  204.  
  205.     ENDSV.
  206.  
  207. ; $GTCAN - Get canonical name for host
  208. ; Accepts:
  209. ;    A/ host name string
  210. ;    B/ destination host name string
  211. ;    C/ pointer to protocol list
  212. ;       or -1 to try all supported protocols
  213. ;       or 0 to try all supported protocols w/o returning an address
  214. ;    CALL $GTCAN
  215. ; Returns +1: Failed
  216. ;      +2: Success, updated destination pointer in A, host address in B
  217. ;            if appropriate, protocol address in C
  218.  
  219. $GTCAN::SKIPN C            ; user want mail validation?
  220.      MOVEI C,$MATAB        ; yes, use internal table
  221.     SKIPG C            ; user want all known protocols?
  222.      MOVEI C,$PRTAB        ; yes, use our internal table
  223.     CAIN C,$MATAB        ; user wants host address returned?
  224.      SAVEAC <B>        ; no - so leave argument untouched
  225.     STKVAR <HSTPTR,DSTPTR,PROPTR>
  226.     TXC A,.LHALF        ; is source LH -1?
  227.     TXCN A,.LHALF
  228.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  229.     MOVEM A,HSTPTR        ; save pointer
  230.     TXC B,.LHALF        ; is destination LH -1?
  231.     TXCN B,.LHALF
  232.      HRLI B,(<POINT 7,>)    ; yes, set up byte pointer
  233.     MOVEM B,DSTPTR        ; save pointer
  234.     DO.
  235.       SKIPN B,(C)        ; get protocol entry
  236.        RET            ; end of list, return failure
  237.       MOVEM C,PROPTR    ; save since TBLUK% clobbers C
  238.       HLROS B        ; make string pointer to name
  239.       MOVEI A,$PRRTS    ; our known table
  240.       TBLUK%        ; see if can find entry in table
  241.        ERJMP R        ; strange failure
  242.       IFXE. B,TL%NOM!TL%AMB    ; found this protocol in table?
  243.         HRRZ C,(A)        ; yes, get pointer to routines to call
  244.         HRRZ C,(C)        ; get canonicalize,,address/string routines
  245.         HLRZ C,(C)        ; get canonicalize routine
  246.         MOVE A,HSTPTR    ; get pointer to host name
  247.         MOVE B,DSTPTR    ; and where to stash it
  248.         CALL (C)        ; see if name known under this protocol
  249.       ANSKP.
  250.         MOVE C,PROPTR    ; get back protocol pointer for return
  251.         RETSKP        ; return success
  252.       ENDIF.
  253.       MOVE C,PROPTR        ; get back protocol pointer
  254.       AOJA C,TOP.        ; not found here, bump pointer and try again
  255.     ENDDO.
  256.  
  257.     ENDSV.
  258.  
  259. ; $GTLCL - Get name of local host
  260. ; Accepts:
  261. ;    A/ pointer to destination host string
  262. ;    CALL $GTLCL
  263. ; Returns +1: Failed (shouldn't happen)
  264. ;      +2: Success, with updated pointer in A
  265. ;  $GTLCL will always return a name, even if there are no networks at
  266. ; all.  This means that any software that uses host names that is
  267. ; meaningful in a non-network environment (e.g. the mailer) must
  268. ; understand the local name as a special concept independent of $GTPRO.
  269.  
  270. $GTLCL::SAVEAC <B,C,D>
  271.     STKVAR <HSTPTR,HSTNUM>
  272.     TXC A,.LHALF        ; is destination pointer's LH -1?
  273.     TXCN A,.LHALF
  274.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  275.     MOVEM A,HSTPTR        ; save pointer
  276.     MOVEI D,$PRTAB        ; our protocol table
  277.     DO.
  278.       MOVEI A,$PRRTS    ; look up protocol
  279.       SKIPN B,(D)        ; get protocol entry
  280.        EXIT.        ; end of list
  281.       HLROS B        ; make string pointer to name
  282.       TBLUK%
  283.        ERJMP R        ; strange failure
  284.       JXN B,TL%NOM!TL%AMB,R    ; very strange if protocol not found
  285.       HRRZ C,(A)        ; get pointer to routines to call
  286.       HRRZ C,(C)        ; get canonicalize,,address/string routines
  287.       HRRZ C,(C)        ; get address/string routine
  288.       MOVE A,HSTPTR        ; pointer to destination string
  289.       SETO B,        ; translate local host
  290.       CALL (C)        ; see if we're known under this protocol
  291.       IFSKP. <RETSKP>    ; we are, return success
  292.       AOJA D,TOP.        ; try next protocol
  293.     ENDDO.
  294.     MOVE A,HSTPTR        ; try a hostname file
  295.     HRROI B,[ASCIZ/SYSTEM:HOSTNAME.TXT/]
  296.     CALL $CPFIL
  297.     IFSKP. <RETSKP>
  298.     MOVE A,HSTPTR        ; lose, this is the last resort
  299.     HRROI B,[ASCIZ/TOPS-20/] ; default name string
  300.     SETZ C,            ; no limit
  301.     SOUT%            ; copy the string
  302.      ERJMP R        ; can't fail
  303.     RETSKP
  304.  
  305.     ENDSV.
  306.     SUBTTL Protocol-specific routines
  307.  
  308. ; Tables of known protocols
  309.  
  310. ; TBLUK% format table when desired naming registry is given
  311.  
  312. DEFINE DN (NAME,ADRNAM,NAMADR,CANNAM) <
  313.  [ASCIZ/'NAME'/],,['NAMADR',,['CANNAM',,'ADRNAM']]
  314. >;DEFINE DN
  315.  
  316. $PRRTS::NPROTS,,NPROTS
  317.     DN Chaos,$CHSNS,$CHSSN,$CHSCA    ; Chaosnet
  318.     DN DECnet,$DECNS,$DECSN,$DECCA    ; DECnet
  319.     DN Internet,$INTNS,$INTSN,$INTCA ; Internet A/MX/WKS/HINFO (no address)
  320.     DN MX,$MXNS,$MXSN,$MXCA        ; MX Internet
  321.     DN Pup,$PUPNS,$PUPSN,$PUPCA    ; Pup Ethernet
  322.     DN Special,$SPCNS,$SPCSN,$SPCCA    ; Special external network
  323.     DN TCP,$GTHNS,$GTHSN,$GTHCA    ; TCP/IP Internet
  324. NPROTS==<.-$PRRTS>-1
  325.  
  326. ;  $PRTAB and $MATAB are default protocol tables; they differ in that the
  327. ; address returned by $MATAB is undefined -- this is used by mail and any
  328. ; other application that merely want to validate the name.
  329. ;  The tables are in the default communication order.  The Special network
  330. ; is first so it overrides any other registries  This allows use of the
  331. ; Special network to do custom delivery to a defined host, and also prevents
  332. ; lossage when some random foreign host comes up with the same name.
  333. ;  Note: you should probably set up an appropriate HIGHER-LEVEL-DOMAIN.TXT
  334. ; file in at least the MAILS: directory so that a fully-qualified domain name
  335. ; appears in local mail.
  336.  
  337. DEFINE DP (NAME) <
  338.  [ASCIZ/'NAME'/],,0
  339. >;DEFINE DP
  340.  
  341. $PRTAB::DP Special
  342.     DP MX
  343.     DP TCP
  344.     DP Pup
  345.     DP Chaos
  346.     DP DECnet
  347.     0            ; terminate for $GTPRO
  348.  
  349. $MATAB::DP Special
  350.     DP Internet
  351.     DP Pup
  352.     DP Chaos
  353.     DP DECnet
  354.     0            ; terminate for $GTPRO
  355.     SUBTTL Protocol-specific routines - Internet
  356.  
  357. ; $GTHNS - Translate Internet host address to host name
  358. ; Accepts:
  359. ;    A/ pointer to destination host string
  360. ;    B/ foreign host address
  361. ;    CALL $GTHNS
  362. ; Returns +1: Failed
  363. ;      +2: Success, updated pointer in A
  364.  
  365. $GTHNS::SAVEAC <C,D>
  366.     STKVAR <HSTPTR,HSTNUM>
  367.     TXC A,.LHALF        ; is string pointer LH -1?
  368.     TXCN A,.LHALF
  369.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  370.     MOVEM A,HSTPTR        ; save host pointer
  371.     MOVEM B,HSTNUM        ; save host address
  372.     CAME B,[-1]        ; want local address?
  373.     IFSKP.
  374.       MOVX A,.GTHSZ        ; yes, get local address so can output
  375.       CALL $GTHST        ;  bracketed if unnamed local host
  376.        RET            ; not on Internet
  377.       JUMPN A,R        ; can't have indeterminate local address!
  378.       MOVEM D,HSTNUM    ; set new host address
  379.     ENDIF.
  380.     MOVX A,.GTHNS        ; number to name conversion
  381.     MOVE B,HSTPTR        ; destination pointer
  382.     MOVE C,HSTNUM        ; host address
  383.     CALL $GTHST
  384.     IFSKP.
  385.     ANDE. A            ; must be determinate
  386.       MOVEM C,HSTNUM    ; return host address
  387.       MOVE A,B        ; set up byte pointer for $ARDOM
  388.     ELSE.
  389.       MOVE A,HSTPTR        ; name unknown, output literal
  390.       MOVE B,HSTNUM
  391.       CALL $GTHWL
  392.     ENDIF.
  393.     HRROI B,[ASCIZ/Internet/] ; add Internet domain
  394.     CALL $ARDOM        ; add domain, leave pointer in A
  395.     MOVE B,HSTNUM        ; and host address
  396.     RETSKP
  397.  
  398.     ENDSV.
  399.  
  400. ; $GTHSN - Translate Internet host name to host address
  401. ; Accepts:
  402. ;    A/ pointer to host string
  403. ;    CALL $GTHSN
  404. ; Returns +1: Failed
  405. ;      +2: Success, updated pointer in A, host address in B
  406.  
  407. $GTHSN::SAVEAC <C,D>        ; preserve these
  408.     STKVAR <HSTPTR,<HSTSTR,HSTNMW>>
  409.     MOVE B,A        ; copy string so we can muck with it
  410.     HRROI A,HSTSTR        ; into HSTSTR
  411.     MOVX C,HSTNML+1        ; up to this many characters
  412.     SETZ D,            ; terminate on null
  413.     SOUT%
  414.      ERJMP R        ; percolate failure up to caller
  415.     JUMPE C,R        ; string too long if exhausted
  416.     MOVEM B,HSTPTR        ; save pointer
  417.     SETO B,            ; back pointer up by one
  418.     ADJBP B,HSTPTR
  419.     MOVEM B,HSTPTR        ; save updated pointer
  420.     HRROI A,HSTSTR        ; now remove Internet domain
  421.     HRROI B,[ASCIZ/Internet/]
  422.     CALL $RRDOM
  423.      RET
  424.     HRROI A,HSTSTR        ; prepare to read literal
  425.     CALL $GTHRL
  426.     IFNSK.
  427.       MOVX A,.GTHSN        ; translate name to number
  428.       HRROI B,HSTSTR    ; foreign host name
  429.       CALL $GTHST
  430.        RET
  431.       IFN. A        ; indeterminate information?
  432.         MOVE B,$UKHST    ; yes, return unknown address
  433.       ELSE.
  434.         MOVE B,C        ; get host address in proper AC
  435.       ENDIF.
  436.     ENDIF.
  437.     MOVE A,HSTPTR        ; get back updated pointer
  438.     RETSKP
  439.  
  440.     ENDSV.
  441.  
  442. $UKHST::BYTE (4) 7 (8) 0,0,0,0    ; the "unknown" Internet host address
  443.  
  444. ; $GTHCA - Get canonical name for Internet host
  445. ; Accepts:
  446. ;    A/ host name string
  447. ;    B/ destination host name string
  448. ;    CALL $GTHCA
  449. ; Returns +1: Failed
  450. ;      +2: Success, updated destination pointer in A, host address in B
  451.  
  452. $GTHCA::SAVEAC <C,D>
  453.     STKVAR <DSTPTR,<HSTSTR,HSTNMW>>
  454.     MOVEM B,DSTPTR        ; save destination pointer
  455.     MOVE B,A        ; copy string so we can muck with it
  456.     HRROI A,HSTSTR        ; into HSTSTR
  457.     MOVX C,HSTNML+1        ; up to this many characters
  458.     SETZ D,            ; terminate on null
  459.     SOUT%
  460.      ERJMP R        ; percolate failure up to caller
  461.     JUMPE C,R        ; string too long if exhausted
  462.     HRROI A,HSTSTR        ; now remove Internet domain
  463.     HRROI B,[ASCIZ/Internet/]
  464.     CALL $RRDOM
  465.      RET
  466.     HRROI A,HSTSTR        ; prepare to read literal
  467.     CALL $GTHRL
  468.     IFSKP.
  469.       MOVE A,DSTPTR        ; get destination pointer
  470.       CALL $GTHNS        ; translate to name for this address
  471.        RET            ; shouldn't ever fail
  472.       RETSKP
  473.     ENDIF.
  474.     MOVX A,.GTDPN        ; get primary name function
  475.     HRROI B,HSTSTR        ; source
  476.     MOVE D,DSTPTR        ; destination
  477.     CALL $GTHST        ; go get the poop
  478.      RET            ; failed
  479.     IFN. A
  480.       MOVE A,DSTPTR        ; copy to canonical name
  481.       HRROI B,HSTSTR
  482.       SETZ C,
  483.       SOUT%
  484.       MOVE B,$UKHST        ; host address is the unknown host
  485.     ELSE.
  486.       MOVE A,D        ; return destination pointer
  487.       HRROI B,[ASCIZ/Internet/]
  488.       CALL $ARDOM
  489.       MOVE B,C        ; and host address
  490.     ENDIF.
  491.     RETSKP            ; success
  492.  
  493.     ENDSV.
  494.  
  495. ; $GTHWL - Write host literal
  496. ; Accepts:
  497. ;    A/ destination string pointer
  498. ;    B/ host address
  499. ;    CALL $GTHRL
  500. ; Returns +1: Always, updated pointer in A
  501.  
  502. $GTHWL::SAVEAC <B,C,D>
  503.     STKVAR <HSTNUM>
  504.     MOVEM B,HSTNUM
  505.     MOVEI B,"["        ; start bracketed number
  506.     IDPB B,A
  507.     LDB B,[POINT 8,HSTNUM,11] ; get first byte
  508.     MOVX C,^D10        ; output host parts in decimal
  509.     NOUT%            ; output it
  510.      ERJMP R
  511.     MOVEI D,"."        ; delimiting dot
  512.     IDPB D,A        ; add delimiting dot
  513.     LDB B,[POINT 8,HSTNUM,19] ; get next byte
  514.     NOUT%            ; output it
  515.      ERJMP R
  516.     IDPB D,A        ; add delimiting dot
  517.     LDB B,[POINT 8,HSTNUM,27] ; get next byte
  518.     NOUT%            ; output it
  519.      ERJMP R
  520.     IDPB D,A        ; add delimiting dot
  521.     LDB B,[POINT 8,HSTNUM,35] ; get final byte
  522.     NOUT%            ; output it
  523.      ERJMP R
  524.     MOVEI D,"]"        ; terminate bracketed number
  525.     IDPB D,A
  526.     RET
  527.  
  528.     ENDSV.
  529.  
  530. ; $GTHRL - Read host literal
  531. ; Accepts:
  532. ;    A/ host string pointer
  533. ;    CALL $GTHRL
  534. ; Returns +1: Failed
  535. ;      +2: Success, updated pointer in A, host address in B
  536.  
  537. $GTHRL::SAVEAC <C>
  538.     STKVAR <HSTNUM>
  539.     TXC A,.LHALF        ; is destination pointer's LH -1?
  540.     TXCN A,.LHALF
  541.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  542.     ILDB B,A        ; get opening character
  543.     CAIE B,"#"        ; moby number following?
  544.     IFSKP.
  545.       MOVX C,^D10        ; read number in decimal
  546.       NIN%            ; do it
  547.        ERJMP R        ; failed
  548.       LDB C,A        ; get terminating byte
  549.       JUMPN C,R        ; string has non-numeric text in it
  550.       RETSKP        ; return success
  551.     ENDIF.
  552.     CAIE B,"["        ; bracketed host following?
  553.      RET            ; no, fail
  554.     SETZM HSTNUM        ; clear out existing crud in number
  555.     MOVEI C,^D10        ; in decimal
  556.     NIN%            ; input number
  557.      ERJMP R        ; failed
  558.     JXN B,<<MASKB 0,27>>,R    ; disallow if not 8-bit number
  559.     DPB B,[POINT 8,HSTNUM,11] ; store byte
  560.     LDB B,A            ; get terminating byte
  561.     CAIE B,"."        ; proper terminator?
  562.      RET            ; return failure
  563.     NIN%            ; input number
  564.      ERJMP R        ; failed
  565.     JXN B,<<MASKB 0,27>>,R ; disallow if not 8-bit number
  566.     DPB B,[POINT 8,HSTNUM,19] ; store byte
  567.     LDB B,A            ; get terminating byte
  568.     CAIE B,"."        ; proper terminator?
  569.      RET            ; return failure
  570.     NIN%            ; input number
  571.      ERJMP R        ; failed
  572.     JXN B,<<MASKB 0,27>>,R    ; disallow if not 8-bit number
  573.     DPB B,[POINT 8,HSTNUM,27] ; store byte
  574.     LDB B,A            ; get terminating byte
  575.     CAIE B,"."        ; proper terminator?
  576.      RET            ; return failure
  577.     NIN%            ; input number
  578.      ERJMP R        ; failed
  579.     JXN B,<<MASKB 0,27>>,R    ; disallow if not 8-bit number
  580.     DPB B,[POINT 8,HSTNUM,35] ; store final byte
  581.     LDB B,A            ; get terminating byte
  582.     CAIE B,"]"        ; proper terminator?
  583.      RET            ; return failure
  584.     ILDB B,A        ; make sure tied off with null
  585.     JUMPN B,R
  586.     MOVE B,HSTNUM        ; return host address
  587.     RETSKP            ; return success
  588.  
  589.     ENDSV.
  590.  
  591. ; $GTHST - Jacket into GTDOM% and GTHST% jsi
  592. ; Accepts:
  593. ;    A/ function code
  594. ;    B-D/ function arguments
  595. ;    CALL $GTHST
  596. ; Returns +1: Failed
  597. ;      +2: Success, A/ status, updated arguments in B-D
  598.  
  599. ; Control flags
  600.  
  601. $GTDOK::-1            ; non-zero => OK to do GTDOM% 
  602. $GTHOK::-1            ; non-zero => OK to do GTHST%
  603. $GTMOK::0            ; non-zero => mailer, indeterminate answer OK
  604. $GTFOK::0            ; non-zero => finger, don't block on .GTHNS
  605.  
  606. $GTHST::CALL $DOGTD        ; try the domain system first
  607.     IFSKP.
  608.       CAIN A,.GTDXN        ; failure?
  609.        RET            ; yes, return that we have lost
  610.       RETSKP        ; otherwise say we won
  611.     ENDIF.
  612.     CALLRET $DOGTH        ; otherwise try the host table
  613.  
  614. ; $DOGTD - Jacket into GTDOM% jsys
  615. ; Accepts:
  616. ;    A/ function code
  617. ;    B-D/ function arguments
  618. ;    CALL $DOGTD
  619. ; Returns +1: Failed, no AC's clobbered
  620. ;      +2: Success, A/ status, updated arguments in B-D
  621.  
  622. $DOGTD::SKIPN $GTDOK        ; is GTDOM% OK?
  623.      RET            ; no, always fail
  624.     STKVAR <<ACS,4>,STAT>
  625.     DMOVEM A,ACS
  626.     DMOVEM C,2+ACS
  627.     SKIPE $GTFOK        ; don't want blocking on address to name?
  628.      CAIE A,.GTHNS        ; yes, is this address to name?
  629.     IFSKP.
  630.       TXO A,GD%RBK        ; resolve in background
  631.       GTDOM%        ; give resolver a kick
  632.        ERJMP .+1
  633.       DMOVE A,ACS        ; restore the AC's
  634.       DMOVE C,2+ACS
  635.       TXO A,GD%LDO        ; note we want to use local data only
  636.     ENDIF.
  637.     TXO A,GD%STA        ; want status on failure
  638.     GTDOM%            ; do the domain thing
  639.     IFNJE.
  640.       CAIE A,.GTDX0        ; total success?
  641.        CAIN A,.GTDXN    ; or total failure?
  642.         RETSKP        ; we have a definite answer
  643.       SKIPN $GTMOK        ; is a "maybe" OK?
  644.     ANSKP.
  645.       MOVEM A,STAT        ; yes, save status code
  646.       DMOVE A,ACS        ; see if host table can help us first
  647.       DMOVE C,2+ACS
  648.       CALL $DOGTH        ; well, does it?
  649.        MOVE A,STAT        ; if not, get the status code back
  650.     ELSE.
  651.       DMOVE A,ACS        ; domains have failed us, restore AC's
  652.       DMOVE C,2+ACS        ;  so we can try the host table
  653.       RET    
  654.     ENDIF.
  655.     RETSKP
  656.  
  657.     ENDSV.
  658.  
  659. ; $DOGTH - Jacket into GTHST% jsys
  660. ; Accepts:
  661. ;    A/ function code
  662. ;    B-D/ function arguments
  663. ;    CALL $DOGTH
  664. ; Returns +1: Failed
  665. ;      +2: Success, A/ .GTDX0, updated arguments in B-D
  666.  
  667. $DOGTH::STKVAR <FUNC,HSTPTR,DSTPTR,HSTADR>
  668.     SKIPN $GTHOK        ; OK to do GTHST%?
  669.      RET            ; no, always fail
  670.     CAIL A,.GTDPN        ; one of the new functions?
  671.      TXO A,GD%STA        ; yes, return status code in A
  672.     MOVEM A,FUNC        ; note function code
  673.     GTHST%            ; try the montior
  674.     IFNJE.
  675.       CAME A,FUNC        ; won, did it return something?
  676.        RETSKP        ; must be a new monitor
  677.     ELSE.
  678.       HRRZ A,FUNC        ; get back function code
  679.       CAIE A,.GTDVN        ; validate name?
  680.        CAIN A,.GTDPN    ; or primary name translation?
  681.       IFSKP. <RET>        ; no, give up
  682.       MOVEM D,DSTPTR    ; save destination pointer
  683.       MOVX A,.GTHSN        ; translate name to number
  684.       GTHST%
  685.        ERJMP R
  686.       MOVEM B,HSTPTR    ; updated source pointer
  687.       MOVEM C,HSTADR    ; host address
  688.       MOVX A,.GTHNS        ; number to name conversion
  689.       MOVE B,DSTPTR        ; destination pointer
  690.       GTHST%
  691.       IFNJE.
  692.         MOVEM B,DSTPTR    ; updated destination pointer
  693.       ELSE.
  694.         MOVE A,DSTPTR    ; name unknown, output literal
  695.         MOVE B,HSTADR    ; host address
  696.         CALL $GTHWL
  697.         MOVEM A,DSTPTR    ; updated destination pointer
  698.       ENDIF.
  699.       MOVE B,HSTPTR        ; updated source pointer
  700.       MOVE C,HSTADR        ; host address
  701.       MOVE D,DSTPTR        ; updated destination pointer
  702.     ENDIF.
  703.     MOVX A,.GTDX0        ; GTHST% success is always total success
  704.     RETSKP
  705.  
  706.     ENDSV.
  707.  
  708. ; $MXNS - Translate MX host address to host name
  709. ; Accepts:
  710. ;    A/ pointer to destination host string
  711. ;    B/ foreign host address
  712. ;    CALL $MXNS
  713. ; Returns +1: Failed
  714. ;      +2: Success, updated pointer in A
  715.  
  716. $MXNS::    CAMN B,[-1]        ; want local address?
  717.     IFSKP.
  718.       TMSG <%HSTNAM: Meaningless call to $MXNS
  719. >                ; otherwise this is totally bogus!
  720.       RET
  721.     ENDIF.
  722.     CALLRET $GTHNS        ; yes, perhaps somebody might want this
  723.  
  724. ; $MXSN - Translate MX host name to host address
  725. ; Accepts:
  726. ;    A/ pointer to host string
  727. ;    CALL $MXSN
  728. ; Returns +1: Failed
  729. ;      +2: Success, updated pointer in A, host address in B
  730.  
  731. $MXSN::    SAVEAC <A>
  732.     STKVAR <<HSTSTR,HSTNMW>>
  733.     HRROI B,HSTSTR        ; set up destination as dummy
  734.     CALLRET $MXCA        ; enter canonicalization routine
  735.  
  736.     ENDSV.
  737.  
  738. ; $MXCA - Get canonical name for MX host
  739. ; Accepts:
  740. ;    A/ host name string
  741. ;    B/ destination host name string
  742. ;    CALL $MXCA
  743. ; Returns +1: Failed
  744. ;      +2: Success, updated destination pointer in A, host address in B
  745.  
  746. MXBLEN==<2*HSTNMW>+1
  747.  
  748. $MXCA::    SAVEAC <C,D>
  749.     STKVAR <DSTPTR,HSTADR,<HSTSTR,HSTNMW>,<HSTBUF,MXBLEN>,<ARGBLK,.GTDML>>
  750.     MOVEM B,DSTPTR        ; save destination pointer
  751.     MOVE B,A        ; copy string so we can muck with it
  752.     HRROI A,HSTSTR        ; into HSTSTR
  753.     MOVX C,HSTNML+1        ; up to this many characters
  754.     SETZ D,            ; terminate on null
  755.     SOUT%
  756.      ERJMP R        ; percolate failure up to caller
  757.     JUMPE C,R        ; string too long if exhausted
  758.     HRROI A,HSTSTR        ; now remove Internet domain
  759.     HRROI B,[ASCIZ/Internet/]
  760.     CALL $RRDOM
  761.      RET
  762.     ILDB A,A        ; sniff at first character
  763.     CAIE A,"#"        ; looks like a literal?
  764.      CAIN A,"["
  765.       RET            ; yes, can't possibly be MX then!!
  766.     MOVX A,.GTDML        ; set up length of argument block
  767.     MOVEM A,.GTDLN+ARGBLK
  768.     SETZM .GTDTC+ARGBLK    ; no special query type/class
  769.     MOVX A,<MXBLEN*5>-1    ; get length of our buffer
  770.     MOVEM A,.GTDBC+ARGBLK
  771.     SETZM .GTDNM+ARGBLK    ; this gets returned
  772.     SETZM .GTDRD+ARGBLK    ; so does this
  773.     MOVX A,.GTDMX        ; want MX poop
  774.     HRROI B,HSTSTR        ; source pointer
  775.     HRROI C,HSTBUF        ; destination string buffer
  776.     MOVEI D,ARGBLK        ; argument block
  777.     CALL $GTHST
  778.      RET
  779.     MOVE B,$UKHST        ; return the unknown host as default address
  780.     MOVEM B,HSTADR
  781.     IFN. A            ; have determinate information?
  782.       MOVE A,DSTPTR        ; indeterminate, just copy the argument
  783.       HRROI B,HSTSTR
  784.       SETZ C,
  785.       SOUT%
  786.     ELSE.
  787.       MOVE A,DSTPTR        ; copy to canonical name
  788.       MOVE B,.GTDNM+ARGBLK    ; get pointer to canonical string
  789.       MOVX C,HSTNML+1    ; up to this many characters
  790.       SETZ D,        ; terminate on null
  791.       SOUT%
  792.        ERJMP R        ; percolate failure up to caller
  793.       JUMPE C,R        ; string too long if exhausted
  794.       MOVEM A,DSTPTR    ; save updated pointer
  795.       MOVE A,.GTDRD+ARGBLK    ; get pointer to relay
  796.       CALL $GTHSN        ; get its address
  797.       IFNSK.
  798.         MOVE A,DSTPTR    ; return the correct pointer
  799.       ELSE.
  800.         MOVEM B,HSTADR    ; save host address
  801.         SETO A,        ; I hate this behavior of SOUT%
  802.         ADJBP A,DSTPTR
  803.         HRROI B,[ASCIZ/Internet/]
  804.         CALL $ARDOM
  805.       ENDIF.
  806.     ENDIF.
  807.     MOVE B,HSTADR
  808.     RETSKP
  809.  
  810.     ENDSV.
  811.  
  812. ; $INTNS - Translate Internet mail host address to host name
  813. ; Accepts:
  814. ;    A/ pointer to destination host string
  815. ;    B/ foreign host address
  816. ;    CALL $INTNS
  817. ; Returns +1: Failed
  818. ;      +2: Success, updated pointer in A
  819.  
  820. $INTNS::TMSG <%HSTNAM: Meaningless call to $INTNS
  821. >                ; totally bogus!
  822.     RET
  823.  
  824. ; $INTSN - Translate Internet mail host name to host address
  825. ; Accepts:
  826. ;    A/ pointer to host string
  827. ;    CALL $INTSN
  828. ; Returns +1: Failed
  829. ;      +2: Success, updated pointer in A, host address in B
  830.  
  831. $INTSN::TMSG <%HSTNAM: Meaningless call to $INTSN
  832. >                ; totally bogus!
  833.     RET
  834.  
  835. ; $INTCA - Get canonical name for Internet mail host
  836. ; Accepts:
  837. ;    A/ host name string
  838. ;    B/ destination host name string
  839. ;    CALL $INTCA
  840. ; Returns +1: Failed
  841. ;      +2: Success, updated destination pointer in A
  842.  
  843. MXBLEN==<2*HSTNMW>+1
  844.  
  845. $INTCA::SAVEAC <B,C,D>
  846.     TXC A,.LHALF        ; is destination pointer's LH -1?
  847.     TXCN A,.LHALF
  848.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  849.     MOVE C,A
  850.     ILDB C,C        ; sniff at first character
  851.     CAIE C,"#"        ; looks like a literal?
  852.      CAIN C,"["
  853.     IFNSK. <CALLRET $GTHCA>    ; it is, use the physical routine
  854.     STKVAR <DSTPTR,<HSTSTR,HSTNMW>>
  855.     MOVEM B,DSTPTR        ; save destination pointer
  856.     MOVE B,A        ; copy string so we can muck with it
  857.     HRROI A,HSTSTR        ; into HSTSTR
  858.     MOVX C,HSTNML+1        ; up to this many characters
  859.     SETZ D,            ; terminate on null
  860.     SOUT%
  861.      ERJMP R        ; percolate failure up to caller
  862.     JUMPE C,R        ; string too long if exhausted
  863.     HRROI A,HSTSTR        ; now remove Internet domain
  864.     HRROI B,[ASCIZ/Internet/]
  865.     CALL $RRDOM
  866.      RET
  867.     MOVX A,.GTDVN        ; validate name
  868.     HRROI B,HSTSTR        ; source pointer
  869.     MOVX C,.GTDVH        ; validate host
  870.     MOVE D,DSTPTR        ; destination designator
  871.     CALL $GTHST
  872.      RET
  873.     IFN. A            ; have determinate information?
  874.       MOVE A,DSTPTR        ; indeterminate, just copy the argument
  875.       HRROI B,HSTSTR
  876.       SETZ C,
  877.       SOUT%
  878.     ELSE.
  879.       MOVE A,D        ; determinate, put Internet after name
  880.       HRROI B,[ASCIZ/Internet/]
  881.       CALL $ARDOM
  882.     ENDIF.
  883.     RETSKP
  884.  
  885.     ENDSV.
  886.     SUBTTL Protocol-specific routines - DECnet
  887.  
  888. ; $DECNS - Translate DECnet host address to host name
  889. ; Accepts:
  890. ;    A/ pointer to destination host string
  891. ;    B/ foreign host address
  892. ;    CALL $DECNS
  893. ; Returns +1: Failed
  894. ;      +2: Success, updated pointer in A
  895.  
  896. $DECNS::SAVEAC <C>
  897.     STKVAR <HSTPTR,HSTNUM,<NODBLK,2>>
  898.     TXC A,.LHALF        ; is string pointer LH -1?
  899.     TXCN A,.LHALF
  900.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  901.     MOVEM A,HSTPTR        ; save destination pointer
  902.     MOVEM B,HSTNUM        ; save host "number"
  903.     CAME B,[-1]        ; want local address?
  904.     IFSKP.
  905.       MOVEM A,.NDNOD+NODBLK    ; set up string pointer in NODE% block
  906.       MOVX A,.NDGLN        ; get local node name function
  907.       MOVEI B,NODBLK    ; pointer to destination name string
  908.       NODE%            ; get local name
  909.        ERJMP R        ; failed
  910.       MOVE A,HSTPTR        ; now build host "number"
  911.       CALL $DECSN
  912.        RET            ; NODE%, but no DECnet apparently
  913.       MOVEM A,HSTPTR    ; set as updated host pointer
  914.       MOVEM B,HSTNUM    ; save host "number"
  915.     ELSE.
  916.       MOVE A,HSTPTR        ; get destination string pointer
  917.       DO.
  918.         SETZ C,        ; prepare for byte
  919.         ROTC B,6        ; get a SIXBIT byte
  920.         JUMPE C,R        ; imbedded space invalid
  921.         ADDI C,"A"-'A'    ; convert to ASCII
  922.         IDPB C,A        ; store in returned string
  923.         JUMPN B,TOP.    ; get next byte
  924.       ENDDO.
  925.       MOVE C,A        ; tie off string
  926.       IDPB B,C
  927.       EXCH A,HSTPTR        ; update pointer
  928.       CALL $DECVY        ; try to verify
  929.        RET
  930.     ENDIF.
  931.     MOVE A,HSTPTR        ; return updated pointer
  932.     HRROI B,[ASCIZ/DECnet/]    ; add DECnet domain
  933.     CALL $ARDMH
  934.     MOVE B,HSTNUM        ; and updated "number"
  935.     RETSKP
  936.  
  937.     ENDSV.
  938.  
  939. ; $DECSN - Translate DECnet host name to host address
  940. ; Accepts:
  941. ;    A/ pointer to host string
  942. ;    CALL $DECSN
  943. ; Returns +1: Failed
  944. ;      +2: Success, updated pointer in A, host address in B
  945.  
  946. $DECSN::SAVEAC <C,D>
  947.     STKVAR <HSTPTR,HSTNUM,<HSTSTR,HSTNMW>>
  948.     MOVEM A,HSTPTR        ; save host pointer
  949.     HRROI A,HSTSTR        ; copy string so we can muck with it
  950.     MOVE B,HSTPTR        ; get back host pointer
  951.     MOVX C,HSTNML+1        ; up to this many characters
  952.     SETZ D,            ; terminate on null
  953.     SOUT%
  954.      ERJMP R        ; percolate failure up to caller
  955.     JUMPE C,R        ; string too long if exhausted
  956.     MOVEM B,HSTPTR        ; save pointer
  957.     SETO B,            ; back pointer up by one
  958.     ADJBP B,HSTPTR
  959.     MOVEM B,HSTPTR        ; save updated pointer
  960.     HRROI A,HSTSTR        ; now remove DECnet domain
  961.     HRROI B,[ASCIZ/DECnet/]
  962.     CALL $RRDMH
  963.      RET
  964.     CALL $DECVY        ; try to verify
  965.      RET
  966.     SETZM HSTNUM        ; now build host "number"
  967.     MOVE B,[POINT 6,HSTNUM]
  968.     DO.
  969.       ILDB C,A        ; get byte of name
  970.       CAIG C," "        ; has a sixbit representation?
  971.        EXIT.        ; no, done
  972.       CAIL C,"`"        ; lowercase?
  973.        SUBI C,"a"-"A"    ; yes, convert to upper case
  974.       SUBI C,"A"-'A'    ; convert to SIXBIT
  975.       IDPB C,B        ; stash in string
  976.       TLNE B,770000        ; at last byte?
  977.        LOOP.
  978.     ENDDO.
  979.     MOVE A,HSTPTR        ; return updated pointer
  980.     MOVE B,HSTNUM        ; and updated "number"
  981.     RETSKP
  982.  
  983.     ENDSV.
  984.  
  985. ; $DECCA - Get canonical name for DECnet host
  986. ; Accepts:
  987. ;    A/ host name string
  988. ;    B/ destination host name string
  989. ;    CALL $DECCA
  990. ; Returns +1: Failed
  991. ;      +2: Success, updated destination pointer in A, host address in B
  992.  
  993. $DECCA::STKVAR <HSTPTR>
  994.     MOVEM B,HSTPTR        ; save destination pointer
  995.     CALL $DECSN        ; get host address
  996.      RET            ; fails
  997.     MOVE A,HSTPTR        ; get destination pointer
  998.     CALL $DECNS        ; translate to canonical name
  999.      RET            ; shouldn't ever fail
  1000.     RETSKP            ; success
  1001.  
  1002.     ENDSV.
  1003.  
  1004. ; $DECVY - Verify DECnet node name
  1005. ; Accepts:
  1006. ;    A/ pointer to node name string
  1007. ; Returns +1: Failed
  1008. ;      +2: Success, name validated
  1009.  
  1010. $DECVY::SAVEAC <A,B>
  1011.     STKVAR <<DCNFIL,40>,DCNJFN,NODPTR,<NODBLK,2>>
  1012.     MOVEM A,NODPTR        ; save pointer for later
  1013.     MOVEM A,.NDNOD+NODBLK    ; and in NODE% block
  1014.     MOVX A,.NDVFY        ; validate node name
  1015.     MOVEI B,NODBLK
  1016.     NODE%
  1017.      ERJMP R        ; syntax invalid
  1018.     JN ND%EXM,.NDFLG+NODBLK,RSKP ; validated name
  1019.     HRROI A,DCNFIL        ; syntax valid, but name not, do extra test
  1020.     HRROI B,[ASCIZ/DCN:/]
  1021.     SETZ C,
  1022.     SOUT%
  1023.     MOVE B,NODPTR
  1024.     SOUT%
  1025.     HRROI B,[ASCIZ/-TASK-DCNVFY-TEST/] ; random task name
  1026.     SOUT%
  1027.     IDPB C,A        ; tie off string with null
  1028.     MOVX A,GJ%SHT        ; see if we can get that name
  1029.     HRROI B,DCNFIL
  1030.     GTJFN%
  1031.      ERJMP R        ; can't get name, no DECnet or something
  1032.     MOVEM A,DCNJFN        ; save JFN for later
  1033.     MOVX B,OF%RD        ; open for read
  1034.     OPENF%
  1035.     IFNJE.
  1036.       CLOSF%        ; won, flush the connection
  1037.        ERJMP .+1
  1038.     ELSE.
  1039.       EXCH A,DCNJFN        ; get back the JFN, save error code
  1040.       RLJFN%        ; free it
  1041.        ERJMP .+1        ; ignore error here
  1042.       MOVE A,DCNJFN        ; get back error code
  1043.       CAIE A,NSPX18        ; was it "No path to node"?
  1044.        RET            ; no, no such node then
  1045.     ENDIF.
  1046.     RETSKP            ; return success
  1047.  
  1048.     ENDSV.
  1049.     SUBTTL Protocol-specific routines - Pup
  1050.  
  1051. ; $PUPNS - Translate Pup Ethernet host address to host name
  1052. ; Accepts:
  1053. ;    A/ pointer to destination host string
  1054. ;    B/ foreign host address
  1055. ;    CALL $PUPNS
  1056. ; Returns +1: Failed
  1057. ;      +2: Success, updated pointer in A
  1058.  
  1059. $PUPNS::SAVEAC <C,D>
  1060.     STKVAR <HSTPTR,<PUPHSN,2>>
  1061.     MOVEM A,HSTPTR        ; save host pointer
  1062.     CAME B,[-1]        ; want local address?
  1063.     IFSKP.
  1064.       MOVX A,SIXBIT/PUPROU/    ; get GETAB% index of PUPROU table
  1065.       SYSGT%        ; B/ -items,,table number
  1066.        ERJMP R        ; shouldn't happen
  1067.       JUMPE B,R        ; fail if no such table
  1068.       HLLZ C,B        ; C/ AOBJN pointer through PUPROU
  1069.       DO.
  1070.         HRR A,B        ; table number
  1071.         HRL A,C        ; index in table
  1072.         GETAB%        ; get table entry
  1073.          ERJMP R        ; shouldn't happen
  1074.         IFXE. A,1B0        ; network inaccessible?
  1075.           JXN A,.RHALF,ENDLP. ; no, done if have local addr on this network
  1076.         ENDIF.
  1077.         AOBJN C,TOP.    ; try next entry
  1078.         RET            ; unable to find our host address
  1079.       ENDDO.
  1080.       HRLI B,1(C)        ; network # is 1+<PUPROU index>
  1081.       HRR B,A        ; host # is in RH of PUPROU entry
  1082.     ENDIF.
  1083.     MOVEM B,PUPHSN        ; save host address argument
  1084.     SETZM 1+PUPHSN        ; don't want port info
  1085.     MOVE A,HSTPTR        ; destination string
  1086.     MOVX B,PN%FLD!PN%OCT!<FLD 1,.LHALF> ; no defaults, use octal if have to
  1087.     HRRI B,PUPHSN        ; pointer to host address
  1088.     PUPNM%            ; call incredibly hairy Pup JSYS
  1089.      ERJMP R        ; failed
  1090.     HRROI B,[ASCIZ/Pup/]    ; add Pup domain
  1091.     CALL $ARDMH
  1092.     MOVE B,PUPHSN        ; return host number too in case argument -1
  1093.     RETSKP
  1094.  
  1095.     ENDSV.
  1096.  
  1097. ; $PUPSN - Translate Pup Ethernet host name to host address
  1098. ; Accepts:
  1099. ;    A/ pointer to host string
  1100. ;    CALL $PUPSN
  1101. ; Returns +1: Failed
  1102. ;      +2: Success, updated pointer in A, host address in B
  1103.  
  1104. $PUPSN::SAVEAC <C,D>
  1105.     STKVAR <HSTPTR,<HSTSTR,HSTNMW>,<PUPHSN,2>>
  1106.     MOVE B,A        ; copy string so we can muck with it
  1107.     HRROI A,HSTSTR        ; into HSTSTR
  1108.     MOVX C,HSTNML+1        ; up to this many characters
  1109.     SETZ D,            ; terminate on null
  1110.     SOUT%
  1111.      ERJMP R        ; percolate failure up to caller
  1112.     JUMPE C,R        ; string too long if exhausted
  1113.     MOVEM B,HSTPTR        ; save pointer
  1114.     SETO B,            ; back pointer up by one
  1115.     ADJBP B,HSTPTR
  1116.     MOVEM B,HSTPTR        ; save updated pointer
  1117.     HRROI A,HSTSTR        ; now remove Pup domain
  1118.     HRROI B,[ASCIZ/Pup/]
  1119.     CALL $RRDMH
  1120.      RET
  1121.     MOVX B,PN%NAM!<FLD 1,.LHALF> ; lookup name, return one word
  1122.     HRRI B,PUPHSN        ; pointer to host address
  1123.     PUPNM%            ; call incredibly hairy Pup JSYS
  1124.      ERJMP R        ; failed
  1125.     MOVE A,HSTPTR        ; return updated pointer
  1126.     MOVE B,PUPHSN        ; get host address
  1127.     RETSKP
  1128.  
  1129.     ENDSV.
  1130.  
  1131. ; $PUPCA - Get canonical name for Pup host
  1132. ; Accepts:
  1133. ;    A/ host name string
  1134. ;    B/ destination host name string
  1135. ;    CALL $PUPCA
  1136. ; Returns +1: Failed
  1137. ;      +2: Success, updated destination pointer in A, host address in B
  1138.  
  1139. $PUPCA::STKVAR <HSTPTR>
  1140.     MOVEM B,HSTPTR        ; save destination pointer
  1141.     CALL $PUPSN        ; get host address
  1142.      RET            ; fails
  1143.     MOVE A,HSTPTR        ; get destination pointer
  1144.     CALL $PUPNS        ; translate to canonical name
  1145.      RET            ; shouldn't ever fail
  1146.     RETSKP            ; success
  1147.  
  1148.     ENDSV.
  1149.     SUBTTL Protocol-specific routines - Chaosnet
  1150.  
  1151. ; $CHSNS - Translate Chaosnet host address to host name
  1152. ; Accepts:
  1153. ;    A/ pointer to destination host string
  1154. ;    B/ foreign host address
  1155. ;    CALL $CHSNS
  1156. ; Returns +1: Failed
  1157. ;      +2: Success, updated pointer in A
  1158.  
  1159. $CHSNS::SAVEAC <C>
  1160.     STKVAR <HSTPTR,HSTNUM>
  1161.     MOVEM A,HSTPTR        ; save host pointer
  1162.     MOVEM B,HSTNUM        ; save host number
  1163.     CAME B,[-1]        ; want local address?
  1164.     IFSKP.
  1165.       MOVX A,.CHNPH        ; return primary name/address
  1166.       MOVE B,HSTPTR        ; pointer to string
  1167.       CHANM%
  1168.        ERJMP R        ; failed
  1169.       MOVEM A,HSTNUM    ; set returned address
  1170.     ELSE.
  1171.       MOVX A,.CHNNS        ; return name for this address
  1172.       MOVE B,HSTPTR
  1173.       MOVE C,HSTNUM
  1174.       CHANM%
  1175.        ERJMP R        ; failed
  1176.     ENDIF.
  1177.     MOVE A,B        ; updated pointer from CHANM% returned in B
  1178.     HRROI B,[ASCIZ/Chaos/]    ; add Chaos domain
  1179.     CALL $ARDMH
  1180.     MOVE B,HSTNUM        ; return host number too in case argument -1
  1181.     RETSKP
  1182.  
  1183.     ENDSV.
  1184.  
  1185. ; $CHSSN - Translate Chaosnet host name to host address
  1186. ; Accepts:
  1187. ;    A/ pointer to host string
  1188. ;    CALL $CHSSN
  1189. ; Returns +1: Failed
  1190. ;      +2: Success, updated pointer in A, host address in B
  1191.  
  1192. $CHSSN::SAVEAC <C,D>
  1193.     STKVAR <HSTPTR,<HSTSTR,HSTNMW>>
  1194.     MOVE B,A        ; copy string so we can muck with it
  1195.     HRROI A,HSTSTR        ; into HSTSTR
  1196.     MOVX C,HSTNML+1        ; up to this many characters
  1197.     SETZ D,            ; terminate on null
  1198.     SOUT%
  1199.      ERJMP R        ; percolate failure up to caller
  1200.     JUMPE C,R        ; string too long if exhausted
  1201.     MOVEM B,HSTPTR        ; save pointer
  1202.     SETO B,            ; back pointer up by one
  1203.     ADJBP B,HSTPTR
  1204.     MOVEM B,HSTPTR        ; save updated pointer
  1205.     HRROI A,HSTSTR        ; now remove Chaos domain
  1206.     HRROI B,[ASCIZ/Chaos/]
  1207.     CALL $RRDMH
  1208.      RET
  1209.     MOVX A,.CHNSN        ; Chaosnet name to number
  1210.     HRROI B,HSTSTR        ; foreign host name
  1211.     CHANM%
  1212.      ERJMP R
  1213.     EXCH A,B        ; want pointer in A, address in B
  1214.     RETSKP
  1215.  
  1216.     ENDSV.
  1217.  
  1218. ; $CHSCA - Get canonical name for Chaosnet host
  1219. ; Accepts:
  1220. ;    A/ host name string
  1221. ;    B/ destination host name string
  1222. ;    CALL $CHSCA
  1223. ; Returns +1: Failed
  1224. ;      +2: Success, updated destination pointer in A, host address in B
  1225.  
  1226. $CHSCA::STKVAR <HSTPTR>
  1227.     MOVEM B,HSTPTR        ; save destination pointer
  1228.     CALL $CHSSN        ; get host address
  1229.      RET            ; fails
  1230.     MOVE A,HSTPTR        ; get destination pointer
  1231.     CALL $CHSNS        ; translate to canonical name
  1232.      RET            ; shouldn't ever fail
  1233.     RETSKP            ; success
  1234.  
  1235.     ENDSV.
  1236.     SUBTTL Protocol-specific routines - "Special" network
  1237.  
  1238. ; $SPCNS - Translate "Special" host address to host name
  1239. ; Accepts:
  1240. ;    A/ pointer to destination host string
  1241. ;    B/ foreign host address
  1242. ;    CALL $SPCNS
  1243. ; Returns +1: Failed
  1244. ;      +2: Success, updated pointer in A
  1245.  
  1246. $SPCNS::SAVEAC <C,D>
  1247.     STKVAR <HSTPTR,HSTNUM,<DIRSTR,20>,TOPDIR,NAMPTR>
  1248.     MOVEM A,HSTPTR        ; save host pointer
  1249.     MOVEM B,HSTNUM        ; save host number
  1250.     MOVX A,.LNSSY        ; get root dir name of special hosts
  1251.     HRROI B,[ASCIZ/MAILS/]    ; it is called MAILS:
  1252.     HRROI C,DIRSTR        ; into DIRSTR
  1253.     LNMST%
  1254.      ERJMP R        ; no such name, no specials!
  1255.     MOVX A,RC%EMO        ; require exact match
  1256.     HRROI B,DIRSTR        ; of directory name
  1257.     RCDIR%            ; see if such a directory exists
  1258.      ERJMP R        ; bogus name, barf
  1259.     JXN A,RC%NOM,R        ; if no match, no special hosts
  1260.     MOVEM C,TOPDIR        ; save directory number
  1261.     HRROI A,DIRSTR        ; get canonical name string for MAILS:
  1262.     MOVE B,TOPDIR
  1263.     DIRST%
  1264.      ERJMP R        ; failed
  1265.     HRROI A,DIRSTR        ; get name string for directory number
  1266.     MOVE B,HSTNUM        ; get back desired address
  1267.     CAME B,[-1]        ; want local address?
  1268.     IFSKP.
  1269.       MOVE B,TOPDIR        ; yes, get our address
  1270.       MOVEM B,HSTNUM    ; save for value return
  1271.     ENDIF.
  1272.     DIRST%            ; get the name strig
  1273.      ERJMP R        ; failed
  1274.     LDB D,A            ; get terminator for later
  1275.     SETZ B,            ; flush terminating brocket
  1276.     DPB B,A
  1277.     DO.
  1278.       SETO B,        ; back up pointer one byte
  1279.       ADJBP B,A
  1280.       MOVE A,B        ; update pointer to "host name"
  1281.       LDB C,B        ; see if found terminator
  1282.       CAIE C,"["
  1283.        CAIN C,"<"        ; if at beginning then top level
  1284.       IFSKP.
  1285.         CAIE C,"."        ; else try to find the dot
  1286.          LOOP.        ; didn't find it
  1287.       ENDIF.
  1288.     ENDDO.
  1289.     MOVEM B,NAMPTR        ; save name pointer
  1290.     MOVE A,HSTNUM        ; see if local host
  1291.     CAMN A,TOPDIR        ; if not we must make sure it's a subdir
  1292.     IFSKP.
  1293.       DPB D,B        ; stuff terminator
  1294.       ILDB D,B        ; get first byte of name
  1295.       SETZ C,        ; wipe it for test
  1296.       DPB C,B
  1297.       MOVX A,RC%EMO        ; require exact match
  1298.       HRROI B,DIRSTR    ; of directory name
  1299.       RCDIR%        ; parse the name
  1300.        ERJMP R        ; bogus name, barf
  1301.       JXN A,RC%NOM,R    ; if no match, barf
  1302.       CAME C,TOPDIR        ; is superior the MAILS: directory?
  1303.        RET            ; no, lose
  1304.       MOVE B,NAMPTR        ; put first byte back again
  1305.       IDPB D,B
  1306.     ENDIF.
  1307.     MOVE A,HSTPTR        ; copy string
  1308.     MOVE B,NAMPTR
  1309.     SETZ C,            ; no limit
  1310.     SOUT%
  1311.      ERJMP R        ; percolate failure up to caller
  1312.     MOVEM A,NAMPTR        ; save current pointer in case SPCDOM fails
  1313.     MOVEI B,"."        ; add domain delimiter
  1314.     IDPB B,A
  1315.     MOVE B,HSTNUM        ; add any higher level domain name
  1316.     CALL $ASDOM
  1317.      MOVE A,NAMPTR        ; no higher level name
  1318.     HRROI B,[ASCIZ/Special/] ; add Special domain
  1319.     CALL $ARDOM
  1320.     MOVE B,HSTNUM        ; return host number too in case argument -1
  1321.     RETSKP
  1322.  
  1323.     ENDSV.
  1324.  
  1325. ; $SPCSN - Translate "Special" host name to host address
  1326. ; Accepts:
  1327. ;    A/ pointer to host string
  1328. ;    CALL $SPCSN
  1329. ; Returns +1: Failed
  1330. ;      +2: Success, updated pointer in A, host address in B
  1331.  
  1332. $SPCSN::SAVEAC <C,D>
  1333.     STKVAR <HSTPTR,<HSTSTR,HSTNMW>,<DIRSTR,HSTNMW>,HSTNUM,NAMPTR,DOMPTR>
  1334.     MOVE B,A        ; copy string so we can muck with it
  1335.     HRROI A,HSTSTR        ; into HSTSTR
  1336.     MOVX C,HSTNML+1        ; up to this many characters
  1337.     SETZ D,            ; terminate on null
  1338.     SOUT%
  1339.      ERJMP R        ; percolate failure up to caller
  1340.     JUMPE C,R        ; string too long if exhausted
  1341.     MOVEM B,HSTPTR        ; save pointer
  1342.     SETO B,            ; back pointer up by one
  1343.     ADJBP B,HSTPTR
  1344.     MOVEM B,HSTPTR        ; save updated pointer
  1345.     HRROI A,HSTSTR        ; now remove Special domain
  1346.     HRROI B,[ASCIZ/Special/]
  1347.     CALL $RRDOM
  1348.      RET
  1349.     SETZM DOMPTR        ; no follow-up domain pointer
  1350.     DO.
  1351.       ILDB B,A        ; see if there's a domain delimiter
  1352.       CAIE B,"."
  1353.        JUMPN B,TOP.        ; not yet, keep on going
  1354.       JUMPE B,ENDLP.    ; end of string?
  1355.       SETZ B,        ; no, tie off string here then
  1356.       DPB B,A
  1357.       MOVEM A,DOMPTR    ; remember the pointer to the domain
  1358.     ENDDO.
  1359.     MOVX A,.LNSSY        ; get root dir name of special hosts
  1360.     HRROI B,[ASCIZ/MAILS/]    ; it is called MAILS:
  1361.     HRROI C,DIRSTR        ; into DIRSTR
  1362.     LNMST%
  1363.      ERJMP R        ; no such name, no specials!
  1364.     MOVX A,RC%EMO        ; require exact match
  1365.     HRROI B,DIRSTR        ; of directory name
  1366.     RCDIR%            ; see if such a directory exists
  1367.      ERJMP R        ; bogus name, barf
  1368.     JXN A,RC%NOM,R        ; if no match, no special hosts
  1369.     MOVEM C,HSTNUM        ; save directory number
  1370.     HRROI A,DIRSTR        ; get canonical name string for MAILS:
  1371.     MOVE B,HSTNUM
  1372.     DIRST%
  1373.      ERJMP R        ; failed
  1374.     MOVEM A,NAMPTR        ; save pointer for later
  1375.     LDB D,NAMPTR        ; get terminator for later
  1376.     SETZ B,            ; flush terminating brocket
  1377.     DPB B,NAMPTR
  1378.     DO.
  1379.       SETO B,        ; back up pointer one byte
  1380.       ADJBP B,A
  1381.       MOVE A,B        ; update pointer to "host name"
  1382.       LDB C,B        ; see if found terminator
  1383.       CAIE C,"["
  1384.        CAIN C,"<"        ; if at beginning then top level
  1385.       IFSKP.
  1386.         CAIE C,"."        ; else try to find the dot
  1387.          LOOP.        ; didn't find it
  1388.       ENDIF.
  1389.     ENDDO.
  1390.     HRROI B,HSTSTR        ; see if it matches top directory
  1391.     STCMP%
  1392.      ERJMP R
  1393.     IFN. A
  1394.       MOVX B,"."        ; it didn't, patch in subdir delimeter
  1395.       DPB B,NAMPTR
  1396.       MOVE A,NAMPTR
  1397.       HRROI B,HSTSTR    ; now patch in host name
  1398.       SETZ C,
  1399.       SOUT%
  1400.       IDPB D,A        ; add on directory delimiter
  1401.       IDPB C,A        ; and tie off with null
  1402.       MOVX A,RC%EMO        ; require exact match
  1403.       HRROI B,DIRSTR    ; of directory name
  1404.       RCDIR%        ; see if such a directory exists
  1405.        ERJMP R        ; bogus name, barf
  1406.       JXN A,RC%NOM,R    ; if no match, no such special host
  1407.       MOVEM C,HSTNUM    ; directory number of the "host"
  1408.     ENDIF.
  1409.     SKIPN DOMPTR        ; did user give a domain?
  1410.     IFSKP.
  1411.       HRROI A,DIRSTR    ; yeah, one last check, get the
  1412.       MOVE B,HSTNUM        ;  correct higher-level name
  1413.       CALL $ASDOM
  1414.        RET            ; there isn't any for this host!
  1415.       MOVE A,DOMPTR        ; compare user's string
  1416.       HRROI B,DIRSTR    ; with correct string
  1417.       STCMP%
  1418.        ERJMP R
  1419.       JUMPN A,R        ; fail if no match
  1420.     ENDIF.
  1421.     MOVE A,HSTPTR        ; return updated pointer
  1422.     MOVE B,HSTNUM        ; and "host number"
  1423.     RETSKP
  1424.  
  1425.     ENDSV.
  1426.  
  1427. ; $SPCCA - Get canonical name for Special network host
  1428. ; Accepts:
  1429. ;    A/ host name string
  1430. ;    B/ destination host name string
  1431. ;    CALL $SPCCA
  1432. ; Returns +1: Failed
  1433. ;      +2: Success, updated destination pointer in A, host address in B
  1434.  
  1435. $SPCCA::STKVAR <HSTPTR>
  1436.     MOVEM B,HSTPTR        ; save destination pointer
  1437.     CALL $SPCSN        ; get host address
  1438.      RET            ; fails
  1439.     MOVE A,HSTPTR        ; get destination pointer
  1440.     CALL $SPCNS        ; translate to canonical name
  1441.      RET            ; shouldn't ever fail
  1442.     RETSKP            ; success
  1443.  
  1444.     ENDSV.
  1445.  
  1446. ; $ASDOM - Copy higher-level domain name for Special network
  1447. ; Accepts:
  1448. ;    A/ pointer to destination string
  1449. ;    B/ directory number
  1450. ; Returns +1: No higher level name exists
  1451. ;      +2: Success, updated pointer in A
  1452.  
  1453. $ASDOM::SAVEAC <B,C>
  1454.     STKVAR <DSTPTR,<DOMTXT,HSTNMW>>
  1455.     MOVEM A,DSTPTR        ; save destination pointer
  1456.     HRROI A,DOMTXT        ; get directory name
  1457.     DIRST%
  1458.      ERJMP R        ; ??
  1459.     HRROI B,[ASCIZ/HIGHER-LEVEL-DOMAIN.TXT/]
  1460.     SETZ C,            ; tack on file name
  1461.     SOUT%
  1462.     MOVE A,DSTPTR        ; get destination again
  1463.     HRROI B,DOMTXT        ; now copy file
  1464.     CALLRET $CPFIL
  1465.  
  1466.     ENDSV.
  1467.     SUBTTL Local domain management routines
  1468.  
  1469. ; $ADDOM - Add top-level domain name
  1470. ; Accepts:
  1471. ;    A/ pointer to host string
  1472. ;    B/ pointer to domain name string
  1473. ;    CALL $ADDOM
  1474. ; Returns +1: Always, updated pointer in A
  1475.  
  1476. $ADDOM::SAVEAC <B,C>
  1477.     MOVEI C,"."        ; add domain delimiter
  1478.     IDPB C,A
  1479.     SETZ C,            ; no limit
  1480.     SOUT%
  1481.     RET
  1482.  
  1483. ; $RMDOM - Remove top-level domain name
  1484. ; Accepts:
  1485. ;    A/ pointer to host string
  1486. ;    B/ pointer to domain name string
  1487. ;    CALL $RMDOM
  1488. ; Returns +1: Always
  1489.  
  1490. $RMDOM::SAVEAC <B>
  1491.     STKVAR <HSTPTR,DOMPTR,DOMNAM>
  1492.     SETZM DOMPTR        ; initially no top-level domain pointer
  1493.     MOVEM B,DOMNAM
  1494.     TXC A,.LHALF        ; is source LH -1?
  1495.     TXCN A,.LHALF
  1496.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1497.     MOVEM A,HSTPTR        ; set up pointer to return
  1498.     DO.
  1499.       ILDB B,A        ; get a byte from name
  1500.       JUMPE B,ENDLP.    ; if null, scan done
  1501.       CAIE B,"."        ; start of a domain segment?
  1502.        LOOP.        ; no
  1503.       MOVEM A,DOMPTR    ; yes, remember its pointer
  1504.       MOVE B,DOMNAM        ; see if top-level domain is the one we want
  1505.       STCMP%
  1506.       IFN. A        ; name match?
  1507.         MOVE A,DOMPTR    ; no, keep on looking
  1508.         LOOP.
  1509.       ELSE.
  1510.         SETZ A,        ; yes, tie off string before top-level domain
  1511.         DPB A,DOMPTR
  1512.       ENDIF.
  1513.     ENDDO.
  1514.     MOVE A,HSTPTR
  1515.     RET
  1516.  
  1517.     ENDSV.
  1518.  
  1519. ; $ARDOM - Add relative domain by type
  1520. ; Accepts:
  1521. ;    A/ pointer to host string
  1522. ;    B/ pointer to domain type string
  1523. ;    CALL $ARDOM
  1524. ; Returns +1: Always, updated pointer in A
  1525.  
  1526. $ARDOM::SAVEAC <B>
  1527.     STKVAR <HSTPTR,<DOMSTR,HSTNMW>>
  1528.     TXC A,.LHALF        ; is source LH -1?
  1529.     TXCN A,.LHALF
  1530.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1531.     MOVEM A,HSTPTR        ; set up pointer to return
  1532.     HRROI A,DOMSTR        ; get relative name
  1533.     CALL $MKREL
  1534.      RET
  1535.     MOVE A,HSTPTR        ; add the relative name
  1536.     HRROI B,DOMSTR
  1537.     CALLRET $ADDOM
  1538.  
  1539.     ENDSV.
  1540.  
  1541. ; $ARDMH - Add relative and higher-level domain by type
  1542. ; Accepts:
  1543. ;    A/ pointer to host string
  1544. ;    B/ pointer to domain type string
  1545. ;    CALL $ARDMH
  1546. ; Returns +1: Always, updated pointer in A
  1547.  
  1548. $ARDMH::SAVEAC <B>
  1549.     STKVAR <HSTPTR,DOMTYP,<DOMSTR,HSTNMW>>
  1550.     TXC A,.LHALF        ; is source LH -1?
  1551.     TXCN A,.LHALF
  1552.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1553.     MOVEM A,HSTPTR        ; set up pointer to return
  1554.     MOVEM B,DOMTYP        ; save domain type
  1555.     HRROI A,DOMSTR        ; make higher level name
  1556.     CALL $MKHLN
  1557.     IFSKP.
  1558.       MOVE A,HSTPTR        ; remove the higher level name
  1559.       HRROI B,DOMSTR
  1560.       CALL $ADDOM
  1561.       MOVEM A,HSTPTR    ; save pointer
  1562.     ENDIF.
  1563.     MOVE A,HSTPTR        ; add the relative name
  1564.     MOVE B,DOMTYP
  1565.     CALLRET $ARDOM
  1566.  
  1567.     ENDSV.
  1568.  
  1569. ; $RRDOM - Remove relative domain by type
  1570. ; Accepts:
  1571. ;    A/ pointer to host string
  1572. ;    B/ pointer to relative domain type string
  1573. ;    CALL $RRDOM
  1574. ; Returns +1: Failed (probably some other relative domain)
  1575. ;      +2: Success, updated pointer in A
  1576.  
  1577. $RRDOM::SAVEAC <B>
  1578.     STKVAR <HSTPTR,DOMPTR,DOMNAM>
  1579.     SETZM DOMPTR        ; initially no top-level domain pointer
  1580.     MOVEM B,DOMNAM
  1581.     TXC A,.LHALF        ; is source LH -1?
  1582.     TXCN A,.LHALF
  1583.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1584.     MOVEM A,HSTPTR        ; set up pointer to return
  1585.     DO.
  1586.       ILDB B,A        ; get a byte from name
  1587.       IFN. B        ; if null, scan done
  1588.         CAIN B,"."        ; start of a domain segment?
  1589.          MOVEM A,DOMPTR    ; yes, remember its pointer
  1590.         LOOP.
  1591.       ENDIF.
  1592.     ENDDO.
  1593.     SKIPN B,DOMPTR        ; have a domain?
  1594.     IFSKP.
  1595.       ILDB A,B        ; see if it's relative
  1596.       CAIE A,"#"
  1597.     ANSKP.
  1598.       MOVE A,DOMNAM        ; see if domain matches
  1599.       STCMP%
  1600.        ERJMP R
  1601.       JUMPN A,R        ; no match
  1602.       DPB A,DOMPTR        ; matched, remove it
  1603.     ENDIF.
  1604.     MOVE A,HSTPTR        ; return pointer
  1605.     RETSKP
  1606.  
  1607.     ENDSV.
  1608.  
  1609. ; $RRDMH - Remove relative and higher-level domain by type
  1610. ; Accepts:
  1611. ;    A/ pointer to host string
  1612. ;    B/ pointer to relative domain type string
  1613. ;    CALL $RRDMH
  1614. ; Returns +1: Failed (probably some other relative domain)
  1615. ;      +2: Success
  1616.  
  1617. $RRDMH::SAVEAC <B>
  1618.     STKVAR <HSTPTR,DOMNAM,<DOMSTR,HSTNMW>>
  1619.     TXC A,.LHALF        ; is source LH -1?
  1620.     TXCN A,.LHALF
  1621.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1622.     MOVEM A,HSTPTR        ; set up pointer to return
  1623.     MOVEM B,DOMNAM        ; save domain type
  1624.     CALL $RRDOM
  1625.      RET
  1626.     HRROI A,DOMSTR        ; make higher level name
  1627.     MOVE B,DOMNAM
  1628.     CALL $MKHLN
  1629.     IFSKP.
  1630.       MOVE A,HSTPTR        ; remove the higher level name
  1631.       HRROI B,DOMSTR
  1632.       CALL $RMDOM
  1633.     ENDIF.
  1634.     MOVE A,HSTPTR
  1635.     RETSKP
  1636.  
  1637.     ENDSV.
  1638.  
  1639. ; $MKHLN - Make a higher level domain name
  1640. ; Accepts:
  1641. ;    A/ pointer to destination string
  1642. ;    B/ pointer to domain type string
  1643. ;    CALL $MKHLN
  1644. ; Returns +1: Failed
  1645. ;      +2: Success, updated pointer in A
  1646.  
  1647. $MKHLN::SAVEAC <B,C,D>
  1648.     STKVAR <DSTPTR,DOMTYP>
  1649.     TXC A,.LHALF        ; is source LH -1?
  1650.     TXCN A,.LHALF
  1651.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1652.     MOVEM A,DSTPTR
  1653.     MOVEM B,DOMTYP
  1654.     HRROI B,[ASCIZ/MAIL:/]    ; make MAIL:domaintype-HIGHER-LEVEL-DOMAIN.TXT
  1655.     SETZ C,
  1656.     SOUT%
  1657.      ERJMP R
  1658.     MOVE B,DOMTYP
  1659.     SOUT%
  1660.      ERJMP R
  1661.     HRROI B,[ASCIZ/-HIGHER-LEVEL-DOMAIN.TXT/]
  1662.     SOUT%
  1663.      ERJMP R
  1664.     MOVE A,DSTPTR        ; now get that file if it's there
  1665.     MOVE B,DSTPTR
  1666.     CALL $CPFIL        ; get it
  1667.      RET
  1668.     RETSKP
  1669.  
  1670.     ENDSV.
  1671.  
  1672. ; $MKREL - Make a relative domain name
  1673. ; Accepts:
  1674. ;    A/ pointer to destination string
  1675. ;    B/ pointer to domain type string
  1676. ;    CALL $MKREL
  1677. ; Returns +1: Failed
  1678. ;      +2: Success, updated pointer in A
  1679.  
  1680. $MKREL::SAVEAC <B,C,D>
  1681.     TXC A,.LHALF        ; is source LH -1?
  1682.     TXCN A,.LHALF
  1683.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1684.     MOVX C,"#"        ; first prepend relative domain
  1685.     IDPB C,A
  1686.     MOVX C,HSTNML+1        ; up to this many characters
  1687.     SETZ D,            ; terminate on null
  1688.     SOUT%
  1689.      ERJMP R        ; percolate failure up to caller
  1690.     JUMPE C,R        ; string too long if exhausted
  1691.     RETSKP
  1692.  
  1693. ; $RMREL - Remove top-level relative domain names
  1694. ; Accepts:
  1695. ;    A/ pointer to host string
  1696. ;    CALL $RMREL
  1697. ; Returns +1: Always
  1698.  
  1699. $RMREL::SAVEAC <B>
  1700.     STKVAR <HSTPTR,DOMPTR>
  1701.     TXC A,.LHALF        ; is source LH -1?
  1702.     TXCN A,.LHALF
  1703.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1704.     MOVEM A,HSTPTR        ; set up pointer to return
  1705.     DO.
  1706.       SETZM DOMPTR        ; initially no top-level domain pointer
  1707.       DO.
  1708.         ILDB B,A        ; get a byte from name
  1709.         IFN. B        ; if null, scan done
  1710.           CAIN B,"."    ; start of a domain segment?
  1711.            MOVEM A,DOMPTR    ; yes, remember its pointer
  1712.           LOOP.
  1713.         ENDIF.
  1714.       ENDDO.
  1715.       MOVE A,HSTPTR        ; get host pointer for return or loopback
  1716.       SKIPN B,DOMPTR    ; get pointer to top-level domain
  1717.       IFSKP.
  1718.         ILDB B,B        ; get first byte of domain name
  1719.         CAIE B,"#"        ; relative domain?
  1720.       ANSKP.
  1721.         SETZ B,        ; yes, tie off string before top-level domain
  1722.         DPB B,DOMPTR
  1723.         LOOP.        ; re-do to eliminate other relative domains
  1724.       ENDIF.
  1725.     ENDDO.
  1726.     RET
  1727.  
  1728.     ENDSV.
  1729.  
  1730. ; $CPFIL - Copy a file into a buffer
  1731. ; Accepts:
  1732. ;    A/ pointer to destination buffer
  1733. ;    B/ pointer to file name
  1734. ;    CALL $CPFIL
  1735. ; Returns +1: Failed (e.g. no such file)
  1736. ;      +2: Success, with updated pointer in A
  1737.  
  1738. $CPFIL::SAVEAC <B,C,D>
  1739.     STKVAR <TMPJFN,<TMPBUF,HSTNMW>,DSTPTR>
  1740.     TXC A,.LHALF        ; is string pointer LH -1?
  1741.     TXCN A,.LHALF
  1742.      HRLI A,(<POINT 7,>)    ; yes, set up byte pointer
  1743.     MOVEM A,DSTPTR        ; save destination pointer
  1744.     MOVX A,GJ%SHT!GJ%OLD    ; try for the local hostname file
  1745.     GTJFN%            ; find system file with our name
  1746.      ERJMP R
  1747.     MOVEM A,TMPJFN        ; save JFN in case OPENF% failure
  1748.     MOVX B,<<FLD 7,OF%BSZ>!OF%RD!OF%PDT> ; open in 7-bit ASCII and
  1749.     OPENF%            ;  don't mangle the FDB
  1750.     IFJER.
  1751.       MOVE A,TMPJFN        ; get back JFN we got
  1752.       RLJFN%        ; free it
  1753.        ERJMP R        ; not interested in errors here
  1754.       RET
  1755.     ENDIF.
  1756.     HRROI B,TMPBUF        ; read in string
  1757.     MOVX C,HSTNML        ; up to this many characters
  1758.     MOVX D,.CHLFD        ; terminate on a linefeed
  1759.     SIN%
  1760.      ERJMP .+1
  1761.     CLOSF%            ; close off file
  1762.      ERJMP .+1
  1763.     MOVEI A,TMPBUF        ; now process string a bit
  1764.     HRLI A,(<POINT 7,>)
  1765.     DO.
  1766.       ILDB B,A        ; get byte from string read in
  1767.       CAIE B,.CHLFD        ; LF terminates
  1768.        CAIN B,.CHCRT    ; CR terminates
  1769.         SETZ B,
  1770.       CAIE B,.CHTAB        ; TAB terminates
  1771.        CAIN B,.CHSPC    ; space terminates
  1772.         SETZ B,
  1773.       IDPB B,DSTPTR        ; return byte to user
  1774.       JUMPN B,TOP.        ; if null, done
  1775.     ENDDO.
  1776.     SETO A,            ; back over the null
  1777.     ADJBP A,DSTPTR        ; return updated pointer
  1778.     RETSKP
  1779.  
  1780.     ENDSV.
  1781.  
  1782.     END
  1783.