Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mm/mmlbx.mac
There are 5 other files named mmlbx.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<MM>MMLBX.MAC.39, 10-Jul-85 19:51:53, Edit by HSS
; Add local changes to support MMAILR -RELAY code
TITLE MMailbox Mailing lists for MMailr
SUBTTL Written by Michael McMahon /MMcM/MRC
VWHO==0 ;Who last edited MMAILBOX (0=developers)
VMAJOR==5 ;TOPS-20 release 5.4
VMINOR==4
VMMLBX==^D40 ;MMLBX's version number
SEARCH MACSYM,MONSYM ;System definitions
SALL ;Suppress macro expansions
.DIRECTIVE FLBLST ;Sane listings for ASCIZ, etc.
.TEXT "/NOINITIAL" ;Suppress loading of JOBDAT
.TEXT "MMLBX/SAVE" ;Save as MMLBX.EXE
.TEXT "/SYMSEG:PSECT:CODE" ;Put symbol table and patch area in CODE
.TEXT "/SET:.LOW.:7000" ;Define lowseg PSECT
.REQUIRE HSTNAM ;Host name routines
.REQUIRE SYS:MACREL ;MACSYM support routines
; *******************************************************************
; * *
; * MMailbox is an multiple network mailbox database program for *
; * TOPS-20. It was originally conceived by Mike McMahon (MIT *
; * (Artificial Intelligence Lab) and jointly developed for TOPS-20 *
; * with Mark Crispin (Stanford Computer Science Dept.). *
; * The TENEX version of XMailbox was developed by Tom Rindfleisch *
; * (Stanford SUMEX Project) and Mike McMahon in January 1981. *
; * MMailbox was developed from XMailbox version 127 for TCP/IP *
; * and SMTP by Mark Crispin in September 1982. *
; * *
; *******************************************************************
;Entry points
;+0: GO User, asks for address and types out answer
;+1: GO Unused (reenter)
;+2: n/a Version
;+3: MMLGO Expansion entry, used by MMAILR
;+4: MMGO Existence check entry, used by MM, FTPSER, MAISER, etc.
; Routines invoked externally
EXTERN $GTPRO,$GTNAM,$GTLCL
; AC definitions
F==0
A=1
B=2
C=3
D=4
E=5
I=6
J=7
T=10
TT=11
N=12
O=13
W=15
;CX=16
;P=17
QUOTE==42
LAB=="<"
RAB==">"
;;; Flags
FL%MRD==1B0 ;Reading from MAILING-LISTS.TXT file
FL%ADI==1B1 ;Allow file indirection
FL%PRV==1B2 ;Override file protections
FL%RLY==1B3 ;On if local address specified as relay address
FL%CMP==1B4 ;Compiling binary file
;; This is where a superior inserts the address to be checked/expanded
LOC 176
SUCES1: 0 ;176 Auxillary value returned to superior
SUCCES: 0 ;177 Value returned to superior
ADDRES: BLOCK 100 ;200 Where superior puts address to be expanded
EXPLST: 0 ;300 Where expansion is put
.PSECT DATA,10000 ;Regular data starts here
RUNP: -1 ;Program has been run
WHEEL: 0 ;We have caps to write new binary file
HAVSUP: 0 ;We have a superior fork
MAISUP: 0 ;Mail delivery process is superior
ENDPOS: 0 ;Last pos before trailing space in MREAD/FREAD
MLSJFN: 0 ;JFN for MAILING-LISTS.TXT
BINJFN: 0 ;JFN for MAILING-LISTS.BIN
BINSIZ: 0 ;Size of file in pages
PRGNAM: BLOCK 2 ;Program name
CMPPDP: BLOCK 1 ;Stack as of compiling
FNGFRK: BLOCK 1 ;Non-zero if we have FINGER mapped
BLKADR: BLOCK 1 ;Address of data block
HSTADR: BLOCK 1 ;Used by local host check
HSTTMP: BLOCK ^D13 ;Ditto
MLSBNM: BLOCK <^D20> ;Filled in at INIT
LCLNAM: ASCIZ/TOPS-20/ ;Storage for local host name string
BLOCK LCLNAM+20-.
NPDL==777
PDL: BLOCK NPDL ;Main stack
LPNPDL==100
LPPDL: BLOCK LPNPDL ;Stack for finding forwarding loops
.ENDPS
; Paged data areas
; Format of binary file documented here
.PSECT BINDAT,100000 ;MAILING-LISTS.BIN area
BINADR==. ;Address where binary file starts
BINPAG==<BINADR/1000> ;Page where binary file starts
BINFID: BLOCK 1 ;SIXBIT /MMLBX/
WRTTIM: BLOCK 1 ;Time of last write on text file
HSHMOD: BLOCK 1 ;Hash modulus
BINHLN==.-BINADR ;Binary file header length
HSHMD0==^D4999 ;Magic prime number for hash modulus
HSHFRE==1000 ;Space at end of hash table
HSHLEN==<<HSHMD0+BINHLN>!777>+HSHFRE-BINHLN ;Length of hash table
HSHTAB: BLOCK HSHLEN ;The hash table itself
BLOCK 1 ;?? Is this still necessary ??
BINFRE: BLOCK 100000-<.-BINADR> ;Binary file free storage
.ENDPS
.PSECT PAGDAT,400000
FNGADR: BLOCK 1000 ;Finger returned data address
FNGPAG==<FNGADR/1000> ;Finger data page
TMPBUF: BLOCK 20000 ;Lots of space
STRSIZ==47777
STRBUF: BLOCK <STRSIZ+1>/5
STRBF1: BLOCK <STRSIZ+1>/5
.ENDPS
; Start of program
.PSECT CODE,20000
EVEC: JRST GO ;Start
JRST GO ;Reenter
BYTE(3)VWHO(9)VMAJOR(6)VMINOR(18)VMMLBX ;Version
JRST MMLGO ;MMAILR entry (expansion)
JRST MMGO ;Existance check entry (MM, etc.)
EVECL==.-EVEC
GO: JSP A,INIT ;Map in database
CALL UREAD ;Get address from user
CALL CHECK ;Check for existence
JRST [ HRROI A,[ASCIZ/No such address/]
JRST ERROR] ;+1 Non-ex
JRST [ TMSG <Local user, mail is not forwarded>
JRST DONE] ;+2 Local user
JRST [ TMSG <Local file, mail is not forwarded>
JRST DONE] ;+3 Local file
SKIPA ;+4 FINGER data
CALL EXPAND ;+5 Expand the address fully
MOVEI J,EXPLST
DO.
SKIPN E,(J)
JRST DONE
HRRO A,E
PSOUT%
IFXN. E,.LHALF
MOVEI A,"@"
PBOUT%
HLRO A,E
PSOUT%
ENDIF.
TMSG <
>
AOJA J,TOP.
ENDDO.
MMGO: JSP A,INIT
SETOM HAVSUP ;Have a superior
CALL CHECK
JRST [ SETZM SUCCES ;+1 No such user
JRST DONE]
JRST [ MOVEI A,1
MOVEM A,SUCCES ;+2 Local user, no forwarding
JRST DONE]
JRST [ MOVEI A,2
MOVEM A,SUCCES ;+3 Local file, no forwarding
JRST DONE]
NOP ;+4 Forward address from FINGER database
MOVEI A,3 ;+5 Mailing list
MOVEM A,SUCCES ;Has a mailing list entry
JRST DONE ;And leave
MMLGO: JSP A,INIT
SETOM HAVSUP ;Have a superior
SETOM MAISUP ;Flag mailer is superior
CALL CHECK
JRST [ SETZM EXPLST ;+1 Not found, no expansion
SETZM SUCCES
JRST DONE]
NOP ;+2 Local user
JRST [ MOVSI A,ADDRES ;+3 Local file
MOVEM A,EXPLST
SETZM EXPLST+1
MOVEI A,2
MOVEM A,SUCCES
JRST DONE]
JRST [ MOVEI A,3 ;+4 Forward address from FINGER database
MOVEM A,SUCCES
JRST DONE]
MOVEI A,3 ;+5 Expanded address
MOVEM A,SUCCES
CALL EXPAND
JRST DONE
;;; Common initialization
;;; Call: JSP A,INIT
INIT: MOVE P,[IOWD NPDL,PDL] ;Init stack
PUSH P,A ;Save return address
SKIPL RUNP ;Have we been run before?
IFSKP.
RESET% ;Once only - reset all I/O
SETO A, ;Get our names
MOVE B,[-2,,PRGNAM]
MOVEI C,.JISNM
GETJI%
NOP ;Shouldn't happen
SETZM FNGFRK ;No FINGER fork just yet
ENDIF.
SETZB F,HAVSUP ;No flags, no superior known as yet
SETZM MAISUP ;Mailer not known as superior yet
SETZM SUCES1 ;No auxillary return value yet
SETZM WHEEL ;Flag not a wheel just yet
MOVX A,.FHSLF ;Enable all privs
RPCAP%
IOR C,B
EPCAP%
TXNE C,SC%WHL!SC%OPR ;Note if we are an enabled wheel
SETOM WHEEL
MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ;Physical only, short form, old file
HRROI B,[ASCIZ/MAIL:MAILING-LISTS.TXT/]
GTJFN%
IFJER.
HRROI B,[ASCIZ/Cannot find mailing list file/]
JRST JSYERR
ENDIF.
MOVEM A,MLSJFN ;Save text JFN
MOVE B,[1,,.FBWRT] ;Get time of last write
MOVEI C,T
GTFDB%
HRLI A,.FBPRT ;Try to ensure right protection
MOVX B,.RHALF
MOVX C,777752
SKIPE WHEEL ;If enabled
CHFDB%
HRROI A,LCLNAM
CALL $GTLCL ;Get the local host name
IFNSK.
HRROI A,[ASCIZ/Cannot get local host name/]
JRST ERROR
ENDIF.
;;; Map in new binary file and see if we can use it
DO.
AOSE RUNP ;Is this the first time we've been run?
IFSKP.
HRROI A,MLSBNM ;Set up binary file name
HRRZ B,MLSJFN ;JFN of text file
MOVE C,[110000,,1] ;Device and directory
JFNS%
HRROI B,[ASCIZ/MAILING-LISTS.BIN;P777752/]
SETZ C,
SOUT% ;Append our filename to it
CALL MAPBIN ;Map in binary file
EXIT. ;Failed, must compile new binary
ENDIF.
SKIPN A,BINJFN ;Have a binary file?
EXIT. ;No, must compile new one
MOVE B,[1,,.FBWRT] ;Get time of last write of binary file..
MOVEI C,D
GTFDB%
CAME T,WRTTIM ;Write time of text file?
CAML D,T ;Binary likely from text?
IFSKP.
SKIPN RUNP ;No, did we just read the binary file?
IFSKP.
SETOM RUNP ;No, perhaps there is a new binary
CALL UMPBIN ; file to accompany the text file
LOOP.
ENDIF.
SKIPN WHEEL ;Can we change the BIN file?
ANSKP.
ELSE.
MOVE A,MLSJFN ;Nothing more to do, flush the text JFN
RLJFN%
NOP
RET ;Return, ready to go
ENDIF.
ENDDO.
;; Compile new binary file
TXO F,FL%CMP ;Flag compiling binary file
MOVEM P,CMPPDP ;Save compiling stack
MOVE A,MLSJFN ;Open text file
MOVX B,<<FLD ^D7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
HRROI B,[ASCIZ/Cannot open mailing list file/]
JRST JSYERR
ENDIF.
CALL UMPBIN ;Unmap old binary
;; Parse new file
MOVE A,MLSJFN
MOVEI N,BINFRE ;Where to put text
MOVEI O,TMPBUF ;Where to expand addresses
MOVEM T,WRTTIM ;Save new update time
MOVE T,[SIXBIT/MMLBX/]
MOVEM T,BINFID
MOVEI T,HSHMD0 ;Initialize hash modulus
MOVEM T,HSHMOD
DO.
CALL FILTYI
IFL. B
HRROI B,[ASCIZ/EOF in file before formfeed/]
JRST IERROR
ENDIF.
CAIE B,.CHFFD
LOOP.
ENDDO.
DO. ;Read name of mailing list
CALL MREAD ;Get a token
JUMPL B,ENDLP. ;EOF, done with file
CAIN B,"="
IFSKP.
HRROI B,[ASCIZ/Bad delimiter, not =/]
JRST IERROR
ENDIF.
MOVEI T,STRBUF ;Token name
CALL HSHLUK ;Find hash table index
IFSKP.
HRROI B,[ASCIZ/Duplicate mailing list name/]
JRST IERROR
ENDIF.
HRLM O,(I) ;Save first address
HRRM N,(I) ;,,name
CALL CPYSTR ;Put in copy of name
DO. ;Read component addresses
CALL MREAD ;Read entry name
PUSH P,B ;Save delimiter
CALL CANADR ;Make site,,name
MOVEM E,(O)
ADDI O,1
POP P,B
CAIE B,.CHCRT ;End of line
JUMPGE B,TOP. ;Or end of file?
ENDDO.
SETZM (O)
ADDI O,1
JUMPGE B,TOP. ;Back for more addresses
ENDDO.
MOVE O,N ;Put all addresses in file now
;; Expand all addresses just within file
MOVE I,[-HSHLEN,,HSHTAB]
DO.
SKIPN (I) ;Is there an entry here?
IFSKP.
HLRZ J,(I) ;Yes, get start of addresses
HRLM O,(I) ;Save relocated list pointer
DO.
SKIPN E,(J) ;An address there?
IFSKP.
CALL EXPADR ;Yes, expand it, no indirect files
AOJA J,TOP.
ENDIF.
ENDDO.
SETZM (O) ;Mark new end
ADDI O,1
ENDIF.
AOBJN I,TOP.
ENDDO.
MOVE B,[1,,.FBGEN] ;While we're here, get generation #
MOVEI C,C ;Into C
GTFDB%
CLOSF% ;Close text file
NOP
SKIPN WHEEL ;Can we write new version?
RET
MOVX A,GJ%FOU!GJ%SHT!GJ%PHY
HLR A,C ;Try to keep generation #'s parallel
HRROI B,MLSBNM
GTJFN%
IFJER.
HRROI B,[ASCIZ/Cannot find mailing list binary file/]
JRST JSYERR
ENDIF.
PUSH P,A
MOVEI B,OF%WR
OPENF%
IFJER.
POP P,A ;Can't update binary file, no-op it
RLJFN%
NOP
RET
ENDIF.
POP P,A
HRLZ B,A
MOVE A,[.FHSLF,,BINPAG]
MOVEI C,777-BINADR(O)
LSH C,-<^D9>
TXO C,PM%CNT!PM%RD!PM%WR!PM%CPY
PMAP%
HLRZ A,B
CLOSF%
NOP
TXZ F,FL%CMP ;No longer compiling binary file
CALL MAPBIN ;Map it back in for read now
JRST ERROR
RET
;;;Bad input file error handler
IERROR: PUSH P,A ;Save JFN
HRROI A,STRBF1 ;Place for error string
SETZ C,
SOUT% ;Print the error string
HRROI B,[ASCIZ/ while parsing /]
SOUT%
POP P,B ;Restore JFN
JFNS%
HRROI B,[ASCIZ/
/]
SOUT%
JRST IERR1
;;; Canonicalize address
;;; Entry: STRBUF/ address from file
;;; Call: CALL CANADR
;;; Returns: +1
;;; E/ host name,,user name
;;; host name of FILHST is special, means destination is indirect file
FILHST==777777
CANADR: SAVEAC <A,B,C>
STKVAR <HSTPTR>
HRRZ E,N ;Save start of name (will be copied here)
MOVE A,[POINT 7,STRBUF]
SETZ B, ;Where host pointer will be if any
DO.
ILDB C,A
IFN. C
CAIN C,"@"
MOVE B,A ;Save pointer to last @
LOOP.
ENDIF.
ENDDO.
JUMPE B,CPYSTR ;If no host name, copy string and return
CAME B,[POINT 7,STRBUF,6] ;Was the @ the first character?
IFSKP.
HRLI E,FILHST ;Yes, local address indirect file
CALL CPYSTR
ELSE.
SETZ C, ;Foreign address
DPB C,B ;Replace @ with null
CALL CPYSTR ;Copy the name
MOVEM B,HSTPTR
MOVE A,HSTPTR ;Get pointer to host
SETO C, ;Try all protocols
CALL $GTPRO ;Look up host name
IFSKP.
MOVEM B,HSTADR ;Save host address returned
HRROI A,HSTTMP ;Store local name in scratch area
SETO B, ;Local host address for this protocol
CALL $GTNAM ;Get local host address for this protocol
IFSKP.
CAMN B,HSTADR ;Is this our local host?
RET ;Yes, don't need host name
ENDIF.
ENDIF.
HRL E,N
MOVE A,HSTPTR ;Start of host name
HRLI N,(<POINT 7,0>)
DO.
ILDB B,A
IDPB B,N
JUMPN B,TOP.
ENDDO.
MOVEI N,1(N) ;Update free pointer
ENDIF.
RET
;;; Expand address from index in I
EXPAND: MOVEI N,TMPBUF ;Where to put any strings we make
MOVEI O,EXPLST ;Where expansion goes
MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
TXO F,FL%ADI!FL%PRV ;Allow file indirection
EXPAN0: SAVEAC <E,J>
HLRZ J,(I) ;Get start of addresses
DO.
SKIPN E,(J) ;An address there?
IFSKP.
CALL CKLOOP ;Looping on this address?
JRST EXPLPX ;Yes
PUSH W,E ;No, save the address being expanded
CALL EXPAD0
ADJSP W,-1 ;Reduce loop stack
AOJA J,TOP.
ENDIF.
ENDDO.
SETZM (O) ;Clear last entry
RET
;;; Expand a single address in E into list accumulating in O
;;; No indirect file handling. EXPADX allows indirect files
EXPADR: TXZ F,FL%ADI!FL%PRV ;Don't allow indirect files here
EXPADX: MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
EXPAD0: IFXE. E,.LHALF ;Is there a host?
SAVEAC <T,I>
MOVE T,E
PUSH P,I ;Save last index as temporary also
CALL HSHLUK ;Look it up
IFSKP.
POP P,T ;Expansion found, retrieve last index
CAME T,I ;Same?
JRST EXPAN0 ;No, recurse
;;; If the indices are the same, then we've reached a self-defined
;;;expansion. This is probably a user on this system which had
;;;the host name stripped by CANADR.
ELSE.
ADJSP P,-1 ;Flush old index
ENDIF.
MOVEM E,(O) ;No expansion
AOJA O,R ;Increment O and return
ENDIF.
IFXE. F,FL%ADI
MOVEM E,(O) ;No expansion
AOJA O,R ;increment O and return
ENDIF.
TLC E,FILHST
TLCN E,FILHST
IFSKP.
MOVEM E,(O) ;No expansion
AOJA O,R ; increment O and return
ENDIF.
;; Read indirect file
SAVEAC <A,B,T,E> ;Save current state
STKVAR <INDJFN> ;Indirect file JFN
;;; This code is necesary to fix a security bug. A malicious user could use
;;;mailer to divulge parts of a protected file by queueing a message
;;;referring to a protected file on the system. The mailer's error report
;;;may have useful information about the contents of the protected file in it.
;;; This requires that all indirect files referenced as such through the
;;;mailsystem (as opposed to directly via MM) must be publicly readable.
;;;However, indirect files referenced through MAILING.LISTS do not have to
;;;be (note however that a protected indirect file may cause problems for an
;;;unprivileged invocation of MMailbox).
IFXE. F,FL%PRV ;Agent of MAILING.LISTS?
SKIPE MAISUP ;No, is mailer our superior?
SKIPN WHEEL ;Do we have capabilities enabled?
ANSKP.
PUSH P,C ;In case necessary
MOVEI A,.FHSLF ;Get current capabilities
RPCAP%
TXZE C,SC%WHL!SC%OPR ;Disable wheel/operator capabilities
EPCAP%
POP P,C
ENDIF.
HRRZ B,E
HRLI B,(<POINT 7,0,6>)
MOVX A,GJ%SHT!GJ%OLD!GJ%PHY!GJ%ACC
GTJFN%
IFJER.
AOS SUCES1 ;Note hard error
HRROI B,[ASCIZ/Cannot find indirect file/]
JRST JSYERR
ENDIF.
MOVEM A,INDJFN
MOVX B,<<FLD ^D7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
MOVE A,INDJFN ;Flush the JFN we got
RLJFN%
NOP
HRROI B,[ASCIZ/Cannot open indirect file/]
JRST JSYERR
ENDIF.
IFXE. F,FL%PRV ;Did we turn our privileges off?
SKIPE MAISUP ;Yes, is mailer our superior?
SKIPN WHEEL ;Need to restore capabilities?
ANSKP.
PUSH P,C ;In case necessary
MOVX A,.FHSLF ;Retrieve capabilities
RPCAP%
IOR C,B ;Enable all capabilities again
EPCAP%
POP P,C
MOVE A,INDJFN ;Restore JFN
ENDIF.
DO.
CALL FREAD ;Read file address
PUSH P,B
LDB B,[POINT 7,STRBUF,6] ;Get first byte of address
IFN. B ;If null, no address to expand
CALL CANADR ;Canonicalize
CALL CKLOOP ;Looping on this address?
JRST EXPLPX ;Yes
PUSH W,E ;No, save the address being expanded
CALL EXPAD0 ;Expand this one
ADJSP W,-1 ;Reduce loop stack
ENDIF.
POP P,B
JUMPGE B,TOP.
ENDDO.
MOVE A,INDJFN ;Indirect file JFN
CLOSF% ;Close off file
IFJER.
HRROI A,STRBF1 ;Build error string in STRBF1
SETO B, ;Timestamp
SETZ C,
ODTIM%
ERJMP .+1
HRROI B,[ASCIZ/MMailbox: Cannot close indirect file "/]
SETZ C,
SOUT%
MOVE B,INDJFN ;JFN that lost
JFNS%
HRROI B,[ASCIZ/" - /]
SOUT%
HRLOI B,.FHSLF
ERSTR%
NOP
NOP
HRROI A,STRBF1
PSOUT%
; For now don't consider this an error
ENDIF.
RET
; Here to bomb out on expansion loop
EXPLPX: HRROI A,[ASCIZ/Loop while expanding address/]
JRST ERROR
; Routine to check on expansion loop
; Entry: e = address to be checked
; w = stack ptr for previous addresses in expansion path
; Call: CALL CKLOOP
; Return: +1, Loop detected
; +2, No loop
CKLOOP: SAVEAC <A,B> ;Save working ACs
MOVE A,[IOWD LPNPDL,LPPDL] ;Start of stack
DO.
CAMN A,W ;End yet?
RETSKP ;Yes, no loop
AOBJP A,CKLPX ;Screw-up if turns positive!
CAME E,0(A) ;Already expanded this address?
LOOP. ;No
ENDDO.
RET ;Yes, expansion loop
; Here on internal screw-up
CKLPX: HRROI A,[ASCIZ/Address expansion screwup/]
JRST ERROR
;;; Check for mailing list
;;; ADDRESS/ user supplied address
;;; CALL CHECK
;;; +1: Not found
;;; +2: Local user
;;; +3: Local file
;;; +4: Have found forward address in FINGER database, returning list
;;; +5: Mailing list, I will have hash table index
CHECK: TXZ F,FL%RLY ;Initially no local relaying done
MOVE A,[POINT 7,ADDRES,6] ;See if "%" style relay address
SETZ D, ;Originally no "last" byte
DO.
ILDB C,A ;Check byte
CAIE C,"@" ;This may be useful for really stupid composers
CAIN C,"%" ;Possible route delimiter?
MOVE D,A ;Remember destination byte pointer
JUMPN C,TOP. ;Loop for further bytes
ENDDO.
IFN. D ;Any "%" seen?
MOVE A,D ;Yes, get pointer to string to check
SETO C, ;Try all protocols
CALL $GTPRO ;Validate host name
RET ;No such host, address fails
MOVEM B,HSTADR ;Save host address returned
HRROI A,HSTTMP ;Store local name in scratch area
SETO B, ;Local host address for this protocol
CALL $GTNAM ;Get local host address for this protocol
IFSKP.
CAMN B,HSTADR ;Is this our local host?
TDZA C,C ;Yes, tie off address
MOVEI C,"@" ;No, convert last "%" to "@"
ELSE.
MOVEI C,"@" ;Local address unknown, use "@"
ENDIF.
DPB C,D ;Edit as appropriate
IFN. C ;If non-local address, simulate FINGER return
DMOVE A,[POINT 7,STRBUF ;Copy string where FNGSMX wants it
POINT 7,ADDRES]
CALL MOVSTR
JRST FNGSIM
ENDIF.
TXO F,FL%RLY ;Local, flag must simulate FINGER return
ENDIF.
HRROI A,STRBF1 ;[39] Make request list address here
HRROI B,ADDRES ;[39] From the passed in list
SETZ C, ;[39]
SOUT% ;[39]
HRROI B,[ASCIZ/-RELAY/] ;[39] Add in RELAY part
SOUT% ;[39]
MOVEI T,STRBF1 ;[39] Get address of request list
CALL HSHLUK ;[39] See if it exists
SKIPA ;[39] No
AOS SUCES1 ;[39] Yes, tell superior, MMAILR
MOVEI T,ADDRES ;Address of user string
CALL HSHLUK ;Look in hash table
JRST CHKUSR ;Failed, try other options
CPOP4J: AOS (P) ;+5 mailing list
CPOP3J: AOS (P) ;+4
CPOP2J: AOS (P) ;+3
CPOP1J: AOS (P) ;+2
RET ;+1
CHKUSR: LDB A,[POINT 7,ADDRES,6] ;Get first character of name
CAIE A,"*" ;Allow filespec
IFSKP.
IFXN. F,FL%RLY ;Was it relayed?
DMOVE A,[POINT 7,STRBUF ;Yes, must simulate FINGER then
POINT 7,ADDRES]
CALL MOVSTR
JRST FNGSIM
ENDIF.
MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ;Else see if file exists
MOVE B,[POINT 7,ADDRES,6]
GTJFN%
ERJMP R ;No, barf address
RLJFN% ;Flush the JFN
ERJMP .+1
JRST CPOP2J ;And return +3 filespec
ENDIF.
CAIE A,"@" ;Allow indirect
IFSKP.
DMOVE A,[POINT 7,STRBUF ;Copy string where FNGSMX wants it
POINT 7,ADDRES]
CALL MOVSTR
JRST FNGSMX ;Return it
ENDIF.
MOVX A,RC%EMO ;A>B see if user name, require exact match
HRROI B,ADDRES ;Proposed user name string
RCUSR% ;Parse it
ERJMP CPOPJ ;If garbage characters, punt it completely
IFXE. A,RC%NOM!RC%AMB ;Was it a user name?
IFXN. F,FL%RLY ;Yes, was it relayed?
DMOVE A,[POINT 7,STRBUF ;Yes, must simulate FINGER then
POINT 7,ADDRES]
CALL MOVSTR
JRST FNGSIM
ENDIF.
RETSKP ;No, local user with no forwarding
ENDIF.
MOVE A,[POINT 7,ADDRES] ;Check to see if BUG-MM mail
MOVE B,[POINT 7,[ASCIZ/BUG-MM/]]
CALL CMPSTR ;Are the strings equal?
JRST [ MOVE A,[POINT 7,STRBUF] ;Buffer to use
MOVEI B,[ASCIZ/[email protected]/] ;Default BUG-MM host
CALL MOVSTR ;Copy the string
JRST FNGSIM] ;Simulate data returned from FINGER
NOP ;A<B return, no-op to A>B return
MOVE A,[POINT 7,ADDRES] ;Check to see if SYSTEM mail
MOVE B,[POINT 7,[ASCIZ/SYSTEM/]]
CALL CMPSTR ;Are the strings equal?
RETSKP ;+2 treat SYSTEM as local user
NOP ;A<B
; falls through
; drops in
;;;Total non-match, see if FINGER will return any information on this string
SKIPLE A,FNGFRK ;Have FINGER yet?
JRST HAVFNG ;Yes, skip FINGER loading
JUMPL A,NOFING ;If FINGER fork negative, don't use it ever
MOVX A,GJ%OLD!GJ%SHT ;Look up FINGER
HRROI B,[ASCIZ/SYS:FINGER.EXE/]
GTJFN%
ERJMP NOFING ;FINGER not present
PUSH P,A ;Save JFN
MOVX A,CR%CAP ;Create a new fork
CFORK%
IFJER.
POP P,A ;Can't get fork, punt
RLJFN% ;Flush the JFN
NOP
JRST NOFING
ENDIF.
MOVEM A,FNGFRK ;Save fork handle
POP P,A ;Get JFN back
HRL A,FNGFRK ;Fork handle,,JFN
GET%
MOVE A,[.FHSLF,,FNGPAG] ;Map FNGPAG of this fork
HRLZ B,FNGFRK ;From page 777 of FINGER (well-known)
HRRI B,777
MOVX C,PM%RD!PM%WR!PM%PLD ;Read/write/preload
PMAP%
HAVFNG: MOVE A,[POINT 7,FNGADR] ;Have FINGER. Where to put the string
MOVEI B,ADDRES ;Source
CALL MOVSTR ;Copy the string to FINGER
MOVE A,FNGFRK ;Get back fork handle
MOVEI B,3 ;Start inferior at offset 3
SFRKV%
ERJMP FNGERR ;FINGER doesn't support +3
RFORK% ;Resume, in case it didn't get going
WFORK% ;Sleep until fork is finished
DMOVE A,PRGNAM ;Restore program name
SETSN%
NOP ;No failure returns defined
MOVE A,FNGFRK ;See if it finished okay
RFSTS%
HLRZ A,A
CAIE A,.RFHLT ;Fork halted?
JRST FNGERR ;No, FINGER fork is sick
SKIPN FNGADR+400 ;Positive reply from FINGER?
JRST NOFING ;No
MOVE A,[POINT 7,STRBUF] ;Where to put it
MOVEI B,FNGADR+400 ;FINGER returns username string here
CALL MOVSTR ;Copy the strings
MOVEI N,TMPBUF ;Where expansion goes
CALL CANADR ;Make canonical address in E
MOVEI O,EXPLST ;Where to put expression
CALL EXPADR ;Expand net address
SETZM (O) ;Tie off list
JRST CPOP3J ;+4 data from FINGER
;;;Fatal error in FINGER fork; flush it...
FNGERR: SETO A, ;Unmap shared page
MOVE B,[.FHSLF,,FNGPAG] ;Mapped to FNGPAG
SETZ C,
PMAP%
MOVE A,FNGFRK ;Get FINGER fork
KFORK% ;Kill the fork
SETOM FNGFRK ;Flag not to use FINGER again
; JRST NOFING
;;;No FINGER or no match. If a BUG-xxx, try for BUG-RANDOM-PROGRAM
NOFING: HRROI A,[ASCIZ/BUG-/] ;Prefix for bug reports
HRROI B,ADDRES ;User's string
STCMP%
TXNN A,SC%SUB ;Is "BUG-" a subset of user's string?
RET ;No, address fails utterly
MOVEI T,[ASCIZ/BUG-RANDOM-PROGRAM/] ;Yes, return BUG-RANDOM-PROGRAM
CALL HSHLUK
RET ;Not present, address fails utterly
JRST CPOP4J ;Return forwarded address
;;;Simulate return from FINGER, STRBUF/ address to return
FNGSIM: TXZA F,FL%ADI ;Don't allow indirect files
FNGSMX: TXO F,FL%ADI ;This is an indirect file
TXZ F,FL%PRV ;Don't override protections
MOVEI N,TMPBUF ;Where expansion goes
CALL CANADR ;Make canonical address in E
MOVEI O,EXPLST ;Where to put expression
CALL EXPADX ;Expand net address
SETZM (O) ;Tie off list
JRST CPOP3J ;+4 simulate data from FINGER
;;; Lookup string in hash table
;;; T/ address of string
;;; Returns +1, not found
;;; +2, found
;;; in either case, I has index to hash table
HSHLUK: PUSH P,A
PUSH P,B
HRLI T,(<POINT 7,0>)
PUSH P,T ;Save string pointer
CALL HASH ;Hash string into number
PUSH P,TT ;Save first index
SKIPA T,TT
HSHLK1: AOS T,(P)
IDIV T,HSHMOD ;Divide by modulus
SKIPN A,HSHTAB(TT) ;Look for entry here
JRST HSHLKN ;Not found, return
HRLI A,(<POINT 7,0>)
MOVE B,-1(P) ;Given string
CALL CMPSTR ;Compare strings
JRST HSHLKO ;Match, found
NOP
JRST HSHLK1
HSHLKO: AOS -4(P)
HSHLKN: MOVEI I,HSHTAB(TT) ;Return absolute pointer
ADJSP P,-2
POP P,B
POP P,A
RET
;;; Hash string in T until null
HASH: PUSH P,C
SETZ TT,
HASH1: ILDB C,T
JUMPE C,HASH2
LSH TT,7
TRZ C,40 ;Case independent
XORI TT,(C)
JRST HASH1
HASH2: TLC TT,(TT) ;Make positive (18-bits)
HLRZ TT,TT
JRST CPOPCJ
;;; Compare strings in A and B
;;; +1 same, +2 A<B, +3 A>B
CMPSTR: PUSH P,C
PUSH P,D
CMPST1: ILDB C,A
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,"a"-"A"
ILDB D,B
CAIL D,"a"
CAILE D,"z"
CAIA
SUBI D,"a"-"A"
CAME C,D
JRST CMPST2
JUMPE C,CMPST6 ;Strings match
JRST CMPST1
CMPST2: CAML C,D
AOS -2(P) ;A greater
AOS -2(P)
CMPST6: POP P,D
POP P,C
RET
;;; Copy string from STRBUF
;;; N/ pointer to string free space
CPYSTR: PUSH P,A
PUSH P,B
MOVE A,[POINT 7,STRBUF]
HRLI N,(<POINT 7,0>)
DO.
ILDB B,A
IDPB B,N
JUMPN B,TOP.
ENDDO.
MOVEI N,1(N) ;Update free pointer
POP P,B
POP P,A
RET
;;; Routine to move an ASCIZ string from B to A
; Entry: a = destination string ptr
; b = source buffer address
; Call: CALL MOVSTR
; Return: +1
MOVSTR: TXCE B,.LHALF ;Source str ptr supplied?
TXCN B,.LHALF
HRLI B,(<POINT 7,0>) ;No, make it a valid str ptr
PUSH P,C ;Working ac
MOVST0: ILDB C,B
JUMPE C,MOVST1 ;Quit on null
IDPB C,A
JRST MOVST0
; Here to finish ASCIZ string
MOVST1: PUSH P,A ;Save dest ptr so can continue string
IDPB C,A
POPACJ: POP P,A
POP P,C
RET
;;; File reading routines
;;; Entry: A/ jfn
;;; Call: CALL MREAD ;Read from MAILING-LISTS.TXT
;;; CALL FREAD ;Read from an @ file
;;; Return: +1
;;; B/ delimiter character
;;; Read a token from MAILING-LISTS.TXT, terminated by space or NL or tab
MREAD: TXOA F,FL%MRD ;Flag reading from MAILING-LISTS.TXT
FREAD: TXZ F,FL%MRD ;Flag reading from user file
PUSH P,C
PUSH P,D
REDTOP: MOVE C,[POINT 7,STRBUF] ;Where to put it
MOVEM C,ENDPOS ;Mark beginning of trailing spaces
MOVEI D,STRSIZ ;Maximum size
CALL WITTYI ;Flush initial whitespace
SKIPA ;Already have first character
REDLUP: CALL FILTYI ;Get next character from file
REDLP1: JUMPL B,REDRET ;Eof always terminates
CAIN B,.CHCRT ;EOL terminates and flushes
JRST SKPWHT
JUMPE B,SKPWHT ;Null terminates and flushes
CAIN B,"-" ;Do funny thing with dash
JRST RDDASH
CAIN B,QUOTE
JRST REDQOT
JXN F,FL%MRD,REDCKM
CAIE B," " ;Tack on spaces for now to be amputated later
CAIN B,.CHTAB
JRST REDSPA
CAIN B,","
JRST REDRET
CAIE B,":"
JRST REDCHR
LDB B,[POINT 7,STRBUF,6]
CAIE B,"*" ;Unless a filespec,
JRST REDTOP ;Ignore atoms terminated by :
MOVEI B,":" ;Otherwise the colon really does go in
REDCHR: SOJL D,REDTLG
IDPB B,C
MOVEM C,ENDPOS
JRST REDLUP
REDTLG: HRROI B,[ASCIZ/Atom too long/]
JRST IERROR
REDRET: SETZ D,
IDPB D,ENDPOS
POP P,D
CPOPCJ: POP P,C
CPOPJ: RET
REDCKM: CAIE B," " ;Space terminates and flushes trailing space
CAIN B,.CHTAB
JRST SKPWHT
CAIN B,"="
JRST REDRET
JRST REDCHR
REDQOT: CALL FILTYI ;Saw quote. Quotes are not included in buffer
IFL. B
HRROI B,[ASCIZ/EOF in the middle of a string/]
JRST IERROR
ENDIF.
CAIN B,QUOTE ;Second quote?
JRST RDQOT1
RDQOT2: SOJL D,REDTLG ;No, insert quoted character into buffer
IDPB B,C
JRST REDQOT
RDQOT1: CALL FILTYI ;Peek at next character
CAIN B,QUOTE ;Was it a doubled quote?
JRST RDQOT2 ;Yes, insert single quote in string
MOVEM C,ENDPOS ;No, end of quoted string
JRST REDLP1 ;Enter loop with next character in B
;;;Skip trailing whitespace, enter SKPWHT with terminator in B
SKPWHT: MOVE D,B ;Keep track of whether we get a CR
SKPWH1: CALL FILTYI ;Get a byte
CAIE B," " ;Space?
CAIN B,.CHTAB ;Or TAB?
JRST SKPWH1 ;Yes, skip to next
JUMPE B,SKPWH1 ;Skip nulls
SKPWH2: CAIN B,.CHCRT ;Remember if we get a CR
JRST SKPWHT
JUMPL B,REDRET ;Return EOF
CAIN B,";" ;Comment?
JRST [ CALL REDCM1 ;Yes, flush and check terminator
JRST SKPWH2]
CAIN B,"!" ;Inline comment?
JRST [ CALL REDXC1 ;Yes, flush
CAIN B,"!" ;If ended on matching excl, get next char
JRST SKPWH1
JRST SKPWH2] ;Check terminator
CAIN B,"-" ;Dash?
JRST [ CALL REDDS1 ;Followed by CR is no-op, else is good char
JRST SKPWH1
JRST .+1] ;Two BKJFNs, bombs here for TTY:!
BKJFN ;None of those, back up over char
NOP
MOVE B,D ;And return saved CR or terminator
JRST REDRET
REDSPA: CALL WITTYI ;Yes, eat white space
JRST REDLP1 ;Go look at the next character
RDDASH: CALL REDDS1 ;On dash, check for EOL
JRST REDLUP
JRST REDCHR
;;; Skip leading whitespace
WITTYI: PUSHJ P,FILTYI
JUMPE B,WITTYI ;Ignore nulls
CAIN B,.CHTAB
JRST WITTYI
CAIE B," "
CAIN B,.CHCRT
JRST WITTYI
CAIN B,";"
JRST REDCMT ;Read a comment
JXN F,FL%MRD,R
CAIN B,"!"
JRST REDXCL
CAIN B,"-"
JRST REDDSH ;Check for - crlf
RET
REDCMT: CALL REDCM1 ;Read the comment
JRST WITTYI ;And skip more leading whitespce
;;;Read and drop until EOL
REDCM1: PUSHJ P,FILTYI
JUMPL B,CPOPJ
CAIE B,.CHCRT
JRST REDCM1
RET
REDXCL: CALL REDXC1 ;Read the comment
JRST WITTYI ;And skip more leading whitespce
REDXC1: CALL FILTYI ;Saw an !, read to matching ! or newline
JUMPL B,CPOPJ
CAIE B,"!"
CAIN B,.CHCRT
RET
JRST REDXC1
REDDSH: CALL REDDS1
JRST WITTYI
RET
REDDS1: PUSHJ P,FILTYI
JUMPL B,REDDS2
CAIN B,.CHCRT
RET
BKJFN
NOP
REDDS2: MOVEI B,"-"
JRST CPOP1J
;;; Read a single character, returns -1 at EOF, Just 15 for CRLF
FILTYI: BIN%
CAIE B,.CHCRT
IFSKP.
BIN%
CAIE B,.CHLFD ;Treat stray CR's as CRLF
BKJFN%
ERJMP .+1
MOVX B,.CHCRT
ENDIF.
CAIN B,.CHLFD ;Stray LF = CR
MOVX B,.CHCRT
IFE. B
GTSTS%
TXNN B,GS%EOF
TDZA B,B
SETO B,
ENDIF.
RET
;;; Map binary file
MAPBIN: SETZM BINJFN
MOVX A,GJ%OLD!GJ%SHT!GJ%PHY
HRROI B,MLSBNM
GTJFN%
JRST [ HRROI A,[ASCIZ/Cannot find mailing list binary file/]
RET]
MOVEI B,OF%RD
OPENF%
JRST [ HRROI A,[ASCIZ/Cannot open mailing list binary file/]
RET]
MOVEM A,BINJFN
MOVE B,[1,,.FBBYV]
MOVEI C,BINSIZ
GTFDB%
HRLZ A,A
MOVE B,[.FHSLF,,BINPAG]
HRRZ C,BINSIZ
HRLI C,(PM%CNT!PM%RD!PM%CPY)
PMAP%
MOVE A,BINFID
CAME A,[SIXBIT /MMLBX/]
JRST [ HRROI A,[ASCIZ/Bad format binary file/]
RET]
AOS (P)
RET
;; Unmap old binary
UMPBIN: SETO A, ;Unmap old binary
MOVE B,[.FHSLF,,BINPAG]
HRRZ C,BINSIZ
TXO C,PM%CNT
PMAP%
MOVE A,BINJFN
CLOSF%
NOP
SETZM BINJFN
RET
;;; Read an address from the user into ADDRES
UREAD: TMSG <Address: >
HRROI A,ADDRES
MOVE B,[RD%CRF+500]
HRROI C,[ASCIZ/Address: /]
RDTTY%
IFJER.
HRROI B,[ASCIZ/RDTTY% failed/]
JRST JSYERR
ENDIF.
SETZ C,
DPB C,A
RET
; Here on JSYS error
JSYERR: HRROI A,STRBF1 ;Place for error string
SETZ C,
SOUT%
HRROI B,[ASCIZ/ - /]
SOUT%
HRLOI B,.FHSLF
ERSTR%
NOP
NOP
IERR1: HRROI A,STRBF1
;;; General error handler
ERROR: MOVEM A,SUCCES ;Failure, give error message
SKIPN HAVSUP
ESOUT%
TXZN F,FL%CMP ;Compiling binary file?
IFSKP.
MOVE P,CMPPDP ;Yes, restore stack as of compiling
CALL MAPBIN ;Map binary file back in
JRST DONE ;Can't, give up!
RET ;A-okay
ENDIF.
DONE: HALTF%
JRST GO
END <EVECL,,EVEC>
; Local Modes:
; Mode: MACRO
; Comment Start:;
; Comment Begin:;
; End: