TITLE MMailbox Mailing lists for MMailr
SUBTTL Written by Michael McMahon and Mark Crispin /MMcM/MRC/BillW
VWHO==0 ;Who last edited MMAILBOX (0=developers)
VMAJOR==7 ;TOPS-20 release 7.0
VMINOR==0
VMMLBX==^D63 ;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
; 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
NLOCAL==5
LCLADR: BLOCK NLOCAL
LCLPRO: BLOCK NLOCAL
NHSTCH==^D300 ;Number of hosts to cache
HSTBFL: 0 ;Flag - host cache is full
HSTBIX: 0 ;Index into address and protocol tables
HSTBFR: HSTBSS ;Host string free space
HSTBAD: BLOCK NHSTCH+2 ;Addresses
HSTBPR: BLOCK NHSTCH+2 ;Protocols
HSTBSS: BLOCK 10*NHSTCH ;Strings
HSTBND: BLOCK 20 ;Slush from strings
HOSTTB: NHSTCH ;TBLUK% table
BLOCK NHSTCH
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==^D15013 ;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
.PSECT FILDAT,500000
JFNPAG: BLOCK 100 ;JFN to Page translations (firstpage,,lastpage)
JFNPTR: BLOCK 100 ;JFN to byte pointer translation
FFP: 0 ;First free page
FILADR=.+1000 & 777000 ;Address of first file page
FILPAG=FILADR/1000 ;First file page
MAXJFN=77
;Note: Files that are mapped into this PSECT are assumed to be opened
; and closed in stack order... (Last opened= first closed)
.ENDPS
; Start of program
.PSECT CODE,25000
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 BINJFN ;No binary JFN yet
SETZM FNGFRK ;No FINGER fork just yet
ENDIF.
SETZM FFP ;No filepages allocated yet
SETZM HSTBIX ;Zero index
SETZM HSTBFL ;Cache not full
MOVEI A,HSTBSS ;Initial string sace pointer
MOVEM A,HSTBFR
MOVEI A,NHSTCH ;Set up TBLUK% table
MOVEM A,HOSTTB
SETZM HOSTTB+1
MOVE A,[HOSTTB+1,,HOSTTB+2]
BLT A,HOSTTB+NHSTCH-1
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%
RPCAP% ;Watch for evil ACJ
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,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
;;; Map in binary file and see if we can use it
DO.
SKIPE A,BINJFN ;Have a binary file?
IFSKP.
TXO F,FL%CMP ;No, must compile unless can find one
SETZM CMPPDP ;Don't have compiling stack yet
CALL MAPBIN ;Map in binary file
EXIT. ;Failed completely, must compile
ENDIF.
SKIPN WHEEL ;Have a binary file, only wheels may recompile
IFSKP.
SKIPE HAVSUP ;Have a superior?
ANSKP. ;No superior, allow recompile
MOVE B,[1,,.FBWRT] ;Get time of last write of binary file
MOVEI C,D ; into D
GTFDB%
CAML D,T ;Binary newer than text?
CAME T,WRTTIM ;Yes, does its WRTTIM match write time of text?
ANNSK.
CALL UMPBIN ;Binary file out of date, toss it
JXE F,FL%CMP,TOP. ;If didn't just map it in, try again
ELSE.
TXZ F,FL%CMP ;Not compiling any more
MOVE A,MLSJFN ;Nothing more to do, flush the text JFN
RLJFN%
NOP
RET ;Return, ready to go
ENDIF.
ENDDO.
;; Compile new binary file
MOVEM P,CMPPDP ;Save compiling stack
MOVE A,MLSJFN ;Open text file
CALL OPNTXT
IFNSK.
HRROI B,[ASCIZ/Cannot open mailing list file/]
JRST JSYERR
ENDIF.
;; 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
TXZ F,FL%ADI!FL%PRV ;Don't bother with indirect files
MOVE W,[IOWD LPNPDL,LPPDL] ;Init forwarding loop stack
MOVE I,[-HSHLEN,,HSHTAB]
DO.
SKIPN (I) ;Is there an entry here?
IFSKP.
HRRZ E,(I) ;Get this address
PUSH W,E ;First one to check
HLRZ J,(I) ;Yes, get start of addresses
HRLM O,(I) ;Save relocated list pointer
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
ADDI O,1
ADJSP W,-1 ;Pop first address
ENDIF.
AOBJN I,TOP.
ENDDO.
MOVE B,[1,,.FBGEN] ;While we're here, get generation #
MOVEI C,C ;Into C
GTFDB%
CALL CLSTXT ;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
SETZM CMPPDP ;Don't have compiling stack any more
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%
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.
IFE. B ;If no host name, copy string and return
SAVEAC <T,TT>
MOVEI T,STRBUF ;Is this name in hash table?
CALL HSHLUK ;Well?
JRST CPYSTR ;No, just copy it then
HRRZ E,(I) ;Yes, use that value
RET
ENDIF.
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 GETPRO ;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 MYADDR ;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
CALL HSHLUK ;Look it up
IFSKP.
CALLRET EXPAN0 ;No, recurse
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
CALL OPNTXT
IFNSK.
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
CALL CLSTXT ;Close off file
IFNSK.
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> ;Save working AC
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
DO.
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.
JUMPE D,ENDLP. ;Any "%" seen?
MOVE A,D ;Yes, get pointer to string to check
SETO C, ;Try all protocols
CALL GETPRO ;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 MYADDR ;Get local host address for this protocol
IFSKP.
CAME B,HSTADR ;Is this our local host?
ANSKP.
SETZ C, ;Yes, tie off address
DPB C,D ;Edit as appropriate
TXO F,FL%RLY ;Local, flag must simulate FINGER return
LOOP. ;Now recurse
ENDIF.
MOVEI C,"@" ;Not local host, change to "@"
DPB C,D ;Edit address
DMOVE A,[POINT 7,STRBUF ;Copy string where FNGSMX wants it
POINT 7,ADDRES]
CALL MOVSTR
JRST FNGSIM
ENDDO.
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.ne.B see if user name, require exact match
LDB B,[POINT 7,ADDRES,6] ;Get first character of name
CAIN B,"&" ;Allow special syntax meaning local user
SKIPA B,[POINT 7,ADDRES,6] ;It was, so slide over by 1
MOVE B,[POINT 7,ADDRES] ;Proposed user name string
MOVE C,B ;See if null string
ILDB C,C ;Get first byte in string
JUMPE C,R ;If null, punt it completely
RCUSR% ;Parse it
ERJMP R ;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?
IFNSK.
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
ENDIF.
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
;;;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%
IFXN. A,SC%SUB ;Is "BUG-" a subset of user's string?
MOVEI T,[ASCIZ/BUG-RANDOM-PROGRAM/] ;Yes, return BUG-RANDOM-PROGRAM
CALL HSHLUK
RET ;Not present, address fails utterly
JRST CPOP4J ;Return forwarded address
ENDIF.
HRROI A,[ASCIZ/HELP-/] ;Prefix for HELP
HRROI B,ADDRES ;User's string
STCMP%
JXE A,SC%SUB,R ;Fail if not a substring
MOVEI T,[ASCIZ/HELP-RANDOM-PROGRAM/]
CALL HSHLUK ;Substring, return HELP-RANDOM-PROGRAM
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: SAVEAC <A,B>
STKVAR <HSHSTR,HSHIDX>
HRLI T,(<POINT 7,0>)
MOVEM T,HSHSTR ;Save string pointer
CALL HASH ;Hash string into number
MOVEM TT,HSHIDX ;Save first index
MOVE T,HSHIDX
DO.
IDIV T,HSHMOD ;Divide by modulus
SKIPN A,HSHTAB(TT) ;Look for entry here
EXIT. ;Not found, return
HRLI A,(<POINT 7,0>)
MOVE B,HSHSTR ;Given string
CALL CMPSTR ;Compare strings
IFSKP.
AOS T,HSHIDX
LOOP.
ENDIF.
AOS (P) ;Set success return
ENDDO.
MOVEI I,HSHTAB(TT) ;Return absolute pointer
RET
ENDSV.
;;; Hash string in T until null
HASH: SAVEAC <C>
SETZ TT,
DO.
ILDB C,T
JUMPE C,ENDLP.
LSH TT,7
TRZ C,40 ;Case independent
XORI TT,(C)
LOOP.
ENDDO.
TLC TT,(TT) ;Make positive (18-bits)
HLRZ TT,TT
RET
;;; Compare strings in A and B
;;; +1 same, +2 different
CMPSTR: SAVEAC <C,D>
DO.
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
IFSKP.
JUMPN C,TOP. ;More to do
RET ;Strings match
ENDIF.
ENDDO.
RETSKP ;Strings don't match
;;; Copy string from STRBUF
;;; N/ pointer to string free space
CPYSTR: SAVEAC <A,B>
MOVE A,[POINT 7,STRBUF]
CPYST1: HRLI N,(<POINT 7,0>)
DO.
ILDB B,A
IDPB B,N
JUMPN B,TOP.
ENDDO.
MOVEI N,1(N) ;Update free pointer
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
SAVEAC <C>
DO.
ILDB C,B
JUMPE C,ENDLP. ;Quit on null
IDPB C,A
LOOP.
ENDDO.
; Here to finish ASCIZ string
PUSH P,A ;Save dest ptr so can continue string
IDPB C,A
POP P,A
RET
;;; Cache the host names used, so as to avoid the full overhead of
;;; a GTHST% or GTDOM% every time we need to look up a host.
; Cache the lookup of our local address for each protocol, A/ pointer
;to string, C/ protocol ID
MYADDR: STKVAR <HSTPTR>
MOVEM A,HSTPTR
SETZ A,
DO.
CAME C,LCLPRO(A) ;This protocol?
IFSKP.
MOVE B,LCLADR(A) ;Get address
MOVE A,HSTPTR ;Restore string pointer
RETSKP
ENDIF.
SKIPE LCLPRO(A) ;End of current list, and not found yet?
IFSKP.
MOVEM C,LCLPRO(A)
EXCH A,HSTPTR ;Get back string pointer
CALL $GTNAM ;Get local host address for this protocol
RET ;Return failure
EXCH A,HSTPTR
MOVEM B,LCLADR(A) ;Save this address
EXCH A,HSTPTR
RETSKP
ENDIF.
CAIGE A,NLOCAL-1 ;End of list?
AOJA A,TOP.
ENDDO.
MOVE A,HSTPTR ;Out of room
CALLRET $GTNAM ;Just chain to normal routine...
ENDSV.
GETPRO: SAVEAC <N>
STKVAR <HSTPTR,HSTPRO,HSTENT>
MOVEM A,HSTPTR
MOVEM C,HSTPRO
MOVEI A,HOSTTB ;Host TBLUK table
MOVE B,HSTPTR ;Get string
TBLUK%
IFXN. B,TL%EXM ;Exact match?
HRRZ A,(A) ;Get arguments
MOVE B,HSTBAD(A) ;Get address
MOVE C,HSTBPR(A) ;Get protocol
MOVE A,HSTPTR ;Return pointer
RETSKP
ENDIF.
MOVE A,HSTPTR ;Get back args to $GTPRO
MOVE C,HSTPRO
CALL $GTPRO
RET ;Return failure
SKIPE HSTBFL ;Cache full?
IFSKP.
AOS A,HSTBIX ;No, increment and fetch index
MOVEM B,HSTBAD(A) ;Save address
MOVEM C,HSTBPR(A) ; and protocol
HRLZ B,HSTBFR ;Where the string will go
HRR B,A ;Index to info for that host
MOVEM B,HSTENT
MOVE N,HSTBFR ;Get free space pointer
MOVE A,HSTPTR ;Get string pointer
CALL CPYST1 ;Copy the string
MOVEM N,HSTBFR ;Save new free space pointer
CAILE N,HSTBND ;Out of free space?
SETOM HSTBFL ;Set full flag...
MOVEI A,HOSTTB ;Host TBLUK% table
MOVE B,HSTENT
TBADD% ;Add it to the table
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
MOVE C,HSTBIX
MOVE A,HSTPTR
MOVE B,HSTBAD(C) ;Get address again
MOVE C,HSTBPR(C) ;Get protocol again
ELSE.
SETOM HSTBFL ;set failure flag
ENDIF.
RETSKP
ENDSV.
;;; 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
SAVEAC <C,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
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.
CAIE B,QUOTE ;Second quote?
IFSKP.
CALL FILTYI ;Peek at next character
CAIN B,QUOTE ;Was it a doubled quote?
ANSKP. ;Yes, insert single quote in string
MOVEM C,ENDPOS ;No, end of quoted string
JRST REDLP1 ;Enter loop with next character in B
ENDIF.
SOJL D,REDTLG ;No, insert quoted character into buffer
IDPB B,C
JRST REDQOT
;;;Skip trailing whitespace, enter SKPWHT with terminator in B
SKPWHT: MOVE D,B ;Keep track of whether we get a CR
DO.
CALL FILTYI ;Get a byte
CAIE B," " ;Space?
CAIN B,.CHTAB ;Or TAB?
LOOP. ;Yes, skip to next
JUMPE B,TOP. ;Skip nulls
DO.
CAIN B,.CHCRT ;Remember if we get a CR
JRST SKPWHT
CAIE B,"-" ;Dash?
IFSKP.
CALL REDDS1 ;Followed by CR is no-op, else is good char
ANSKP.
MOVE B,D
JRST SKPWHT
ENDIF.
JUMPL B,REDRET ;Return EOF
CAIE B,";" ;Comment?
IFSKP.
CALL REDCM1 ;Yes, flush and check terminator
LOOP.
ENDIF.
CAIN B,"!" ;Inline comment?
IFSKP.
CALL BCKTXT ;Back up over character
MOVE B,D ;And return saved CR or terminator
JRST REDRET
ENDIF.
CALL REDXC1 ;Yes, flush
CAIE B,"!" ;Ended on matching excl?
LOOP. ;No, check terminator
ENDDO.
LOOP. ;Yes, get next character and continue
ENDDO.
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: CALL 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: CALL FILTYI
JUMPL B,R
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,R
CAIE B,"!"
CAIN B,.CHCRT
RET
JRST REDXC1
REDDSH: CALL REDDS1
JRST WITTYI
RET
REDDS1: CALL FILTYI
JUMPL B,REDDS2
CAIN B,.CHCRT
RET
CALL BCKTXT
REDDS2: MOVEI B,"-"
JRST CPOP1J
;;; Read a single character, returns -1 at EOF, Just 15 for CRLF
FILTYI: CAIG A,MAXJFN ;Reasonable JFN?
IFSKP.
HRROI A,[ASCIZ/Illegal JFN at FILTYI/]
JRST ERROR
ENDIF.
ILDB B,JFNPTR(A) ;Get a byte
CAIE B,.CHCRT
IFSKP.
ILDB B,JFNPTR(A) ;Get a byte
CAIE B,.CHLFD ;Treat stray CR's as CRLF
CALL BCKTXT
MOVX B,.CHCRT
ENDIF.
CAIN B,.CHLFD ;Stray LF = CR
MOVX B,.CHCRT
SKIPN B ;Assume a NUL only at EOF...
SETO B,
RET
BCKTXT: CAIG A,MAXJFN ;Reasonable JFN?
IFSKP.
HRROI A,[ASCIZ/Illegal JFN at BCKTXT/]
JRST ERROR
ENDIF.
SAVEAC <B>
SETO B,
ADJBP B,JFNPTR(A) ;Back up the pointer
MOVEM B,JFNPTR(A)
RET
OPNTXT: CAIG A,MAXJFN ;Reasonable JFN?
IFSKP.
HRROI A,[ASCIZ/Illegal JFN at OPNTXT/]
JRST ERROR
ENDIF.
MOVEI B,FILPAG
SKIPN FFP ;Initialized yet?
MOVEM B,FFP ;No, do so...
MOVX B,<<FLD ^D7,OF%BSZ>!OF%RD>
OPENF%
ERJMP R
PUSH P,A
SIZEF% ;Get file size (in C)
SETZB B,C
MOVE B,FFP ;First page to use
HRLZM B,JFNPAG(A)
ADDM C,FFP ;Update first free page
HRLI B,.FHSLF ;.FHSLF,,FFP as destination
HRLZ A,A ;Put JFN,,0 as source address
TXO C,PM%CNT!PM%RD!PM%PLD!PM%CPY
PMAP% ;Map the pages
IFJER.
POP P,A
HRROI A,[ASCIZ/Indirect file PMAP failed/]
JRST ERROR
ENDIF.
POP P,A ;get JFN back
MOVE B,FFP
SUBI B,1
HRRM B,JFNPAG(A) ;Save last page used by thiss file
HLRZ B,JFNPAG(A) ;First page
LSH B,^D9 ;Address
HRLI B,(POINT 7) ;Make a byte pointer
MOVEM B,JFNPTR(A)
RETSKP
CLSTXT: SAVEAC <C>
CAIG A,MAXJFN ;Reasonable JFN?
IFSKP.
HRROI A,[ASCIZ/Illegal JFN at OPNTXT/]
JRST ERROR
ENDIF.
PUSH P,A
HLR B,JFNPAG(A) ;Starting page
HRR C,JFNPAG(A) ;Ending page
SUB C,B
ADDI C,1 ;Number of pages
MOVE A,FFP
SUB A,C
MOVEM A,FFP ;save updated first free page.
SETO A,
HRLI B,.FHSLF
PMAP%
POP P,A
CLOSF%
ERJMP R
RETSKP
;;; Map binary file
MAPBIN: CALL UMPBIN ;Toss out what might have been there before
MOVX A,GJ%OLD!GJ%SHT!GJ%PHY ;Try to get binary file
HRROI B,MLSBNM
GTJFN%
IFJER.
HRROI A,[ASCIZ/Cannot find mailing list binary file/]
RET
ENDIF.
PUSH P,A ;Save JFN
MOVEI B,OF%RD ;Now try to open it
OPENF%
IFJER.
POP P,A ;Get back JFN
RLJFN% ;Flush it
NOP
HRROI A,[ASCIZ/Cannot open mailing list binary file/]
RET
ENDIF.
POP P,BINJFN ;Set BINJFN now that it's open
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
CAMN A,[SIXBIT/MMLBX/]
IFSKP.
CALL UMPBIN ;Unmap the sucker
HRROI A,[ASCIZ/Bad format binary file/]
RET
ENDIF.
MOVE A,BINJFN ;Return with JFN in A
RETSKP
;; Unmap old binary
UMPBIN: SETO A, ;Unmap old binary
MOVE B,[.FHSLF,,BINPAG]
HRRZ C,BINSIZ
TXO C,PM%CNT
PMAP%
SKIPE 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
SKIPE HAVSUP
IFSKP.
ESOUT%
TMSG <
>
ENDIF.
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!
TMSG <[Using previous version of database]
>
RET ;A-okay
ENDIF.
DONE: HALTF%
JRST GO
..LIT: LIT
END <EVECL,,EVEC>
; Local Modes:
; Mode: MACRO
; Comment Start:;
; Comment Begin:;
; End:
