.title	jtscramble
; Copyright (c) 1993, 1994, 1995, 1996 Glenn C. Everhart
; All Rights Reserved
; JT authorize scrambler generator.
; Glenn C. Everhart
; Embodies code to generate the "authentication" part of
; our ACEs in an image, rather than straight DCL, to keep it a
; bit harder to reverse engineer.
	.library /sys$library:lib.mlb/
	$fabdef
	$namdef
	$acedef
	$atrdef
	$fibdef
;
	.if	ndf,evax
	.macro .jsb_entry in,out
;entry in out
	.endm
	.endc
; auth -
; call: r0,r1 = security info
;       r2,r3 = file ID
;       (r11)key; ucb ptr in r5
; output in r0,r1 = auth string
auth: .jsb_entry input=<r0,r1,r2,r3,r8,r10,r11>,output=<r0,r1>
; simple minded scrambler
	movl	(r10),r0
	movl	4(r10),r1	;get security info
	movl	(r9),r2		;get file id
	movl	4(r9),r3
        xorl2   r3,r0
        xorl2   r2,r1
        xorl2   0(r11),r0
        xorl2   4(r11),r1   ;bunch of xors to scramble
; now xor once more with a constant
        xorl2   #^x5218fba2,r0
        xorl2   #^xaba7126c,r1
; Xors are too simple. since this represents a security risk, we need a
; more reasonable authentication cipher. Adding some random bits in and
; crossing between 32 bit halves should help some...so go ahead and
; do the messup. Same as in jtdriver...
; The final FFSs make the result not simple combinatorics of the
; pieces, so should make the thing harder to break.
        pushl   r0
        pushl   r1
        ashl   #3,r0,r0
        addl2   r0,r1
        addl2   r2,r1
; (sp) is old r1
;4(sp) is old r0
        addl2   r1,4(sp)
        movzwl  5(r11),r1
        addl2   r1,4(sp)
        movl    (sp),r1         ;get old r1
        ashl    #5,r1,r1
        addl2   r3,r1
        addl2   r1,(sp)         ;mix up r1
        movzwl  1(r11),r1
        addl2   r1,(sp)
;for weirdness use a couple ffs's
        ffs     #0,#32,(sp),r1
        addl2   r1,4(sp)
        ffs     #0,#32,4(sp),r1
        addl2   r1,(sp)
        popl    r1
        popl    r0
	movl	r0,(r8)+
	movl	r1,(r8)		;return result
        rsb
; call jtscr(sekey,secinfo,fid,auth)
; outputs auth.
	.entry	jtscr,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	4(ap),r11	;sec key info
	movl	8(ap),r10	;security info (priv mask or ident)
	movl	12(ap),r9	;file id
	movl	16(ap),r8	;where to store info at end
	jsb	auth		;produce the scramble
	movl	#1,r0
	ret
;getfid(fab,fidadr)
	.globl	getfid
	.entry	getfid,^m<r2,r3,r4,r5>
; Get FID and return to arg 2 buffer. Arg1 = fab addr
	movl	4(ap),r2	;get fab address
	movl	fab$l_nam(r2),r3	;get nam blk address
	movl	8(ap),r4		;output pid address
	movab	nam$w_fid(r3),r3	;point at 6 bytes of fid
	movl	(r3)+,(r4)+		;store pid
	movw	(r3)+,(r4)+		;(6 bytes)
	ret
	.psect dat2
iosb:	.long	0,0
lpct:	.long	0
vchn:	.long	0
gcelit: .ascii  /GCEV/  ;special literal
rtnst:  .long   0       ;return status
ainbf:  .blkb   4       ;hdr here
        .blkl   1       ;my "call dmn" flg or 0
gcetgt: .long   0       ;will be "GCEV" for my ACEs
        .blkl   224     ;data
        .blkl   8       ;safety
fid:    .long   0,0     ;file id scratch storage
; scratch FIB to read acl with an entry at a time
myfib:  .long   <fib$m_nolock+fib$m_norecord>
fibfid: .blkw   3       ;fid
fibdid: .blkw   3       ;did
fibctx: .long   0       ;wc context
        .long   0       ;nmctl/exctl
        .long   0,0,0,0,0,0
fibacx: .long   0       ;acl context
fibast: .long   0       ;acl status
fibgst: .long   0       ;status
myfibl=.-myfib-2        ;size
; descriptors for io$_access
mf3tp1: .word   255
        .word   atr$c_addaclent
        .globl  myfdsc
myfdsc:
mfdsc:  .long   myfibl
        .address        myfib   ;open by file id
; Itemlist to get old ace, delete it, add replacement one.
myil3:  .word   255     ;length of itemlist item
        .word   atr$c_fndacetyp ;find ace
        .address        uace            ;of our type
myin2:  .word   255
        .word   atr$c_delaclent ;delete an acl entry...
        .address        uace    ;namely the old one
; locs to zero if the ace is empty now (0 in byte 16)
        .long   0
uace:   .blkb   256     ;copy of our ACE
	.psect cod2
; redacl(fid,myacebuf,vchn)
; fid = 8 bytes
; myacebuf = 256 byte buffer
p1=4
p2=8
p3=12
	.entry	redacl,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movzwl	@p3(ap),vchn	;get channel
	bleq	999$		;skip if illegal
	movq	@p1(ap),fibfid		;get the file id
	bsbw	getace
;if r0=1 on return, we got an ACE, copy to caller, else he zeroes it
	blbc	r0,999$			;on error just return to caller
	pushl	r0	;preserve success status
	movc3	#255,ainbf,@p2(ap)	;copy ace to user buffer
	popl	r0
999$:
	ret
; getace - Entry to read an ACL for our ACE (if any) (used where
; the ACL is too long so we can't tell if our ACE is there or not.)
getace: .jsb_entry output=<r0>
	clrl	lpct
	clrl	fibacx		;init acl context
	clrl	fibast
        clrl    fibctx		;init fib context
        clrl    fibdid        ;clear the DID...
        clrw    fibdid+4       ;...fid all out
        pushr   #^m<r0,r1,r2,r3,r4,r5,r6,r7>
	movc5	#0,fibctx,#0,#48,fibctx	;clr fib generally past fid
100$:
        movab   myil3,r7        ;address of itemlist
	incl	lpct
	cmpl	lpct,#250	;max tries (got to terminate somewhere)
	bgeq	200$		;if over this then exit
; processed here again, though it may be processed in other entries.
        $qiow_s efn=#0,chan=vchn,iosb=iosb,func=#io$_access,p1=mfdsc,p5=r7
        movl    iosb,r6         ;get result for debug
	blbc	r6,200$		;exit on error/end
	blbc	fibast,200$	;exit on ast status err
	blbc	r0,200$		;on qio call or i/o status
	cmpl	gcelit,gcetgt	;our entry?
	beql	300$		;if eql yes...
	brb	100$		;else no, look some more
200$:
        popr    #^m<r0,r1,r2,r3,r4,r5,r6,r7>
	movl	#2,r0		;flag error to caller
	rsb
300$:
        popr    #^m<r0,r1,r2,r3,r4,r5,r6,r7>
	movl	#1,r0		;flag NO error to caller
	rsb
	.end