Trailing-Edge
-
PDP-10 Archives
-
T10_DECMAIL_MS_V11_FT1_860414
-
10,7/mail/ms/msgusr.mac
There are 7 other files named msgusr.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
; 1983,1984,1985,1986 Maynard, Massachusetts, USA
TITLE MSGUSR - GETUSR, parses usernames (addresses)
SEARCH GLXMAC,MSUNV,MACSYM
PROLOG (MSGUSR)
CPYRYT
MSINIT
.DIRECTIVE FLBLST
SALL
;GETUSR is completely different depending on Operating System. This
; file contains both TOPS-10 and TOPS-20 code, in separate conditionals.
TOPS20<
;Define globals
GLOBS ; Storage
GLOBRS ; Routines
;Routines defined within
INTERNAL GETUSR, UNGGNU
;Routines defined elsewhere
;MSNSRV.MAC
EXTERNAL DIRLKP
;MSHTAB.MAC
EXTERNAL VALID8
;MSUTL.MAC
EXTERNAL ALCSB, CLRFIB, CMDER1, CRIF, COUNTS
EXTERNAL RFIELD, RFLDE, TSOUT
;Global data items defined herein
INTERNAL BRACKF,STPNT
;Global data items defined elsewhere
;MS.MAC
EXTERNAL MYHSPT, MYHDPT
;MSHTAB.MAC
EXTERNAL HOSTAB
;MSUTL.MAC
EXTERNAL ATMBUF, SBK
;Local storage
IMPUR0
SVABLK: BLOCK 1 ; Saved A-block during address-list expansion
BRACKF: BLOCK 1 ; Inside angle brackets
OLDAT: BLOCK 1 ; 0 or pointer to @ in address
QCHAR: BLOCK 1
STPNT: BLOCK 1
SPNTR: BLOCK 1
TYPEIS: BLOCK 1
IAM: BLOCK 20 ; Filled in with own username
OKLOC: BLOCK 1 ;-1 IF STRING IS A GOOD LOCAL USERNAME
PARBLK: BLOCK 5 ;for first parse
SBKTMP: BLOCK 6 ;for saving parts of SBK
PURE
SUBTTL GETUSR - Parses addresses
;Get User@site string
;Call with:
; U/ addr where to stick string
;
;Return +1: blank line or error typed
; +2: success, B/ addr of string,,code
; where code =
; NETCOD (-1) for network address
; SYSCOD (-2) for mail to SYSTEM
; PFXCOD (-3) for prefix name of an address list (name:)
; SFXCOD (-4) for suffix of address list (;)
; PRNCOD (-5) for personal name
; or 1 for a local username
;
;The caller should call SVSTAT before calling here
GETUSR: MOVE A,U
HRLI A,(POINT 7)
MOVEM A,SPNTR ; set place to write to
SETZM TYPEIS
SETZM BRACKF
SETZM OLDAT
SETZM OKLOC
SETZM (U)
TXZ F,F%AT!F%CMA ; Assume not net address yet, no comma yet
SKIPE C,SVABLK ; Any saved A-blocks waiting to be used?
JRST GETUSA ; Yes, go use up this one
GTUSR0: MOVX A,CM%XIF ; Clear @ allowed flag in case of error
ANDCAM A,SBK+.CMFLG
MOVE A,SBK+.CMPTR
MOVEM A,STPNT
MOVX A,<.CMKEY>B8+CM%BRK+PARS20
MOVE B,KWDTBL
DMOVEM A,PARBLK
MOVEI A,KEYBRK
MOVEM A,PARBLK+.CMBRK
MOVEI B,PARBLK
MOVEI A,SBK
CALL PARSE
JRST OTHPAR
CAIN D,.CMKEY
JRST ALIAS
CAIN D,.CMUSR
JRST LOCALU
CAIN D,.CMTOK
JRST SELF
CAIN D,.CMQST
JRST QUOTED
JRST FINALE ;MUST BE .CMCFM
ALIAS: MOVX A,CM%XIF
ANDCAM A,SBK+.CMFLG
HLRZ C,(B) ;POINT TO ALIAS/ADDR NAME IN CASE NEEDED
HRRZ B,(B)
CAIN B,SYSCOD ;SYSTEM INSTEAD OF REAL ALIAS?
JRST SYSINS ;THAT'S EASY
SKIPE BRACKF
JRST [CMERR (Aliases and Address lists are illegal in angle brackets)
JRST CMDER1]
MOVE A,AB.FLG(B) ; Get flags for this A-block
TXNE A,AB%INV ; Invisible?
JRST [ MOVE C,B ; Yes, no prefix then
JRST GETUSA] ; Go handle alias
MOVEM B,SVABLK ; A-block, save its address
TXO F,F%CMA!F%SUFX ; Make caller call us again
MOVX A,PFXCOD ; Indicate returning prefix
MOVEM A,TYPEIS ; ..
HRLI C,(POINT 7,) ; Form byte pointer to name
MOVE B,C
SETZ C, ; Assume no quoting needed
CALL SPCCHK ; See if quoting needed
MOVEI C,42 ; Yep, get the quote char
MOVEM C,QCHAR ; Save it
MOVE A,SPNTR
CAIE C,0
IDPB C,A
CALL CSTRB
SKIPE C,QCHAR
IDPB C,A
MOVEM A,SPNTR
JRST FINALE
;Here to return addr and code from A-block, C points to A-block
; c(C)=-1 means that we need to return a suffix placeholder
GETUSA: TXZ F,F%CMA ; Assume no more coming
CAMN C,[-1] ; Suffix pending?
JRST [ MOVX B,SFXCOD ; Get suffix code
MOVEM B,TYPEIS ; Return to user
SETZM SVABLK ; All done handling this alias now
JRST PARCCM] ; Check for CR or comma and return
MOVE B,AB.COD(C) ; Get user number or network code
MOVEM B,TYPEIS ; Save away
SKIPE A,AB.LNK(C) ; Get link (if any)
TXOA F,F%CMA ; There is one, flag caller
JRST [ TXZN F,F%SUFX ; No more left -- need suffix?
JRST .+1 ; No, rejoin main flow
SETO A, ; Yes, flag suffix needed
TXO F,F%CMA ; and make caller call us again
JRST .+1]
MOVEM A,SVABLK ; Remember for subsequent calls
MOVE A,SPNTR
MOVE B,AB.ADR(C) ; Point to string for synonym
HRLI B,(POINT 7,) ; ..
CALL CSTRB ; Move 'em on out!
MOVEM A,SPNTR
TXNN F,F%CMA ; Any more addresses in this list?
JRST PARCCM ; No, check for CR or comma
JRST FINALE
QUOTED: MOVEI C,""""
MOVE A,SPNTR
IDPB C,A
MOVE B,[POINT 7,ATMBUF]
CALL CSTRB
MOVEI C,""""
IDPB C,A
MOVEI C," "
IDPB C,A
MOVEM A,SPNTR
JRST ATCHCK
SYSINS: MOVX A,SYSCOD
MOVEM A,TYPEIS
MOVE B,[POINT 7,[ASCIZ/SYSTEM/]]
JRST LOCALI
SELF: SKIPE IAM
JRST LCLOK
SETO A,
HRROI B,C
MOVX C,.JIUNO
GETJI%
ERJMP LCLOK
MOVE B,C
HRROI A,IAM
DIRST%
ERJMP .+1
LCLOK: SKIPA B,[POINT 7,IAM]
LOCALU: MOVE B,[POINT 7,ATMBUF]
LOCALI: MOVE A,SPNTR
CALL CSTRB
MOVEI B," "
IDPB B,A
MOVEM A,SPNTR
SETOM OKLOC ;LEGAL AS A LOCAL MAIL ADDRESS SO FAR!
ATCHCK: MOVX A,CM%XIF
IORM A,SBK+.CMFLG
MOVEI B,ATBKCC ;PARSE ANY OF @ ANGLEBRACKET, OR CONFIRM
SKIPGE BRACKF
MOVEI B,ATONLY ;IN BRACKET, ONLY TRY "@"
MOVEI A,SBK
CALL PARSE
JRST TRYATS ;NO, TRY " AT "
CAIN D,.CMCFM
JRST FINALE ;CONFIRMED, GO FIGURE WHAT WE GOT
CAIN D,.CMCMA
JRST COMMA
LDB A,[POINT 7,ATMBUF,6]
CAIN A,"@"
JRST ADDAT
;HERE IF WE JUST PARSED ANGLEY AS SOMETHING OTHER THAN THE FIRST ATOM
;BACKUP AND RETURN SUCH THAT THE NEXT FIRST PARSE IS THE ANGLEY...
SETO B,
ADJBP B,SBK+.CMPTR
MOVEM B,SBK+.CMPTR
AOS SBK+.CMINC
SETZM OKLOC
MOVX A,PRNCOD
MOVEM A,TYPEIS
JRST COMMAF
TRYATS:
MOVEI B,[ <.CMKEY>B8
[2,,2
[CM%NOR+CM%INV+CM%FW
ASCIZ/A/ ],,0
[ASCIZ/AT/],,-1] ]
MOVEI A,SBK
CALL PARSE
JRST NOTATT ;NOT THE AT TOKEN EITHER..
MOVE A,SPNTR
SETO B,
ADJBP B,A ;POINT BACK AT SPACE AFTER LAST ATOM
MOVEM B,OLDAT ;STORE SO WE CAN PUT "@" THERE
HRROI B,ATMBUF ;COPY IN "AT" AS USER TYPED IT
CALL CSTRB
MOVEI B," " ;TRAILING SPACE
IDPB B,A
MOVEM A,SPNTR
JRST ATISIN
ADDAT: LDB C,SPNTR
JUMPE C,ADDATB
CAIE C," "
JRST LOADAT
ADDATB: SETO B,
ADJBP B,SPNTR
MOVEM B,SPNTR
JRST ADDAT
LOADAT: MOVEI A,"@"
IDPB A,SPNTR
ATISIN: TXO F,F%AT
MOVEI B,NO2INB
MOVEI A,SBK
CALL PARSE
JRST BADNOD ;*SHOULD* TRY [DOMAIN] HERE
CAIN D,.CMTOK
JRST [MOVE B,MYHDPT
JRST NODEO1]
CAIE D,.CMFLD
JRST NODEOK
HRROI A,ATMBUF
CALL VALID8
JRST BADNOD
NODEOK: MOVE B,[POINT 7,ATMBUF]
NODEO1: SKIPN C,OLDAT
JRST ATSIGN
MOVEI D,"@"
IDPB D,C
SKIPA A,C
ATSIGN: MOVE A,SPNTR
CALL CSTRB
MOVEM A,SPNTR
SKIPL BRACKF
JRST PARCCM ;GO PARSE CONFIRM OR ","
MOVEI B,CANINB
MOVEI A,SBK
CALL PARSE
JRST [CMERR (No close angle bracket seen)
JRST CMDER1]
MOVNS BRACKF
JRST PARCCM
NOTATT: SKIPL BRACKF
JRST MULTI
MOVEI B,CANINB
MOVEI A,SBK
CALL PARSE
JRST CHKBDP
MOVNS BRACKF
JRST PARCCM
CHKBDP: ;COMMA OR CONFIRM HERE WOULD BE ILLEGAL. LOOK FOR IT AND COMPLAIN
MOVE A,[SBK+.CMBFP,,SBKTMP]
BLT A,SBKTMP+5 ;SAVE VOLITALE PART OF BLOCK
MOVEI B,CCMLST
MOVEI A,SBK
CALL PARSE
JRST MULTI ;WE WANT THE ERROR HERE
MOVE A,[SBKTMP,,SBK+.CMBFP]
BLT A,SBK+.CMINC
CMERR (Address terminated while within angle brackets)
JRST CMDER1
BADNOD: SKIPL BRACKF ;DID WE NEED A NODENAME HERE?
SKIPN OLDAT
JRST NODERR
SETZM OLDAT
MOVE A,SPNTR
MOVE B,[POINT 7,ATMBUF] ;GET FALSE NODENAME
CALL CSTRB ;PUT IT IN AFTER " AT "
MOVEI C," "
IDPB C,A
MOVEM A,SPNTR
TXZ F,F%AT
JRST ATCHCK
NODERR: SETZM OLDAT
HRROI A,ATMBUF
CMERR (No such nodename "%1S")
JRST CMDER1
OTHPAR: MOVEI B,OANINB
MOVEI A,SBK
CALL PARSE ;TRY FOR AN ANGLE BRACKET
JRST MULTI ;WELL, IT WASN'T LIKELY
SETZM OKLOC
SKIPE BRACKF
JRST [CMERR (May not open angle brackets here)
JRST CMDER1]
SETOM BRACKF
JRST GTUSR0
;NOT A LOCAL USER OR ANYTHING NICE LIKE THAT. PROBABLY TRYING TO PARSE
; A FOREIGN USERNAME OR PERSONAL NAME. EAT A WORD, STORE IT, AND GO LOOK
; FOR TELLTALE THINGS LIKE "@" OR ANGLEBRACKET OR EVEN " AT ".
;PARSE AT ATOM WITH .CMFLD, STOP ON SPACE,@,,<CR>
;IF IN ANGLE BRACKETS, THE STOP CHARACTERS ARE MORE RESTRICTED
MULTI: MOVEI A,SBK
MOVEI B,ODDATM
CALL PARSE
JRST [CMERR (Address parse failed)
JRST CMDER1]
MOVE A,SBK+.CMINC
SOJG A,NATSPA
MOVE A,SBK+.CMPTR
ILDB A,A
CAIE A," "
JRST NATSPA
MOVEI A,.CHBEL ;IF NEEDED
PBOUT% ;YES, THIS ISN'T A USERNAME, SO BEEP
NATSPA: MOVE A,SPNTR
MOVE B,[POINT 7,ATMBUF]
SCANAN: ILDB C,B
CAIE C,74
CAIN C,76
JRST [CMERR (Angle bracket is illegal here)
JRST CMDER1]
JUMPE C,SCANEN
IDPB C,A
JRST SCANAN
SCANEN: MOVEI B," "
IDPB B,A
MOVEM A,SPNTR
SETZM OKLOC
JRST ATCHCK
DOREAL: MOVE A,SPNTR
CALL CSTRB
JRST FINALE
PARCCM: MOVEI B,CCMLST
MOVEI A,SBK
CALL PARSE
JRST [CMERR (Confirm or Comma required)
JRST CMDER1]
CAIE D,.CMCMA
JRST FINALE
COMMA:
COMMAF: TXO F,F%CMA
FINALE: SETZ A,
IDPB A,SPNTR
STOP: MOVE A,U
HRLI A,(POINT 7)
STRIPA: SETZM OLDAT
STRIP: ILDB B,A
JUMPE B,STRIPE
CAIGE B," "
CAIN B,.CHTAB
JRST STRIPX
CMERR (Illegal control characters seen in address)
JRST CMDER1
STRIPX: CAIE B," "
JRST STRIPA
SKIPN OLDAT
MOVEM A,OLDAT
JRST STRIP
STRIPE: SKIPN C,OLDAT
JRST SETUPU
DPB B,C
MOVE A,C
SETUPU: SKIPN (U)
JRST [SKIPE B,TYPEIS
JRST NOSTRI
TXNN F,F%CMA
RET
CMERR (Null address seen)
JRST CMDER1]
MOVEM U,SPNTR
MOVEI U,1(A)
SKIPN OKLOC
TXNN F,F%FDIR
JRST NOFDIR
TXNN F,F%AT
SKIPE TYPEIS
JRST NOFDIR
;Well, we have to verify this username. Verify consists of seeing if it is
; a directory on POBOX:. However, the userame could contain comments of
; the form (comment string). Strip these, and leading and trailing spaces,
; before we do the verify.
HRROI B,[ASCIZ/POBOX:/]
HRROI A,ATMBUF ;BUILD POBOX:<username> in ATMBUF
CALL CSTRB
MOVEI B,74
IDPB B,A
MOVE B,SPNTR
HRLI B,(POINT 7) ;POINTER TO USERNAME
SETZ D, ;FLAG: NO NON-SPACES SEEN YET
SCANPR: ILDB C,B ;GRAB A CHARACTER
JUMPE C,SCANPE ;NULL MEANS END
CAIN C,.CHCNV ;^V HAS PRIORITY OVER EVERYTHING
JRST [IDPB C,A ;WRITE IT
ILDB C,B ;GET NEXT CHARACTER
JRST ADDCHX] ;AND GO WRITE IT TOO
CAIE C,"(" ;COMMENT BEGINNING?
JRST SCANCN ;NO, GO ADD IF NOT LEADING SPACE
FINDPE: ILDB C,B ;COMMENT, SCAN FOR ")"
JUMPE C,SCANPE ;IMPOLITE END
CAIN C,"\" ;THIS IS A QUOTE CHARACTER
JRST [IBP B ;SO SKIP NEXT CHARACTER..
JRST FINDPE] ;AND GO AGAIN
CAIE C,")" ;TERMINATOR?
JRST FINDPE ;NO, GOBBLE SOME MORE
JRST SCANPR ;YES, GO GET REAL CHARACTERS
SCANCN: JUMPN D,ADDCHX ;HAVE WE SEEN A SIGNIFICANT CHARACTER
CAIN C," " ;NO, SO WE CAN STILL TOSS SPACES
JRST SCANPR ;LEADING SPACE, TOSS IT
SETO D, ;REAL CHARACTER, CAN'T TOSS ANY MORE
ADDCHX: IDPB C,A ;ADD CHAR TO ATMBUF
JRST SCANPR ;AND GO AGAIN
SCANPX: SETO B, ;HERE TO BACK OVER TRAILING SPACE
ADJBP B,A
MOVE A,B ;KEEP POINTER IN A
SCANPE: LDB C,A ;GOT A TRAILING SPACE??
CAIN C," " ;..
JRST SCANPX ;YES, BACK UP ONE
MOVEI C,76 ;DONE! ADD CLOSE ANGLE
IDPB C,A
SETZ C, ;AND NULL
IDPB C,A
MOVX A,RC%EMO ;MATCH EXACTLY
HRROI B,ATMBUF
RCDIR%
ERJMP BADDIR ;MUST HAVE BEEN *REALLY* BAD
TXNE A,RC%NOM ;FLUNK?
JRST BADDIR ;YES, SO SORRY...
;..
NOFDIR: MOVE B,TYPEIS
NOSTRI: HRL B,SPNTR
TRNE B,-1
RETSKP
HRRI B,1 ;ZERO WOULD MEAN FAILURE
TXNE F,F%AT
HRRI B,NETCOD
RETSKP
BADDIR: CMERR (No such user as ")
HRRO A,SPNTR
PSOUT%
MOVEI A,""""
PBOUT%
JRST CMDER1
OANINB: <.CMTOK>B8
-1,,[BYTE(7)74,0]
CANINB: <.CMTOK>B8
-1,,[BYTE(7)76,0]
ATONLY: <.CMTOK>B8
-1,,[ASCIZ/@/]
ATBKCC: <.CMTOK>B8+ATBKC1
-1,,[ASCIZ/@/]
ATBKC1: <.CMTOK>B8+CCMLST
-1,,[BYTE(7)74,0]
CCMLST: <.CMCMA>B8+[<.CMCFM>B8]
NO2INB: <.CMTOK>B8+CM%HPP+NO3INB
-1,,[ASCIZ/./]
-1,,[ASCIZ/for local host use/]
NO3INB: FLDBK1 (.CMFLD,,,<-1,,HSTHLP>,,[
BRMSK. (FLDB0.,FLDB1.,FLDB2.,FLDB3.,<.->,<@<>!% ,;&^()> )])
KEYBRK: BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<_%\-!&$.>,<>)
ODDATM: <.CMFLD>B8+CM%BRK
0
0
0
ODDBRK
ODDBRK: BRMSK. <1B<.CHCRT>+1B<.CHLFD>+1B<.CHTAB>>,0,0,0,,< @,>
;CALL TO PARSE WHATEVER.
;RETURN A AND B AS COMND%, AND D/ TYPE OF BLOCK HIT
PARSE: COMND%
PARSIN: ERJMP [SETO D, ;EOF (assumed) RETS -1
MOVX A,CM%NOP ;AND PARSE FAILURE
RET]
HRRZ D,C
LDB D,[POINT 9,(D),8]
TXNN A,CM%NOP
CPOPJ1: AOS (P)
CPOPJ: RET
PARS20: <.CMUSR>B8+.+1
<.CMTOK>B8+.+2
-1,,[ASCIZ/./]
<.CMQST>B8+.+1
<.CMCFM>B8
CSTRB: TLC A,-1
TLCN A,-1
HRLI A,(POINT 7)
TLC B,-1
TLCN B,-1
HRLI B,(POINT 7)
CSTRBA: ILDB C,B
IDPB C,A
JUMPN C,CSTRBA
SETO C,
ADJBP C,A
MOVE A,C
RET
> ;;END OF TOPS-20
TOPS10 <
;Get User@site string, U/ addr where to stick string
;
;Return +1: blank line or error typed
; +2: success, B/ addr of string,,code
; where code =
; NETCOD (-1) for network address
; SYSCOD (-2) for mail to SYSTEM
; PFXCOD (-3) for prefix name of an address list (name:)
; SFXCOD (-4) for suffix of address list (;)
; PRNCOD (-5) for personal name
; or 1 for a local username
;
;This tries to parse all typein, and then return the addresses one at a time
; on subsequent calls.
;If an alias is typed which expands to more than one address,
; subsequent calls to GETUSR will return each address in the expansion.
; Further parsing of input will not occur until all addresses in the
; expansion have been returned. If the alias is a address-list, the
; first and last entries returned will be the prefix and suffix.
;
;Note that .TO and .CC, which allocate storage and change MS's state
; based on what GETUSR does, must call SVSTAT before calling GETUSR.
; SVSTAT dummies things up so that any reparse (either because of
; user editing or a command error) will undo anything .TO and .CC
; did. SVSTAT puts a dummy return on the stack so that its effect
; is undone automagically. Any other callers of GETUSR should
; probably do a similar thing.
;
;This code is very different than the TOPS-20 version and should be expected
; to manifest different behaviour. The main differences center around the fact
; that, to verify a username, we must talk to ACTDAE. This being a very slow
; process, we try to gather up everything we can and do it all in just one
; call to ACTDAE (done via the QUEUE. UUO). The noteworthy exception is
; ESCape handling, where previous addresses are handled in one such call, and
; the currently open address (the one completion and verification is being
; attempted on) is done with a separate QUEUE. call.
;As an address is parsed, it is built in ADRSTR (via the BP in PDST). When
; a comma, Confirm, or Open angle bracket is parsed, the text in ADRSTR is
; gathered up. If an Open angle bracket was parsed, the text we have is just
; a personal name, and we store it as such and go parse what is in the
; brackets. In any other case we rebuild the contents of ADRSTR, pulling
; out extraneous spaces, looking for "@" or " at ", and checking the
; syntax. If a nodename introducer was found, the nodename must be verified;
; if just a local username was given, it is looked for in the username
; cache (if it is found there, we can flag the fact that this address
; doesn't need verification via ACTDAE. Of course, addresses involving remote
; nodes don't get verified by ACTDAE either).
;Whatever we got, if it isn't immediately known to be bad (bad nodename, absurd
; syntax, etc.), we stick it in a linked list (via ADVBLK) and go parse more
; addresses.
;When we run into the end of the parse buffer (ESC) or a confirm, we go back
; over that linked list (pointed to by VLIST) and build a QUEUE. UUO block
; from what it contains (skipping the remote addresses and addresses we know
; are OK already). We verify the set, and try to set up for a reparse if
; one of the users didn't verify.
;Current restrictions and quirks:
; The following characters are never good ideas in usernames:
; ()<>,@[]"\;:% and any control character and rubout
;Of those, the following are guaranteed to cause parse errors:
; ()<>,@[]" and any control character
;Any address with "@" in it (or the archaic " AT ") is assumed to be a
; remote address, and the username is not verified, even if the nodename
; given is local (this is largely intentional, as it allows you to bypass
; ACTDAE).
;The [] characters are used to enclose a PPN and will cause problems if used for
; any other purpose. The string:
; any string [p,pn]
;is transformed to
; any string <username>
;Just [ppn] is expanded to the approprate username without angle brackets.
;Note that no text can follow a [ppn], hence the form [ppn]@nodename will
; not be parsed (MX won't handle it). Also, using <ESC> to verify a PPN
; only succeeds if used before the (required) closing square bracket.
; If the ppn is legal, the ] is given as completion.
;Note that usernames that contain punctuation will be quoted, but completion
; will likely produce slightly misleading actions when used on such usernames.
; That is, given a username LOMATIRE,D the input LOMA<ESC>, if unique, will
; display LOMATIRE at the terminal and put "LOMATIRE,D" in the buffer. Also,
; usernames that take advantage of the full 8 bit character set are likely
; to act in a fashion not strictly user friendly.
;Recognition of usernames (or anything else) is not available in quoted
; strings.
;Completion is not available for nodenames, and they cannot be verified with
; ESC.
;Define globals
GLOBS ; Storage
GLOBRS ; Routines
SEARCH ACTSYM
;Routines defined within
INTERNAL GETUSR,KILLST,UNGGNU
;Routines defined elsewhere
;MSNSRV.MAC
;MSHTAB.MAC
EXTERNAL VALID8
;MSUTAB.MAC
;MSUTL.MAC
EXTERNAL ALCSB, CLRFIB, CMDER1, CRIF, COUNTS
EXTERNAL MOVST0, MOVST1, MOVST2, MOVSTR, RELSB
EXTERNAL RFIELD, RFLDE, TSOUT
;Global data items defined herein
INTERNAL BRACKF,STPNT,USRTAB
;Global data items defined elsewhere
;MS.MAC
EXTERNAL MYHSPT, MYHDPT, MYPPN
;MSUTL.MAC
EXTERNAL ATMBUF, SBK
V.HDR==0
V.TYP==1
V.VROK==1B0
V.PPN==1B1
V.REAL==2
V.RPRS==3
V.VLNK==4
V.TEXT==5
V.LEN==V.TEXT+1
;CACHE BLOCK FORMAT
C.HDR==0 ;SIZE,,0
C.LNK==1 ;LAST,,NEXT
C.WEI==2 ;WEIGHT OF BLOCK
C.TXT==3 ;TEXT IN THIS BLOCK
C.LEN=C.TXT+1
E.HDR==0
E.CNT==1
E.PNTS==2 ;AND 3
E.PNT2==E.PNTS+1
E.LEN==E.PNT2+1
CCHSIZ==^D50 ;50 USERS IN CACHE
;Local storage
IMPUR0
USRTAB: BLOCK 1 ; Pinter to user name cache
SVABLK: BLOCK 1 ; Saved A-block during address-list expansion
BRACKF: BLOCK 1 ; Inside angle brackets
STPNT: BLOCK 1 ;WHATFOR?
PBGN: BLOCK 1 ;Pointer to beginning of the address we build
PDST: BLOCK 1 ;Point to current place in address
VLIST: BLOCK 1 ;Points to first element built
VLISTE: BLOCK 1 ;Points to end of list (or advances through it)
ELIST: BLOCK 1 ;Points to QUEUE block list
WEIGHT: BLOCK 1 ;For the cache. Last entry weight here.
MYNAME: BLOCK 1 ;Points to block containing my name
PURE
GETUSR: TRVAR <STPARS,SAVUSR,QCHAR,ATSIGN,SMASH,CHKLST,<FLDDBU,2>,<ADRSTR,70>,<TRNSTR,50>,<TMPBLK,4>,<CHTRNB,6>>
MOVX A,<.CMKEY>B8+PARS10
MOVE B,KWDTBL
DMOVEM A,FLDDBU ;Build parse chain
HNDOUT:
IFG CCHSIZ,<
SKIPE USRTAB ;GOT A USER NAME CACHE?
JRST CHECKB ;YES, GOOD
MOVEI A,CCHSIZ+1 ; Aloocate space for a username cache
CALL M%GMEM
JUMPF CHECKB ; This bodes ill...
MOVEM B,USRTAB ; ok, this is the address of the table
SUBI A,1 ; Discount header word in tbluk room count
MOVEM A,(B) ; An empty tbluk table is born
>
IFLE CCHSIZ,<
SKIPE USRTAB
CMERR (User cache exists, but should not, in MSGUSR)
SETZM USRTAB
>
CHECKB: SKIPE C,SVABLK ; Any saved A-blocks waiting to be used?
JRST GETUSA ; Yes, go use up this one
SKIPE C,VLISTE ;Returning already-parsed strings?
JRST GORETP ;YES, GO RETURN NEXT BLOCK
SETZM BRACKF ;No bracket seen yet
GTUSR0: MOVX A,CM%XIF ; Clear @ allowed flag in case of error
ANDCAM A,SBK+.CMFLG
TXZ F,F%CMA!F%AT ;CLEAR FLAGS
;HERE TO START THE FIRST PARSE OF AN ADDRESS (OR AN ADDRESS IN ANGLES)
PARSE1: MOVEI A,ADRSTR ;BUILD A BP TO SCRATCH SPACE
SETZM (A) ;MAKE SURE IT IS EMPTY TO START
HRLI A,(POINT 7) ; ..
MOVEM A,PDST ;MOVING POINTER
MOVEM A,PBGN ;POINTER TO BEGINNING
MOVE A,SBK+.CMPTR ;POINT AT TEXT TO BE PARSED
MOVEM A,STPARS ;REMEMBER SO WE CAN RECOVER
;OK, PARSE BLOCK ALL SET UP. WE TRY TO PARSE ONE OF THE FOLLOWING:
; KEYWORD (ALIAS OR ADDRESS LIST)
; QUOTED STRING (NEEDS SPECIAL HANDLING)
; CONFIRM (FOR NULL LISTS)
ADDBFR: SETZM SAVUSR ;Clear token type
ADDBF1: MOVEI A,FLDDBU
CALL RFLDE ; Get name
JRST PARFLD ;Need to parse as a field
MOVX C,CM%XIF ; No more "@" indirect files
IORM C,SBK+.CMFLG
MOVE A,CR.COD(A) ; See what parsed
CAIN A,.CMTOK ;"." token?
JRST GETMEN ;yes, insert my name
CAIN A,.CMKEY ; Keyword?
JRST GETUSK ;YES, GO GET ADDRESS LIST OR ALIAS
CAIN A,.CMCFM ;CONFIRM?
JRST [SKIPE @PBGN ;GOT ANYTHING?
JRST EVALUA ;YES, GO UNDERSTAND IT
SKIPN VLIST ;NO, WAS ANYTHING DONE BEFORE?
RET ;NO, SO JUST RETURN +1
JRST EVALUA] ;YES, GO EVALUATE WHAT WE HAVE
;MUST BE .CMQST
MOVEI C,"""" ; Yes, quote string
ADDCOX: MOVE A,PDST
CAIE C,0
IDPB C,A ;If quoting, add quote
ADDSTD: MOVEM C,QCHAR ;Remember...
MOVE B,[POINT 7,ATMBUF]
CALL MOVST1 ;Copy in string so far
SKIPE C,QCHAR
IDPB C,A ;Add quote if needed
ESCTSB: MOVEM A,PDST ;Add whatever we parsed to our buffer
ESCTST: SKIPG SBK+.CMINC ;Did we stop on <ESC>?
JRST ESCHIT ;Go handle the escape
MOVEI A,STPINB ;Parse the character that stopped us
CALL RFLDE ;This is ,(ANGLEBRACKET[CR but not quote
JRST ADDBFR ;No stop character, keep adding to name buffer
MOVE A,CR.COD(A)
CAIN A,.CMCFM
JRST EVALUA ;GO FLAG DONE, AND START INTREPRETING
LDB A,[POINT 7,ATMBUF,6] ;FETCH TOKEN FROM BUFFER
CAIN A,"," ;COMMA?
JRST COMMA ;YES, FLAG AND INTREPERT THIS ADDRESS
CAIN A,"(" ;COMMENT BEGIN?
JRST COMENT ;YA, GO GOBBLE IT
CAIN A,"[" ;PPN INTRODUCER?
JRST SQUARE ;YES, GO HANDLE
CAIN A,76 ;CLOSE ANGLE?
JRST TERMAD ;CHECK IF LEGAL, AND PARSE COMMA OR <CR>
;MUST HAVE BEEN OPEN ANGLE BRACKET. ADRSTR HAS A PERSONAL NAME
PERSON: SKIPE BRACKF ;HAVE WE ALREADY SEEN OPEN ANGLE IN HERE?
JRST [CMERR (Mayn't use multiple sets of angle or square brackets)
JRST FAILRT]
CHOPTS: SKIPE C,@PBGN ;ANYTHING AT THE BEGINNING?
LDB C,PDST ;SPACE AT END?
CAIE C," "
JRST GOADDP ;NO
SETO A,
ADJBP A,PDST
MOVEM A,PDST
JRST CHOPTS
GOADDP: MOVEI A,ADRSTR
MOVX B,PRNCOD ;PERSONAL CODE
SETZ C, ;NO ADDITIONAL DATA
IDPB C,PDST ;CLOSE OFF STRING
CALL ADVBLK ;GO CREATE A V BLOCK
SETOM BRACKF ;INSIDE BRACKETS NOW (THE RULES CHANGE)
JRST GTUSR0 ;GO PARSE REAL ADDRESS
PARFLD: MOVEI A,PARS1C
CALL RFLDE
JRST [CMERR (Unable to parse address)
JRST FAILRT] ;Really should not happen
;TRY FOR NODE::USER, IN CASE SOME PEOPLE FORGET WHERE THEY ARE
MOVE A,[POINT 7,ATMBUF]
SETZ B, ;BE NICE; SCAN FOR NODE::USER.
SCANCL: ILDB C,A
SCANCA: JUMPE C,ADDCOX ;SINCE C IS ALREADY 0
CAIN C,"("
JRST [ILDB C,A
JUMPE C,ADDCOX
CAIE C,")"
JRST @.
JRST SCANCL]
CAIN C,""""
TRCE B,1
CAIE C,":"
JRST SCANCL
ILDB C,A ;GOT ONE. TWO IN A ROW?
CAIE C,":"
JRST SCANCA ;NO, BACK TO SCANNING STRING
SWAPFM: MOVE D,A ;WE SAW ::, LET'S DO THINGS.
SETO B,
ADJBP B,A
SETZ A,
DPB A,B ;NULL OUT FIRST COLON.
;HERE, D POINTS TO USERNAME, AND ATMBUF CONTAINS NULL TERMINATED NODENAME
MOVE B,D
MOVE A,PDST
CALL MOVST1 ;ADD USERNAME
MOVEI C,"@"
IDPB C,A ;ADD ATSIGN
SETZ C,
JRST ADDSTD ;GO ADD NODENAME
ADDCON: SETZ C,
JRST ADDCOX
SQUARE: SKIPE @PBGN ;ANYTHING ALREADY PARSED?
JRST BACK1 ;YES, MAKE IT PERSONAL (BACKUP PARSER)
MOVEI A,PAROCC ;OCTAL PARSE OR COMMA
CALL RFLDE ;..
JRST OCTERR ;SORRY
MOVE A,CR.COD(A)
CAIN A,.CMCMA
JRST [MOVE A,MYPPN ;COMMA? HE WANTS OUR PROJECT NUMBER
MOVEM A,ADRSTR
JRST PARPN2] ;GO SKIP COMMA PARSE
GOTOCT: HRLZM B,ADRSTR ;STORE 1ST HALF OF PPN
MOVEI A,CMAINB ;GET COMMA
CALL RFLDE
JRST [CMERR (Comma required in PPN)
JRST FAILRT]
PARPN2: MOVEI A,PAROCT
CALL RFLDE
JRST OCTERR
HRRM B,ADRSTR
SKIPE SBK+.CMINC ;WANT A VERIFY?
JRST NVRPPN ;NO
CALL VERIFY
JRST BADONE ;SOMETHING GIVEN PREVIOUSLY FAILED
CALL ALLOE1
MOVE A,ADRSTR
MOVEM A,(B) ;FILL IN SOURCE QUEUE SUBBLOCK WITH PPN
MOVE A,ELIST
ADD A,[.QUARG+4,,E.LEN]
QUEUE. A,
JRST QUEFAL
SKIPN 1(C)
JRST [OUTCHR [.CHBEL] ;FLUNKED. BEEP
CALL DELEBK ;TOSS E-BLOCK
JRST NVRPPN] ;AND NEGLECT TO PROVIDE THE "]" FOR HIM
CALL DELEBK ;TOSS THE E-BLOCK
HRROI A,[ASCIZ/] /] ;IT'S GOOD, GIVE HIM THE BRACKET
CALL INSERB
NVRPPN: MOVEI A,CLBINB
CALL RFLDE
JRST [CMERR (Close square bracket required in PPN)
JRST FAILRT]
CALL PARCCM
JRST CCMERR
MOVEI A,ADRSTR ;POINT TO WHERE PPN IS
MOVX B,V.PPN ;SAY "THIS IS A PPN"
SETZ C, ;NOTHING GOES WITH IT
CALL ADVBLK ;ADD IT
MOVNS BRACKF ;MAKE SURE THIS IS 0 OR 1
JRST CLOSED ;GO CLOSE
OCTERR: CMERR (Bad octal value seen in PPN)
JRST FAILRT
BACK1: SETO A,
ADJBP A,SBK+.CMPTR
MOVEM A,SBK+.CMPTR
AOS SBK+.CMINC
JRST PERSON
GETMEN: MOVE B,[POINT 7,MYDIRS]
MOVEI A,1 ;IT'S REAL IF IT IS ALL WE HAVE
SKIPE @PBGN ;HAVE WE PARSED OTER THINGS?
MOVEM A,SAVUSR ;NO, OK SO FAR
MOVE A,PDST ;APPEND TO WHATEVER WE HAVE
CALL MOVST1
JRST ESCTSB ;GO DO MORE PARSING
ESCHIT: CALL VERIFY ;VERIFY WHAT WE HAVE FOR CLOSED ADDRESSES
JRST BADONE ;FAILED
SKIPN @PBGN ;HAVE WE GOT ANYTHING OPEN?
JRST SPACEI ;NO. GO HANDLE SIMPLE <ESC>
MOVE A,PDST
SETZ B,
IDPB B,A ;INSURE NULL
LDB A,PDST ;WAS LAST THING ADDED A QUOTE?
CAIE A,""""
JRST NOCLOB ;NO, GOOD
SETO A, ;YES, MUST CLOBBER IT
ADJBP A,PDST
MOVEM A,PDST
SETZ B,
IDPB B,A ;NULLED OUT
NOCLOB: MOVE A,PBGN ;COPY WHAT WE HAVE, LESS COMMENTS, TO
CALL CHOPCM ;TRNSTR
HRROI B,[ASCIZ/SYSTEM/]
CALL S%SCMP
JUMPE A,SPACEI ;IT'S "SYSTEM", ALLOW IT
;What follows is a cheap hack to get completion and verification in the
; currently open address. Take the address and blindly try to verify it.
; "How about using the username cache to speed this up?" you are asking.
; Or, "Let's cache the result!"
;
;Implement it yourself. This is a cheap hack to get completion and verification
; in the currently open address...
CALL ALLOE1 ;WE NEED AN E-BLOCK FOR ONE USER
MOVEI A,1(B) ;BUILD A BP TO WHERE THE STRING GOES
HRLI A,(POINT 8) ; 8 BIT FOR ACTDAE
MOVEI B,TRNSTR ;WERE IT IS NOW (WITH COMMENTS STRIPPED)
HRLI B,(POINT 7)
SETZ D, ;COUNT WHAT WE COPY
CPYEST: ILDB C,B ;COPY DELETING QUOTES
CAIN C,""""
JRST CPYEST ;SINCE ACTDAE DOESN'T WANT TO SEE THEM
JUMPE C,NAILIT ;NULL MEANS DONE
CAIN C,"@" ;ATSIGN?
JRST GOBEEP ;PROBABLY NON-LOCAL ADDRESS
IDPB C,A ;WRITE IT
AOJA D,CPYEST ;COUNT IT
NAILIT: JUMPE D,SPACEY ;NULL RESULT? JUST GO ADD SPACE
MOVEM D,TMPBLK ;SAVE COUNT FOR FUTURE CALLS
MOVE A,ELIST ;GET THE BLOCK ALLOE MADE FOR US
ADD A,[.QUARG+4,,E.LEN] ;SET UP YE QUEUE.
QUEUE. A,
ACTDAS: JRST QUEFAL
MOVE A,ELIST ;POINT TO BLOCK AGAIN
MOVE A,E.PNT2(A) ;POINT TO RESULT
SKIPE (A) ;IS IT VALID?
SKIPN 1(A) ;ANY STRING BACK?
JRST GOBEEP ;NO, BEEP
;BUILD STUFF FOR CHTRN.
ADD A,[POINT 8,1] ;BP TO RESULT
MOVE B,TMPBLK ;SET UP TO SKIP WHAT USER TYPED IN
ADJBP B,A ;ADVANCE PAST USER TYPEIN (IT'S OK AS IS)
MOVEI A,^D40 ;MAX CHARS IN USERNAME, PLUS NULL
SUB A,TMPBLK ;JUST DO WHAT'S LEFT
TXO A,CH.FBR ;INDICATE WHAT WE ARE DOING, WITH COUNT
DMOVEM A,CHTRNB ;B CONTAINS SOURCE POINTER, START BLOCK BUILD
SETZ B, ;NEXT TWO WORDS, PLEASE
MOVEI C,^D75 ;MAX COUNT FOR USERNAME, I HOPE
DMOVEM B,2+CHTRNB ;STORE 0 AND COUNT
MOVE A,ELIST ;USE DEAD SPACE IN E-BLOCK
ADD A,[POINT 7,E.LEN] ;SKIP HEADER STUFF
MOVEM A,TMPBLK ;SAVE POINTER TO RESULT
DMOVEM A,4+CHTRNB ;STORE IT AND 0
MOVEI A,CHTRNB ;GET ADDRESS
CHTRN. A, ;CONVERT
JFCL ;CERTAINLY UNNECESSARY?
MOVE A,TMPBLK ;CONVERTED TEXT IS FOUND HERE
SETOM CHTRNB ;FLAG: OK SO FAR
CHKPPB: ILDB C,A
JUMPE C,INSIN
CAIL C," "
CAIN C,177
JRST BADCHN
MOVE B,[POINT 7,BADCHL]
CHKBDL: ILDB D,B
JUMPE D,CHKPPB
CAIE D,(C)
JRST CHKBDL
BADCHN: SETZB D,CHTRNB ;FLAG: BAD CHAR SEEN, BEEP
DPB D,A
INSIN: MOVE A,TMPBLK
CALL INSERA ;ADD TO INPUT BUFFER (AND ECHO) REMAINDER
LDB A,[POINT 7,TRNSTR,6] ;GET FIRST CHARACTER IN REQUESTED STRING
CAIE A,""""
JRST SPACEX ;NOT QUOTE, NEEDN'T ADD TRAINING QUOTE
HRROI A,[ASCIZ/"/]
CALL INSERB ;INSERT QUOTE
SPACEX: SKIPN CHTRNB ;ALL OK?
JRST GOBEEP ;NO, BEEP AT USER
SPACEY: HRROI A,[ASCIZ/ /]
CALL INSERB ;INSERT SPACE
CALL DELEBK
JRST ADDBF1
GOBEEP: OUTCHR [.CHBEL] ;GEEP AT USER
CALL DELEBK ;DELETE E-BLOCK WE USED
SPACEI: MOVEI A," "
IDPB A,PDST
JRST ADDBFR
DELEBK: MOVE B,ELIST ;KILL FIRST E-BLOCK: FETCH POINTER..
HRRZ C,E.HDR(B) ;GET NEXT BLOCK
MOVEM C,ELIST ;ADVANCE POINTER
HLRZ A,E.HDR(B) ;FETCH LENGTH
JRST M%RMEM ;RETURN THROUGH MEMORY RETURN CALL
COMENT: IDPB A,PDST ;ADD OPEN PARENTHESIS
COMMOR: MOVEI A,CMTINB ;PARSE TEXT ENDING WITH A ")"
CALL RFLDE
JRST [CMERR (Unterminated comment in address)
JRST FAILRT]
MOVE A,PDST
HRROI B,ATMBUF
CALL MOVSTR ;COPY IN
MOVEM A,PDST
MOVEI A,CMTEND
CALL RFLDE
JRST COMMOR
MOVEI C,")"
IDPB C,PDST
MOVEI C," "
IDPB C,PDST
JRST ESCTST ;ADD STRING AND DELIMITER
COMMA: TXO F,F%CMA
JRST EVALUA
TERMAD: SKIPL A,BRACKF ;BETTER BE IN BRACKETS!
JRST [CMERR (Close angle bracket seen without open angle before it)
JRST FAILRT]
MOVNM A,BRACKF ;SAY AFTER BRACKET NOW
CALL PARCCM
JRST CCMERR
;HERE TO ANALYZE AN ADDRESS TO SEE IF NET, ETC. IF IT LOOKS OK WE WILL PUT
; IT ON THE V BLOCK LIST
EVALUA: SETZ A,
IDPB A,PDST ;TERMINATE THE STRING WE HAVE
SKIPGE BRACKF ;NO BRACKETS, OR PAST THEM?
JRST [CMERR (No closing angle bracket seen in address)
JRST SETPRS] ;NO RIGHT TO BE HERE WITHOUT IT
MOVE A,PBGN ;SCAN STRING TO FIGURE OUT WHAT IT REALLY IS
MOVEI D,10 ;FLAG WORD: KILL LEADING SPACES
MOVE B,A ;WRITE TO SAME BUFFER WE READ FROM
;This bit of code compresses multiple spaces into one, changes tabs to spaces,
; Finds "@" or " at " (hence revealing net addresses), all while leaving
; quoted strings and (comments) alone. Plus, we make sure
; the address is at least minimally well formed {A@B or A but not
; A@ or @B or A@"B"}
SCANAN: ILDB C,A ;WE GET THIS CHARACTER, RIGHT?
JUMPE C,SCANEN ;NULL MEANS END
CAIN C,"""" ;IS IT BEGINNING A QUOTED STRING?
JRST [TRNE D,2 ;AFTER AN "@"?
JRST [CMERR (Quoted string after an "@")
JRST SETPRS] ;THAT'S SILLY
IDPB C,B ;WRITE THE QUOTE
TRO D,1 ;GOT A CHARACTER BEFORE "@"
JRST SKPJNK]
CAIN C,"(" ;HOW ABOUT COMMENT?
JRST [TRNN D,2 ;IF BEFORE "@", STORE IT
IDPB C,B
TRZ D,10 ;CLEAR SPACE FLAG
MOVEI C,")" ;SCAN UNTIL COMMENT ENDS
JRST SKPJNK]
CAIN C,.CHTAB
MOVEI C," " ;TRANSLATE TAB TO SPACE
CAIE C," "
JRST ADDCHR
TROE D,10 ;ALREADY GOT SPACES?
JRST SCANAN ;YES, SKIP
MOVEM D,1+TMPBLK ;FREE AN AC
CHKATS: MOVEM A,TMPBLK ;Check for "AT " ignoring leading spaces
ILDB C,A
JUMPE C,NOTATS ;NULL MEANS IT ISN'T "AT"
CAIE C,.CHTAB
CAIN C," " ;LEADING SPACE?
JRST CHKATS ;YES, TOSS IT
MOVEI D,[EXP "A","T"," ",0] ;CHECK FOR THIS STRING
CHKATL: ADJBP C,[POINT 7,UPCASE,6] ;FORCE UPPERCASE (OR TAB TO SPACE)
LDB C,C ;..
CAME C,(D) ;MATCH?
JRST NOTATS ;NO, CAN'T BE "AT"
SKIPN 1(D)
JRST GOTATF
ILDB C,A ;GET NEXT CHARACTER
AOJA D,CHKATL ;YES, GO TEST
GOTATF: MOVE D,1+TMPBLK ;GOT AT "AT ", RECOVER FLAGS
MOVEI C,"@" ;SAY WE GOT AN ATSIGN
JRST ADDCHS ;AND INSERT IT
NOTATS: MOVE A,TMPBLK ;NO "AT " SEEN. RECOVER POINTER..
MOVE D,1+TMPBLK ;RECOVER FLAGS
SKIPA C,[" "] ;PUT SPACE IN HERE
ADDCHR: TRZ D,10 ;SAY NON-SPACE SEEN
ADDCHS: IDPB C,B ;WRITE CHARACTER IN
CAIN C,"@" ;WAS YOU "@"?
JRST FLAGAT ;YES, GO REMEMBER THAT
CAIN C," "
JRST SCANAN ;SPACE ISN'T REAL ENOUGH TO CALL A NAME
TRNN D,2 ;BEFORE "@" OR AFTER?
TROA D,1 ;BEFORE, MARK USERNAME SEEN
TRO D,4 ;AFTER, MARK NODENAME SEEN
JRST SCANAN
FLAGAT: TROE D,2 ;YES, MARK THAT
JRST [CMERR (Too many atsigns)
JRST SETPRS]
TRO D,10 ;START COMPRESSING SPACES OUT AFTER "@"
MOVEM B,ATSIGN ;REMEMBER WHERE IT IS
JRST SCANAN
;SCAN OVER "FOO" AND (BAR). SINCE WE BUILT THESE STRINGS, WE HAVE ASSURANCE
; THAT THE TERMINATING CHARATER IS IN FACT OUT THERE.
SKPJNK: MOVEM C,QCHAR ;STORE TERMINATOR CHARACTER
SCNJNK: ILDB C,A
IDPB C,B ;NO, SO (COMMENT) IS OK
CAME C,QCHAR
JRST SCNJNK
JRST SCANAN
SCANEN: TRZE D,10 ;COULD SPACE BE THE LAST CHARACTER WRITTEN?
SKIPN @PBGN ;IF NOTHING IS IN THE BUFFER, NO
JRST DOBITS ;LEAVE STRING ALONE (NO TRAILING SPACE)
LDB A,B ;GET LAST CHARACTER WRITTEN
CAIN A," " ;IS IT IN FACT SPACE?
DPB C,B ;NULL IT OUT
DOBITS: IDPB C,B ;CLOSE OFF STRING (CLOBBERING TRAILING SPACE)
CAIL D,0
CAILE D,7 ;CATCH CODING ERRORS, JUST IN CASE
MOVEI D,4 ;WE WANT TO SAY "INTERNAL ERROR"
MOVE A,STATE(D) ;YIELDS 0,,JUMP-ADDR OR -1,,ADDR-OF-MESSAGE
JUMPG A,(A) ;TRANSFER IF IT IS A JUMP ADDRESS
CMERR (Bad address syntax: %1S)
JRST SETPRS
STATE: -1,,[ASCIZ/No addresses found/] ;all spaces and comments
0,,LOCALU ;ok, local address (no "@")
-1,,[ASCIZ/Address contained only "@" (no local part or nodename)/]
-1,,[ASCIZ/Address contained "@" but no nodename was found/]
-1,,[ASCIZ/Internal error/] ;code has been messed up, SPR it
-1,,[asciz/Address contained "@" and nodename but no local part/]
-1,,[ASCIZ/Internal error/] ;code messed up
0,,NETUSR ;OK, net address
NETUSR: MOVE A,ATSIGN ;POINT TO ATSIGN
CALL CHOPCM ;COPY NODENAME INTO TRNSTR, LESS COMMENTS
MOVE B,(A) ;FETCH FIRST 5 CHARS OF THE NODENAME
CAME B,[ASCIZ/./] ;IS IT JUST "."?
JRST VALNOD ;NO, GO VALIDATE A REAL NODENAME
MOVE A,ATSIGN
MOVE B,MYHDPT ;MOVE OUR NODENAME OVER "."
CALL MOVST2 ;NOTE: CLOBBERS THINGS LIKE @.(OURNODE)
JRST PLUNKN ;NEEDN'T VERIFY SELF!
VALNOD: MOVEI A,TRNSTR ;BUILD POINTER TO NODENAME
HRLI A,(POINT 7)
CALL VALID8
JRST [HRROI A,TRNSTR
CMERR (Unknown nodename "%1S")
JRST SETPRS]
JRST PLUNKN ;NODE IS OK
LOCALU: MOVE B,SAVUSR ;GET TYPE
TXNE B,V.PPN ;IS IT JUST A PPN?
JRST PLUNK1 ;PPN, MUST VERIFY IN *ALL* CASES, TO GET NAME
TXNE F,F%FDIR ;"FORCE NO VERIFY" SET BY USER?
JRST DOVERC ;DEFAULT: WE ARE SUPPOSED TO VERIFY THINGS
HRRI B,1 ;AVOID THE VERIFY; SAY "KNOWN GOOD LOCAL USER"
MOVEM B,SAVUSR ;SET IT SO
JRST PLUNK1 ;AND ACT LIKE IT WAS IN THE CACHE
;Here we have to try to verify it. Try the Cache (if it exists) to avoid the
; delay of doing a QUEUE.
DOVERC: SKIPN USRTAB ;NO, DO WE HAVE A USER CACHE?
JRST PLUNK1 ;CAN'T VERIFY VIA CACHE
IFG CCHSIZ,<
MOVE A,PBGN ;GET TEXT OF LOCAL USERNAME
CALL CHOPCM ;COPY, STRIPPING COMMENTS, TO TRNSTR
MOVE B,A ;MOVE POINTER TO B
HRLI B,(POINT 7)
MOVE A,USRTAB ;POINT TO USER CACHE
CALL S%TBLK
TXNN B,TL%EXM
JRST PLUNK ;NO EXACT MATCH, SORRY
HRRZ B,(A) ;GET CACHE BLOCK ADDRESS
AOS A,WEIGHT ;UPDATE WEIGHT
MOVEM A,C.WEI(B) ;..
MOVEI B,1 ;SAY "THIS IS KNOWN OK"
TRNA
>
PLUNKN: MOVX B,NETCOD
MOVEM B,SAVUSR
TRNA
PLUNK: MOVE B,SAVUSR ;TIME TO ADD THIS TO THE V LIST...
PLUNK1: MOVE A,PBGN ;POINT TO STRING
SETZ C, ;NO ADDITIONAL DATA
CALL ADVBLK ;IN YA GO
CLOSED: SETZM BRACKF ;CLOSE OFF THIS ADDRESS
TXNE F,F%CMA ;GO AGAIN?
JRST GTUSR0 ;YES
FINIS: CALL VERIFY ;Verify the V list
JRST BADONE ;We got something bad
SKIPN A,VLIST ;START HANDING BACK BLOCKS
RET ;Nothing to return? Fine...
MOVEM A,VLISTE ;GETUSR USES THIS TO CHASE CHAIN
JRST HNDOUT ;START HANDING OUT THE BLOCKS WE BUILT!
BADCHK: SKIPA A,STPARS
;Here if VERIFY claims a user isn't real. It returns A/ BP to bad name
BADONE: MOVEM A,STPARS
ILDB C,A ;ADVANCE OVER SPACES AND GET FIRST NONSPACE
CAIN C," "
JRST BADONE ;HOW DID THAT GET HERE?
MOVEI B,TRNSTR
HRLI B,(POINT 7) ;POINT TO DESTINATION FOR ERROR MESSAGE
CAIE C,"[" ;ARE WE COMPLAINING ABOUT A PPN?
TDZA D,D ;NO, ONE COMMA TERMINATES
SETO D, ;YES, ALLOW ONE COMMA IN ADDRESS
TRNA ;ALREADY HAVE THE FIRST CHAR IN C
COMPLN: ILDB C,A
CAIN C,"," ;COMMA?
AOJG D,ZAPCHR ;ALLOW ONE IN A PPN, OTHERWISE STOP
CAIE C,76 ;ANGLE BRACKET?
CAIN C,.CHCRT ;CR?
JRST ZAPCHR ;YES, STOP
CAIN C,";" ;UNLIKELY
ZAPCHR: SETZ C,
IDPB C,B
JUMPN C,COMPLN
MOVEI A,TRNSTR
CMERR (No such user as "%1S")
SETPRS: MOVE A,STPARS
MOVEM A,SBK+.CMPTR ;LIE TO GLXLIB
SETZ B,
IDPB B,A
EXCH B,SBK+.CMINC
ADDM B,SBK+.CMCNT
HRRZS SBK+.CMFLG ;TOSS FLAGS
FAILRT: CALL KILLST
SETZM BRACKF
JRST CMDER1
CHOPCM: MOVEI D,1 ;FLAG: TOSS LEADING SPACES
MOVEI B,TRNSTR ;POINT TO TRNSTR
SETZM (B) ;MAKE SURE IT STARTS ZERO
HRLI B,(POINT 7) ;MAKE A BP TO IT
HACKPN: ILDB C,A ;FETCH GIVEN CHARACTER
JUMPE C,EHCKPN ;NULL IS DONE
CAIN C,"(" ;COMMENT?
JRST HAKOUT ;YES, REMOVE
CAIE C," "
TRZA D,1 ;NOT SPACE, CLEAR FLAG
TRON D,1 ;SPACE, LIGHT FLAG AND SKIP IF ALREADY ON
IDPB C,B ;NO, WRITE CHARACTER (MULTIPLE SPACES GONE)
CAIE C,""""
JRST HACKPN
HCKQTE: ILDB C,A
IDPB C,B
CAIE C,""""
JRST HCKQTE
JRST HACKPN
HAKOUT: ILDB C,A
CAIE C,")"
JRST HAKOUT
JRST HACKPN
EHCKPN: LDB A,B
CAIN A," "
DPB C,B
IDPB C,B
HRROI A,TRNSTR
RET
PARCCM: MOVEI A,CCMLST ;PARSE COMMA OR CONFIRM
CALL RFLDE
RET ;NEITHER, GO HOME SINGLE
MOVE A,CR.COD(A)
CAIE A,.CMCFM
TXOA F,F%CMA ;COMMA, LIGHT BIT
TXZ F,F%CMA ;CONFIRM, CLEAR BIT
RETSKP ;RETURN MARRIED
CCMERR: CMERR (Comma or CR expected)
JRST SETPRS
;Come here to add an item to the V list. Enter with
; A/ address of text to add (word aligned, null termineated)
; B/ Type of entry being added (0 if might be local...)
; C/ Additional data (usually a pointer)
ADVBLK: DMOVEM A,TMPBLK
MOVEM C,2+TMPBLK ;SAVE ARGS
MOVE D,B
SETZ B, ;COUNT STRING LENGTH
TXNE D,V.PPN ;IS THIS A PPN?
JRST LENPPN ;YES, AND THEY REQUIRE JUST ONE WORD
HRLI A,(POINT 7)
CNTADV: ILDB C,A
CAIE C,0
AOJA B,CNTADV
IDIVI B,5
LENPPN: MOVEI A,1+V.TEXT(B)
CALL M%GMEM ;GET SOME MEMORY...
JUMPF NOMEM
HRLZM A,V.HDR(B) ;STORE SIZE,,0 (NO NEXT) IN BLOCK
MOVEM B,3+TMPBLK ;SAVE BLOCK ADDRESS
DMOVE C,1+TMPBLK ;PICK UP TYPE AND ADDITIONAL INFO
TRNE C,-1 ;IS TYPE "NEEDS VERIFY"?
TXO C,V.VROK ;NO, SO IT DOESN'T NEED VERIFICATION
MOVEM C,V.TYP(B) ;SAVE TYPE INFO
MOVEM D,V.REAL(B) ;SAVE ADDITIONAL INFO WORD
MOVE D,STPARS ;FETCH LOCATION OF PARSE BEGINNING..
MOVEM D,V.RPRS(B) ;OF THIS ADDRESS, AND SAVE THAT TOO
SETZM V.VLNK(B) ;NO VERIFY LINKING YET
HLRZ A,V.HDR(B) ;GET LENGTH AGAIN
SUBI A,V.TEXT ;NUMBER OF WORDS THAT CONTAINS STRING
MOVNS A ;NEGATE
HRLI A,V.TEXT(B) ;POINT TO TARGET
MOVSS A ;SWAP TO AOBJN POINTER
MOVE B,TMPBLK ;FETCH POINTER TO STRING
MOVEI B,(B) ;EVALUATE TO WORD ADDRESS
CPYTTV: MOVE C,(B) ;FETCH WORD
MOVEM C,(A) ;STORE IN BLOCK
ADDI B,1 ;ADVANCE FETCH POINTER
AOBJN A,CPYTTV ;ADVANCE STORE POINTER AND TEST COUNT
MOVE B,3+TMPBLK ;FETCH POINTER TO BLOCK AGAIN
SKIPN A,VLISTE ;DO WE HAVE A LIST STARTED?
JRST [MOVEM B,VLIST ;NO, START ONE
JRST .+2]
HRRM B,V.HDR(A) ;MAKE LAST BLOCK POINT TO THIS ONE
MOVEM B,VLISTE ;MAKE THIS BLOCK NEW LAST ONE
RET ;WASN'T THAT EASY?
NOMEM: CMERR (Out of memory)
JRST FAILRT ;DIE SHAMELESSLY
;Here if keyword parsed -- this is an address-list, alias, SYSTEM,
; or TOPS10 username. B has index into keyword table.
GETUSK: HRRZ A,(B) ; Get A-block ptr or code
CAIN A,SYSCOD ; SYSTEM?
JRST SYSTHT ;YES, TAKE IT
SKIPE BRACKF
JRST [CMERR (Aliases and Address lists are illegal in angle brackets)
JRST CMDER1]
MOVE C,AB.FLG(A) ; Get flags for this A-block
TXNE C,AB%INV ; Invisible?
JRST ALIAS
MOVE C,A ;MOVE POINTER TO ADDRESS LIST EXPANSION TO C
HLRO A,(B) ;GET ADDRESS LIST NAME POINTER TO A
MOVX B,PFXCOD ;TYPE (PREFIX) TO B
CALL ADVBLK ;ADD TO THE V-LIST
CALL PARCCM ;PARSE COMMA OR CONFIRM
JRST CCMERR ;SORRY
JRST CLOSED ;GO SET UP FOR NEXT
ALIAS: MOVE B,AB.COD(A)
HRRZ A,AB.ADR(A)
HRLI A,(POINT 7)
SETZ C,
CALL ADVBLK ;AND IN IT GOES DIRECTLY
CALL PARCCM
JRST CCMERR
JRST CLOSED ;CLOSE THE BOOKS ON IT
SYSTHT: MOVEM A,SAVUSR ;RECORD THE FACT THAT THIS IS SYSTEM
MOVEM B,TMPBLK ;SAVE TBLUK POINTER
MOVE A,SBK+.CMFLG ;DID <ESC> TERMINATE THIS FIELD?
TXNN A,CM%ESC ;..?
JRST ADDCON ;NO, MUST BE AN EXACT MATCH
HLRZ B,(B) ;POINT TO TEXT AS STORED IN TABLE
MOVE A,PBGN
CALL MOVSTR ;GO LOAD THAT
JRST ESCTSB ;LOAD IT
VERIFY: SKIPN A,VLIST ;ANYTHING TO DO?
RETSKP ;NO, GIVE OK RETURN
HRROM A,VLIST ;ASSUME ANOTHER PASS IS NEEDED
VERPSN: SETZB B,D ;CLEAR COUNTER AND LINKER
VERCNT: MOVE C,V.TYP(A) ;FETCH FLAGS
SETZM V.VLNK(A) ;CLEAR LINK TO START
TXNE C,V.VROK ;DOES IT NEED VERIFY?
JRST VERCN2 ;NO, SKIP THIS
ADDI B,1 ;ADD 1 TO COUNT
JUMPE D,FSTINV ;IS THIS THE FIRST?
MOVEM A,V.VLNK(D) ;NO, MAKE LAST POINT TO THIS
CAILE B,^D37 ;QUEUE CAN ONLY DO SO MANY AT ONCE
JRST DOSET ;THAT'S ENOUGH, COME BACK FOR MORE LATER
TRNA
FSTINV: MOVEM A,CHKLST ;FIRST, MAKE CHKLST POINT TO IT
MOVE D,A ;MAKE D POINT HERE FOR NEXT TIME
VERCN2: HRRZ A,V.HDR(A) ;NEXT IN LIST?
JUMPN A,VERCNT ;AGAIN IF NOT AT END
HRRZS VLIST ;WE FIT THEM ALL, CLEAR REPEAT FLAG
CAIG B,0 ;GET ANY?
RETSKP ;NO! FINE, LET'S GET OUT OF HERE
DOSET: CALL ALLOE ;WITH COUNT IN B, BUILD QUEUE. DATASTRUCTURE
DMOVEM B,1+TMPBLK ;SAVE RETURNED POINTERS TO SEND & RETURN BLOCKS
MOVE A,CHKLST ;SCAN BLOCKS NEEDING VERIFY
VERBLD: MOVEM A,TMPBLK ;SAVE POINTER TO CURRENT BLOCK
DMOVE B,1+TMPBLK ;GET POINTERS TO SOURCE & DEST BLOCKS
SETZM (C) ;CLEAR DEST PPN WORD
ADDI C,1 ;POINT TO RETURN STRING
SETZM (C) ;CLEAR THAT TOO
MOVEM C,V.REAL(A) ;HAVE V-BLOCK POINT TO WHERE STRING WILL GO
SETZM 1(B) ;CLEAR SOURCE USERNAME TO START
MOVE D,V.TYP(A) ;GET FLAGS
TXNE D,V.PPN ;ARE YOU A PPN BLOCK?
JRST VERPPN ;YES, THAT'S EASY, GO DO
SETZM (B) ;CLEAR SOURCE PPN WORD
ADD B,[POINT 8,1] ;POINT TO WHERE SOURCE USERNAME WILL GO
ADD A,[POINT 7,V.TEXT] ;AND WHERE IT IS NOW
SETZ D,
VERCPY: ILDB C,A ;COPY IN, DELETING (COMMENTS)
CAIN C,""""
JRST VERCPY ;DELETE QUOTES
CAIN C,"(" ;COMMENT BEGIN?
JRST [ILDB C,A ;SCAN FOR END
CAIE C,")" ;..
JRST @. ;NOPE, CONTINUE LOOP GROSSLY
JRST VERCPY] ;OK, GET ONE WITH REAL COPY]
JUMPE C,VERCLS
IDPB C,B ;WRITE INTO VERIFIER BLOCK
CAIGE D,^D39-1 ;MAX NUMBER OF LEGAL CHARS IN USERNAME HERE
AOJA D,VERCPY ;STILL OK, ADD ONE AND GO ON
SETOM @2+TMPBLK ;TOO LONG! CLOBBER THE STRING TO INSURE IT FAILS
JRST VERADV ;(HECKUVA TIME TO FIND OUT)
VERCLS: LDB A,B ;TRAILING SPACE?
CAIN A," " ;..?
DPB C,B ;YES, NUKE
IDPB C,B ;NO, TERMINATE
JRST VERADV
VERPPN: MOVE D,V.TEXT(A) ;JUST GET PPN
MOVEM D,(B) ;STORE IN PPN WORD OF SOURCE BLOCK
VERADV: MOVEI D,13 ;ADVANCE POINTERS TO NEXT SUB BLOCK
ADDM D,1+TMPBLK ;ADVANCE THIS
ADDM D,2+TMPBLK ;ADVANCE THAT
MOVE A,TMPBLK ;FETCH POINTER TO CURRENT BLOCK
SKIPE A,V.VLNK(A)
JRST VERBLD
MOVE A,ELIST
ADD A,[.QUARG+4,,E.LEN]
QUEUE. A,
ACTDAE: JRST QUEFAL
;HAVING GOTTEN A RESPONSE, LET'S LOOK IT OVER, AND ADD GOOD ENTRIES INTO THE
; CACHE. IF ANYTHING COMES OUT INVALID, FLAG IT (SMASH WILL POINT TO THE
; FIRST INVALID ENTRY) AND ERROR OUT WHEN ALL DONE
SETZM SMASH
MOVE A,CHKLST ;POINT TO V-BLOCKS WE ARE CHECKING
CHCK2X: MOVEM A,TMPBLK ;MAKIN' A LIST, AND..
MOVE C,V.REAL(A) ; (POINT TO RESPONSE SUB BLOCK)
SKIPE -1(C) ;CHECKIN' IT TWICE (CHECK PPN)
SKIPN (C) ;GONNA FIND OUT WHO'S (NO USERNAME RETURNED?)
JRST NOSUCH ;NAUGHTY.. (FLAG THIS AS FLUNKED)
MOVX B,V.VROK+1 ;OR NICE (FLAG THIS ONE AS OK)
IORM B,V.TYP(A) ;..
CALL CACHEB ;GO BUILD A CACHE BLOCK AND REBUILD STRINGS
INCACH: MOVE B,3+TMPBLK ;BUILD TBLUK TABLE ENTRY
HRLI B,C.TXT(B) ;..
SKIPN A,USRTAB ;GET CACE ADDRESS
JRST CCHDEN ;NONE!!? GO DELETE THIS BLOCK
CALL S%TBAD ;INSERT THAT ENTRY
JUMPF CCHFUL ;ERROR? FULL OR DUPLICATE, GO SEE
JRST CHKUSN ;DONE WITH THIS V-BLOCK ENTRY
NOSUCH: SKIPN SMASH ;IS THIS FIRST THAT FAILED?
MOVEM A,SMASH ;YES, POINT TO V-BLOCK THAT BLEW IT
JRST CHKUSN ;AND GO ON
CCHFUL: MOVE C,USRTAB ;SEE IF CACHE IS FULL
HLRZ B,(C) ;GET COUNT
HRRZ A,(C) ;GET SIZE
CAIE A,(B) ;SAME?
JRST CCHDEN ;NO, PROBABLY DUPLICATE, GO DELETE
MOVN C,@USRTAB ;GET NEGATIVE LENGTH IN RH
HRL C,USRTAB ;AND ADDDRESS IN LEFT
MOVSS C ;SWAP'EM
ADDI C,1 ;POINT TO TABLE, NOT HEADER
MOVX D,.INFIN ;FIND OLDEST (SMALLEST) WEIGHT
HRRZ B,C ;WE *WILL* KILL SOMETHING
DEADUS: HRRZ A,(C) ;POINT TO ENTRY
CAMG D,C.WEI(A) ;WHICH IS OLDER?
JRST NOKILL ;NOT THIS ONE, TOO FRESH
MOVE D,C.WEI(A) ;NEW CANDIDATE
HRRZ B,C ;POINT TO TBLUK ENTRY
NOKILL: AOBJN C,DEADUS ;FINISH SCAN
MOVE D,B ;THIS ENTRY COMES OUT
HRRZ B,(B) ;FIRST FETCH BLOCK
CALL CCHDEB ;AND ZAP IT
MOVE B,D ;NOW REMOVE FROM TABLE
MOVE A,USRTAB
CALL S%TBDL
JRST INCACH
CCHDEN: MOVE B,3+TMPBLK ;DELETE WHAT WE JUST BUILT
CALL CCHDEB
CHKUSN: MOVE A,TMPBLK ;ON TO NEXT V-BLOCK
SKIPE A,V.VLNK(A) ;..
JRST CHCK2X ;..
SKIPN A,SMASH ;ANY FAILURES?
JRST VALIOK ;NO, GOOD
MOVE A,V.RPRS(A) ;RETURN POINTER INTO PARSE BUFFER TO CALLER
RET ;FAIL
VALIOK: SKIPL VLIST ;DO WE NEED ANOTHER CHUNK DONE?
RETSKP ;NO, ALL DONE
JRST VERPSN ;YES, HEIGH-HO
CACHEB: MOVEM C,2+TMPBLK ;
HRLI C,(POINT 8) ;COUNT # OF CHARACTERS IN THIS NAME
MOVEI B,1 ;COUNT NULL AHEAD OF TIME
GETLEN: ILDB D,C
CAIE D,0
AOJA B,GETLEN
MOVEM B,1+TMPBLK ;SAVE # OF CHARS + NULL (FOR CHTRN.)
IMULI B,3 ;ANY CHAR CAN BECOME 3 CHARS AFTER CHTRN.
LSH B,-2 ;4 CHARS PER WORD IN 8 BIT
MOVEI A,1+C.LEN(B) ;TRANSLATED FORM, PLUS HEADER, PLUS NULL
CALL M%GMEM ;GET THE BLOCK THAT BIG (THIS BECOMES C-BLOCK)
JUMPF NOMEM ;EMBARRASING
HRLZM A,C.HDR(B) ;SET UP C-BLOCK HEADER
MOVEM B,3+TMPBLK ;TUCK AWAY POINTER
;SET UP FOR CHTRN.
MOVE A,1+TMPBLK
TXO A,CH.FBR ;INDICATE WHAT WE ARE DOING
MOVE B,2+TMPBLK
HRLI B,(POINT 8)
DMOVEM A,CHTRNB ;B CONTAINS SOURCE POINTER, START BLOCK BUILD
SETZ B, ;NEXT TWO WORDS, PLEASE
MOVEI C,^D75 ;MAX COUNT FOR USERNAME, I HOPE
DMOVEM B,2+CHTRNB ;STORE 0 AND COUNT
MOVE A,3+TMPBLK
ADD A,[POINT 7,C.TXT] ;GET POINTER TO DEST
DMOVEM A,4+CHTRNB ;STORE IT AND 0
MOVEI A,CHTRNB ;GET ADDRESS
CHTRN. A, ;CONVERT
JFCL ;CERTAINLY UNNECESSARY?
;ALL TRANSLATED IN
MOVE B,3+TMPBLK ;POINTER TO C-BLOCK
AOS C,WEIGHT ;GIVE IT CURRENT WEIGHT
MOVEM C,C.WEI(B) ;..
ADD B,[POINT 7,C.TXT] ;POINT TO C-BLOCK TEXT (SOURCE)
MOVSI A,(POINT 7)
HRR A,2+TMPBLK ;POINT A AT E-BLOCK (WHERE STRING GOES)
SETZ C,
CALL SPCCHK ;SOURCE HAVE FUNNY CHARS?
MOVEI C,"""" ;GROAN!
MOVEM C,QCHAR ;REMEMBER ANY FUNNYNESS
CAIE C,0 ;IF NEEDED..
IDPB C,A ;DO THE QUOTE
CALL MOVST1 ;MOVE FROM B TO A
SKIPE C,QCHAR ;NEED QUOTE?
IDPB C,A ;YES
SETZ C, ;TERMINATE WITH NULL
IDPB C,A
SKIPN QCHAR ;DID WE ADD QUOTES?
RET ;NO, E-BLOCK AND C-BLOCK ARE THE SAME
MOVE B,2+TMPBLK ;YES, MUST COPY IT BACK NOW!!
HRLI B,(POINT 7) ;POINTER TO E-BLOCK (SOURCE)
MOVE A,3+TMPBLK
ADD A,[POINT 7,C.TXT] ;POINT TO C-BLOCK (DEST)
JRST MOVST2 ;COPY BACK WITH NULL
CCHDEB: HLRZ A,C.HDR(B)
JRST M%RMEM
QUEFAL: CMERR (Unexpected QUEUE. error return, internal error)
JRST FAILRT
;CALL WITH NUMBER OF USERS TO VERIFY IN B. ALLOCATES AND SETS UP THE QUEUE.
; BLOCK FOR THE VERIFIER ROUTINE (BUT DOES NOT FILL IN THE ACTUAL USERNAMES)
ALLOE1: MOVEI B,1
ALLOE: MOVEI D,(B) ;USER COUNT IN D AND B
IMULI B,2*13 ;2 BLOCKS OF LENGTH 13 FOR EACH USER..
MOVEI A,E.LEN+.QUARG+1+3+2*3+1(B) ;+HEADER OF E BLOCK, .QUARG+1 FOR
;QUEUE CALL HEADER, +3 WORDS FOR REST
;OF QUEUE BLOCK, PLUS 2 3 WORD HEADERS
;FOR THE SUB BLOCKS, PLUS ONE FOR PARANOIA
CALL M%GMEM
JUMPF NOMEM ;SAD
HRL A,ELIST ;BUILD NEXT POINTER,,LENGTH
MOVSM A,E.HDR(B) ;PUT LENGTH,,NEXT IN E.HDR
MOVEM B,ELIST ;INSERT NEW BLOCK AT HEAD OF CHAIN
MOVEM D,E.CNT(B) ;STORE # OF NAMES IN E.CNT
MOVEI A,E.LEN(B) ;POINT A TO WHERE QUEUE BLOCK STARTS
IMULI D,13 ;CALC LENGTH OF SUB BLOCKS..
MOVSI D,3(D) ;AND PUT IN LH OF D
MOVX B,QF.RSP+.QUMAE ;START LOADING QUEUE BLOCK HEADER
MOVEM B,.QUFNC(A) ;FUNCTION
SETZM .QUNOD(A) ;CENTRAL STATION
MOVX B,QA.IMM!1B17!.QBAFN
MOVEM B,.QUARG(A) ;LOAD ARG WORD
MOVX B,UGMAP$
MOVEM B,.QUARG+1(A)
HRRI D,.QBAET ;SIZE,,FUNCTION TYPE
MOVEM D,.QUARG+2(A)
MOVEI C,.QUARG+4(A) ;ADDRESS OF FIRST SUB BLOCK
MOVEM C,.QUARG+3(A) ;RIGHT AFTER QUEUE BLOCK
HRRI D,UGMAP$ ;LENGTH,,FUNCTION
MOVEM D,UU$TYP(C) ;START BUILDING SOURCE SUB BLOCK
HLRZ B,D ;GET SIZE
ADDI B,(C) ;POINT TO RESPONSE BLOCK
HRRI D,(B) ;SIZE,,ADDR OF RESPONSE BLOCK
MOVEM D,.QURSP(A) ;FILL IN POINTER IN MAIL QUEUE BLOCK
MOVE A,ELIST ;POINT TO WHOLE THING
MOVE D,E.CNT(A) ;FETCH # OF USERS AGAIN
MOVEM D,2(C) ;LOAD INTO SOURCE BLOCK
ADDI C,3 ;POINT TO FIRST STRING IN SOURCE
;DESTINATION DOESN'T REALLY HAVE A HEADER, SO B ISN'T ADVANCED
EXCH B,C ;SWAP FOR CALLER
DMOVEM B,E.PNTS(A) ;FILL THESE IN
RET ;ALL BUILT NOW!
GORETP: MOVEM C,TMPBLK ;SAVE BLOCK POINTER
HRRZ B,V.HDR(C) ;GET NEXT BLOCK
MOVEM B,VLISTE ;ADVANCE
CAIE B,0 ;MORE TO RETURN?
TXOA F,F%CMA ;YES
TXZ F,F%CMA ;NO
HRRZ A,V.TYP(C)
MOVEM A,SAVUSR ;RETURN STRING TYPE
TRNN A,1B18 ;IS IT A NEGATIVE CODE?
SKIPN B,V.REAL(C) ;NO, USERNAME, USE REAL STRING IF AVAILABLE
MOVEI B,V.TEXT(C) ;POINT TO TEXT TO COPY OUT
HRRZ A,U
HRLI A,(POINT 7)
CALL MOVST0
MOVE B,SAVUSR
CAIE B,PFXCOD ;ADDRESS LIST BEGINNING??
JRST FINAL ;NO, RETURN WHAT WE HAVE
MOVE C,TMPBLK ;YES, GET POINTER TO BLOCK
HRRZ C,V.REAL(C) ;GET POINTER TO ADDRESS LIST CHAIN
MOVEM C,SVABLK ;SET IT UP
TXO F,F%CMA!F%SUFX ;COME BACK SOON, AND HAVE A SUFFIX
JRST FINAL ;RETURN THE PREFIX CODE
;Here to return addr and code from A-block, C points to A-block
; c(C)=-1 means that we need to return a suffix placeholder
GETUSA: TXZ F,F%CMA ; Assume no more coming
JUMPL C,[ ;Need suffix code now?
MOVX B,SFXCOD ; Get suffix code
MOVEM B,SAVUSR ; Return to user
SETZM SVABLK ; All done handling this alias now
JRST ADRDON] ;GO FINISH UP
MOVE B,AB.COD(C) ; Get type
MOVEM B,SAVUSR ; Save away
SKIPE A,AB.LNK(C) ; Get link (if any)
TXOA F,F%CMA ; There is one, flag caller
JRST [ TXZN F,F%SUFX ; No more left -- need suffix?
JRST .+1 ; No, rejoin main flow
SETOM SVABLK ; Yes, flag suffix needed
TXO F,F%CMA ; and make caller call us again
JRST ANDADL]
HRRZM A,SVABLK ; Remember for subsequent calls
ANDADL: MOVE B,AB.ADR(C) ; Point to string for synonym
HRLI B,(POINT 7,) ; ..
INTOU: HRRZ A,U ; Where to put real string
HRLI A,(POINT 7,) ; ..
CALL MOVST0 ; Move 'em on out!
FINAL: HRRZ B,SAVUSR ; Is this address a net address?
CAIN B,NETCOD ; ..
TXOA F,F%AT ; Yes, flag that for caller
TXZ F,F%AT ;no, make it off
HRLM U,SAVUSR ; Remember where string starts
IBP A ; Step over null
MOVEI U,1(A) ; Point to first free word
JRST FINALE
ADRDON: SKIPE VLISTE ;MORE TO RETURN YET?
TXOA F,F%CMA ;YES, SAY SO
TXZA F,F%CMA ;NO
FINALE: TXNN F,F%CMA ;IS caller coming back?
CALL KILLST ;NO, LETS KILL THE LISTS!
MOVE B,SAVUSR ; Return string ptr and code
RETSKP ; Good return
KILLST: SETZM VLISTE
SKIPN B,VLIST
RET ;IF THIS IS NULL SO IS ELIST
KILNXT: HLRZ A,V.HDR(B)
HRRZ C,V.HDR(B)
CALL M%RMEM
SKIPE B,C
JRST KILNXT
SETZM VLIST
SKIPN B,ELIST
RET
EKILL: HLRZ A,E.HDR(B)
HRRZ C,E.HDR(B)
CALL M%RMEM
SKIPE B,C
JRST EKILL
SETZM ELIST
RET
INSERT: TLCE A,-1
TLCN A,-1
INSERB: HRLI A,(POINT 7)
INSERA: LDB C,SBK+.CMPTR
CAIE C," "
JRST INSERD
OUTCHR [.CHBSP]
SETO C,
ADJBP C,SBK+.CMPTR
MOVEM C,SBK+.CMPTR
INSERD: MOVE B,SBK+.CMINC ;HOW MUCH TO MOVE PAST
ADJBP B,SBK+.CMPTR
INSERC: ILDB C,A ;FETCH CHARACTER TO INSERT
IDPB C,B
JUMPE C,[RET]
OUTCHR C
AOS SBK+.CMINC
SOSL SBK+.CMCNT
JRST INSERC
CMERR (Buffer overflow)
JRST FAILRT
CCMLST: <.CMCFM>B8+.+1
CMAINB: <.CMCMA>B8
STPINB: <.CMCFM>B8+.+1
<.CMTOK>B8+.+2
-1,,[ASCIZ/,/]
<.CMTOK>B8+.+2
-1,,[ASCIZ/(/]
<.CMTOK>B8+.+2
-1,,[BYTE(7)74] ;OPEN ANGLE
<.CMTOK>B8+.+2
-1,,[BYTE(7)76] ;CLOSE ANGLE
<.CMTOK>B8
-1,,[BYTE(7)"["]
PAROCC: <.CMCMA>B8+PAROCT
PAROCT: <.CMNUM>B8
8
CLBINB: <.CMTOK>B8
CLBTOK: -1,,[ASCIZ/]/]
CMTINB: <.CMFLD>B8+CM%BRK
BLOCK 3
COMSTP
COMSTP: BRMSK. 0,0,0,0,,<)>
CMTEND: <.CMTOK>B8
-1,,[ASCIZ/)/]
PARS10: <.CMTOK>B8+PARS1A
-1,,[ASCIZ/./]
PARS1A: <.CMQST>B8+PARS1B
PARS1B: <.CMCFM>B8
PARS1C: <.CMFLD>B8+CM%BRK
BLOCK 3
STOPCH
STOPCH: BRMSK. 1B10+1B13+1B27,1B28+1B30,0,0,,<,(?[>
;STOP ON CRLF, OPEN/CLOSE ANGLE, OPEN PARENTHESIS, COMMA
;This converts lower case to uppercase, tab to space, and delete to null.
UPCASE: ASCII | |
ASCII | !"#$%&'|
ASCII |()*+,-./0123456789:;|
ASCII |<=>?@ABCDEFGHIJKLMNO|
ASCII |PQRSTUVWXYZ[\]^_`ABC|
ASCII /DEFGHIJKLMNOPQRSTUVWXYZ{|}~ /
BADCHL: ASCIZ/,;[]()<>@\:"/ ;THESE SHOULDN'T BE IN USERNAMES
> ;;END OF TOPS-10
;UNGGNU IS COMMON TO BOTH. It cleans up aborted parses, throwing away such
; things as half-expanded address lists, and clears F%CMA and similiar
; state variables.
UNGGNU:
TOPS10<
CALL KILLST
>
SETZM SVABLK
SETZM BRACKF
TXZ F,F%AT!F%CMA
RET
END
; Edit 2458 to MSGUSR.MAC by PRATT on 24-Oct-85
; Put NAMSRV support into it's own unsupported module.
; *** Edit 2467 to MSGUSR.MAC by MAYO on 6-Nov-85
; Allow (comments) in usernames even if F%FDIR (FORCE-DIRECTORY-LOOKUP) is on.
; *** Edit 2470 to MSGUSR.MAC by MAYO on 11-Nov-85 (TCO MSFIX)
; Tighten up parsing within angle brackets; catch improperly terminated
; addresses.
; *** Edit 2472 to MSGUSR.MAC by MAYO on 14-Nov-85
; Catch null addresses followed by a comma (USER,,OTHERUSER) and complain.
; *** Edit 2476 to MSGUSR.MAC by MAYO on 20-Nov-85
; Bring back <beep> after an <ESC> is typed to a non-existant username.
; *** Edit 2484 to MSGUSR.MAC by SANTEE on 21-Nov-85
; Clean up the various edit histories.
; *** Edit 2486 to MSGUSR.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2487 to MSGUSR.MAC by MAYO on 25-Nov-85
; Merge MSGUSRs for the -10 and -20. Have MS.MAC call KILLST when cleaning up a
; ^U, etc. on the -10 side.
; *** Edit 2491 to MSGUSR.MAC by MAYO on 26-Nov-85
; Clean up some comments.
; *** Edit 2628 to MSGUSR.MAC by MAYO on 3-Jan-86
; Fix so keyword parsing doesn't intercept legimate username parsing.
; *** Edit 2651 to MSGUSR.MAC by SANTEE on 2-Feb-86
; Eliminate the need for MSUTAB at all. Move the few useful lines elsewhere.
; *** Edit 2660 to MSGUSR.MAC by MAYO on 21-Feb-86
; MS10 - don't use QUEUE. to get our own username when translating "."; MYDIRS
; contains our name already.
; *** Edit 2662 to MSGUSR.MAC by MAYO on 26-Feb-86
; Fix Return-Receipt-Requested-to to properly parse addresses. Allow the normal
; range of possibilities offered by GETUSR.
; *** Edit 2663 to MSGUSR.MAC by MAYO on 28-Feb-86
; Allow SET NO DIRECTORY-LOOKUP-CONFIRMATION to perform the proper analogous
; operation on the -10 (Don't check with the accnting daemon unless forced).
; *** Edit 2665 to MSGUSR.MAC by MAYO on 3-Mar-86
; Quietly allow node::username under TOPS10. Not supported!
; *** Edit 2674 to MSGUSR.MAC by MAYO on 5-Mar-86
; Don't use %1S at BADDIR. GLXLIB doesn't handle arbitrary strings.
; *** Edit 2684 to MSGUSR.MAC by MAYO on 19-Mar-86
; Catch control characters and complain at FINALE:, and prevent loops parsing
; them at MULTI/ODDBRK.
; *** Edit 2686 to MSGUSR.MAC by MAYO on 24-Mar-86
; SYSTEM as the first element of an address list truncates the address list.
; Remove the check in ALIAS: that forces this behaviour.