.enabl	lc
	.title	paswrd
	.rem	$

Change the password associated with a username.

John Wilson, 07-Dec-85.

Must be assembled with HEADER.MAC

$
	.mcall	exit$s
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
calfip=	emt	;call file processor
opnfq=	2	;CALFIP subfunc to open a file
crefq=	4	;subfunc to create and open a file
rstfq=	20	;subfunc to reset channel(s)
.read=	emt+2	;read a record
.write=	emt+4	;write a record
.ttech=	emt+20	;enable echo
.ttnch=	emt+22	;disable echo
.postn=	emt+32	;get carriage column
.uuo=	emt+66	;FIP calls
uu.sys=	26.	;subfunc to return system info
;
cr=	15	;carriage return
lf=	12	;line feed
;
paswrd:	; first read username from NAMEjj.TMP
	movb	#rstfq,firqb+3	;close all files
	clrb	firqb+4
	calfip
	mov	#firqb+3,r0	;point into firqb
	movb	#uu.sys,(r0)+	;func=get system info
	clr	(r0)		;current job
	.uuo			;do it
	movb	firqb+2,r1	;get job # (*2)
	asr	r1		;/2=job
	clr	r0		;sxt
	div	#10.,r0		;separate digits of job #
	mov	r0,r3		;copy high digit
	mul	#50,r3		;shift left (rad50)
	add	r3,r1		;add together
	add	#^R 00,r1	;convert to rad50
	jsr	pc,clrfrq	;clear the firqb
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+10,r5	;point at filename
	mov	#^RNAM,(r5)+
	add	#^RE  ,r1	;name='NAMEjj.TMP'
	mov	r1,(r5)+
	mov	#^RTMP,(r5)
	mov	#120000,firqb+22 ;open the file read-only
	calfip			;open the file
	tstb	firqb		;error?
	beq	10$		;no, skip
; NAMEjj.TMP doesn't exist - assume anonymous login
	jsr	r5,type		;print message
	.word	l.nous,nouser
	jmp	exit1		;die
10$:	mov	#buf,r0		;point at buffer
	mov	#xrb,r1		;point at xrb
	mov	#512.,(r1)+	;read one block
	clr	(r1)+		;nothing read yet
	mov	r0,(r1)+	;into @#buf
	mov	#2,(r1)+	;channel 1
	clr	(r1)+		;next (first) block
	clr	(r1)+		;(KB wait time)
	clr	(r1)		;(modifier bits)
	.read			;read username from NAMEjj.TMP
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
; look up the username in BBUSER.DAT
	mov	#12.,r1		;length=12 chars
	mov	#usrnam,r5	;point at buffer
	mov	#4,r4		;4 words (12 chars)
	jsr	pc,rad50	;convert to radix-50
	jsr	r5,type		;prompt for password
	.word	l.pw,pw
	.ttnch			;turn off echo
	jsr	pc,getlin	;get password
	mov	#psword,r5	;point at buffer
	mov	#2,r4		;2 words (6 chars)
	jsr	pc,rad50	;convert to radix-50
	bcc	30$		;legal password, continue
20$:	;bad or invalid username or password
	jsr	r5,type		;print message
	.word	l.wron,wrong
	jmp	exit		;bag
30$:	; look up password
	jsr	pc,clrfrq	;clear the firqb
	movb	#opnfq,firqb+3	;func=open file for input
	movb	#2,firqb+4	;on channel 1
	mov	#firqb+6,r0	;point at filename
	mov	#bbsppn,(r0)+	;filename='devn:[p,pn]BBUSER.DAT'
	mov	#^RBBU,(r0)+
	mov	#^RSER,(r0)+
	mov	#^RDAT,(r0)
.iif ne <bbsdev>, mov #bbsdev,firqb+30
.iif ne <bbsunt>, mov #bbsunt,firqb+32
	calfip			;open the file
	mov	firqb+16,r5	;get file size
40$:	mov	#8.,r4		;# of records per block
	mov	#buf,r3		;point at buffer
	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;read one block
	clr	(r0)+		;nothing read yet
	mov	r3,(r0)+	;into @#buf
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;(modifier bits)
	.read			;read the block
