;*; Updated on 31-Jan-96 at 8:02 AM by ACS; edit time: 0:00:41
;*************************** AMUS Program Label ******************************
; Filename: CD.M68 Date: 1/31/96
; Category: UTIL Hash Code: 345-626-263-772 Version: 1.0(100)
; Initials: ML/AM Name: Steve Ash
; Company: Alpha Clean Systems, Inc. Telephone #: 5019254414
; Related Files:
; Min. Op. Sys.: AMOS 2.X Expertise Level: BEG
; Special:
; Description: Modified version of AMOS's LOG.M68 that sets the job prompt to
; current devn:[p,pn] or ERSATZ name if one exists. Reduces wasted time when
; switching between AMOS/DOS/UNIX. (Hopefully AM doesn't mind?)
;*****************************************************************************
;*; Updated on 28-Sep-95 at 9:33 AM by SAA; edit time: 0:05:31
;CD.M68 - Change Directory/Login
;===========================================================================
; Alpha Clean Systems, Inc
; 8995 N Old Dutch Rd
; Rogers, AR 72756-7839
; (501) 925-4414
;===========================================================================
; Notes/Usage:
; Adapted from and an alternative to AMOS's LOG.LIT that sets
; user's prompt to current devn:[p,pn] or ersatz name if one exists.
;===========================================================================
VMAJOR = 1.
VMINOR = 0.
VSUB = 0.
VEDIT = 100.
VWHO = 0.
;===========================================================================
; Revision History
; == Vers 1.0 ==
; [100] 28-Sep-95 - initial release /saa
;===========================================================================
;**************************************************************************;
; ;
; LOGIN COMMAND PROGRAM ;
; ;
;**************************************************************************;
; ASL-00067-00
; NOTICE
;
;All rights reserved. This software is the property of Alpha Microsystems
;and the material contained herein is the proprietary property and trade
;secrets of Alpha Microsystems, embodying substantial creative efforts and
;confidential information, ideas and expressions, no part of which may be
;reproduced or transmitted in any form or by any means, electronic,
;mechanical, or otherwise, including photocopying or input into any
;information storage or retrieval system without the express written
;permission of Alpha Microsystems.
;
;CAUTION: Unauthorized distribution or reproduction of this material may
;subject you to legal action.
;
;Copyright (C) 1977, 1985, 1988 - Alpha Microsystems
;All rights reserved
;
; VMAJOR=2
; VMINOR=0
; VEDIT=141.
;
;Edit History:
;
;[141] 14 December 1993 Edited by Jose Celaya
; Fixed problem with large DO files.
;[140] 08 July 1993 08:55 Edited by Dan Danknick
; Fixed bug in edit [138].
;[139] 07 July 1993 14:15 Edited by Dan Danknick
; Allow logging to same project within same device (across units)
; without prompting for a password. (SPR# 31179)
;[138] August 26, 1992 10:39 AM Edited by Bob Pizzi
; Fix a problem changing the language of a new user that was specified
; in MUSER as a mixed case specification, i.e. make the string
; comparison routine insensitive to case ONLY for the langauge parameter
; in MUSER. Maintain case sensitivity for other parameters.
;[137] 13 March 1992 11:52 Edited by BOB PIZZI
; SPR Maintenance - a. eliminate trailing spaces from user name
; b. use a retry count trying to access
; USER.SYS
;
;[136] 16 April 1991 11:12 Edited by Bob Currier
; Fix problem with setting user's language before system memory
; has been set up.
;[135] 10 January 1991 Edited by Jose Celaya
; Corrected symble problems.
;[134] 03 July 1990 Edited by Dave French
; Added option to turn file locking ON/OFF on a job basis according
; to the user's default lock setting in USER.SYS (i.e. set by MUSER).
;
;************************ AMOS 2.0 Release ************************
;
;[133] 07 March 1990 Edited by Jose Celaya
; Added /N switch to ignore the START.CMD file processing. /JC
;[132] 08 August 1989 Edited by Jose Celaya
; Allow HEX/OCTAL to be correctly set. Allow user names to be used.
;[131] 27 September 1988 Edited by Jose Celaya
; Remove edit [130] because we can not do a clean job.
; Watch what account we are currently logged into.
;[130] 15 September 1988 Edited by Jose Celaya
; Restrict access to passwords with the line editor.
;[129] 28 January 1988 13:57 Edited by Bob Currier
; Fix really stupid mistake made in edit 128. (I don't want to talk
; about it.)
;[128] 11 January 1988 15:01 Edited by Bob Currier
; Add change to allow user names starting with periods and M's.
; Change to standard method of resetting terminal mode, as well
; as resetting it when we should. Fix problem with local echo
; selection not working. Fix problem with a too long ersatz name
; getting the wrong error message.
;[127] 12 December 1986
; Fixed problem where improper init caused disk and cache errors when
; logging on to a device other than DSK from a logged off state. /DLF
;[126] 10 November 1986 14:32 Edited by Bob Currier
; Fix problem with JOBDFP not getting set.
;[124] 02 November 1986 15:57 Edited by Bob Currier
; Reinstall the 2.0 version of CHKMFD so we work on all types of
; directory structures. Also make change at CHKPSW since password
; now comes back in the DDB rather than the buffer.
;
;************************ AMOS/32 1.0 Release ************************
;
;[123] 22 July 1986 09:24 Edited by Bob Currier
; Correct problem with bad user name allowing login.
;[122] 16 April 1986 18:50 Edited by Bob Currier
; Allow specification of user name if it matches current one. Allow
; mix of ersatz and user names. Make sure we don't get an error
; if a null user name is specified.
;[121] 30 January 1985 18:40 Edited by Bob Currier
; Fix CHKMFD so it works.
;[120] 13 December 1985 11:41 Edited by Bob Currier
; Create special version for AMOS/32 by replacing DIRACC and DIRSCH
; calls with the old CHKMFD routine.
;[119] 17 October 1985
; Add support for US.PRI, US.DFP, US.PRM, and US.LNG. Make sure we
; handle exception cases gracefully. /RBC
;[118] 14 August 1985
; Add support for user names, root PPNs, etc. Also add support for
; LOGGER call. Also add code to use the language tables to get PPN
; terminator characters. Remove pre-1.3 monitor checks since we don't
; support that use any more. Add check for pre-2.0 monitor before
; filling in the 2.0 fields. /RBC
;
;************** AMOSL Version 1.3 Release ***********************************
;
;[117] 4 December 1984
; Add command codes from Disk cache symbol file to turn on/off
; the UFD/MFD locking mechanism. /RJH
;[116] 28 November 1984
; Make it possible to print up to 6 characters of Ersatz name./IRH
;[115] 27 November 1984
; Add check for running under pre-1.3 monitor to allow use. /RBC
;[114] 15 October 1984
; Added dynamic MFD/UFD locking and unlocking for use with the
; AMOS/L 1.3 disc cache. /DLF /IRH
;[113] 17 February 1984
; Modified code for new ersatz device support.
; Removed code for old ersatz device support. /DJS
;
;************** AMOSL Version 1.2 Release ************************************
;************** AMOSL Version 1.1 Release ************************************
;
;[112] 2 December 1983
; Fixed problem with job hanging up when logging on and MAIL.JNK
; is a null file. /RJH (SPR # - 1693)
;[111] 18 January 1983.
; Add device & drive information to ersatz name table.
; Also general cleanup of flags and offsets.
; (SPR #3053).
; (T edit [026]). /PPJ
;[110] 07 January 1983.
; Add code to clear DDB INITed flag after buffer is freed.
; (T edit [028]). /PPJ
;[109] 07 January 1983.
; Add code to save & restore current number base.
; (T edit [023). /PPJ
;[108] 07 January 1983.
; Add code to detect an illegal programmer number of 8 or 9.
; (SPR #3077).
; (T edit [027]). /PPJ
;
;************** AMOSL Version 1.0 Release ************************************
;
;[107] 9 March 1982
; Added support for extended MFD's. /PAE
;[106] 14 January 1982
; Add VUE: to the ersatz list.
;[105] 30 December 1981
; Add program header and add code to reset JOBPRV on login.
;[104] 15 November 1981
; Finish converting the START.CMD code.
;[103] 20 October 1981
; Correct code that checks for other users on the same PPN
;[102] 25 September 1981
; Add code to clear disk read/write counters on new login
;[101] 6 September 1981
; Add connect and CPU time code.
;[100] 22 March 1981
; Converted to L. Removed MAIL code. /RBC
;
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM
EXTERN $FNUSR
PAGE
; Impure area definition
.OFINI
.OFDEF PPN, 2 ; PPN to log in to
.OFDEF OLDTYP, 2 ; old job type
.OFDEF LOG.FL, 2 ; flags, up to 16 of them (FL.xxx)
FL.LOG= 1 ; user already logged in
FL.ETZ= 2 ; logging in as ersatz device
FL.BAD= 4 ; error, abort command file (if any)
FL.RTP=10 ; we are using root PPN as default [118]
FL.USR=20 ; we are logging in with a user name [132]
.OFDEF PBF, 8. ; print buffer [116]
.OFDEF DDB, D.DDB ; DDB
.OFDEF DDB.B, 512. ; DDB buffer [114]
.OFDEF ERSDEV, 4 ; temp work area for ersatz device name [113]
.OFDEF UDDB, D.DDB ; DDB for user file fetch [118]
.OFDEF PPL, 1 ; left side PPN character [118]
.OFDEF PPR, 1 ; right side PPN character [118]
.OFDEF SFLG, 1 ; START.CMD flag [133]
.OFDEF UNAM, 21. ; current user name [132]
.OFSIZ IMP.SIZ ; size of impure area
;
; Disk cache command codes.
;
DC.DM =20 ; Dynamic MFD Lock [117]
DC.DU =21 ; Dynamic UFD Lock [117]
DC.XM =22 ; Dynamic MFD Unlock [117]
DC.XU =23 ; Dynamic UFD Unlock [117]
;
I$NLK =374 ; [135]
I$JOB =10_16. ; [135]
I$OFF = 4_16. ; [135]
I$JCB =8. ; [135]
O$RET =24 ; [135]
I%OFF =18. ; [135]
RETRYCNT = 5. ; $FNUSR retry count [137b]
PAGE
;********************
;* LOG *
;********************
;User is requesting login function
;If no PPN entered we tell him who he is now
LOG: PHDR -2,0,PH$REE!PH$REU ; allow to run logged out [105]
GETIMP IMP.SIZ,A5,EXIT ; get some impure space
CLRW LOG.FL(A5) ; initialize flags [109]
CLRB SFLG(A5) ; set START.CMD flag to process file [133]
BYP ; skip over blanks [133]
LIN ; a line terminator? [133]
BEQ 10$ ; yes, continue [133]
CMPB @A2,#'/ ; is it a /? [133]
BNE 10$ ; no, continue [133]
INC A2 ; bump it [133]
MOVB @A2,D1 ; get the switch [133]
UCS ; make it upper case [133]
CMPB D1,#'N ; do we wish to skip the START.CMD? [133]
BNE 10$ ; no, continue [133]
INC A2 ; bump it [133]
SETB SFLG(A5) ; set START.CMD flag to skip file [133]
10$: GTLANG A6 ; index language table [118]
MOVB LD.PPL(A6),PPL(A5) ; store left side character [118]
MOVB LD.PPR(A6),PPR(A5) ; and right side character [118]
JOBIDX A0 ; set job table index
MOVW JOBTYP(A0),OLDTYP(A5) ; save job type word [109]
ANDW #J.HEX,OLDTYP(A5) ; just the hex/octal bit [109]
LIN ; login code entered?
BNE LOGOK ; yes - perform LOGIN scan
TSTW JOBUSR(A0) ; currently logged in?
BEQ NLOG ; no - let the user know
TYPESP <Current login is>
CALL PRTLOG ; print account user is logged in on
CALL CURETZ ; and then the ersatz name (if any)
JMP EXIT$
NLOG: TYPE <Not logged in>
JMP EXIT$
;********************
;* LOGOK *
;********************
;Login request is explicit
;Scan command line and process device code and PPN
LOGOK: CLRW DDB+D.DEV(A5) ; clear device code
MOVW #-1,DDB+D.DRV(A5) ; preset default drive number
MOV A2,A3 ; save input line [113]
BYP ; bypass any spaces [113]
CMMB @A2,PPL(A5) ; PPN only if [PROJ,PROG] [113][118]
BEQ LGPA ; [113]
NUM ; PPN only if PROJ,PROG [113]
BEQ LGPA ; [113]
CMPB @A2,#', ; PPN only if ,PROG [113]
BEQ LGPA ; [113]
LEA A1,ERSDEV(A5) ; index ersatz device code result [113]
PACK ; pack the ersatz device code [113]
PACK ; [113]
CMPB (A2)+,#': ; syntax check [113]
JEQ LOGIT ; check for ersatz device table entry [113]
MOV A3,A2 ; try again [118]
LGDEV: MOV A2,A4 ; save input line [113]
BYP ; bypass spaces [113]
LIN ; end of line? [113]
JEQ LOGSC ; yes - see if user is on this device [113]
LEA A1,DDB+D.DEV(A5) ; no - index device code result
CMMB @A2,PPL(A5) ; PPN only if [PROJ,PROG] [118]
BEQ LGPA
NUM ; PPN only if PROJ,PROG
BEQ LGPA
;Must be device code or user name here
PUSH @A1 ; save current device and unit [122]
PACK ; pack the device code
NUM ; check for drive number entered
BNE LGDA
MOV A1,A3 ; save index
GTDEC ; pick up drive number
MOVW D1,@A3 ; and put in ddb
LGDA: POP D1 ; get old device and unit [122]
CMPB (A2)+,#': ; syntax check
BEQ LGPA
MOV A4,A2 ; restore input line
MOV D1,DDB+D.DEV(A5) ; restore old device and unit [122]
BR LGPA ; process PPN or user name
;Command format error
LGFE: TYPE <?Command format error>
ORW #FL.BAD,LOG.FL(A5) ; set abnormal exit bit
JMP EXIT$
;Process PPN or user name here
LGPA: TSTW PPN(A5) ; has PPN been set up yet? [113]
BNE 10$ ; yes - don't move in user's PPN [113]
MOVW JOBUSR(A0),PPN(A5) ; no - preset current PPN [113]
10$: LIN ; check for no PPN entered [113]
JEQ LOGGO
CMMB @A2,PPL(A5) ; check for optional brackets [118]
BNE GETPPN
INC A2
GETPPN: ANDW #^C<J.HEX>,JOBTYP(A0) ; all entry in octal
CMPB @A2,#', ; comma?
BEQ GETPJ ; yes - get old project number
CMPB @A2,#'M ; M (next to comma)?
BEQ 10$ ; yes - could be project or user name [128]
CMPB @A2,#'. ; period (other side of comma)?
BNE NEWPJ ; no - get project number
10$: MOVB 1(A2),D6 ; get next character [128]
CMPB D1,#'0 ; is it a valid PPN character? [128]
JLO GETUSN ; no - must be user name [128]
CMPB D1,#'7 ; [128]
JHI GETUSN ; no - must be user name [128]
GETPJ: MOVW JOBUSR(A0),D1 ; get old account
RORW D1,#8. ; put project number in right place
BR GETPG ; now go get programmer number
NEWPJ: MOVB @A2,D1 ; check for octal digit [118]
CMPB D1,#'0 ; must be 0-7 [118]
JLO GETUSN ; error - perhaps user name? [118]
CMPB D1,#'7 ; [118]
JHI GETUSN ; error - perhaps user name? [118]
GTOCT ; get project number
TST D1 ; proper range?
JEQ LGFE ; no - too small
CMP D1,#377
JHI LGFE ; no - too large
CMPB @A2,#', ; comma seperator?
BEQ GETPG ; yes - get programmer number
CMPB @A2,#'M ; M (next to comma) seperator?
BEQ GETPG ; yes - get programmer number
CMPB @A2,#'. ; period (other side of comma) seperator?
JNE LGFE ; no - format error
GETPG: INC A2 ; move to number
MOVB D1,D3 ; save project number
CMMB @A2,PPR(A5) ; optional terminator? [118]
BEQ GETPG1 ; yes - use current programmer number
LIN ; end of line?
BNE GETPG2 ; no - get programmer number
GETPG1: MOVW JOBUSR(A0),D1 ; old account number
ANDW #377,D1 ; save just the programmer number
BR GETPG9 ; form new user account
GETPG2: GTOCT ; get programmer number
BYP ; bypass spaces. [113]
LIN ; end of line? [108]
BEQ 10$ ; yes, go check number range [108]
CMMB @A2,PPR(A5) ; optional terminator? [108][118]
JNE LGFE ; no - illegal programer [108]
10$: ; [108]
CMP D1,#377 ; proper range?
JHI LGFE ; no - too high
GETPG9: ROL D3,#8. ; rotate project into right position
CLRB D3
OR D3,D1 ; put project,programmer together
GETP10: MOVW D1,PPN(A5) ; save the PPN [118]
ANDW #^C<J.HEX>,JOBTYP(A0) ; make sure J.HEX is off [109]
MOVW OLDTYP(A5),D6 ; [109]
ORW D6,JOBTYP(A0) ; restore job J.HEX value [109]
JMP LOGGO ; check for device code [113][118]
;Come here to handle input of a user name [118]
GETUSN: BYP ; skip leading spaces [137a]
CALL STRIPSPACES ; strip trailing spaces [137a]
TSTB JOBUSN(A0) ; are we already logged in as user? [118]
JNE 20$ ; yes - error [118]
5$: CALL CKUSN ; check for valid user name [118]
BNE 10$ ; error - [118]
MOVW PPN(A5),D1 ; already have a PPN from ersatz? [122]
JNE GETP10 ; yes - use it [122]
MOVW JOBRTP(A0),D1 ; get root PPN [118]
MOVW JOBRTD(A0),DDB+D.DEV(A5); and root device [118]
MOVW JOBRTU(A0),DDB+D.DRV(A5); and unit [118]
ORW #FL.RTP,LOG.FL(A5) ; flag as using root [118]
JMP GETP10 ; go finish login procedure [118]
10$: ORW #FL.BAD,LOG.FL(A5) ; set error flag [118]
JMP EXIT$ ; [118]
;Already logged in as a user -- if same user name ignore it [122]
20$: PUSH A2 ; save line index
;Check to see if user input is a valid user name
25$: MOVB (A2)+,D6 ; get character from user input [128]
CMPB D6,#': ; a colon in user input? [128]
JEQ LGFE ; yes - error [128]
CMPB D6,#', ; a comma in user input? [128]
JEQ LGFE ; yes - error [128]
LIN ; end of input? [128]
BNE 25$ ; no - keep scanning [128]
MOV @SP,A2 ; retreive line index [128]
LEA A1,JOBUSN(A0) ; index current user name [122]
CLR D0 ; clear counter [132]
30$: LIN ; end of line? [122]
JEQ 50$ ; yes - should be end [122]
MOVB (A1)+,D1 ; get user name character [122]
BEQ 40$ ; null - end of name so no match [122]
UCS ; force upper case for compare [122]
INC D0 ; bump byte count [132]
CMPB D1,(A2)+ ; do the names match? [122]
BEQ 30$ ; yes - keep scanning [122]
;Names don't match -- give error [122]
40$: MOV @SP,A2 ; restore line index [132]
LEA A1,JOBUSN(A0) ; current user name [132]
LEA A6,UNAM(A5) ; save index [132]
MOV #19.,D1 ; byte count less one [132]
41$: MOVB (A1)+,(A6)+ ; save it [132]
BEQ 42$ ; EOL [132]
DBF D1,41$ ; loop for 20 bytes [132]
42$: LEA A1,UDDB(A5) ; index DDB to use for scan [132]
LEA A6,DDB.B(A5) ; index buffer [132]
MOV A6,D.BUF(A1) ; and store address [132]
MOVB #D$INI,D.FLG(A1) ; set the INIT flag [132]
;[137b] CALL $FNUSR ; locate the user ID [132]
CALL GETUSR ; locate the user ID [137b]
BMI 44$ ; error reading file - [132]
BNE 43$ ; error invalid user name
TSTW US.RTP(A2) ; do we have a root PPN? [132]
BEQ 43$ ; no - remote user [132]
POP A2 ; restore line index [132]
ORW #FL.USR,LOG.FL(A5) ; set logging with a user name [132]
JMP 5$ ; [132]
43$: TYPE <?Invalid user name>
BR 45$
44$: TYPE <?Error reading DSK0:USER.SYS[1,2]>
45$: POP A2
JMP 10$
; [132]
; POP A2 ; restore line index [122]
; TYPESP <?Already logged in as user> ; [118]
; TTYL JOBUSN(A0) ; display user name [118]
; CRLF ; [118]
; TYPE <?Please use LOGOFF, then try again> ; [118]
; JMP 10$ ; [118]
; [132]
;Come here at end of input line -- check for end of user name [122]
50$: CMP D0,#20. ; is it max? [132]
BEQ 55$ ; yes - ignore test [132]
TSTB @A1 ; are we at end of name? [122]
JNE 40$ ; no - names don't match [122]
55$: POP A2 ; yes - restore line index [122][132]
JMP 5$ ; and go process it [122]
;********************
;* LOGIT *
;********************
;Ready to process the LOG command.
;The ersatz table is scanned first, and if the user is not
;logging in under an ersatz name or device, then the device
;table will be scanned to insure the device exists.
LOGIT: TST ERSATZ ; is there an ersatz table? [113]
BNE 10$ ; yes - check for ersatz device entry [113]
5$: MOV A3,A2 ; no - restore input line [113]
JMP LGDEV ; and check for device code [113]
10$: MOV ERSATZ,A1 ; get 1st entry of ersatz tbl [113]
LEVA: MOV EZ.NAM(A1),D6 ; end of table? [113]
BNE 10$ ; no - proceed [113]
MOV A3,A2 ; yes - restore input line [113]
JMP LGDEV ; and check for device code [113]
10$: CMP D6,ERSDEV(A5) ; found name? [111][113]
BNE LEVB ; no - scan some more
TSTW EZ.PPN(A1) ; yes - is there a PPN? [113]
BEQ 20$ ; no - proceed [113]
MOVW EZ.PPN(A1),PPN(A5) ; yes - set PPN for ersatz [111][113]
20$: TSTW EZ.DEV(A1) ; is there a device? [113]
BEQ 30$ ; no - proceed [113]
MOVW EZ.DEV(A1),DDB+D.DEV(A5) ; yes - set device for ersatz [111][113]
MOVW EZ.UNT(A1),DDB+D.DRV(A5) ; & drive for ersatz [111][113]
30$: ORW #FL.ETZ,LOG.FL(A5) ; signal ersatz login
JMP LGDEV ; [113]
LEVB: ADDW #EZ.SIZ,A1 ; skip to next entry [111][113]
BR LEVA ; check it
LOGGO: TSTW DDB+D.DEV(A5) ; explicit device entered? [113]
BEQ LOGSC ; no - bypass check [113]
MOV DEVTBL,A1 ; yes - index the device table
LDVA: CMMW DV.DEV(A1),DDB+D.DEV(A5)
BNE LDVC
TSTW DDB+D.DRV(A5) ; bypass drive check if default
BMI LDVB
CMMW DV.UNT(A1),DDB+D.DRV(A5); compare drive numbers
BNE LDVC
LDVB: MOVW DV.FLG(A1),D7
ANDW #DV$MNT,D7 ; disk mounted?
BNE LOGSC ; yes - see if user is on this device
TYPE <?Disk not mounted>
LDBD: ORW #FL.BAD,LOG.FL(A5) ; login unsuccessful
BR EXIT$
LDVC: MOV @A1,A1 ; bump table index
MOV A1,D7
BNE LDVA
LDVN: TYPE <?Nonexistent device>
BR LDBD
;********************
;* LOGSC *
;********************
;Account number verification is done here
;If the device was explicitly entered we will limit the search to that device
;If no explicit device was entered we will scan all valid LOGIN devices
; with the same device name as the user's default device name
LOGSC: TSTW DDB+D.DEV(A5) ; full scan if no device entered
JEQ FULSCN
TSTW DDB+D.DRV(A5) ; device scan if no drive entered
JMI DEVSCN ; [118]
;Explicit device and drive were entered
;Check for LOGIN under this specific condition only
EXPLIT: CALL CHKMFD ; go check device MFD
JEQ CHKPSW
;LOGIN was unsuccessful
LOGBUM: MOVW LOG.FL(A5),D7
ANDW #FL.ETZ,D7 ; ersatz login?
JNE LDVN ; yes - "device" does not exist
TYPE <?Account number invalid>
ORW #FL.BAD,LOG.FL(A5)
EXIT$: JOBIDX A0
ANDW #^C<J.CCC>,JOBSTS(A0) ; just in case
ANDW #^C<J.HEX>,JOBTYP(A0) ; make sure J.HEX is off [109]
MOVW OLDTYP(A5),D6 ; [109]
ORW D6,JOBTYP(A0) ; restore job J.HEX value [109]
CRLF
MOVW LOG.FL(A5),D7
ANDW #FL.BAD,D7 ; abnormal abort?
BEQ EXIT ; no - check for module deletion
CLRW JOBCMZ(A0) ; yes - del any running command file
MOVW LOG.FL(A5),D7 ; get flags [118]
ANDW #FL.RTP,D7 ; did we try root PPN and fail? [118]
BEQ EXIT ; no - [118]
CLRW JOBUSR(A0) ; yes - make double sure we are off [118]
CLRB JOBUSN(A0) ; with no name [118]
CLRW JOBPRV(A0) ; or privileges [118]
USRBAS A1 ; make sure to delete modules [118]
CLR @A1 ; [118]
EXIT: EXIT
;********************
;* FULSCN *
;********************
;Full scan or device scan due to default device implied in input command
;Full scan will attempt to LOGIN first on current device and then
; on a scan of all drives currently mounted with the user's default
; device name
;Device scan will limit itself to the drives of the specified device
FULSCN: MOVW JOBDEV(A0),DDB+D.DEV(A5); set device code
MOVW JOBDRV(A0),DDB+D.DRV(A5); set drive number
CALL CHKMFD ; go see if we have any luck here
BEQ CHKPSW ; found account, now check password
DEVSCN: MOV DEVTBL,A1 ; set device code table
DVLP: CMMW DV.DEV(A1),DDB+D.DEV(A5); compare to current device
BNE DVNX
MOVW DV.UNT(A1),DDB+D.DRV(A5); set drive number for MFD check
MOVW DV.FLG(A1),D7
ANDW #DV$MNT,D7 ; is device mounted?
BEQ DVNX ; no - get next device
CALL CHKMFD ; check this device - drive for account
BEQ CHKPSW
DVNX: MOV @A1,A1 ; next device table entry
MOV A1,D7
BNE DVLP ; no - check some more
JMP LOGBUM ; yes - LOGIN unsuccessful
;********************
;* CHKPSW *
;********************
;PPN has been found in MFD
;If project numbers match we can bypass the PASSWORD check
;This does not apply to the all glorious 1,2 account
CHKPSW: MOV DDB+D.PRT(A5),D4 ; pick up PASSWORD (RAD50) [121][124]
JEQ LOGO ; but forget it if none there [131]
CALL CKFCHG ; check for no change in account [131]
PAGE
;************************************************************************
; *
; To always check for password if one exists, remove following 6 *
; *
; lines (up to, but not including, location GETPSW) *
; *
;************************************************************************
TSTW JOBUSR(A0) ; currently logged in?
BEQ GETPSW ; no - go get PASSWORD
CMPW PPN(A5),#ED.OPR ; yes - logging into 1,2?
BEQ GETPSW ; yes - always need PASSWORD
CMMW JOBDEV(A0),DDB+D.DEV(A5); same device? [131]
BNE GETPSW ; no - [131]
;[139] CMMW JOBDRV(A0),DDB+D.DRV(A5); same drive? [131]
;[139] BNE GETPSW ; no - [131]
CMMB JOBUSR+1(A0),PPN+1(A5) ; same project number?
BEQ LOGO ; yes - no need to check PASSWORD
GETPSW: TYPESP <Password:>
TRMRST D6 ; get current terminal status
ORW #T$ECS,D6 ; set echo suppress
TRMWST D6 ; and write it back out
KBD ; get PASSWORD
CTRLC EXIT$
CRLF
TRMRST D6 ; get current terminal status
ANDW #^C<T$ECS>,D6 ; clear echo suppress
TRMWST D6 ; and write it back out
SUB #6,SP
FILNAM @SP,XXX ; pack RAD50
CMP D4,(SP)+ ; compare to PASSWORD from MFD
BEQ LOGOP
PSWBUM: TYPE <?Bad password>
ORW #FL.BAD,LOG.FL(A5)
JMP EXIT$
;********************
;* LOGO *
;********************
;PASSWORD is either ok or not required
;Print details of the LOGIN process
LOGOP: POPW
LOGO: CALL CKFCHG ; check for no change in account [131]
BR LONA ; continue [131]
CKFCHG: MOVW LOG.FL(A5),D7 ; get flags [132]
ANDW #FL.USR,D7 ; is this a user name logging? [132]
BNE 10$ ; yes - [132]
CMMW JOBDEV(A0),DDB+D.DEV(A5); check for no change in account [131]
BNE 10$ ; or device - drive [131]
CMMW JOBDRV(A0),DDB+D.DRV(A5); [131]
BNE 10$ ; [131]
CMMW JOBUSR(A0),PPN(A5) ; [131]
BNE 10$ ; [131]
TYPESP <Already logged in under>
CALL PRTLOG ; [131]
CALL CURETZ ; [131]
JMP EXIT$ ; [131]
10$: RTN ; [131]
LONA: TSTB JOBUSN(A0) ; do we already have a user name? [118]
JNE 10$ ; yes - skip request [118]
TYPESP <User name:> ; no - request user name [118]
TRMRST D6 ; get terminal status
ORW #T$ILC,D6 ; allow lower case
TRMWST D6 ; and write it back out
KBD EXIT$ ; accept user name [118]
TRMRST D6 ; get terminal status
ANDW #^C<T$ILC>,D6 ; disable lower case
TRMWST D6 ; and write it back out
CALL CKUSN ; check user name [118]
BEQ 10$ ; found it -
CRLF ; error - finish message [118]
JMP LOGO ; and repeat [118]
10$: TSTW JOBUSR(A0) ; coming from another PPN?
BEQ LOGF
CALL DCUNLD ; Unlock MFD/UFD [114]
ORW #FL.LOG,LOG.FL(A5)
TYPESP <Transferred from>
MOVW LOG.FL(A5),D7 ; get flags [132]
ANDW #FL.USR,D7 ; is this a user name logging? [132]
BEQ 20$ ; no - [132]
TYPE <(> ; ( [132]
LEA A1,UNAM(A5) ; index current user name [132]
TTYL @A1 ; show user [132]
TYPE <) > ; ) [132]
20$: CALL PRTLOG ; [132]
TYPE < >
BR LOUP
;Is new login - clear CPU time counter and set connect time
LOGF: CLR JOBCPU(A0) ; start with no CPU time
GTIMEI JOBCON(A0) ; set connect time
GDATEI D1
SUB #2444240.,D1 ; convert to days since 1/1/80
SWAP D1
ASL D1
OR D1,JOBCON(A0) ; combine date with time
CLR JOBDSR(A0) ; clear disk read counter
CLR JOBDSW(A0) ; and disk write counter
;[118] MOVW #-1,JOBPRV(A0) ; reset job privileges [105]
ANDW #^C<FL.LOG>,LOG.FL(A5)
TYPE <Logged in>
LOUP: MOVW DDB+D.DEV(A5),JOBDEV(A0); store default device
MOVW DDB+D.DRV(A5),JOBDRV(A0); store default drive
MOVW PPN(A5),JOBUSR(A0) ; Store PROJECT,PROGRAMMER number
TYPESP <to>
MOVW LOG.FL(A5),D7 ; get flags [132]
ANDW #FL.USR,D7 ; is this a user name logging? [132]
BEQ 20$ ; no - [132]
TYPE <(> ; ( [132]
LEA A6,JOBUSN(A0) ; index new user name [132]
TTYL @A6 ; show user [132]
TYPE <) > ; ) [132]
20$: CALL PRTLOG ; [132]
MOVW PPN(A5),DDB+D.PPN(A5) ; Set new ppn [114]
CALL DCLOCD ; Lock MFD/UFD [114]
;********************
;* CHKSAM *
;********************
;Scan job table and print message if other jobs same PPN
CHKSAM: MOV JOBTBL,A1 ; set job table index
MOVW PPN(A5),D6
10$: MOV (A1)+,D7 ; check for end of table or empty slot [103]
BMI AUTO ; -1 means end [103]
BEQ 10$ ; 0 means not used [103]
CMP D7,A0 ; bypass if I am me [103]
BEQ 10$ ; [103]
MOV D7,A6 ; [103]
CMPW D6,JOBUSR(A6) ; other job same PPN? [103]
BNE 10$ ; no, continue checking
CRLF
TYPE <Caution - other jobs same PPN>
PAGE
;************************************************************************
; *
; Automatic startup functions. To remove a particular *
; *
; Auto function, remove it's associated call *
; *
;************************************************************************
AUTO: CALL CURETZ ; print ersatz name (if any)
CALL SYSMSG ; system message
MOV #21,D1 ; get LOGGER function code [118]
LOGMSG ; and send it to LOGGER [118]
CALL AUTOST ; autostart program
JMP EXIT$ ; MUST follow call to AUTOST!
;********************
;* CURETZ *
;********************
;Type current ersatz name, if any
CURETZ: MOVW LOG.FL(A5),D7
ANDW #FL.ETZ,D7 ; ersatz name already printed?
BNE 99$ ; yes - no need to reprint
CALL FNDERS ; no, go check for ersatz [111]
BNE 99$ ; not an ersatz [111]
CRLF
TYPESP <Ersatz name is>
CALL PRTERS ; go print ersatz [111]
99$: RTN
;********************
;* SYSMSG *
;********************
;Display system message
;First line of file DSK0:MAIL.JNK[7,2]
;Do not display if user was already logged in
SYSMSG: MOVW LOG.FL(A5),D7
ANDW #FL.LOG,D7 ; was he already logged in?
BNE 99$ ; yes - do not display message
CRLF
MOVW #[MAI],DDB+D.FIL(A5) ; no - set up junk mail file
MOVW #[L ],DDB+D.FIL+2(A5)
MOVW #[JNK],DDB+D.EXT(A5)
MOVW #ED.BOX,DDB+D.PPN(A5) ; on account [7,2]
MOVW #[DSK],DDB+D.DEV(A5)
CLRW DDB+D.DRV(A5) ; on DSK0:
LEA A4,DDB(A5) ; ddb address [127]
CALL DCINIT ; reinit ddb [127]
ORB #<D$ERC!D$BYP>,DDB+D.FLG(A5) ; do not abort on errors [111]
OPENI DDB(A5)
BNE 99$ ; error - assume no message
ANDB #^C<D$ERC!D$BYP>,DDB+D.FLG(A5) ; resume error abort [111]
10$: FILINB DDB(A5) ; get a character
TST DDB+D.SIZ(A5) ; Is it the EOF ? [112]
BEQ 99$ ; Yes. [112]
CMPB D1,#15 ; end of line?
BEQ 99$ ; yes - output CRLF and exit
TTY ; no - type character
BR 10$ ; go get another one
99$: CRLF
ANDB #^C<D$ERC!D$BYP>,DDB+D.FLG(A5) ; set error abort [111]
RTN
;********************
;* AUTOST *
;********************
;Look for autostart program (START.CMD on user's account)
; and execute if found
AUTOST: TSTB DDB+D.OPN(A5) ; DDB currently open?
BEQ 10$ ; no - open it up
CLOSE DDB(A5) ; yes - close last file
10$: TSTB SFLG(A5) ; do we skip it? [133]
BNE 99$ ; yes - continue [133]
MOVW #[STA],DDB+D.FIL(A5) ; look up prog on user's PPN
MOVW #[RT ],DDB+D.FIL+2(A5)
MOVW #[CMD],DDB+D.EXT(A5)
CLRW DDB+D.PPN(A5) ; look up autostart prog on user's PPN
CLRW DDB+D.DEV(A5) ; and user device
CLRW DDB+D.DRV(A5) ; and user drive
LEA A4,DDB(A5) ; ddb address [127]
CALL DCINIT ; reinit ddb [127]
LOOKUP DDB(A5) ; is it there?
BNE 99$ ; no - just exit
LEA A1,STRCMD ; command file name (START.CMD)
MOV #13,D0 ; size of command file
TSTW JOBCMZ(A0) ; user already running command file?
BNE 20$ ; yes - all ok
MOVW #<12_10>+C.SIL,JOBCMS(A0); no - reset status
20$: MOV JOBBAS(A0),A2 ; set current base index
ADD JOBSIZ(A0),A2 ; figure mem end
ADDW D0,JOBCMZ(A0) ; new command module size
;[141] SUBW JOBCMZ(A0),A2 ; reset mem end
CLR D6 ; clear it [141]
MOVW JOBCMZ(A0),D6 ; get it [141]
SUB D6,A2 ; reset mem end [141]
ANDW #^C<J.NUL>,JOBTYP(A0) ; make sure EXIT doesn't reset memory
; partition
30$: MOVB (A1)+,(A2)+ ; so we have a place to move to
SOB D0,30$
99$: RTN ; command file in place, go back
;********************
;* CHKMFD *
;********************
;Check the device MFD for valid account number
;Set the Z-bit if the account was found
;A2 will be left indexing the MFD entry for PASSWORD inspection
;[107]
CHKMFD: INIT DDB(A5) ; INIT device buffer
MOVW PPN(A5),DDB+D.FIL(A5) ; set PPN to search for
BEQ 10$ ; zero illegal
ORB #<D$ERC>,DDB+D.FLG(A5) ; bypass errors in case disk not ready
DIRACC DDB(A5),#DA$INI ; initialize search
BNE 10$ ; error
DIRSCH DDB(A5),#DS$DIR+DS$CMP ; search for PPN
BNE 10$ ; error
TSTW D6 ; did we find it?
BPL 20$ ; yes
;PPN was not found
10$: DELMEM DDB+D.BUF(A5) ; deallocate the buffer
ANDB #^C<D$ERC!D$INI>,DDB+D.FLG(A5) ; clear the INITed flag [110]
MOV #1,D7 ; set not found flag
RTN
;PPN was found
20$: CLR D7 ; set found flag
RTN
;********************
;* PRTLOG *
;********************
;Subroutine to print LOGIN parameters per job table
PRTLOG: MOVW LOG.FL(A5),D7
ANDW #FL.ETZ,D7 ; logged in as ersatz device?
BEQ 10$ ; no - print full account spec
CALL FNDERS ; go find it in ersatz tbl [111]
BEQ 20$ ; found - so go print it [111]
10$: LEA A1,JOBDEV(A0) ; not an ersatz account
LEA A2,PBF(A5) ; unpack device name into here
UNPACK
TTYL PBF(A5) ; print device name
CLR D1
MOVW JOBDRV(A0),D1 ; get drive number
DCVT 0,2 ; print drive number
TYPE <:> ; [118]
MOVB PPL(A5),D1 ; get left PPN character [118]
TTY ; and output it [118]
PRPPN JOBUSR(A0) ; print account number
MOVB PPR(A5),D1 ; get right PPN character [118]
TTY ; and output it as terminator [118]
;@@@
LEA A1,JOBDEV(A0)
LEA A2,JOBPRM(A0) ; index place to put it [119]
UNPACK
CLR D1
MOVW JOBDRV(A0),D1
DCVT 0,OT$MEM
MOVB #':,D1
OUT OT$MEM
MOVB PPL(A5),(A2)+
CLR D1 ; clear all of D1 again
MOVB JOBUSR+1(A0),D1 ; get first part of PPN
OCVT 0,OT$MEM ; output project number
MOVB #<',>,(A2)+ ; output comma
MOVB JOBUSR(A0),D1 ; get second part of PPN
OCVT 0,OT$MEM ; output programmer number
MOVB PPR(A5),(A2)+
MOVB #'.,D1
OUT OT$MEM
CLRB @A2
;@@@
RTN
20$: CALL PRTERS ; go print ersatz [111]
RTN
PAGE
;**********************
;* UNLOCK MFD/UFD * [114]
;**********************
;
;ENTRY: A0 - JCB Address
; A5 - Impure Area Address
;
;EXIT: A0 - JCB Address
; A5 - Impure Area Address
;
;PURPOSE: This routine is called to unlock the user's old MFD and UFD prior to
; locking the user's new MFD and UFD. The user's MFD is unlocked by
; DCACHE.SYS if the disc cache is configured for dynamic MFD locking.
; The user's UFD is unlocked by DCACHE.SYS if the disc cache is
; configured for dynamic UFD locking.
DCUNLD:
;[118] CMPW JOBESZ,#JOBTBE ; are we under pre-1.3 monitor? [115]
;[118] BLO 99$ ; yes - don't try disk cache [115]
SAVE A4 ; Save Reg's
LEA A4,DDB(A5) ; DDB address
PUSHB D.FLG(A4) ; Save flags
PUSHW D.DEV(A4) ; Save new device
PUSHW D.DRV(A4) ; Save new unit
PUSHW D.PPN(A4) ; Save new ppn
MOVW JOBDEV(A0),D.DEV(A4) ; Get old device
MOVW JOBDRV(A0),D.DRV(A4) ; Get old unit
MOVW JOBUSR(A0),D.PPN(A4) ; Get old ppn
CALL DCINIT ; Set up DDB
MOV #DC.XM,D7 ; Unlock MFD code
MOV DCACHE,A6 ; DCACHE.SYS entry address
CALL @A6 ; To DCACHE.SYS
CLRB D.ERR(A4) ; Clear any error
MOVB #D$INI,D.FLG(A4) ;
MOV #DC.XU,D7 ; Unlock UFD code
MOV DCACHE,A6 ; DCACHE.SYS entry address
CALL @A6 ; To DCACHE.SYS
CLRB D.ERR(A4) ; Clear any error
POPW D.PPN(A4) ; Restore new ppn
POPW D.DRV(A4) ; Restore new unit
POPW D.DEV(A4) ; Restore new device
POPB D.FLG(A4) ; Restore flags
REST A4 ; Restore Reg's
99$: RTN ; Return
PAGE
;********************
;* LOCK MFD/UFD * [114]
;********************
;
;ENTRY: A0 - JCB Address
; A5 - Impure Area Address
;
;EXIT: A0 - JCB Address
; A5 - Impure Area Address
;
;PURPOSE: This routine is called to lock the user's MFD and UFD. The user's
; MFD is loaded, if necessary, and locked by DCACHE.SYS if the disc
; cache is configured for dynamic MFD locking and there is space
; available. Does the same for user's UFD.
DCLOCD:
;[118] CMPW JOBESZ,#JOBTBE ; are we under pre-1.3 monitor? [115]
;[118] BLO 99$ ; yes - don't use disk cache [115]
SAVE A4 ; Save Reg
LEA A4,DDB(A5) ; DDB address
PUSHB D.FLG(A4) ; Save flags
CALL DCINIT ; Set up DDB
MOV #DC.DM,D7 ; Lock MFD code
MOV DCACHE,A6 ; DCACHE.SYS entry address
CALL @A6 ; To DCACHE.SYS
CLRB D.ERR(A4) ; Clear any error
MOVB #D$INI,D.FLG(A4) ;
MOV #DC.DU,D7 ; Lock UFD code
MOV DCACHE,A6 ; DCACHE.SYS entry address
CALL @A6 ; To DCACHE.SYS
CLRB D.ERR(A4) ; Clear any error
POPB D.FLG(A4) ; Restore flags
REST A4 ; Restore reg
99$: RTN ; Return
PAGE
;******************
;* SET UP DDB * [114]
;******************
;
;ENTRY: A4 - DDB Address
; A5 - Impure Area Address
;
;EXIT: A4 - DDB Address
; A5 - Impure Area Address
;
;PURPOSE: Sets buffer address, buffer size, and inits DDB.
DCINIT: LEA A6,DDB.B(A5) ; Buffer address
MOV A6,D.BUF(A4) ; Set buffer address
MOV #512.,D.SIZ(A4) ; Set buffer size
MOVB #D$INI,D.FLG(A4) ; Indicate buffer allocated
INIT @A4 ; Init DDB
RTN ; Return
PAGE
;*****************************************************************************
;* *
;* Find ersatz name in ersatz table *
;* *
;*****************************************************************************
;
; Return with Z-bit set if found & A1 pointing to table entry
FNDERS:
;[118] CMPW JOBESZ,#JOBTBE ; are we under pre-1.3 monitor? [115]
;[118] BLO 35$ ; yes - don't check ersatz table [115]
TST ERSATZ ; check for ersatz account [111][113]
BEQ 35$ ; no table - return not found [115]
10$: MOV ERSATZ,A1 ; get first entry of ersatz table [113]
20$: CMMW EZ.PPN(A1),JOBUSR(A0) ; are the accounts the same ? [111][113]
BNE 30$ ; no [111]
CMMW EZ.DEV(A1),JOBDEV(A0) ; are the devices the same ? [111][113]
BNE 30$ ; no [111]
CMMW EZ.UNT(A1),JOBDRV(A0) ; are the drives the same ? [111][113]
BEQ 40$ ; yes - print ersatz name [111]
30$: ADDW #EZ.SIZ,A1 ; skip to next ersatz account [111][113]
TSTW @A1 ; at the end? [111]
BNE 20$ ; no - look some more [111]
35$: MOV #1,D7 ; clear Z-bit for not found [111][115]
40$: RTN
PAGE
;*****************************************************************************
;* *
;* Print entry in ersatz table *
;* *
;*****************************************************************************
;
; Print ersatz name indexed by A1 on user's terminal
;
PRTERS: LEA A1,EZ.NAM(A1) ; index ersatz name [111][113]
LEA A2,PBF(A5) ; unpack ersatz into PBF [111]
UNPACK
UNPACK ; Unpack another 3 characters [116]
; Delete space if there is one [116]
10$: CMPB -(A2),#^H20 ; Is it a space? [116]
BNE 20$ ; No, done [116]
CLRB @A2 ; Yes, clear it [116]
BR 10$ ; and check for next [116]
20$: INC A2
CLR D1
MOVB #':,D1
OUT OT$MEM
CLRB @A2
TTYL PBF(A5) ; print it
LEA A2,JOBPRM(A0)
OUTL PBF(A5),OT$MEM
CLR D1
MOVB #'.,D1
OUT OT$MEM
CLRB @A2
RTN
PAGE
;CKUSN Routine to Check for Valid User Name [118]
; [118]
;Inputs: A2 Indexes user name [118]
; [118]
;Outputs: Z-bit Set if user name found, reset if not [118]
; [118]
CKUSN: LIN ; are we at end of line? [122]
BEQ 5$ ; yes - error [122]
;Validate user name format by making sure there are no colons or commas in the [128]
; specified string [128]
PUSH A2 ; save index [128]
2$: MOVB (A2)+,D6 ; get a character [128]
CMPB D6,#': ; colon? [128]
BEQ 4$ ; yes - error [128][129]
CMPB D6,#', ; comma? [128]
BEQ 4$ ; yes - error [128][129]
LIN ; end of line? [128]
BNE 2$ ; no - keep looking [128]
POP A2 ; yes - restore line index [128]
LEA A1,UDDB(A5) ; index DDB to use for scan [118]
LEA A6,DDB.B(A5) ; index buffer [118]
MOV A6,D.BUF(A1) ; and store address [118]
MOVB #D$INI,D.FLG(A1) ; set the INIT flag [118]
;[137b] CALL $FNUSR ; locate the user ID [118]
CALL GETUSR ; locate the user ID [137b]
BMI 10$ ; error reading file - [118]
BEQ 20$ ; found it - [118]
BR 5$ ; go handle error [128]
4$: POP A2 ; restore line index [128]
5$: TYPE <?Invalid user name> ; display error message [118][122]
MOV #1,D7 ; reset Z-flag [123]
RTN ; return error flag [118]
10$: TYPE <?Error reading DSK0:USER.SYS[1,2]> ; [118]
JMP EXIT$ ; leave under duress [118]
;Found the user name - transfer the good stuff to the DDB [118]
20$: TSTW US.RTP(A2) ; do we have a root PPN? [118]
JEQ 50$ ; no - remote user [118]
CALL CHKUPW ; check the user's password
JNE 60$ ; error -
LEA A1,JOBUSN(A0) ; index the user name in the DDB [118]
LEA A6,US.USN(A2) ; and in the entry [118]
MOV #19.,D1 ; byte count less one [132]
30$: MOVB (A6)+,(A1)+ ; transfer name [118]
BEQ 31$ ; until a null is seen [118]
DBF D1,30$ ; loop for 20 bytes [132]
31$: MOVW US.PRV(A2),JOBPRV(A0) ; transfer job privilege word [118][132]
MOVW US.RTP(A2),JOBRTP(A0) ; root PPN [118]
MOVW US.RTD(A2),JOBRTD(A0) ; root device [118]
MOVW US.RTU(A2),JOBRTU(A0) ; root unit [118]
MOVB US.CLS(A2),JOBLVL(A0) ; user class [118]
MOVB US.EXP(A2),JOBEXP(A0) ; user experience [118]
MOV US.DFP(A2),JOBDFP(A0) ; default protection [125]
BNE 32$ ; non-zero - use what we get [125]
MOV #0505051717,JOBDFP(A0) ; zero - use default [125]
32$: MOVW US.PRI(A2),JOBRNQ+22(A0); job priority [119]
BNE 35$ ; [119]
MOV #13.,JOBRNQ+20(A0) ; [119]
;@@@
;35$: MOV #<20./4>-1,D7 ; get size of prompt [119]
; LEA A1,US.PRM(A2) ; index prompt [119]
; LEA A6,JOBPRM(A0) ; index place to put it [119]
;37$: MOV (A1)+,(A6)+ ; transfer prompt [119]
; DBF D7,37$ ; [119]
;@@@
35$:
MOV US.FLG(A2),D1 ; get desired settings [119]
;US$NLK is handled by LOKSER and requires a check for locked files (i.e. from
;a previous close/keep LOKSER call). Clear flag for now and process it in the
;NOLOCK routine below.
AND #^C<US$NLK>,D1 ; clear us$nlk [134]
MOVW JOBTYP(A0),D7 ; get current jobtype settings [119]
ANDW #^C<J.HEX!J.DER!J.VER!J.CCA!J.GRD>,D7 ; [119]
ORW D1,D7 ; set flags [119]
MOVW D7,JOBTYP(A0) ; and store in JCB [119]
CALL NOLOCK ; set file locking status [134]
MOV US.FLG(A2),D7 ; get flags again [122]
ANDW #J.HEX,D7 ; get just the hex/octal bit [122]
MOVW D7,OLDTYP(A5) ; and store in case we restore later [122
TRMRST D7 ; get current terminal status
ANDW #^C<T$LCL>,D7 ; reset to echo mode [119]
TST D1 ; do we want no echo mode? [119]
BPL 40$ ; no - [119]
ORW #T$LCL,D7 ; yes - set it [119]
40$: TRMWST D7 ; write terminal status back
; ANDW #J.HEX,D6 ; get just the hex/octal bit [122][132]
; MOVW D6,OLDTYP(A5) ; and store in case we restore later [122][132]
CALL SETLNG ; set the user's language [119]
CLR D7 ; set success flag [118]
RTN ; [118]
;Come here on attempt to log in as remote user
50$: TYPESP <?User> ; display error message [118]
TTYL US.USN(A2) ; display user name [118]
TYPE < is a remote user only and may not log in to this system> ; [118]
60$: MOV #1,D7 ; set error code [118]
RTN ; and return [118]
PAGE
;Set the user's selected language [119]
SETLNG: SAVE A1-A5 ; save registers
LEA A2,US.LNG(A2) ; index name of language
LEA A5,SYSBAS ; index base of system memory
MOV @A5,A5 ; pick up system area base
MOV A5,D7 ; check for none
BEQ 125$
;Scan the system memory area
120$: TST @A5 ; check for end of system area
BNE 130$ ; still some left -
125$: MOV SYSLNG,A1 ; try the system default [136]
LEA A3,LD.NM1(A1) ; compare against primary name
;[138] CALL CMPSTR ; is it a match?
CALL CMPSTR2 ; is it a match? [138]
BEQ 150$ ; yes -
LEA A3,LD.NM2(A1) ; compare against alternate name
;[138] CALL CMPSTR ; is it a match?
CALL CMPSTR2 ; a match?? [138]
BEQ 150$ ; yes -
TYPECR <?Unable to locate requested language>
BR 150$ ; go use the system default
;Have a module to check
130$: LEA A1,12(A5) ; index the extension
CMPW (A1)+,#[LDF] ; is it a language defintion file?
BNE 140$ ; no -
LEA A3,LD.NM1(A1) ; compare against primary name
;[138] BCALL CMPSTR ; is it a match?
BCALL CMPSTR2 ; a match?? [138]
BEQ 150$ ; yes -
LEA A3,LD.NM2(A1) ; compare against alternate name
;[138] BCALL CMPSTR ; is it a match?
BCALL CMPSTR2 ; a match?? [138]
BEQ 150$ ; yes -
140$: ADD @A5,A5 ; bump to next program
JMP 120$
;A1 now indexes the requested language defintion table
150$: MOV A1,JOBLNG(A0) ; set the language
REST A1-A5 ; restore reggies
RTN
PAGE
;CMPSTR Routine to Compare Two Case-Independent Strings
;
;Inputs: A2 Indexes item to check for
; A3 Indexes item to compare against
;
;Outputs: Z-flag Set if items match
;
CMPSTR: PUSH A2 ; save input index
1100$: MOVB (A3)+,D1 ; get a match character
BEQ 1400$ ; end of this string -
UCS ; convert to upper case
MOVB (A2)+,D6 ; get an input character
BEQ 1200$ ; end of this string - no match
CMPB D6,D1 ; do we have a match?
BEQ 1100$ ; yes - keep looping
1200$: MOV #1,D7 ; no - flag failure
1300$: POP A2 ; restore register
RTN ; and return
;One string terminated - if other did too, we have a match
1400$: TSTB @A2 ; did other string terminate?
BEQ 1300$ ; yes - OK
CMPB @A2,#15 ; carrriage return terminator?
BR 1300$ ; return flag
;[138]
;CMPSTR2 Routine to Compare Two Case-Insensitive Strings
;
;Inputs: A2 Indexes item to check for
; A3 Indexes item to compare against
;
;Outputs: Z-flag Set if items match
;
CMPSTR2:SAVE A2,D5 ; save input index [140]
1100$: MOVB (A3)+,D1 ; get a match character
BEQ 1400$ ; end of this string -
UCS ; convert to upper case
MOVB D1, D5 ; save character [140]
MOVB (A2)+,D1 ; get an input character
BEQ 1200$ ; end of this string - no match
UCS ; force upper
CMPB D5,D1 ; do we have a match? [140]
BEQ 1100$ ; yes - keep looping
1200$: MOV #1,D7 ; no - flag failure
1300$: REST A2,D5 ; restore register [140]
RTN ; and return
;One string terminated - if other did too, we have a match
1400$: TSTB @A2 ; did other string terminate?
BEQ 1300$ ; yes - OK
CMPB @A2,#15 ; carrriage return terminator?
BR 1300$ ; return flag
PAGE
;CHKUPW Routine to Accept and Validate User Level Password
;
;Inputs: A2 Indexes user file entry
;
;Outputs: Z-flag Set if successful or no password
;
CHKUPW: SAVE A1-A3 ; save registers
LEA A1,US.PAS(A2) ; index the user's password
TSTB @A1 ; do we have a password?
BEQ 110$ ; no - just ignore all this
TYPESP <User Password:>
TRMRST D6 ; get current terminal status
ORW #T$ECS,D6 ; set echo suppress
TRMWST D6 ; and write it back out
KBD ; get PASSWORD
CTRLC EXIT$
TRMRST D6 ; get current terminal status
ANDW #^C<T$ECS>,D6 ; clear echo suppress
TRMWST D6 ; and write it back out
CRLF
MOV A1,A3 ; index the password
CALL CMPSTR ; compare the passwords
BEQ 110$ ; they match!
;Come here on bad password
100$: TYPE <?Bad password>
MOV #1,D7 ; set failure flag
;Come here to exit
110$: REST A1-A3 ; restore registers
RTN
PAGE
;Startup command file
STRCMD: ASCII /START.CMD/
BYTE 15
BYTE 12
EVEN
PAGE
;[134]
;**********;
; NOLOCK ;
;**********;
;
;A0 - JCB Address
;A2 - User Record (in USER.DAT)
;
;Modifies: A6,D6,D7
;
;Turn locking ON/OFF for a job and record event in system log file.
;
NOLOCK: SAVE A3,A4,D0 ; save reg's
MOVW JOBTYP(A0),D6 ; job type flags
ANDW #J.NLK,D6 ; mask nolock flag
MOV US.FLG(A2),D7 ; user flags
ANDW #US$NLK,D7 ; mask nolock flag
CMPW D6,D7 ; compare flags, same ?
BEQ RTX ; yes, just return
MOV #I$NLK!I$JOB,D0 ; locking on flags
ANDW #US$NLK,D7 ; turn locks on ?
BEQ 10$ ; yes
MOV #I$NLK!I$JOB!I$OFF,D0 ; locking off flags
10$: QGET A3 ; get a queue block, error ?
BNE ERRNOQ ; yes, error exit
MOV A0,I$JCB(A3) ; set jcb address
LEA A4,DDB(A5) ; get a ddb (for lokser)
LOKSER @A3,D0 ; turn locking on/off
TSTW O$RET(A3) ; error ?
BNE ERRLOK ; yes, error exit
CALL LOGGER ; log event
RTQ: QRET A3 ; return queue block
RTX: REST A3,A4,D0 ; restore reg's
RTN ; exit
;Display system error message
;
ERRNOQ: CALL ERRMOD ;
MOVB #D$ENOQ,D.ERR(A4) ; insufficient queue blocks
ERRMSG D.ERR(A4),OT$TRM!OT$LDQ ; display error
CRLF ; next line
BR RTX ; exit
ERRLOK: CALL ERRMOD ;
MOVW O$RET(A3),D7 ;
MOVB D7,D.ERR(A4) ;
ERRMSG D.ERR(A4),OT$TRM!OT$LDQ ; display lokser error
CRLF ; next line
BR RTQ ; exit
ERRMOD: TYPECR <?Error setting lock mode>
RTN
PAGE
;[134]
;***********;
; LOG EVENT ;
;***********;
;
;D0 - LOKSER opcode and flags
;A0 - JCB address of job being turned on/off
;A3 - Queue block address
;
;Log event in system log file, if file exists.
;
LOGGER: SAVE A1,A2,D1 ; save reg's
MOV A3,A2 ; message buffer
LEA A1,MSGOFF ; locks off message
BTST #I%OFF,D0 ; turning locks off ?
BNE 10$ ; yes, skip
LEA A1,MSGON ; locks on message
10$: MOVB (A1)+,(A2)+ ; copy message, done ?
BNE 10$ ; no, repeat
DEC A2 ; backup one space
MOVB #'(,(A2)+ ; open bracket
LEA A1,JOBNAM(A0) ; job name
UNPACK ;
UNPACK ;
MOVB #^H20,@A2 ; terminate buffer
SUB #6,A2 ;
20$: CMPB (A2)+,#^H20 ;
BNE 20$ ;
DEC A2 ; backup one space
MOVB #'),(A2)+ ; close bracket
CLRB @A2 ; terminate buffer
;
;Log event in system log file
;
MOV #41,D1 ; logger function code
CLR D3 ; user code, unused
MOV A3,A1 ; user message
LOGMSG ; log event
REST A1,A2,D1 ; rest reg's
RTN ; return
;[137a]
;**************************************
; STRIPSP - Strip trailing whitespace from user name found
; - in the command line.
;
; entry : A2 points to start of string.
; exit : A2 points to start of string with trailing whitespaces gone.
;**************************************
STRIPSPACES:
; find the end of the string first.
LIN ; are we at end of line?
BEQ 50$ ; yes - done
PUSH A2 ; save index [128]
2$: MOVB (A2)+,D6 ; get a character [128]
CMPB D6,#': ; colon? [128]
BEQ 40$ ; yes - error [128][129]
CMPB D6,#', ; comma? [128]
BEQ 40$ ; yes - error [128][129]
LIN ; end of line? [128]
BNE 2$ ; no - keep looking [128]
; ok, A2 points to the char AFTER the line terminator
5$: MOVB -(A2), D0
CMPB D0, #' ; is the character a space?
BEQ 5$ ; yes, try previous character
CMPB D0, #^H09 ; is the char a TAB?
BEQ 5$
10$: MOVB #^H0D,1(A2) ; and write a CR at end of string
40$: POP A2
50$: RTN
;[137b]
;***************
; GETUSR - find a given user in the USER.SYS file.
;
; entry : A2, A1 set up according to $FNUSR library routine
; exit: D0, D6, A2, and CCR set up as per $FNUSR
;***************
GETUSR: MOVW #RETRYCNT-1, D4 ; get max retry count
ORB #<D$BYP>, D.FLG(A1) ; don't show any errors
5$: CALL $FNUSR ; get user
BEQ 10$ ; YES, exit now
BMI 20$ ; error, try again
10$: RTN ; exit, everything set up
20$: SLEEP #500. ; sleep 20th of a second
DBF D4, 5$ ; then, try again
LCC #PS.N ; set minus flag
RTN ; exit please!
MSGON: ASCII /- Locking ON for /
BYTE 0
MSGOFF: ASCII /- Locking OFF for /
BYTE 0
EVEN
END