.TITLE	SETPWD	SET PASSWORD
	.IDENT	/1.01/			;FILE "SETPWD.MAR"

;
;	COPYRIGHT (C) 1979
;		MANAGEMENT SCIENCE ASSOCIATES, INC.
;		5100 CENTRE AVENUE
;		PITTSBURGH, PENNSYLVANIA  15232
;
;	THIS SOFTWARE IS DISTRIBUTED WITHOUT COST, AND MAY BE
;	REPRODUCED ONLY WITH THE INCLUSION OF THIS COPYRIGHT
;	STATEMENT.  MANAGEMENT SCIENCE ASSOCIATES ASSUMES NO
;	RESPONSIBILITY FOR THE PERFORMANCE OF THIS SOFTWARE.
;

;++
;	SETPWD
;
; FUNCTION:	ENABLE A USER TO CHANGE HIS/HER PASSWORD
;
; SPECIAL CONSIDERATIONS:
;	LINK:		WITH SYS$SYSTEM:SYS.STB/SEL
;			 TO PRODUCE SYS$SYSTEM:SETPWD.EXE
;	INSTALL:	WITH CMKRNL PRIVILEGES
;--
	.PAGE

	.EXTRN	LGI$HPWD		;EXTERNAL ROUTINE TO HASH PWD

	.LIBRARY	"SYS$LIBRARY:LIB.MLB"
	.LIBRARY	"DBA0:[DCL.OBJ]DCL.MLB"

	$DCDEF				;DEVICE CODE DEFINITIONS
	$FABDEF				;FAB DEFINITIONS
	$IODEF				;I/O DEFINITIONS
	$JPIDEF				;$GETJPI FIELD DEFINITIONS
	$PHDDEF				;PROCESS HEADER DEFINITIONS
	$RABDEF				;RAB DEFINITIONS
	$RMSDEF				;RMS DEFINITIONS
	$SSDEF				;SYSTEM STATUS DEFINITIONS
	$UAFDEF				;USER AUTHORIZATION FILE DEFNS
	DEFCMDWRK			;DCL DEFINITIONS

	.MACRO	CHECK	TYP,?L$		;;ERROR CHECKING
	BLBS	R0,L$			;;XFER ON SUCCESS
	  BRW	ERR'TYP			;;ELSE TO ERROR HDLR
L$:					;;CONTINUE
	.ENDM	CHECK			;;

	.PSECT	DATA,RD,WRT,NOEXE,LONG

ASIARG:	$ASSIGN	DEVNAM=INPNAM,-		;ASSIGN I/O CHANNEL
		CHAN=RPTARG+QIOW$_CHAN	;STUFF CHANNEL INTO QIO

INPNAM:	.ASCID	/TT/			;INPUT DEVICE NAME

CHNARG:	$GETCHN	PRIBUF=CHNDSC		;WANT TO ASSURE A TTY

CHNDSC:	.LONG	8			;DESCRIPTOR FOR CHAN INFO
	.ADDRESS	CHNDAT		;
CHNDAT:	.BLKQ	1			;CHANNEL INFO GOES HERE

JPIARG:	$GETJPI	ITMLST=JPILST		;GET JOB INFO

JPILST:	.WORD	12			;USER NAME LENGTH
	.WORD	JPI$_USERNAME		;ITEM CODE
	.ADDRESS	USRNAM		;BUFFER ADDRESS
	.LONG	0			;NO RETURN LENGTH
	.LONG	0			;TERMINATE LIST

USRNAM:	.BYTE	^X20[12]		;BLANK FILL FOR USERNAME

OHSPWD:	.BLKL	1			;OLD HASHED PASSWORD
NHSPWD:	.BLKL	1			;NEW HASHED PASSWORD

PWDDSC:	.BLKL	1			;SLOT FOR LENGTH OF PWD STRING
	.ADDRESS	TXTBUF		;ADDRESS OF PWD STRING

RPTARG:	$QIOW	FUNC=<IO$_READPROMPT!-	;READ WITH PROMPT
			IO$M_NOECHO!-
			IO$M_CVTLOW!-
			IO$M_PURGE!-
			IO$M_TRMNOECHO>,-
		IOSB=IOSBLK,-		;WANT A STATUS BLOCK
		P1=TXTBUF,-		;READ TO BUFFER
		P2=TXTLEN,-		;LENGTH OF TEXT BUFFER
		P4=BRKADR,-		;WANT SPECIAL BREAK MASK
		P6=PRMLEN		;LENGTH OF PROMPT

