program recordpasswords
c Copyright (c) 1994 Glenn C. Everhart
c All Rights Reserved
c create logicals that get used for file passwords.
c The logical names are computed from the file ID and the
c values are a scramble on the entered password, with the
c value XORed with a value 128+n,n=1 to 16 to make it more
c difficult to see them with show logical. This means of course
c that we get the password entered here and then must pre-xor it
c after our scramble so the next xor gets back to what's in the
c file. Idea is to make the passwords harder to forge.
c	subroutine dolog(isaccok,buf,dskrec,uace,mdace)
c see if access is OK
	integer*4 isaccok
	integer*4 buf(128),uace(256),mdace(256)
	include '($jpidef)'
	integer*4 iprv(2),sys$getjpiw,iuic
	external sys$getjpiw
        integer*4 iosb(2),jpiitm(3,7),KIOS
        integer*2 jp2itm(6,7),kfid(4)
	integer*4 k4fid(2)
	equivalence(k4fid(1),kfid(1))
        equivalence(jpiitm(1,1),jp2itm(1,1))
	character*20 clognm
	character*80 wcmd,wfid,wpwd
	integer*4 clogln,lwcmd,ipt
	external lib$sys_trnlog,lib$set_logical
        external lib$get_foreign
c	byte ttyspb(32),imgspb(256),unamb(32)
	jp2itm(1,1)=32
        jp2itm(2,1)=JPI$_UIC
        jpiitm(2,1)=%loc(IUIC)
        jpiitm(3,1)=0
        jp2itm(1,2)=0
        jp2itm(2,2)=0
        jpiitm(2,2)=0
        jpiitm(3,2)=0
        jp2itm(1,3)=0
        jpiitm(3,6)=0
        jpiitm(1,7)=0
        jpiitm(2,7)=0
        jpiitm(3,7)=0
	isaccok=1
c is there a file password? If so we have a hash here that is non
c zero. See if a logical of form EZ$hexfileid contains our hashed
c password as stored.
c Passwords are initially checked in the user's process table
c (courtesy of a kernel AST), then in the group/sys tables
c with our UIC set to the victim's. We use 'em if we get 'em.
c
c In practice this isn't as useful as one would like since "show logicals"
c will show the values...sort of.
c get the UIC of the current process
	kk=sys$getjpiw(%val(1),,,jpiitm,iosb,,)
        istat=lib$get_foreign(wcmd,'FID,passwd>',lwcmd,ipt)
c expect fid string (filnum,seq,rvn), space, password
	llp=index(wcmd,'(')
	if(llp.le.0)return
	lrp=index(wcmd,')')
	if(lrp.eq.0)return
	if(llp.ge.lrp)return
	wfid=wcmd(llp+1:lrp-1)
	icomm=index(wfid,',')
	if(icomm.le.1)return
	read(wfid(:icomm-1),20)lfilno
	ifilno=lfilno
20	format(i)
	wfid=wfid(icomm+1:)
	icomm=index(wfid,',')
	if(icomm.le.1)return
	read(wfid(:icomm-1),20)ifilsq
	wfid=wfid(icomm+1:)
	icomm=ivlen(wfid,80)
	read(wfid(:icomm),20)irvn
c now the fid is available. Encode like vms does.
	ixfid=ifilno/65536
	ifilno=ifilno.and.65535
	ixfid=ixfid.and.255
	irvn=irvn+(256*ixfid)
	kfid(1)=ifilno
	kfid(2)=ifilsq
	kfid(3)=irvn
	kfid(4)=0
	write(wfid(1:15),21)k4fid(1),kfid(3)
21	format('EZ$',z8.8,z4.4)
c now we have the hex file ID as needed for the logical name.
c Now grab the password & muck with it like we do for marking
c the file.
c
c (We assume this gets driven be a dcl script since
c f$file_attributes(filename,"fid") gives the fid string as we
c read it here.)
	ispc=index(wcmd,' ')
	wcmd=wcmd(lrp+1:)
	lwcmd=ivlen(wcmd,80)
22	continue
c skip any spaces
	ispc=index(wcmd,' ')
	if(ispc.eq.0.or.ispc.ge.lwcmd)goto 23
	wcmd=wcmd(2:)
	lwcmd=ivlen(wcmd,80)
	goto 22
c there are 8 bytes of stored password.
23	continue
c now get password values
	call getpv(wcmd(:lwcmd),lwcmd,ilo,ihi)	
c xor with 3 * uic
	kuic=3*iuic
	ilo=ieor(ilo,kuic)
	ihi=ieor(ihi,kuic)
	write(clognm(1:16),34)ilo,ihi
34	format(2z8.8)
c now pre-xor before building the logical
	do 35 n=1,16
	m=n+128
	ii=ichar(clognm(n:n))
	ii=ieor(ii,m)
c this ensures the value isn't printable ASCII, which will make it a little
c harder to crack.
	clognm(n:n)=char(ii)
35	continue
c 
c now store the logical
c (note: if we need to make it a system or group logical, dcl can do this.)
c
	ii=lib$set_logical(wfid(1:15),clognm(1:16),,,)
	call exit
c	return
	end
	integer*4 function ivlen(arg,len)
	integer*4 len
	character*(*) arg
c return length of printable string
	do 1 n=1,len
	k=len+1-n
c go back in loop looking for a printing char.
	if(ichar(arg(k:k)).gt.32)goto 2
1	continue
	ivlen=0
	return
2	continue
	ivlen=k
	return
	end
	subroutine getpv(pwd,lpwd,ilo,ihi)
	character*80 pwd
	integer*4 ilo,ihi,lpwd
	ilo=0
	ihi=0
c crazy little function of password string to produce a couple of
c different values. Lossy, but that's what we want.
	do 1 n=1,lpwd
	khar=ichar(pwd(n:n))
	ilo=ilo*3 + khar
	ihi=ihi*5 + khar
	if(ilo.lt.0)ilo=ilo+1
	if(ihi.lt.0)ihi=ihi+1
1	continue
	return
	end