Google
 

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.