BRKADR:	.LONG	MSKLEN			;LENGTH OF BREAK MASK
	.ADDRESS	BRKMSK		;ADDRESS OF BREAK MASK

BRKMSK:	.LONG	^XFFFFFFFF		;00-1F  ALL CONTROL CHARS BREAK
	.LONG	^XFC00FFFF		;20-3F  LET DIGITS PASS
	.LONG	^XF8000001		;40-5F  ALPHABETIC PASS
	.LONG	^XF8000001		;60-7F	LOWER CASE WILL BE SHIFTED
	MSKLEN = . - BRKMSK		;LENGTH OF BREAK MASK

IOSBLK:	.BLKQ	1			;I/O STATUS BLOCK

TRMTAB:	.BYTE	^X07,^X0A,^X0B,^X0C,^X0D,^X1B ;BEL,LF,VT,FF,CR,ESC VALID
	TRMLEN = . - TRMTAB		;LENGTH OF VALID TRM LIST

	CRLF = ^X0A0D			;CRLF
OPPBUF:	.WORD	CRLF
	.ASCII	/Old Password>/		;OLD PWD PROMPT
NPPBUF:	.WORD	CRLF
	.ASCII	/New Password>/		;NEW PWD PROMPT
REPBUF:	.WORD	CRLF
	.ASCII	/Once again..>/		;REPEAT PASSWORD PROMPT
	PRMLEN = . - REPBUF		;LENGTH OF EACH PROMPT

	.ALIGN	LONG
AUTFAB:	$FAB	FAC=<GET,UPD>,-		;AUTHORIZATION FILE FAB
		FNA=AUTNAM,-		;NAME
		FNS=AUTSIZ,-		;LENGTH OF NAME
		MRS=UAF$C_LENGTH,-	;RECORD LENGTH
		ORG=SEQ,-		;SEQUENTIAL
		RFM=FIX			;FIXED LENGTH RECORDS

AUTNAM:	.ASCII	/SYS$SYSTEM:SYSUAF.DAT/	;AUTHORIZATION FILE
	AUTSIZ = . - AUTNAM		;LENGTH OF NAME STRING

	.ALIGN	LONG
AUTRAB:	$RAB	FAB=AUTFAB,-		;POINT TO THE FAB
		RAC=SEQ,-		;SEQUENTIAL ACCESS
		RBF=RECBUF,-		;INPUT RECORD BUFFER
		RSZ=UAF$C_LENGTH,-	;BUFFER SIZE
		UBF=RECBUF,-		;OUTPUT BUFFER
		USZ=UAF$C_LENGTH	;SIZE OF BUFFER

TIMARG:	$SETIMR	EFN=1,-			;STALL 'CAUSE GUY LIED
		DAYTIM=WAITIM		;

