;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 ;**;[3103] Change comment at PBXSTR:+0L MDR 12-FEB-88 PBXSTR: BLOCK 20 ; [3103] Storage for POBOX: when translating ; [3103] POBOX: to physical structures ;**;[3103] Add 1 line at PBXSTR:+2L MDR 12-FEB-88 LOGPBX: BLOCK 200 ; [3103] Place to keep POBOX: translation 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 ; Init flags SETZM BRACKF SETZM OLDAT SETZM OKLOC SETZM (U) TXZ F,F%AT!F%CMA!F%F1!F%F2 ; Assume not net address yet, no comma yet, ; Also, init the flag for parsing '::' and ; use F%F2 for flagging quoted strings 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 ; "AT" or "@" is part of the address SETZM OKLOC ; Indicate not local user anymore MOVEI B,NO2INB ; Now try to validate node 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 ; Is node good? JRST BADNOD ; No, do something about it 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,@,, ;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 ; Is this a null? CAIN B,"""" ; Are we seeing a quote? TXC F,F%F2 ; Toggle the quote bit CAIN B,":" ; Is this a colon? JRST STRIPC ; Yes, flag so and bomb on '::' TXZ F,F%F1 ; Let's reset the colon flag CAIGE B," " ; No, munch white noise 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 STRIPC: TXNE F,F%F2 ; Are perusing a quoted string? JRST STRIPA ; Yes, don't complain about :: TXNN F,F%F1 ; Was the previous character a :? IFNSK. ; No TXO F,F%F1 ; Flag we have seen one JRST STRIPA ; Go back for more characters ENDIF. CMERR (Address parse failed) ; Saw ::, this is a no-no JRST CMDER1 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: 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%DIR ; Files-only? JRST BADDIR ; Yes, we fail. TXNN A,RC%NOM ; Flunk? JRST NOFDIR ; No, we are all set. HRROI A,ATMBUF ; Get string back SETO B, ; Flag that we have POBOX: CALL CHKPBX ; Yes, check to see if dir is on POBOX: JRST BADDIR ; It isn't, now bomb ;.. NOFDIR: MOVE B,TYPEIS NOSTRI: HRL B,SPNTR TRNE B,-1 RETSKP HRRI B,1 ; Assume local user TXNE F,F%AT ; "AT" or "@" seen so we are HRRI B,NETCOD ; sending network mail. Flag it here. RETSKP BADDIR: CMERR (No such user as ") HRRO A,SPNTR PSOUT% MOVEI A,"""" PBOUT% JRST CMDER1 ; CHKPBX - Routine to check to see if given local user is on POBOX:. ; It translates POBOX: to a list of structures and then pulls the ; structures out one at a time until it finds the first structure ; the user is on. ; ; Accepts in: ; A/ Byte pointer to username string we are validating ; B/ 0 - Means we have user name ; -1 - Means we have POBOX: already ; ; Returns: ; +1 No match, user is not on POBOX: ; +2 User exists on POBOX: ;**;[3103] Rewrite CHKPBX: MDR 12-FEB-88 CHKPBX::STKVAR ; [3103] We want a temp locations here ;**;[3104] Add 2 lines at CHKPBX:+1L MDR 16-FEB-88 TLC A,-1 ; [3104] Check source pointer TLCN A,-1 ; [3104] Is it -1,,addr? HRLI A,(POINT 7,) ; [3104] Yes, make it real MOVEM A,USRNAM ; [3078] Put pointer to user name here MOVEM B,FLAG ; [3078] For safe keeping SKIPE B ; [3078] Have POBOX: ? JRST NOQUOT ; [3078] Don't have to look for quotes HRLI A,(POINT 7) ; [3078] ASCII pointer MOVE C,[POINT 7,STRBUF] ; [3078] Deposit username here DEQUOT: ILDB B,A ; [3078] Get a character CAIN B,42 ; [3078] Is it a quote? JRST DEQUOT ; [3078] Yes, strip it IDPB B,C ; [3078] Move character to here SKIPE B ; [3078] Any more characters? JRST DEQUOT ; [3078] Yes, continue. NOQUOT: SKIPL FLAG ; [3103] Do we have POBOX: already? IFSKP. ; [3103] If so, MOVE B,USRNAM ; [3103] Strip out POBOX: DO. ; [3103] Loop over all characters ILDB C,B ; [3103] Get character CAIE C,"<" ; [3103] Is it directory delimiter? JRST TOP. ; [3103] No, get eating character OD. ; [3103] MOVE C,[POINT 7,STRBUF] ; [3103] Username goes here DO. ; [3103] Insert username ILDB A,B ; [3103] Get byte CAIN A,">" ; [3103] End of directory? SETZ A, ; [3103] Yes, make null IDPB A,C ; [3103] Put byte in SKIPE A ; [3103] Done? JRST TOP. ; [3103] No, OD. ; [3103] ENDIF. ; [3103] MOVEI A,.LNSSY ; [3103] Get system definition... HRROI B,[ASCIZ /POBOX/] ; [3103] ...of this logical name HRROI C,LOGPBX ; [3103] And put it here LNMST% ; [3103] Do the translation ERJMP [RETSKP] ; [3103] If no POBOX:, then say local user MOVE C,[POINT 7,LOGPBX] ; [3103] Point to the translation MOVEM C,SAVPTR ; [3103] Initialize this CHPBX1: SKIPN C,SAVPTR ; [3103] Get continuous byte pointer if there is one RET ; [3103] There is none and we couldn't find the user MOVE A,[POINT 7,PBXSTR] ; [3103] Put POBOX: here DO. ; [3103] Now loop over all structures in list ILDB B,C ; [3103] Get a character CAIE B,.CHNUL ; [3103] End of logical name list? IFSKP. ; [3103] Yes, SETZM SAVPTR ; [3103] Say this is done JRST CHKPB2 ; [3103] And go on ENDIF. ; [3103] CAIN B,"," ; [3103] Done with structure? EXIT. ; [3103] Yes, out of here IDPB B,A ; [3103] Drop byte in here JRST TOP. ; [3103] And keep going OD. ; [3103] MOVEM C,SAVPTR ; [3103] Save the byte pointer for later CHKPB2: MOVEI B,"<" ; [3103] Directory delimiter IDPB B,A ; [3103] Put it in string HRROI B,STRBUF ; [3103] Now get username SETZB C,D ; [3103] Stop on null SOUT% ; [3103] Put string in ERJMP .+1 ; [3103] Won't happen MOVEI B,">" ; [3103] Now end directory IDPB B,A ; [3103] Stick it in SETZ B, ; [3103] Don't forget the null IDPB B,A ; [3103] Drop it in MOVX A, ; We want an exact match HRROI B,PBXSTR ; on this string RCDIR% ; Is it there? ERJMP [RET] ; Something is messed up, return illegal TXNE A,RC%DIR ; Are we files-only? JRST CHPBX1 ; [3103] Yes, ignore this structure TXNE A,RC%NOM ; No match? JRST CHPBX1 ; [3103] Yes, try next structure in list RETSKP ; Everything checks out 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 ; Accepts in ; A/ Destination ; B/ Source ; Returns ; +1 always with an updated byte pointer for both ; the source and destination. ; ; This routine takes two byte pointers. It copies the from source ; byte pointer (one byte at a time) to the destination. CSTRB: TLC A,-1 ; Check for -1,,addr TLCN A,-1 HRLI A,(POINT 7) ; Make it a real byte pointer TLC B,-1 ; Now check source too TLCN B,-1 HRLI B,(POINT 7) ; Make it a real byte pointer CSTRBA: ILDB C,B ; Read byte from source IDPB C,A ; Move it to destination JUMPN C,CSTRBA ; Are we done (finish on null)? SETO C, ; All done. ADJBP C,A ; One too far in destination. MOVE A,C ; Back it up and return 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 ;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 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, 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 ;**;[3082] Replace 8 lines with 9 at definition of V.HDR NED 24-Feb-87 V.HDR==0 ;[3082]SIZE,,PTR TO NEXT BLOCK V.TYP==1 ;[3082]BITS,,ENTRY TYPE (NETCOD, SYSCOD, ETC.) V.VROK==1B0 ;[3082]THIS ENTRY DOES NOT NEED TO BE VERIFIED V.PPN==1B1 ;[3082]THIS ENTRY IS A PPN V.PTR==1B2 ;[3082]V.REAL IS A PTR TO MORE INFO, NOT TEXT V.REAL==2 ;[3082]PTR TO ACTUAL TEXT OR PTR TO ADDITIONAL ADDRS V.RPRS==3 ;[3082]REPARSE ADDRESS V.VLNK==4 ;[3082]LINKS FOR VERIFYING V.TEXT==5 ;[3082]TEXT FOR THIS V-BLOCK 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 ,,,,> MOVE A,[<.CMKEY>B8+CM%BRK+PARS10] ; Set up to parse a keyword MOVE B,KWDTBL ; Through the KWDTBL DMOVEM A,FLDDBU ; .. SETZM 2+FLDDBU ; Zero some appropriate locations SETZM 3+FLDDBU ; .. MOVEI A,KWDBRK ; Points to the break mask MOVEM A,4+FLDDBU ; And save it for COMND 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 ? 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 ;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 MOVEI D,"""" ;WE MAY NEED QUOTES AROUND OUR NAME IDPB D,A ;SO PUT THEM ON CALL MOVST1 ;MOVE OUR NAME IDPB D,A ;END QUOTE (QUOTES MAY BE STRIPPED LATER) 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 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). DIE IF NO TERMINATOR. SKPJNK: MOVEM C,QCHAR ;STORE TERMINATOR CHARACTER SCNJNK: ILDB C,A IDPB C,B ;NO, SO (COMMENT) IS OK JUMPE C,BDCHRT ;UH OH. NO TERMINATOR. CAME C,QCHAR JRST SCNJNK JRST SCANAN BDCHRT: MOVE C,QCHAR ;WRITE IN TERMINATOR AND NULL DPB C,B SETZ C, IDPB C,B CMERR (Missing terminator after quote or open parenthesis) JRST SETPRS ;SORRY, TRY AGAIN... 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,MYHSPT ;DEFAULT TO ANF NODE NAME TXNE F,F%DECN ;IF WE HAVE DECNET THEN USE MYHDPT 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 ;**;[3082] Insert 2 lines at LENPPN:+8L NED 24-Feb-87 TRNE D,-1 ;[3082]DID WE PASS A POINTER TXO C,V.PTR ;[3082]WELL, LET US NOT FORGET 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 ;**;[3082] Replace 4 lines at ALIAS: NED 24-Feb-87 ALIAS: MOVE C,AB.LNK(A) ;[3082]POINT TO THE NEXT PORTION OF THE ALIAS (IF ANY) MOVE B,AB.COD(A) ;[3082]TYPE OF ENTRY HRRZ A,AB.ADR(A) ;[3082]ACTUAL TEXT HRLI A,(POINT 7) ;[3082]IN POINTER FORM 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 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 ;**;[3082] Replace 5 lines with 7 at GORETP:+6L NED 24-Feb-87 MOVE A,V.TYP(C) ;[3082]BITS,,TYPE OF ENTRY MOVEM A,SAVUSR ;[3082]RETURN STRING TYPE TXNE A,V.PTR ;[3082]IS V.REAL ACTUALLY A POINTER JRST GORET1 ;[3082]YES, THEN DON'T USE IT FOR THE USERNAME TRNN A,1B18 ;[3082]IS IT A NEGATIVE CODE? SKIPN B,V.REAL(C) ;[3082]NO, USERNAME, USE REAL STRING IF AVAILABLE GORET1: MOVEI B,V.TEXT(C) ;[3082]POINT TO TEXT TO COPY OUT HRRZ A,U HRLI A,(POINT 7) CALL MOVST0 ;**;[3082] Replace 3 lines with 8 at GORETP:+14L NED 24-Feb-87 HRRZ B,SAVUSR ;[3082]GET THE TYPE CAIN B,PFXCOD ;[3082]IF THIS IS A PREFIX CODE JRST GORET2 ;[3082] THEN AN ADDRESS LIST FOLLOWS MOVE B,SAVUSR ;[3082]GET BITS,,TYPE TXNN B,V.PTR ;[3082]IF V.REAL IS NOT A PTR JRST FINAL ;[3082] THEN WE'RE DONE TXOA F,F%CMA ;[3082]OTHERWISE, WE MUST HAVE A LONG ALIAS, PROCEED GORET2: TXO F,F%CMA!F%SUFX ;[3082]REMEMBER THAT WE NEED A SUFFIX ON THE END 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 ;**;[3082] Delete 1 line at GORETP:+20L NED 24-Feb-87 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 ;**;[3082] Replace 1 lines with 4 at GETUSA:+10L NED 24-Feb-87 JRST [ SKIPE VLISTE ;[3082] More to return yet? TXOA F,F%CMA ;[3082] Yes, remember that TXZA F,F%CMA ;[3082] No TXZN F,F%SUFX ;[3082] 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/)/] ;The temptation is to just let you figure it out, however do a keyword search ;through KWDTBL. The break characters are any control character (-1), <"> or ; "<" or ">" (1B2+1B28+1B30), or anything between the < and > . KWDBRK: BRMSK. -1,1B2+1B28+1B30,0,0,,<%(),.:;?@[\]^{}~> 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 after an 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. ; *** Edit 2692 to MSGUSR.MAC by MAYO on 2-Apr-86 ; MS10: an address of ""q"@node isn't legal. MS knew that, but got the error ; wrong. Get it right. ; *** Edit 2709 to MSGUSR.MAC by RASPUZZI on 3-Jun-86 ; Fix problem parsing USER AT NODE when node doesn't exist and user is legal on ; the current system. Assume always netmail when parsing "AT" or "@". Also, add ; comments that are needed badly in this module. ; *** Edit 2710 to MSGUSR.MAC by SANTEE on 4-Jun-86 ; @. loses for ANF only sites. Replace @. with @node where node is the ANF ; name. ; *** Edit 2711 to MSGUSR.MAC by RASPUZZI on 5-Jun-86 ; Teach MS to not accept NODE::USER@NODE1. Instead, force it to look for ; "NODE::USER"@NODE1. ; *** Edit 2716 to MSGUSR.MAC by RASPUZZI on 6-Jun-86 ; Teach MS about looking for users on other structures when POBOX: contains a ; list of structures and there is no directory for a recipient of a message on ; the first structure listed in the logical name. ; *** Edit 2720 to MSGUSR.MAC by SANTEE on 16-Jun-86 ; Put quotes around our name if sending to "." . ; *** Edit 2724 to MSGUSR.MAC by SANTEE on 16-Jun-86 ; Set up the correct break mask for parsing keywords in the TO and CC lists. ; *** Edit 2725 to MSGUSR.MAC by RASPUZZI on 16-Jun-86 ; Fix minor problem with edit 2711 parsing '::' within aliases or address-lists ; within quoted strings. ; *** Edit 2726 to MSGUSR.MAC by RASPUZZI on 17-Jun-86 ; Kludge patrol - Fix edits 2711 and 2725 so they aren't quite as kludgey. Deal ; with quoted strings in the common code. ; *** Edit 2727 to MSGUSR.MAC by SANTEE on 17-Jun-86 ; Edit to fix TOPS-10 user parsing didn't go far enough. Keep on going. ; *** Edit 3078 to MSGUSR.MAC by RASPUZZI on 9-Sep-86 ; Make CHKPBX have the ability to verify a username if that username has quotes ; around it. ; *** Edit 3082 to MSGUSR.MAC by SANTEE on 9-Mar-87, for SPR #35534 ; Make aliases work always, as opposed to occasionally. Tops-10 only. ; *** Edit 3103 to MSGUSR.MAC by RASPUZZI on 12-Feb-88 ; Change CHKPBX to check the POBOX: list of structures instead of doing a ; GTJFN% on the user's MAIL.TXT file as unprived users may not be able to do ; this. ; *** Edit 3104 to MSGUSR.MAC by RASPUZZI on 16-Feb-88 ; Make CHKPBX accept a byte pointer in the form -1,,ADDR (by translating it to ; 440700,,ADDR).