50$:	mov	#4,r2		;name is 4 words long
	mov	r3,r1		;copy ptr
	mov	#usrnam,r0	;point at name
60$:	cmp	(r0)+,(r1)+	;do they match?
	bne	80$		;no, skip
	sob	r2,60$		;loop
	mov	#2,r2		;compare passwords
70$:	cmp	(r0)+,(r1)+	;match?
	bne	90$		;no, gack
	sob	r2,70$		;loop
	br	100$		;go get new password
80$:	add	#100,r3		;point at next entry in block
	sob	r4,50$		;check the whole block
	sob	r5,40$		;for all blocks
90$:	; bad password
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
	br	20$		;print message
100$:	mov	xrb+10,-(sp)	;save block #
	sub	#4,r1		;pt at begn of password
	mov	r1,-(sp)	;save
110$:	jsr	r5,type		;prompt for new password
	.word	l.newp,newpw
	jsr	pc,getlin	;read it
	mov	#psword,r5	;point at buffer
	mov	#2,r4		;2 words (6 chars)
	jsr	pc,rad50	;cvt to radix-50
	bcc	130$		;legal password, continue
120$:	jsr	r5,type		;print message
	.word	l.inva,inval
	br	110$		;try again
130$:	jsr	r5,type		;prompt for confirmation
	.word	l.conf,conf
	jsr	pc,getlin	;read password again
	mov	(sp),r5		;point into buffer
	mov	#2,r4		;2 words (6 chars)
	jsr	pc,rad50	;convert
	bcs	140$		;not rad50, mismatch
	mov	(sp)+,r0	;point at one copy
	mov	#psword,r1	;pnt at other copy
	cmp	(r0)+,(r1)+	;compare
	bne	140$		;different, gag
	cmp	(r0),(r1)	;compare
	beq	150$		;same, skip
140$:	jsr	r5,type		;print message
	.word	l.mism,mismat
	br	exit		;croak
150$:	mov	#xrb,r0		;point at xrb
	mov	#512.,(r0)+	;write one block
	mov	#512.,(r0)+	;...
	mov	#buf,(r0)+	;from @#buf
	mov	#2,(r0)+	;to channel 1
	mov	(sp)+,(r0)+	;block #
	clr	(r0)+		;(KB wait time)
	clr	(r0)		;no modifiers
	.write			;write the block back
	clrb	firqb+3		;(=CLSFQ) func=close file
	movb	#2,firqb+4	;channel 1
	calfip			;do it
	br	exit1		;skip
exit:	; close files, exit
	movb	#rstfq,firqb+3	;func=reset all files
	clrb	firqb+4
	calfip
exit1:	.ttech			;echo back on
	jsr	r5,type		;extra lf
	.word	2,crlf
	exit$s			;die
;+
;
; RAD50
;
; Convert a string to radix-50.
; On entry, r0 points to a string, r1 contains the length,
; r5 points to the area in which to store the result,
; and r4 contains the length (words) of the area.
;
; On return, everything is peachy unless C=1,
; in which case the string contained one or more
; non-radix-50 characters.
;
;-
rad50:	clr	r3		;init
	jsr	pc,20$		;do 3 chars
	jsr	pc,10$
	jsr	pc,10$
	mov	r3,(r5)+	;save
	sob	r4,rad50	;loop
;
10$:	;do a single char
	mul	#50,r3		;make space for the char
20$:	tst	r1		;anything left?
	beq	80$		;no, return
	dec	r1		;yes, dec count
	movb	(r0)+,r2	;and get the char
	cmp	#'$,r2		;dollar sign?
	bne	30$		;no
	add	#33,r3		;yes
	rts	pc
30$:	cmp	#'_,r2		;underline?
	bne	40$		;no
	add	#35,r3		;yes, use undefined code
	rts	pc
40$:	cmp	#'.,r2		;decimal point?
	beq	50$		;yes
	cmp	r2,#'0		;digit?
	blo	60$		;no
	cmp	r2,#'9		;hm?
	bhi	60$		;no
50$:	add	#36-'0,r2	;yes, convert to rad50
	br	70$		;skip