;	NOTE:	THE USER IS FORCED TO WAIT (WITH ^Y'S DISABLED)
;		IF THE OLD PASSWORD IS INCORRECT.  THIS IS TO
;		MINIMIZE THE CHANCE THAT A MALICIOUS PERSON COULD
;		SUCCEED IN CHANGING THE PASSWORD OF A USER WHO HAS
;		LEFT HIS/HER TERMINAL UNATTENDED.  AT MSA THE DELAY
;		IS FIVE SECONDS.  THIS MAY BE CHANGED BY MODIFYING
;		THE STALL TIME, STLTIM, BELOW.
		STLTIM=5
WAITIM:	.LONG	<-10*1000*1000>*STLTIM	;STALL
	.LONG	-1			;DELTA TIME

WAIARG:	$WAITFR	EFN=1			;WAIT FOR TIME TO EXPIRE

DASARG:	$DASSGN				;CHANNEL TO BE STUFFED

EXIARG:	$EXIT	CODE=SS$_NORMAL		;PRESUME NORMAL EXIT

SAVUIC:	.BLKL	1			;SAVED UIC
FLGBYT:	.BYTE	0			;FLAG BYTE
	FLAG_NOCTLY = 0			;POSITION OF ^Y FLAG
	FLAG_BADPWD = 1			;POSITION OF BAD PWD FLAG

;	NOTE:	THE RESTRICTION OF PASSWORDS TO EIGHT OR FEWER CHARACTERS
;		IS AN ARBITRARY LIMIT IMPOSED AT MSA.  IN FACT, PASSWORDS
;		MAY BE MUCH LONGER (OVER A HUNDRED CHARS, I BELIEVE) IF
;		ONLY THE LIMITATIONS IMPOSED BY LOGINOUT ARE CONSIDERED.
;		FOR A LIMIT OF N CHARS, SET TXTLEN (BELOW) TO N+1.
	TXTLEN = 9			;ROOM FOR A PASSWORD + DELIMITER
TXTBUF:	.BLKB	TXTLEN			;TEXT BUFFER
	RECBUF = TXTBUF			;REUSE TEXT BUFFER FOR AUTH RECORD
	.IF GT	<UAF$C_LENGTH - TXTLEN> ;;NEED MORE ROOM FOR RECORD
		.BLKB	<UAF$C_LENGTH - TXTLEN> ;;EXTEND THE BUFFER
	.ENDC				;;
	.PAGE

	.PSECT	CODE,RD,NOWRT,EXE,LONG

	.ENTRY	SETPWD,0		;ENTER; SAVE NO REGISTERS
	$ASSIGN_G	ASIARG		;ASSIGN INPUT CHANNEL
	CHECK	ASI			;
	MOVL	RPTARG+QIOW$_CHAN,CHNARG+GETCHN$_CHAN ;CHANNEL WORD
	$GETCHN_G	CHNARG		;GET CHANNEL TYPE
	CHECK	CHN			;
	CMPB	#DC$_TERM,CHNDAT+4	;CHECK FOR A TERMINAL
	BEQL	10$			;XFER IF GOT ONE
	  BRW	ERRTRM			;
10$:	$GETJPI_G	JPIARG		;GET USERNAME
	CHECK	JPI			;
	MOVAB	OPPBUF,RPTARG+QIOW$_P5	;SET ADDRESS OF OLD PWD PROMPT
	BSBW	READPT			;READ PASSWORD WITH PROMPT
	MOVL	R0,OHSPWD		;SAVE OLD HASHED PASSWORD
	MOVAB	NPPBUF,RPTARG+QIOW$_P5	;SET ADDRESS OF NEW PWD PROMPT
	BSBW	READPT			;READ PWD WITH PROMPT
	MOVL	R0,NHSPWD		;SAVE NEW HASHED PASSWORD
	MOVAB	REPBUF,RPTARG+QIOW$_P5	;ADDRESS OF REPEAT PROMPT
	BSBW	READPT			;GET THE PASSWORD AGAIN
	CMPL	R0,NHSPWD		;CHECK FOR TWO TRIES MATCHING
	BEQL	20$			;XFER ON SUCCESS
	  BRW	ERRMCH			;DON'T MATCH
20$:	$CMKRNL_S	DISABL		;DISABLE ^Y AND SET UIC
30$:	$OPEN		FAB=AUTFAB	;OPEN THE AUTHORIZATION FILE
	CMPL	R0,#RMS$_FLK		;CHECK FOR FILE LOCKED
	BEQL	30$			;IF SO THEN TRY AGAIN
	CHECK	OPN			;
	$CONNECT	RAB=AUTRAB	;CONNECT RAB TO FAB
	CHECK	CON			;
	$GET		RAB=AUTRAB	;FIRST GET TO BYPASS DEFAULT RECORD
	CHECK	GET			;
40$:	$GET		RAB=AUTRAB	;GET A RECORD
	CHECK	GET			;
	CMPC3	#12,USRNAM,RECBUF+UAF$T_USERNAME ;CHECK FOR USER'S RECORD
	BNEQ	40$			;XFER IF NO MATCH
	CMPL	OHSPWD,RECBUF+UAF$L_PWD	;VALID PASSWORD CHECK
	BEQL	50$			;XFER ON VALID
	  BRW	ERRPWD			;
50$:	MOVL	NHSPWD,RECBUF+UAF$L_PWD	;PUT THE NEW PASSWORD IN PLACE
	$UPDATE		RAB=AUTRAB	;UPDATE THE RECORD
	CHECK	UPD			;
	.PAGE

EXIDIS:	$DISCONNECT	RAB=AUTRAB	;DISCONNECT THE RAB
EXICLO:	$CLOSE		FAB=AUTFAB	;CLOSE THE AUTHORIZATION FILE
	BBCC	#FLAG_BADPWD,FLGBYT,EXIENA ;XFER IF GUY DIDN'T LIE
	$SETIMR_G	TIMARG		;SET THE TIMER
	$WAITFR_G	WAIARG		;MAKE THE BASTARD WAIT
EXIENA:	$CMKRNL_S	ENABLE		;FIX UIC AND ^Y ENABLE
EXIDAS:	MOVL	RPTARG+QIOW$_CHAN,DASARG+DASSGN$_CHAN ;THE TERMINAL CHANNEL
	$DASSGN_G	DASARG		;DEASSIGN THE CHANNEL
EXIEXI:	$EXIT_G		EXIARG		;QUIT WITH STATUS
	.PAGE

READPT:	$QIOW_G		RPTARG		;READ WITH PROMPT
	CHECK	RPT			;
	MOVZWL	IOSBLK,R0		;GET DRIVER STATUS
	CHECK	RPT			;
	CVTWL	IOSBLK+2,PWDDSC		;GET CHAR COUNT BEFORE DELIMITER
	BGTR	20$			;XFER IF POSITIVE
10$:	  BRW	ERRFMT			;BAD STRING
20$:	LOCC	IOSBLK+4,#TRMLEN,TRMTAB	;CHECK FOR VALID TERMINATOR
	  BEQL	10$			;XFER ON INVALID TERMINATOR
	PUSHAL	PWDDSC			;ARG FOR HASHING
	CALLS	#1,LGI$HPWD		;HASH THE PASSWORD
	RSB				;RETURN



DISABL:	.WORD	0			;KERNEL MODE ENTRY
	MOVL	#CTL$AG_CLIDATA,R0	;CLI DATA BASE
	BBCS	#PRC_V_NOCTLY,PRC_W_FLAGS(R0),10$ ;DISABLE ^Y
	BBCS	#FLAG_NOCTLY,FLGBYT,10$	;NOTE WAS SET
10$:	MOVL	@#SCH$GL_CURPCB,R0	;GET PCB ADDRESS
	MOVL	PCB$L_UIC(R0),SAVUIC	;SAVE THE CURRENT UIC
	MOVL	#<^X00070007>,PCB$L_UIC(R0) ;SET UIC TO [7,7]
	RET				;EXIT TO USER MODE


ENABLE:	.WORD	0			;KERNEL MODE ENTRY
	MOVL	@#SCH$GL_CURPCB,R0	;GET PCB ADDRESS
	MOVL	SAVUIC,PCB$L_UIC(R0)	;RESTORE ORIGINAL UIC
	BBS	#FLAG_NOCTLY,FLGBYT,10$	;XFER IF ^Y WAS DISABLED
	MOVL	#CTL$AG_CLIDATA,R0	;CLI DATA BASE
	BBCC	#PRC_V_NOCTLY,PRC_W_FLAGS(R0),10$ ;ENABLE ^Y
10$:	RET				;EXIT TO USER MODE
	.PAGE

	ERRCOD = EXIARG + EXIT$_CODE

ERRASI:	MOVL	R0,ERRCOD		;CHANNEL ASSIGNMENT ERROR
	BRW	EXIEXI			;

ERRCHN:	MOVL	R0,ERRCOD		;CAN'T GET CHANNEL INFO
	BRW	EXIDAS			;

ERRTRM:	MOVZWL	#SS$_IVCHAN,ERRCOD	;WHAT WE SAY WHEN NOT A TERMINAL
	BRW	EXIDAS			;

ERRJPI = ERRCHN				;CAN'T GET JPINFO

ERRRPT = ERRCHN				;ERROR READING FROM TTY

ERRFMT:	MOVZWL	#SS$_BADPARAM,ERRCOD	;WHAT WE SAY WHEN INVALID TYPE-IN
	BRW	EXIDAS			;

ERRMCH = ERRFMT				;IF TWO NEW PWDS DON'T MATCH

ERROPN:	MOVL	R0,ERRCOD		;RMS OPEN ERROR
	BRW	EXIENA			;

ERRCON:	MOVL	R0,ERRCOD		;RMS CONNECT ERROR
	BRW	EXICLO			;

ERRGET:	MOVL	R0,ERRCOD		;RMS GET ERROR
	BRW	EXIDIS			;

ERRPWD:	MOVZWL	#SS$_NOPRIV,ERRCOD	;WHEN THE GUY LIED ABOUT HIS PWD
	BBSS	#FLAG_BADPWD,FLGBYT,10$	;
10$:	BRW	EXIDIS			;

ERRUPD = ERRGET				;RMS UPDATE ERROR

	.END	SETPWD			;THAT'S ALL, FOLKS!