Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mm/relay.mac
There are 5 other files named relay.mac in the archive. Click here to see a list.
TITLE RELAY Module to handle hosts defined in DOMAIN.TXT
SUBTTL Written by C. Hedrick/CLH/MRC
SEARCH MACSYM,MONSYM ;System definitions
SALL ;Suppress macro expansions
.DIRECTIVE FLBLST ;Sane listings for ASCIZ, etc.
EXTERN $ADDOM,MOVST1,CPYSTR
SUBTTL Definitions
A=1 ;JSYS/argument passing
B=2 ;...
C=3 ;...
D=4 ;...
;P=17 ;Stack pointer
; Character definitions
.CHDQT==42 ;Double quote
SUBTTL Paged storage
.PSECT DATPAG
DEFINE DEFPAG (ADDR,LENGTH) <
ADDR: IFB <LENGTH>,<BLOCK 1000>
IFNB <LENGTH>,<BLOCK 1000*LENGTH>
>;DEFINE DEFPAG
RLYPGS==2
DEFPAG RLYTBL,RLYPGS ;TBLUK table for host/nicknames
SUBTTL Impure storage
.PSECT DATA
BRCHAR: BLOCK 1 ;Break char, in INIRLY
RLYJFN: BLOCK 1 ;JFN for reading RELAYS.TXT
RLYSTK: BLOCK 1 ;Saved P for nonlocal exit in INIRLY
MEMALC: BLOCK 1 ;Address of memory allocator
HSTNME: BLOCK 1 ;Address of hostname
DMTBLL==20
DOMTAB: BLOCK DMTBLL+1 ;TBLUK table for domains
STRBFL==30 ;Length of string buffers
STRBFR: BLOCK STRBFL ;String buffer, used globally
SUBTTL Relay code
;Basic data structures:
DM%LEN==:3 ;Domain block:
DM%NAM==:0 ; Pointer to ASCIZ name of the domain
DM%RLY==:1 ; Pointer to a list of hosts that will relay to this domain
DM%TRN==:2 ; Pointer to ASCIZ text to be used for transmogrification.
; The first character is % or . and the rest are a host
; name. foo@HOST will transmogrify to foo%HOST@new-host
HS%LEN==2 ;Host block:
HS%DOM==0 ; Address of domain descriptor block
HS%CAN==1 ; Canonical name of host, including .DOMAIN, ASCIZ
;Nickname block:
; Nickname, ASCIZ, including .DOMAIN
;TBLUK tables:
; Hosts/nicknames
; Domains
.ENDPS
.PSECT CODE
; $GTRLY - Gets a relay host name
; Accepts:
; a/ pointer to host name
; CALL $GTRLY
; Returns +1: Failure
; +2: Success, with pointer to canonical name in A, domain block in B
$GTRLY::SAVEAC <C,D>
STKVAR <HSTPTR,DOMPTR,<STRBF1,STRBFL>>
TXC A,.LHALF ; is source LH -1?
TXCN A,.LHALF
HRLI A,(<POINT 7,>) ; yes, set up byte pointer
MOVEM A,HSTPTR
;We want the match to be exact, except that the user may omit
;the domain. The strings in the table all have domains. The
;easiest way to do this is (1) if the user supplies a domain
;force the match to be exact; (2) if not, stick on a dot and
;then allow any match that doesn't have TL%NOM set.
;First question. Does the user's string include a domain?
DO.
ILDB B,A ;Look for a domain
JUMPE B,ENDLP.
CAIE B,"."
LOOP.
ENDDO.
MOVEM A,DOMPTR ;Save domain for later
IFN. B ;If have domain, do an exact match
MOVE B,HSTPTR
MOVEI A,RLYTBL
TBLUK%
IFXE. B,TL%EXM ;Host is unknown?
MOVE B,DOMPTR ;Yes, get back domain
MOVEI A,DOMTAB
TBLUK% ;See if we know the domain
JXE B,TL%EXM,R ;No, forget this guy
HRRZ B,(A) ;Return domain block in A
MOVE A,HSTPTR ;And host name in A
RETSKP
ENDIF.
ELSE.
;No, stick on a dot and allow anything
MOVEI A,STRBF1
HRLI A,<(POINT 7,)>
MOVE B,HSTPTR ;Have to copy to STRBFR
CALL MOVST1
MOVEI C,"." ;Now add the dot
IDPB C,A
SETZ C,
IDPB C,A
MOVEI A,RLYTBL
MOVE B,[POINT 7,STRBF1]
TBLUK%
JXN B,TL%NOM,R ;Any match is OK here
ENDIF.
HRRZ A,(A) ;Address of host block
MOVE B,HS%DOM(A) ;Domain block
HRRI A,HS%CAN(A) ;Name
HRLI A,(<POINT 7,>) ;Make pointer
RETSKP
ENDSV.
;INIRLY sets up the tables involving relaying. Here is the file format:
;DOMAIN MIT-CHAOS,%MIT-MC,MIT-MC,MIT-XX
; domain name
; string for transmogrification
; list of hosts you can relay to
;DOMAIN SU-NET,%SU-SCORE,SU-SCORE,SUMEX-AIM
;HOST MIT-OZ.MIT-CHAOS,OZ
; primary host name, must include domain
; nicknames, any domains will be ignored
;HOST MIT-EECS.MIT-CHAOS,MIT-EE,EE
;HOST SU-SIERRA.SU-NET,SIERRA
;INIRLY
; A/ address of ALCBLC. This routine takes a block size in A and
; returns a block of that size in B.
; B/ address of HSTNAM. This routine takes a string in B and returns
; the representation that the caller wants for a host. It is
; used to construct lists of hosts for relaying. If the caller
; passes 0, host lists will not be constructed.
;return + 1 always, with address of DOMTAB in A
$INRLY::SAVEAC <B,C,D>
ACVAR <T,TT>
STKVAR <BLKSIZ,HSTBLK>
MOVEM A,MEMALC ;Save address of memory allocator
MOVEM B,HSTNME ;And address of host name thing
MOVEM P,RLYSTK ;Save P for nonlocal exit at EOF
MOVEI A,<RLYPGS*1000>-1 ;Init TBLUK tables
MOVEM A,RLYTBL
MOVEI A,DMTBLL
MOVEM A,DOMTAB
MOVX A,GJ%SHT!GJ%OLD
HRROI B,[ASCIZ/MAIL:DOMAINS.TXT/]
GTJFN%
ERJMP INRRET
MOVEM A,RLYJFN
MOVX B,7B5!OF%RD
OPENF%
IFJER.
TMSG <%Can't open MAIL:DOMAINS.TXT
>
JRST INRRET
ENDIF.
SETZ T,
DO.
CALL RDATOM ;Get an atom
MOVE C,STRBFR ;Now look at the atom
ANDCM C,[1+<BYTE (7) 040,040,040,040,040>] ;Upper caseify
CAMN C,[ASCII/DOMAI/]
JRST RDDOM
CAMN C,[ASCII/HOST/]
JRST RDHST
RDEOL: MOVE A,RLYJFN
MOVE B,BRCHAR
DO.
CAIN B,.CHLFD
EXIT.
BIN%
ERJMP RLYEOF
LOOP.
ENDDO.
LOOP.
DM%LEN=3 ;Domain block:
DM%NAM=0 ; Pointer to ASCIZ name of the domain
DM%RLY=1 ; Pointer to a list of hosts that will relay to this domain
DM%TRN=2 ; Pointer to ASCIZ text to be used for transmogrification.
; The first character is % or . and the rest are a host
; name. foo@HOST will transmogrify to foo%HOST@new-host
HS%LEN=2 ;Host block:
HS%DOM=0 ; Address of domain descriptor block
HS%CAN=1 ; Canonical name of host, including .DOMAIN, ASCIZ
;Here for DOMAIN command. Build up a domain block, and add it to DOMTAB.
; The relay list is built up in T
RDDOM: SETZ T, ;Start with empty list
MOVEI A,DM%LEN ;Generate domain block
CALL @MEMALC
IFNSK.
TMSG <%No space for domain block
>
JRST RLYEOF
ENDIF.
MOVE TT,B
MOVE A,RLYJFN
CALL RDATOM ;Domain name
SKIPE STRBFR ;Make sure there is one
IFSKP.
TMSG <%Missing domain name
>
JRST RDEOL
ENDIF.
MOVEI A,STRBFR
CALL CPYSTR ;Copy it into free space
MOVEM B,DM%NAM(TT)
MOVE A,RLYJFN
DO.
BIN%
ERJMP RLYEOF
CAIE B,.CHCRT
CAIN B,.CHLFD
IFNSK.
TMSG <%Missing transmogrification character
>
JRST RDEOL
ENDIF.
CAIE B,.CHSPC
CAIN B,.CHTAB ;Skip space
LOOP.
ENDDO.
MOVE C,[POINT 7,STRBFR]
SETZM STRBFR
IDPB B,C ;Put funny char at beginning of name
CALL RDATM1 ;Now read host for transmogrification
MOVEI A,STRBFR
CALL CPYSTR ;Copy it into free space
MOVEM B,DM%TRN(TT)
MOVE A,RLYJFN
DO. ;Now make up relay list
CALL RDATOM ;Host name into STRBFR
SKIPN STRBFR ;Check for syntax error
IFSKP.
MOVE B,[POINT 7,STRBFR]
CALL RLCONS
ENDIF.
MOVE B,BRCHAR
CAIE B,.CHCRT
IFSKP.
BIN%
ERJMP RLYEOF
ENDIF.
CAIE B,.CHLFD
LOOP.
ENDDO.
MOVEM T,DM%RLY(TT) ;T (from RLCONS) is now relay list
MOVEI A,DOMTAB ;Now add it to domain table
HRL B,DM%NAM(TT) ;Get name,,domain block
HRR B,TT
TBADD% ;And add to table
ERCAL TBADLZ
MOVE A,RLYJFN ;Get back JFN
LOOP.
;Here for HOST command. Build up the RELAY spec in T
;Build a host block and nickname blocks, and add to RLYTBL
RDHST: CALL RDATOM ;Domain
SKIPN STRBFR ;Check for syntax errors
JRST RDEOL ;Ignore line
HRROI B,STRBFR ;And look up domain
MOVEI A,DOMTAB ;In domain table
TBLUK%
JXE B,TL%EXM,RDEOL ;Don't worry about host if no match
HRRZ TT,(A) ;Get domain block for this domain
MOVE A,RLYJFN
CALL RDATOM ;Now main name
SETO A, ;Need to back over null
ADJBP A,C ;Host
HRRO B,DM%NAM(TT) ;Domain
CALL $ADDOM
IBP A
MOVEI A,-STRBFR+2(A) ;Size of block needed
MOVEM A,BLKSIZ ;Save for later
CALL @MEMALC ;Address of block to B
JRST RDEOL ;Forget it
MOVEM B,HSTBLK ;This is the host block
HRLI A,STRBFR ;Copy name to block
HRRI A,1(B) ;Leave one word for code
MOVE C,BLKSIZ
ADD C,B
BLT A,-1(C) ;Name
MOVEM TT,(B) ;Put in list of relay hosts
HRLI B,1(B) ;Now have nickname,,host block
MOVEI A,RLYTBL
TBADD%
ERCAL TBADLZ
MOVE A,RLYJFN
MOVE B,BRCHAR
DO.
MOVE B,BRCHAR
CAIE B,.CHCRT
IFSKP.
BIN%
ERJMP RLYEOF
ENDIF.
CAIN B,.CHLFD
EXIT.
CALL RDATOM
SKIPN STRBFR ;Check for syntax error
IFSKP.
SETO A, ;Need to back over null
ADJBP A,C ;Host
HRRO B,DM%NAM(TT) ;Domain
CALL $ADDOM
IBP A
MOVEI A,-STRBFR+1(A) ;Size of block needed
MOVEM A,BLKSIZ ;Save for later
CALL @MEMALC ;Addr of block to B
JRST RDEOL ;Forget it
HRLI A,STRBFR ;Copy name to block
HRRI A,(B)
MOVE C,BLKSIZ
ADD C,B
BLT A,-1(C) ;Name
HRL B,B ;Now have nickname,,host block
HRR B,HSTBLK
MOVEI A,RLYTBL
TBADD%
ERCAL TBADLZ
MOVE A,RLYJFN
ENDIF.
LOOP.
ENDDO.
LOOP.
ENDDO.
RLYEOF: MOVE P,RLYSTK ;Restore stack for nonlocal exit
MOVE A,RLYJFN
CLOSF%
NOP
INRRET: MOVEI A,DOMTAB ;Return domain table
RET
TBADLZ: SAVEAC <A,B,C>
TMSG <%Entry in MAIL:DOMAINS.TXT ">
HLRO A,B ;Name that couldn't be added
PSOUT%
TMSG <" ignored - >
MOVX A,.PRIOU ;To primary output
HRLOI B,.FHSLF ;This process,,last error
SETZ C, ;No limit
ERSTR%
NOP
NOP
TMSG <
>
RET
ENDSV.
;RDATOM
;A - jfn
;B - returns break char
;C - returns updated pointer to STRBFR
;Jumps to RLYEOF at end
;sets BRCHAR to break char
RDATOM: SETZM STRBFR
MOVE C,[POINT 7,STRBFR] ;Place to put keyword
RDATM1: MOVEI D,STRBFR*5 ;Max keyword length
DO.
BIN%
ERJMP RLYEOF
CAIE B,.CHSPC ;Skip spaces
CAIN B,.CHTAB
LOOP.
ENDDO.
DO. ;Collect an atom
CAIE B,.CHSPC ;Stop at break chars
CAIN B,.CHTAB
EXIT.
CAIE B,","
CAIGE B,.CHSPC
EXIT.
IDPB B,C ;Else file it away
SOJLE D,[TMSG <%Atom too long in DOMAINS.TXT
>
JRST RLYEOF]
BIN%
ERJMP RLYEOF
LOOP.
ENDDO.
MOVEM B,BRCHAR
SETZ B,
IDPB B,C
MOVE B,BRCHAR
RET
;B - string pointer to relay host name
;T - old list
;returns T - new list
RLCONS: SKIPN HSTNME ;Does the user want relay host lists?
RET ;No, forget it
SAVEAC <A,C>
STKVAR <HSTPTR>
CALL @HSTNME ;Convert string pointer to host pointer
RET
IFN. T ;First item?
MOVEI A,1 ;No, need to CONS up list element
MOVEM B,HSTPTR ;Save pointer
CALL @MEMALC
RET ;This should be impossible
MOVE A,HSTPTR ;Put address of new entry
HRRZM A,(B) ;In free word we just got
MOVEI A,T ;A := current entry
DO.
HLRZ C,(A) ;Get next in list
IFN. C ;End of list?
MOVEI A,(C) ;No, make this the current entry
LOOP. ;Run down rest of list
ENDIF.
ENDDO.
HRLM B,(A) ;Put new entry at end of list
ELSE.
MOVE T,B ;First time, just use T
ENDIF.
RET
ENDAV.
ENDSV.
...LIT: XLIST
LIT
LIST
END