60$:	sub	#'A,r2		;letter?
	blo	90$		;no
	cmp	r2,#25.		;hm?
	bhi	90$		;no
	inc	r2		;yes, convert to rad50
70$:	add	r2,r3		;add in
80$:	rts	pc
90$:	tst	(sp)+		;purge stack
	sec			;error
	rts	pc		;fall through to original caller
;+
;
; GETLIN
;
; Read a line from the KB (channel 1);
; hang up and kill job on ^C or HB.
; Return ptr to line in r0, length in r1,
; Z=1 if length is zero.
;
;-
getlin:	mov	#xrb,r1		;point at xrb
	mov	#82.,(r1)+	;length of buffer
	clr	(r1)+		;nothing in it yet
	mov	#kbbuf,r0	;point at buffer
	mov	r0,(r1)+	;save
	clr	(r1)+		;channel 0
	clr	(r1)+		;read next block
	clr	(r1)+		;unlimited wait
	clr	(r1)		;no modifiers
	.read			;read a line
	movb	firqb,r5	;any errors?
	bne	50$		;yes, exit
	mov	r0,r1		;no, copy ptr
	mov	xrb+2,r3	;get length of line read
10$:	movb	(r0)+,r5	;get a char
	cmp	r5,#3		;^C?
	beq	50$		;yes, hang up
	cmp	r5,#40		;space or ctrl char?
	blos	30$		;yes, ignore
	cmp	r5,#'A+40	;lower case?
	blo	20$		;no
	cmp	r5,#'Z+40	;eh?
	bhi	20$		;no
	sub	#40,r5		;yes, convert
20$:	movb	r5,(r1)+	;no, copy
30$:	sob	r3,10$		;loop
	clrb	xrb+6		;see if at begn of line
	.postn			;return column
	tstb	xrb+2		;at begn of line?
	beq	40$		;yes
	jsr	r5,type		;print crlf
	.word	2,crlf
40$:	mov	#kbbuf,r0	;point at string
	sub	r0,r1		;find length
	rts	pc
50$:	jmp	exit		;^Z or something, exit
;+
;
; TYPE
;
; Print string with inline length and addr.
; Must be called through r5.
;
;-
type:	mov	(r5),xrb	;get length
	mov	(r5)+,xrb+2	;twice
	mov	(r5)+,xrb+4	;get ptr
	clr	xrb+6		;channel 0
	clr	xrb+10		;next block
	clr	xrb+14		;RECORD 0%
	.write			;write
	rts	r5		;no, return
;
; Clear out the FIRQB.
;
clrfrq:	mov	#firqb,r5	;point at firqb
	mov	#20,r4		;length=20 words
10$:	clr	(r5)+		;clear out the firqb
	sob	r4,10$		;loop
	rts	pc
;
nouser:	.ascii	<lf>/?Anonymous login - can't set password/
crlf:	.byte	cr,lf
l.nous=	.-nouser
;
pw:	.ascii	<lf>/What is the current password? /
l.pw=	.-pw
;
wrong:	.ascii	<lf>/?Password incorrect/<cr><lf>
l.wron=	.-wrong
;
newpw:	.ascii	<lf>/What do you want the new password to be? /
l.newp=	.-newpw
;
inval:	.ascii	<lf>/%Invalid password/<cr><lf>
	.ascii	/A password may consist of 0 to 6 characters,/<cr><lf>
	.ascii	/each of which may be A-Z, 0-9, $, ., or _./<cr><lf>
	.ascii	/Embedded blanks are not significant./<cr><lf>
l.inva=	.-inval
;
conf:	.ascii	/Reenter the new password to confirm: /
l.conf=	.-conf
;
mismat:	.ascii	/?Passwords do not match - change aborted/<cr><lf>
l.mism=	.-mismat
;
	.even
kbbuf:	.blkb	82.		;keyboard buffer,
buf:	.blkb	512.		;and block buffer for BBUSER.DAT
;
usrnam:	.blkw	4		;username, rad50
psword:	.blkw	2		;password, rad50
; PSWORD must immediately follow USRNAM!
;
	.end	paswrd