title	pswchk

;Program to analyze a TOPS-10 accounting file
;in order to find badly chosen passwords

;for additional information about this program contact:

;	Dr. Edmund West
;	Computing Services (MP331)
;	255 Huron St.
;	University of Toronto
;	Toronto, Ontario, Canada M5S 1A1
;	(telephone: 416-978-4085)

;the author would also appreciate receiving additional ideas
;which could be included in later versions of the program.

	search	glxmac,ornmac
	prolog	(pswchk)
	parset

;version information

pswver==1
pswmin==0
pswwho==0
pswedt==0

	loc	137
	vrsn.	(psw)
	reloc	0

;assembly options
	nd	a$rc.l,16		;accounting file record length

;default switch values

	nd	d%encrypt,-1		;passwords are encrypted
	nd	d%accname,-1		;check accounting name formats
	nd	d%logname,-1		;check login name formats
	nd	d%ppn,-1		;check ppn formats
	nd	d%words,-1		;check selected passwords
	subttl	macro definitions

;list of possible passwords to be tested by routine "words"

	define	pswlst<
	X	<>			;blank (ie, no password)
	X	ABC
	X	ABCD
	X	ABCDE
	X	ABCDEF
	X	FEDCBA
	X	EDCBA
	X	DCBA
	X	CBA
	X	UVW
	X	UVWX
	X	UVWXY
	X	UVWXYZ
	X	VWXYZ
	X	WXYZ
	X	XYZ
	X	ZYX
	X	ZYXW
	X	ZYXWV
	X	ZYXWVU
	X	YXWVU
	X	XWVU
	X	WVU
	X	123
	X	1234
	X	12345
	X	123456
	X	654321
	X	54321
	X	4321
	X	321
	X	LGN
	X	LOG
	X	LOGI
	X	LOGIN
	X	PASS
	X	PASSW
	X	PASSWO
	X	PASSWD
	X	PASWRD
	X	PSW
	X	PSWD
	X	PSWRD
	X	PSWORD
	X	WORD
	X	WRD
	X	SYS
	X	SYST
	X	SYSTE
	X	SYSTEM
	X	TEST
	X	TESTS
	X	TESTER
	X	EXAMPL
	X	EXAMP
	X	EXAM
	X	LOCK
	X	SECRET
	X	FAILSA
	X	MAINT
	X	DAEMON
	X	DEMON
	X	DEMONS
	X	DEC
	X	DEC10
	X	DEC-10
	X	1090
	X	DECSWS
	X	SWS
>;end of pswlst macro
;special macros

define	$trett<jumpt	.rett>		;if true, return true
define	$fretf<jumpf	.retf>		;if false, return false

;constants

	nd	pdll,100		;push down list length
	nd	a.byt,^d36		;byte size of accounting file
	nd	r.byt,7			;byte size of report file
	nd	slash,ascii\/\		;slash (left justified)
	subttl	data structures

prompt:	asciz\PSWCHK>\			;command prompt
eqlstr:	asciz\= \			;equal is delimiter
iflspc:	asciz\STD:ACCT.SYS\		;input (accounting) file specification
oflspc:	asciz\DSK:PSWCHK.RPT\		;output (report) file specification
ifd%df:	xwd	fdmsiz,5		;default input file descriptor
	sixbit	\STD\
	sixbit	\ACCT\
	sixbit	\SYS\
	exp	0
ofd%df:	xwd	fdmsiz,5		;default output file descriptor
	sixbit	\DSK\
	sixbit	\PSWCHK\
	sixbit	\RPT\
	exp	0

	$data	pdl,pdll		;push down list
	$data	ib,ib.sz		;initialization buffer
	$data	pab,par.sz		;parser argument block
	$data	a$ifn			;accounting file index
	$data	r$ifn			;report file index
	$data	reccnt			;record counter
	$data	mchcnt			;count of matched passwords
	$data	prj6bt			;project number in sixbit
	$data	prg6bt			;programmer number in sixbit
	$data	ppn6bt			;ppn in sixbit
	$data	nam6bt			;accounting name in sixbit
	$data	pswold			;previous password candidate
	$data	outpnt			;points to output routine for glxlib

;data set up by command parser
	$data	fl$encrypt		;flag for encryption
	$data	fl$word			;flag for special word test
	$data	fl$ppn			;flag for ppn test
	$data	fl$accname		;flag for accounting name test
	$data	fl$logname		;flag for login name test

;data read from accounting file
	$data	a$rec,a$rc.l		;accounting file record
	nd	ppn,a$rec		;project programmer number
	nd	psw,a$rec+1		;password (encrypted)
	nd	nm6bt1,a$rec+3		;name, chars 1-6
	nd	nm6bt2,a$rec+4		;name, chars 7-12

a$fob:	exp	a$fd			;acct.sys file open block
	exp	a.byt			;byte size
	nd	a$fo.l,.-a$fob

a$fd:	block	fdxsiz			;accounting file descriptor
	nd	a$fd.l,.-a$fd

r$fob:	exp	r$fd			;report file open block
	exp	r.byt			;byte size
	nd	r$fo.l,.-r$fob

r$fd:	block	fdxsiz			;report file descriptor
	nd	r$fd.l,.-r$fd

pswmsk:					;table of password masks
	maskb(0,3*6-1)			;3 characters
	maskb(0,4*6-1)			;4 characters
	maskb(0,5*6-1)			;5 characters
	maskb(0,6*6-1)			;6 characters
	nd	msk.l,.-pswmsk		;length of password mask table
	subttl	text fields

initxt:	itext	< Password check beginning at ^H/[-1]/
 Report file is ^F/r$fd/
 Examining file ^F/a$fd/
 Switches are: ^A>

fintxt:	itext	< Password check finished at ^H/[-1]/^M^J ^D/mchcnt/ matches found in ^D/reccnt/ accounts^M^J>

hdrtxt:	itext	<
       PPN          User Name     Type      Password
>
fndtxt:	itext	< ^P15L/ppn/    ^W6L/nm6bt1/^W6L/nm6bt2/  ^T10L/@t1/^W6L/p1/>
	subttl	parsing tables

confrm:	$crlf

cmdpdb:	$init(rptpdb)

rptpdb:	$ofile(eqlpdb,<report file specification>,<$pdefault(oflspc),$alternate(eqlpdb)>)

eqlpdb:	$token(accpdb,<=>,<$pdefault(eqlstr),$alternate(swtpdb)>)

accpdb:	$ifile(swtpdb,<accounting file specification>,<$pdefault(iflspc),$alternate(swtpdb)>)

swtpdb:	$switch(,swttbl,<$action(shrswt),$alternate(confrm)>)

swttbl:	$stab
	dsptab(next(swtpdb),w$accname,<accname>)
	dsptab(next(swtpdb),w$all,<all>)
	dsptab(next(swtpdb),w$encrypt,<encrypt>)
	dsptab(next(swtpdb),w$logname,<logname>)
	dsptab(next(swtpdb),w$noaccname,<noaccname>)
	dsptab(next(swtpdb),w$noencrypt,<noencrypt>)
	dsptab(next(swtpdb),w$nologname,<nologname>)
	dsptab(next(swtpdb),w$none,<none>)
	dsptab(next(swtpdb),w$noppn,<noppn>)
	dsptab(next(swtpdb),w$nowords,<nowords>)
	dsptab(next(swtpdb),w$ppn,<ppn>)
	dsptab(next(swtpdb),w$words,<words>)
	$etab
	subttl	pswchk - main program

;initialization section

pswchk:
	jfcl				;no ccl
	reset				;reset the world
	move	p,[iowd pdll,pdl]	;set up stack pointer

	movx	s1,it.oct		;open command terminal for parser
	movem	s1,ib+ib.flg
	move	s1,[sixbit\pswchk\]	;name of program
	movem	s1,ib+ib.prg		;into init block
	movx	s1,ib.sz		;size of initialization block
	movx	s2,ib			;address of initialization block
	$call	i%init			;initialize glxlib
	jumpf	[outstr [asciz\? PSWCHK Cannot initialize GLXLIB\]
		$call	i%exit]		;quit on init failure

	setzb	s1,s2			;clear args
	$call	p$init			;initialize parser
	jumpf	[$fatal(cannot initialize parser)]

cmd:					;here to process commands
	$call	getcmd			;get input command
	jumpf	pswchk			;try again

	setzm	reccnt			;clear record counter
	setzm	mchcnt			;clear match counter

	$call	ttyhead			;output header on tty
;open report file for output
	movx	s1,r$fo.l		;length of block
	movx	s2,r$fob		;address of block
	$call	f%oopn			;open file for output
	jumpf	[$warn(Cannot open report file ^F/r$fd/)
		jumpa	pswchk]		;quit on open error
	movem	s1,r$ifn		;save ifn for file

	$call	rpthead			;output report header

	$text	(rptout,<^M^J^I/hdrtxt/>)
	move	s1,r$ifn		;select report file
	$call	f%chkp			;checkpoint it
	jumpf	[$warn(Cannot checkpoint report file header)
		jumpa	pswchk]		;quit on error

;open accounting file for input
	movx	s1,a$fo.l		;length of block
	movx	s2,a$fob		;address of block
	$call	f%iopn			;open file for input
	jumpf	[$warn(Cannot open accounting file ^F/a$fd/)
		jumpa	pswchk]		;quit on error
	movem	s1,a$ifn		;save ifn for file

;read first word of accounting file to confirm record size
	move	s1,a$ifn		;get ifn for accounting file
	$call	f%ibyt			;read first byte
	jumpf	[$warn(Cannot read accounting file record)
		jumpa	pswchk]		;quit on error
	hrrzs	s2			;extract record size from file
	caxe	s2,a$rc.l		;is it correct?
	 jumpa	[$warn(Accounting record size does not match)
		jumpa	pswchk]		;quit on error
;this is the main loop of program

loop:					;main io loop
	$call	rdrec			;read record from accounting file
	jumpf	rderr			;if error, process it
	skipn	ppn			;is this ppn=0,,0?
	 jumpa	loop			;yes, ignore it
	aos	reccnt			;increment record counter
	$call	check			;check this account
	jumpf	loop			;if no match, get the next one
	$call	found			;found a match, report it
	jumpf	pswchk			;if error, give up
	jumpa	loop			;get the next ppn

rderr:					;here if error reading the file
	caxe	s1,ereof$		;is it an eof?
	 jumpa	[$warn(Cannot read accounting file)
		jumpa	pswchk]		;no, a real error

;here to proceed with normal termination
	$text	(rptout,<^M^J^I/fintxt/>)
	move	s1,r$ifn		;report file index
	$call	f%rel			;close and release the file
	jumpf	[$warn(Error closing report file)
		jumpa	pswchk]		;quit on error
	move	s1,a$ifn		;account file index
	$call	f%rel			;close and release the file
	jumpf	[$warn(Error closing accounting file)
		jumpa]		;quit on error
	$text	(t%tty,<^M^J^I/fintxt/>)

	jumpa	pswchk			;try again
	subttl	header output routines

ttyhead:
	movei	s1,t%tty		;address of terminal output routine
	movem	s1,outpnt		;point to it
	jumpa	outhead			;output the header

rpthead:
	movei	s1,rptout		;address of terminal output routine
	movem	s1,outpnt		;point to it
	jumpa	outhead			;output the header

outhead:
	$text	(@outpnt,<^M^J^I/initxt/>)
	move	s1,[asciz\/NO\]
	skipe	fl$encrypt
	movsi	s1,(slash)
	$text	(@outpnt,< ^T/s1/ENCRYPT^A>)
	move	s1,[asciz\/NO\]
	skipe	fl$words
	movsi	s1,(slash)
	$text	(@outpnt,< ^T/s1/WORDS^A>)
	move	s1,[asciz\/NO\]
	skipe	fl$accname
	movsi	s1,(slash)
	$text	(@outpnt,< ^T/s1/ACCNAME^A>)
	move	s1,[asciz\/NO\]
	skipe	fl$logname
	movsi	s1,(slash)
	$text	(@outpnt,< ^T/s1/LOGNAME^A>)
	move	s1,[asciz\/NO\]
	skipe	fl$ppn
	movsi	s1,(slash)
	$text	(@outpnt,< ^T/s1/PPN^A>)
	$text	(@outpnt,<^M^J>)
	$ret
	subttl	getcmd - prompt user and process the command

getcmd:
	move	s1,[xwd ofd%df,r$fd]	;copy default output file spec
	blt	s1,r$fd+fdmsiz-1
	move	s1,[xwd ifd%df,a$fd]	;copy default input file spec
	blt	s1,a$fd+fdmsiz-1
ifn d%encrypt,<	setom	fl$encrypt		;set encrypt flag>
ife d%encrypt,<	setzm	fl$encrypt		;clear encrypt flag>
ifn d%words,<	setom	fl$words		;set words flag>
ife d%words,<	setzm	fl$words		;clear words flag>
ifn d%ppn,<	setom	fl$ppn			;set ppn flag>
ife d%ppn,<	setzm	fl$ppn			;clear ppn flag>
ifn d%accname,<	setom	fl$accname		;set accounting name flag>
ife d%accname,<	setzm	fl$accname		;clear accounting name flag>
ifn d%logname,<	setom	fl$logname		;set login name flag>
ife d%logname,<	setzm	fl$logname		;clear login name flag>

	movei	s1,cmdpdb		;top of command tree
	movem	s1,pab+par.tb
	movei	s1,prompt		;address of prompt string
	movem	s1,pab+par.pm
	setzm	pab+par.sr		;clear to read from tty

	movx	s1,par.sz		;parser argument block pointers
	movei	s2,pab
	$call	parser##		;parse the command
	move	t1,s2			;save parser return block pointer
	jumpf	[move	s1,prt.fl(t1)	;in case of error
		txnn	s1,p.erro	;was it bad syntax?
		 $fatal(unexpected error return from PARSER)	;no, bad trouble
		$warn(^T/@prt.em(t1)/)	;yes, tell him
		jumpa	getcmd]		;and try again
	move	s1,prt.cm(t1)		;address of parsed data
	addi	s1,com.sz		;address of parser block
	$call	p$setu			;set up for scanning the input

getpbk:
	$call	p$curr			;get current parser block
	jumpe	s1,[$warn(error return from P$CURR)	;legal address?
		$retf]			;no, quit
	hrrz	s1,pfd.hd(s1)		;get data type
	cain	s1,.cmswi		;is it a switch?
	 jumpa	getswt			;yes
	cain	s1,.cmifi		;no, is it an input file?
	 jumpa	getifl			;yes
	cain	s1,.cmofi		;no, is it an output file?
	 jumpa	getofl			;yes
	cain	s1,.cmtok		;no, is it a token?
	 jumpa	gettok			;yes
	cain	s1,.cmcfm		;no, is it a confirm?
	 jumpa	getcfm			;yes

	$warn(unexpected data type (^O/s1/) returned from P$CURR)
	$retf
gettok:				;process a token

	$call	p$tok			;read the token
	jumpf	[$warn(data type error ^O/s1/ in P$TOK)
		$retf]
	jumpa	getpbk

getswt:					;process a switch
	$call	p$swit			;read the switch
	jumpf	[$warn(data type error ^O/s1/ in P$SWIT)
		jumpa	getpbk]
	jumpa	(s1)			;process the switch

getifl:					;process input file spec
	$call	p$ifil			;get input file descriptor
	jumpf	[$warn(data type error ^O/s1/ in P$IFIL)
		$retf]
	movss	s1			;source address in left half
	hrri	s1,a$fd			;destination address in right half
	movei	t1,a$fd+a$fd.l-1	;final destination address
	blt	s1,@t1			;save the file descriptor
	jumpa	getpbk			;get next input field

getofl:					;process output file spec
	$call	p$ofil			;get output file descriptor
	jumpf	[$warn(data type error ^O/s1/ in P$IFIL)
		$retf]
	movss	s1			;source address in left half
	hrri	s1,r$fd			;destination address in right half
	movei	t1,r$fd+r$fd.l-1	;final destination address
	blt	s1,@t1			;save the file descriptor
	jumpa	getpbk			;get next input field

getcfm:					;here to confirm the command

	$call	p$cfm			;get confirmation
	jumpf	[$warn(data type error ^O/s1/ in P$CFM)
		$retf]
	$rett
w$encrypt:
	setom	fl$encrypt		;set encryption flag
	jumpa	getpbk

w$noencrypt:
	setzm	fl$encrypt		;clear encryption flag
	jumpa	getpbk

w$all:
	setom	fl$words		;set words flag
	setom	fl$ppn			;set ppn flag
	setom	fl$accname		;set accounting name flag
	setom	fl$logname		;set login name flag
	jumpa	getpbk

w$none:
	setzm	fl$words		;clear words flag
	setzm	fl$ppn			;clear ppn flag
	setzm	fl$accname		;clear accounting name flag
	setzm	fl$logname		;clear login name flag
	jumpa	getpbk

w$accnam:
	setom	fl$accname		;set accounting name flag
	jumpa	getpbk

w$noaccname:
	setzm	fl$accname		;clear accounting name flag
	jumpa	getpbk

w$lognam:
	setom	fl$logname		;set login name flag
	jumpa	getpbk

w$nolognam:
	setzm	fl$logname		;clear login name flag
	jumpa	getpbk

w$ppn:
	setom	fl$ppn			;set ppn flag
	jumpa	getpbk

w$noppn:
	setzm	fl$ppn			;clear ppn flag
	jumpa	getpbk

w$words:
	setom	fl$words		;set words flag
	jumpa	getpbk

w$nowords:
	setzm	fl$words		;clear words flag
	jumpa	getpbk
	subttl	routine to read a record from the input file

rdrec:					;read accounting file record
	move	s1,a$ifn		;get index
	movsi	t1,-a$rc.l		;accounting record length,,loop index
rdrec1:
	$call	f%ibyt			;read next word
	$fretf				;if error, return error
	movem	s2,a$rec(t1)		;save this word
	aobjn	t1,rdrec1		;if count still negative, get next
	$rett				;done, return true

;routine to process a password match
; p1 = (not encoded) password

found:					;here to report a match
	aos	mchcnt			;count number of matches
	$text	(rptout,<^I/fndtxt/>)
	move	s1,r$ifn		;select report file
	$call	f%chkp			;checkpoint it
	jumpf	[$warn(Cannot checkpoint report file)
		$retf]		;quit on error
	$rett				;return to caller

;routine to pass characters to the report file

rptout:
	move	s2,s1			;put character into s2
	move	s1,r$ifn		;report file index
	$call	f%obyt			;output byte in s2
	jumpf	[$fatal(Cannot write report file)]	;quit if error
	$rett
	subttl	routine to check password

check:					;check this ppn for bad password

	skipn	fl$word			;word check selected?
	 jumpa	chk010			;no, skip this
	setzm	pswold			;yes, clear previous password attempt
	$call	wrdchk			;check password list
	jumpt	[movei	t1,[asciz\word\]	;if found a match, set type
		 $rett]			;and return true
chk010:

	skipn	fl$ppn			;ppn check selected?
	 jumpa	chk020			;no, skip this
	$call	ppnchk			;yes, check user's PPN (various forms)
	jumpt	[movei	t1,[asciz\ppn\]	;if found a match, set type
		 $rett]			;and return true
chk020:

	skipn	fl$accname		;accounting name check selected?
	 jumpa	chk030			;no, skip this
	$call	accnam			;yes, check accounting name
	jumpt	[movei	t1,[asciz\accnam\]	;if found a match, set type
		 $rett]			;and return true
chk030:

	skipn	fl$logname		;login name check selected?
	 jumpa	chk040			;no, skip this
	$call	lgnnam			;login name
	jumpt	[movei	t1,[asciz\lgnnam\]	;if found a match, set type
		 $rett]			;and return true
chk040:
	$retf				;no match, return false
	subttl	routine to test possible passwords

wrdchk:
	movx	p4,list.l		;length of password list
word1:
	sojl	p4,.retf		;if list is exhausted, return false
	move	p1,list(p4)		;get possible password
	$call	compar			;test this candidate
	$trett				;if true, return true
	jumpa	word1			;not true, try next candidate

;table of password candidates

	define	x(a),<sixbit \a\>
list:
	lall
	pswlst
	sall
	nd	list.l,.-list
	subttl	routine to check various forms of the PPN

ppnchk:
	hlrz	t1,ppn			;get project number
	$call	oct6bt			;convert octal to sixbit
	movem	p1,prj6bt		;save it for later
	movx	s1,msk.l		;index for password mask table
ppn0a:
	sojl	s1,ppn1			;if done, try next format
	move	p1,prj6bt		;get sixbit project
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	jumpa	ppn0a			;no match, try next fragment

ppn1:
	hrrz	t1,ppn			;get programmer number
	$call	oct6bt			;convert to sixbit
	movem	p1,prg6bt		;save it for later
	movx	s1,msk.l		;index for password mask table
ppn1a:
	sojl	s1,ppn2			;if done, try next format
	move	p1,prg6bt		;get sixbit programmer
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	jumpa	ppn1a			;no match, try next fragment

ppn2:					;combine project and programmer
	setzm	ppn6bt			;clear ppn test word
	movx	t4,^d6			;maximum number of sixbit bytes
	move	p4,[point 6,ppn6bt]	;pointer to ppn in sixbit (deposit)
	move	p3,[point 6,prj6bt]	;pointer to project in sixbit (load)
ppn2a:
	ildb	t1,p3			;get project byte
	jumpe	t1,ppn2b		;if null, done with prj6bt
	  sojl	t4,ppn2d		;if no more room, test it
	idpb	t1,p4			;store byte
	jumpa	ppn2a			;get the next one
ppn2b:
	move	p3,[point 6,prg6bt]	;pointer to programmer in sixbit (load)
ppn2c:
	ildb	t1,p3			;get programmer byte
	jumpe	t1,ppn2d		;if null input, test it
	  sojl	t4,ppn2d		;if no more room, test it
	idpb	t1,p4			;store byte
	jumpa	ppn2c			;get the next one
ppn2d:
	movx	s1,msk.l		;index for password mask table
ppn2e:
	sojl	s1,ppn3			;if done, try next format
	move	p1,ppn6bt		;get sixbit ppn
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	jumpa	ppn2e			;no match, try next fragment

ppn3:

;here when all the formats fail
	$retf
	subttl	routine to convert the octal number (in t1) to sixbit (in p1)

oct6bt:
	setz	p1,			;clear password ac
	movx	t3,^d12			;maximum number of octal digits
	move	p3,[point 3,t1]	;pointer to octal byte
	movx	t4,^d6			;maximum number of sixbit byte
	move	p4,[point 6,p1]	;pointer to sixbit bytes

;discard leading zeros
oct1:
	sojl	t3,[$fatal(tried to convert 0 to sixbit)]	;quit if all bytes zero
	ildb	t2,p3			;get next octal byte
	jumpe	t2,oct1			;if zero, get next byte
	jumpa	oct3			;non-zero, start processing

;here to get octal bytes (after discarding leading zeros)
oct2:
	sojl	t3,.popj		;if all octal bytes used, return
	ildb	t2,p3			;more to come, get next octal byte
oct3:					;enter here with first good octal byte
	iori	t2,'0'			;convert octal to sixbit
	idpb	t2,p4			;stick into test word
	sojg	t4,oct2			;if room for another sixbit byte, get it
	$ret				;if not, return
	subttl	routine to test various forms of the accounting name

accnam:
	move	t1,nm6bt1		;get accounting name
	movem	t1,nam6bt		;set up test word for processing
	movx	s1,msk.l		;index for password mask table
acc0:
	sojl	s1,acc1			;if done, try next format
	move	p1,nam6bt		;get accounting name
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	jumpa	acc0			;no, try next fragment
	subttl	make copy of accounting name with only letters and digits
acc1:
	setzm	nam6bt			;clear test word
	movx	t3,^d12			;maximum characters in input
	move	p3,[point 6,nm6bt1]	;pointer to accounting name
	movx	t4,^d6			;maximum characters in output
	move	p4,[point 6,nam6bt]	;pointer to sixbit accounting name
acc1a:
	sojl	t3,acc1c		;if input exhausted, test word
	ildb	t1,p3			;get next byte
	jumpe	t1,acc1c		;if input empty, test word now
	caige	t1,'0'			;is character below '0'?
	 jumpa	acc1a			;yes, count it and ignore it
	caile	t1,'9'			;is character in range 0-9?
	 jumpa	acc1b			;yes, include it
	caige	t1,'a'			;is character below 'a'?
	 jumpa	acc1a			;yes, ignore it
	caile	t1,'z'			;is character in range a-z?
	 jumpa	acc1b			;yes, include it
	jumpa	acc1a			;no, ignore it

acc1b:
	idpb	t1,p4			;store next byte
	sojg	t4,acc1a		;if more space, get next byte

;test the modified accounting name
acc1c:
	move	p1,nam6bt		;get modified accounting name
	camn	p1,nm6bt1		;is it same as original?
	 jumpa	acc2			;yes, try next format
	movx	s1,msk.l		;length of password mask table
acc1d:
	sojl	s1,acc2			;if done, try next format
	move	p1,nam6bt		;get accounting name
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	 jumpa	acc1d			;no, try next fragment
	subttl	test part of name following a period (if any)

acc2:
	setzb	s1,nam6bt		;clear flag and test word
	movx	t3,^d12			;maximum characters in input
	move	p3,[point 6,nm6bt1]	;pointer to accounting name
	movx	t4,^d6			;maximum characters in output
	move	p4,[point 6,nam6bt]	;pointer to sixbit accounting name
acc2a:
	sojl	t3,acc2c		;if input exhausted, test word
	ildb	t1,p3			;get next byte
	jumpe	t1,acc2c		;if input empty, test word now
	cain	t1,'.'			;is this a period?
	 aoja	s1,acc2a		;yes, count it and get next byte
	jumpe	s1,acc2a		;no, if no period yet, get next byte

acc2b:	idpb	t1,p4			;store this byte
	sojg	t4,acc2a		;if more space, get next byte

;test the modified accounting name
acc2c:
	jumpe	s1,acc3			;if no period seen, skip test
	movx	s1,msk.l		;length of password mask table
acc2d:
	sojl	s1,acc3			;if done, try next format
	move	p1,nam6bt		;get accounting name
	and	p1,pswmsk(s1)		;convert to fragment
	$call	compar			;test this candidate
	$trett				;if matches, return true
	jumpa	acc2d			;no, try next fragment

acc3:

	$retf				;return false
	subttl	routine to test user's login (ie, SWITCH.INI) name

	nd	s.byt,7			;byte size of user's switch.ini file

	$data	inpsav			;word to save last input character
	$data	qqf			;double quote flag
	$data	s$ifn			;switch.ini file index
s$fob:	exp	s$fd			;user's SWITCH.INI file open block
	exp	s.byt			;byte size
	nd	s$fo.l,.-s$fob

s$fd:	xwd	s$fd.l,.fdnat		;length of fd,,native format
	sixbit	\all\			;device
	sixbit	\switch\		;filename
	sixbit	\ini\			;extension
s$ppn:	exp	0			;ppn
	nd	s$fd.l,.-s$fd

lgnnam:
	move	t1,ppn			;get this ppn
	movem	t1,s$ppn		;set up ppn for this user
	movx	s1,s$fo.l		;length of file open block
	movx	s2,s$fob		;address of file open block
	$call	f%iopn			;open file for input
	$fretf				;if cannot open file, return false
	movem	s1,s$ifn		;save ifn for file

;fall through to process the user's switch.ini file
	subttl	read lines in file to find login line

lgn1:
	$call	f%ibyte			;read first byte in line
	jumpf	nofile			;if error, release file
	caie	s2,"L"			;upper case ok?
	cain	s2,"l"			;no, lower case ok?
	 skipa				;yes, check next character
	  jumpa	lgnlin			;no, process rest of input line
	$call	f%ibyte			;read second byte in line
	jumpf	nofile			;if error, release file
	caie	s2,"O"			;upper case ok?
	cain	s2,"o"			;no, lower case ok?
	 skipa				;yes, check next character
	  jumpa	lgnlin			;no, process rest of input line
	$call	f%ibyte			;read third byte in line
	jumpf	nofile			;if error, release file
	caie	s2,"G"			;upper case ok?
	cain	s2,"g"			;no, lower case ok?
	 skipa				;yes, check next character
	  jumpa	lgnlin			;no, process rest of input line
	$call	f%ibyte			;read fourth byte in line
	jumpf	nofile			;if error, release file
	caie	s2,"I"			;upper case ok?
	cain	s2,"i"			;no, lower case ok?
	 skipa				;yes, check next character
	  jumpa	lgnlin			;no, process rest of input line
	$call	f%ibyte			;read fifth byte in line
	jumpf	nofile			;if error, release file
	caie	s2,"N"			;upper case ok?
	cain	s2,"n"			;no, lower case ok?
	 skipa				;yes, check next character
	  jumpa	lgnlin			;no, process rest of input line
;here to scan the login line for the /name switch

lgn2:
	$call	f%ibyt			;read a character
	jumpf	nofile			;if error, return false
lgn2a:
	caie	s2,.chcrt		;carraige return?
	cain	s2,.chlfd		;or line feed?
	 jumpa	lgnlin			;yes, read to end of line
	caie	s2,"/"			;no, is this a slash?
	 jumpa	lgn2			;no, read the next character

;here if found "/"
	setzm	qqf			;clear the double quote flag
	$call	f%ibyt			;read a character
	jumpf	nofile			;if error, return false
	caie	s2,"N"			;upper case ok?
	cain	s2,"n"			;no, lower case ok?
	skipa				;yes, read next character
	 jumpa	lgn2a			;no, search for next switch

;here if found "/N"
	$call	f%ibyt			;read a character
	jumpf	nofile			;if error, return false
	caie	s2,"A"			;upper case ok?
	cain	s2,"a"			;no, lower case ok?
	skipa				;yes, read next character
	 jumpa	lgn2a			;no, search for next switch
;here if found "/NA"; now search for the colon
lgn3:
	$call	f%ibyt			;read a byte
	 jumpf	nofile			;if error, return false
lgn3a:
	caie	s2,.chcrt		;carraige return?
	cain	s2,.chlfd		;or line feed?
	 jumpa	lgnlin			;yes, read to end of line
	caie	s2,":"			;no, is this a colon?
	 jumpa	lgn3			;no, read the next byte

;here to read the switch value (ie, login name)

lgn3b:
	setzm	nam6bt			;clear test word
	$call	f%ibyt			;read a byte
	jumpf	nofile			;if error, return false
	caie	s2,.chcrt		;carraige return?
	cain	s2,.chlfd		;or line feed?
	 jumpa	lgnlin			;yes, read to end of line
	caie	s2,42			;no, is this a double quote?
	 jumpa	lgn4			;no , read the login name
	setom	qqf			;yes, set the double quote flag
	$call	f%ibyt			;and read the next byte
	jumpf	nofile			;if error, return false
;here to process the login name itself

lgn4:
	movx	t4,^d6			;maximum bytes in password
	move	p4,[point 6,nam6bt]	;pointer to test word
lgn4a:
	movem	s2,inpsav		;save this character
	sojl	t4,lgn5			;if input done, process the word
	skipn	qqf			;is quoted input in effect?
	 jumpa	lgn4b			;no, process normally
	cain	s2,42			;yes, is it a double quote?
	 jumpa	lgn5			;yes, process the word
	jumpa	lgn4c			;no, accept anything except end of line
lgn4b:
	cain	s2,"/"			;is it a slash?
	 jumpa	lgn5			;yes, process the word
lgn4c:
	caie	s2,.chcrt		;is it a carraige return?
	cain	s2,.chlfd		;or line feed?
	 jumpa	lgn5			;yes, process the word
	caige	s2,140			;no, convert to sixbit. upper case?
	 addi	s2,40			;yes, change range
	andi	s2,77			;retain only six bits
	idpb	s2,p4			;no, use this byte
	$call	f%ibyt			;read a byte
	jumpf	nofile			;if error, return false
	jumpa	lgn4a			;and get the next one
;here to process this password candidate

lgn5:
	move	s2,inpsav		;restore the last character
	movx	p4,msk.l		;length of password mask table
lgn5a:
	sojl	p4,lgn2a		;if done, continue parsing this line
	move	p1,nam6bt		;get the word
	and	p1,pswmsk(p4)		;convert to fragment
	$call	compar			;test this candidate
	jumpt	[move	s1,s$ifn	;if a match,
		$call	f%rel		;release file
		$rett]			;and return true
	jumpa	lgn5a			;not a match, try next fragment
;here to read to the end of the present line

lgnlin:
	cain	s2,.chlfd		;is this a line feed?
	 jumpa	lgn1			;yes, process the next line
	$call	f%ibyte			;no, read next byte
	jumpf	nofile			;if error, release file
	jumpa	lgnlin			;process this character

nofile:					;here for any failure after file opened
	move	s1,s$ifn		;get index
	$call	f%rel			;release file
	$retf				;and return false
	subttl	routine to compare test password with the real one

;call with  test password in p1
;
;	$call	compar
;
;return:	true:	password matched
;		false:	no match
;
;	p1 = original contents

compar:

	skipe	fl$encrypt		;processing encrypted passwords?
	 jumpa	comencrypt		;yes, go do it
	came	p1,psw			;no, are they the same?
	 $retf				;no, return false
	$rett				;yes, return true

comencrypt:				;here if passwords are encrypted
	camn	p1,pswold		;is this same as last try?
	 $retf				;yes, return false
	movem	p1,pswold		;no, save it for later
	$call	encode			;hash it
	came	p1,psw			;does it match the true hashed password?
	 jumpa	[move	p1,pswold	;no, restore previous candidate
		$retf]			;and return false
	move	p1,pswold		;yes, restore the password
	$rett				;and return true
	subttl	encode - routine to encrypt potential passwords

;this routine is copied from LOGIN
;ACs used: T1,T2,T3,T4,P1

;ROUTINE TO HASH-CODE THE PASSWORD FOR GREATER SECURITY
;HASHING FUNCTION IS NON-INVERTIBLE
;CALL:	MOVE	P1,[PASSWORD]
;	PUSHJ	P,ENCODE##
;	RETURN HERE WITH HASHED PASSWORD IN P1

ENCODE::MOVE	T2,P1		;GET PSWD IN T2
	MOVE	T1,T2		;AND T2
	HRRZ	T4,PPN		;GET PROGRAMMER NUMBER
	IDIVI	T2,(T4)		;DIVIDE INTO PASSWORD
	MOVM	T3,T3		;GET ABS(REMAINDER)
	MOVE	T4,T3		;COPY FOR A LOOP COUNTER
FOO:	MUL	T1,T1		;SQUARE THE PASSWORD
	ROTC	T1,^D18		;GET MIDDLE 36 BITS OF RESULT
	JUMPN	T1,.+2		;MAKE SURE NON-ZERO
	MOVE	T1,T2		;IF ZERO, PICK UP PSWD AGAIN
	SOJG	T4,FOO		;DO THIS A LARGE (RANDOM) NO. OF TIMES
	XOR	T1,P1		;MUNGE IT STILL MORE
	IDIVI	T3,^D35		;DIVIDE LOOP COUNTER
	ROT	T1,1(T4)	;ROTATE T1 BY REMAINDER
	MOVE	P1,T1		;COPY FINAL RESULT BACK TO P1
	POPJ	P,		;ALL DONE!

	end	pswchk