; ; Modified for VMS 4 - AJS, AUG 85 ; .TITLE UAF interrogation procedures .SBTTL DECLARATIONS .LIBRARY /SYS$LIBRARY:LIB/ $UAFDEF .PSECT UAFWRT,NOEXE,NOSHR,PIC,RD,WRT ; ; MACROS: ; .macro pushq src movq src,-(sp) .endm .macro popq dst movq (sp)+,dst .endm ; ; EQUATED SYMBOLS ; OUTDSC = 4 PWDDSC = OUTDSC + 4 ENCRYPT = PWDDSC + 4 SALT = ENCRYPT + 4 USRDSC = SALT + 4 RETRY_RLK = 2 ; Number of retries for a locked record SLEEP_RLK = 75 ; ms to sleep before retrying UAF$_NORMAL = -1 UAF$_INVPWD = 0 uaffab: $fab fac=- ; UAF FAB fop=cif,- fns=6,- dns=15,- org=idx,- shr=,- rfm=var,- mrs=uaf$c_length uafrab: $rab rop=rlk,- ; UAF RAB rac=key,- usz=uaf$c_length uafrecord: .blkb uaf$c_length ; UAF record buffer uafnam: .ascii /SYSUAF/ uafdnm: .ascii /SYS$SYSTEM:.DAT/ ; ; AUTODIN-II polynomial table used by CRC algorithm ; AUTODIN: .LONG ^O00000000000,^O03555610144,^O07333420310,^O04666230254 .LONG ^O16667040620,^O15332650764,^O11554460530,^O12001270474 .LONG ^O35556101440,^O36003711504,^O32665521750,^O31330331614 .LONG ^O23331141260,^O20664751324,^O24002561170,^O27557371034 ; The following table of coefficients is used by the Purdy polynomial ; algorithm. They are prime, but the algorithm does not require this. C: .long -83, -1 ; C1 .long -179, -1 ; C2 .long -257, -1 ; C3 .long -323, -1 ; C4 .long -363, -1 ; C5 WAKEDELTA: .LONG -10*1000*SLEEP_RLK, -1 COUNTER: .LONG 0 ENCRYPT_BUF: .BLKB UAF$S_PWD .page .PSECT UAFCODE,NOWRT,SHR,EXE,PIC .SBTTL UAF_OPEN - UAF open/close subroutines .entry openuaf,^m<> ; Opens the UAF file ; $fab_store fab=uaffab,fna=uafnam,dna=uafdnm $open fab=uaffab blbc r0,1$ $rab_store rab=uafrab,ubf=uafrecord,fab=uaffab $connect rab=uafrab 1$: ret .entry closeuaf,^m<> ; Closes the UAF file ; $close fab=uaffab ret .SBTTL UAF_LOCATE - UAF access subroutines ;++ ; These subroutines locate user records in the UAF file randomly by either ; USERNAME or UIC, or sequentially. ; Automatic retry is attempted for locked records. ; ;-- .entry uafunlock,^m<> ; Releases the current record. ; $release rab=uafrab ret .entry uafuiclocate,^m<> ; Locates a record in the UAF file given a UIC. The record is read into ; uafrecord for future processing. ; ; Inputs: ; 4(ap) : UIC to be located ; ; Outputs: ; none ; movb #rab$c_key,uafrab+rab$b_rac movb #1,uafrab+rab$b_krf movb #4,uafrab+rab$b_ksz movl 4(ap),uafrecord+uaf$l_uic moval uafrecord+uaf$l_uic,uafrab+rab$l_kbf brb get_uaf .entry uafuserlocate,^m ; Locates a record in the UAF file given a USERNAME. The record is read into ; uafrecord for future processing. ; ; Inputs: ; 4(ap) : Address of the string containing the required USERNAME ; ; Outputs: ; none ; movb #rab$c_key,uafrab+rab$b_rac clrb uafrab+rab$b_krf movl 4(ap),r1 movzbl (r1)+,r0 movb #uaf$s_username,uafrab+rab$b_ksz movc5 r0,(r1),#32,#uaf$s_username,uafrecord+uaf$t_username moval uafrecord+uaf$t_username,uafrab+rab$l_kbf brb get_uaf .entry uaflocatenext,^m<> ; Locates the next record in sequence in the UAF file. The record is ; read into uafrecord for future processing. ; movb #rab$c_seq,uafrab+rab$b_rac get_uaf: movl #retry_rlk,counter 1$: $get rab=uafrab cmpl r0,#rms$_rlk bneq 2$ decl counter blss 2$ $schdwk_s daytim=wakedelta blbc r0,1$ $hiber_s brb 1$ 2$: ret .SBTTL UAF_READ - UAF record interrogation subroutines .entry uafinfo,^m<> ; Returns the address of the current UAF record ; movab uafrecord, r0 ret .entry uafuic,^m<> ; Returns the UIC from the current UAF record ; movl uafrecord+UAF$l_uic,r0 ret .entry uafaccount,^m ; Returns the ACCOUNT from the current UAF record. Trailing spaces are ; deleted. movl #uaf$s_account-1, r2 moval uafrecord+uaf$t_account,r3 brb strip .entry uafpriv,^m<> ; Returns the quadword priviledge field from the current UAF record ; movq uafrecord+UAF$q_priv,@4(AP) ret .entry uafusername,^m ; Returns the USERNAME from the current uaf record. Trailing spaces ; are deleted. movl #uaf$s_username-1, r2 moval uafrecord+uaf$t_username,r3 brb strip .entry uafowner,^m ; Returns the OWNER from the current UAF record. Trailing spaces are ; deleted. ; movl #uaf$s_owner-1, r2 moval uafrecord+uaf$t_owner,r3 movzbl (r3)+,r2 decl r2 brb strip strip: ; Strips trailing spaces from a character string: ; R2 : Length of string -1 ; R3 : String address ; cmpb (r3)[r2],#32 bneq done sobgeq r2,strip done: incl r2 movl 4(ap),r6 movb r2,(r6) movc3 r2,(r3),1(r6) ret .entry uafdir,^m ; Returns the default directory from the current UAF record. ; movl 4(ap),r6 movzbl uaf$t_defdir+uafrecord,r7 moval uafrecord+uaf$t_defdir,r5 incl r7 movc3 r7,(r5),(r6) ret .entry uafdev, ^m ; Returns default device of user. movl 4(ap), r6 movzbl uaf$t_defdev+uafrecord, r7 moval uaf$t_defdev+uafrecord, r5 incl r7 movc3 r7, (r5), (r6) ret .SBTTL UAF_CHKPASS - Check valid password .entry checkpassword,^m pushab encrypt_buf ; form encryption buffer descriptor pushl #uaf$s_pwd pushab uafrecord+uaf$t_username ; form username descriptor pushl #uaf$s_username movl 4(ap),r0 ; form password descriptor pushab 1(r0) movzbl (r0),-(sp) pushal 8(sp) ; push parameters movzwl uafrecord+uaf$w_salt,-(sp) movzbl uafrecord+uaf$b_encrypt,-(sp) pushab 12(sp) pushaq 32(sp) calls #5,hpwd cmpc3 #uaf$s_pwd,encrypt_buf,uafrecord+uaf$q_pwd bneq 1$ movl #uaf$_normal,r0 ret 1$: movl #uaf$_invpwd,r0 ret .SBTTL HPWD - hash user password subroutine HPWD: .word ^m tstb encrypt(ap) beql 20$ subl2 #20,sp movl sp,r6 movq @USRDSC(ap),(r6) cmpb #1,ENCRYPT(ap) bneq 10$ movc5 (r6),@4(r6),#32,#12,8(r6) movw #12,(r6) movab 8(r6),4(r6) brb 20$ 10$: movzwl (r6),r5 clrw (r6) movl 4(r6),r0 15$: cmpb (r0)+,#32 beql 20$ incw (r6) cmpw #31,(r6) beql 20$ cmpw r5,(r6) beql 20$ brb 15$ 20$: movaq @PWDDSC(ap),r4 tstl (r4) bneq 25$ movaq @OUTDSC(ap),r4 clrw (r4) movc5 #0,(r4),#0,#8,@4(r4) brb 40$ 25$: movaq @OUTDSC(ap),r4 movaq @4(r4),r4 tstb ENCRYPT(ap) bgtru 30$ mnegl #1,r0 movaq @PWDDSC(ap),r1 crc AUTODIN,r0,(r1),@4(r1) clrl r1 movq r0,(r4) brb 40$ 30$: clrq (r4) movaq @PWDDSC(ap),r3 bsbb COLLAPSE_R2 addw2 SALT(ap),3(r4) movl r6,r3 bsbb COLLAPSE_R2 pushaq (r4) calls #1,Purdy 40$: Movl #1,r0 ret COLLAPSE_R2: .enabl LSB ; This routine takes a string of bytes (the descriptor for which is pointed ; to by r3) and collapses them into a quadword (pointed to by r4). It does ; this by cycling around the bytes of the output buffer adding in the bytes ; of the input string. movzwl (r3),r0 ; Obtain the number of input bytes beqlu 20$ moval @4(r3),r2 ; Obtain pointer to input string 10$: bicl3 #-8,r0,r1 ; Obtain cyclic index into output buffer addb2 (r2)+,(r4)[r1] sobgtr r0,10$ ; Loop until input string is exhausted 20$: rsb .dsabl LSB .sbttl Purdy - evaluate Purdy polynomial a=59 ; 2^64 - 59 is the biggest quadword prime n0=1@24 - 3 ; These exponents are prime, but this is n1=1@24 - 63 ; not required by the algorithm. Purdy: .word ^m ; ; This routine computes f(U) = p(U) mod P. Where P is a prime of the form ; P = 2^64 - a. The function p is the following polynomial: ; X^n0 + X^n1*C1 + X^3*C2 + X^2*C3 + X*C4 + C5 ; The input U is an unsigned quadword. ; pushq @4(ap) ; Push U bsbw PQMOD_R0 ; Ensure U less than P movaq (sp),r4 ; Maintain a pointer to X movaq C,r5 ; Point to the table of coefficients pushq (r4) pushl #n1 bsbb PQEXP_R3 ; X^n1 movq (r4),-(sp) pushl #n0-n1 bsbb PQEXP_R3 pushq (r5)+ ; C1 bsbw PQADD_R0 ; X^(n0 - n1) + C1 bsbw PQMUL_R2 ; X^n0 + X^n1*C1 pushq (r5)+ ; C2 movq (r4),-(sp) bsbw PQMUL_R2 ; X*C2 movq (r5)+,-(sp) ; C3 bsbw PQADD_R0 ; X*C2 + C3 movq (r4),-(sp) bsbb PQMUL_R2 ; X^2*C2 + X*C3 movq (r5)+,-(sp) ; C4 bsbw PQADD_R0 ; X^2*C2 + X*C3 + C4 movq (r4),-(sp) bsbb PQMUL_R2 ; X^3*C2 + X^2*C3 + C4*X movq (r5)+,-(sp) ; C5 bsbw PQADD_R0 ; X^3*C2 + X^2*C3 + C4*X + C5 bsbw PQADD_R0 ; Add in the high order terms movq (sp)+,@b^04(ap) ; Replace U with f(X) movl #01,r0 ret PQEXP_R3: .enabl LSB ; Replaces the inputs with U^n mod P where P is of the form P = 2^64 - a. ; U is a quadword, n is an unsigned longword. popr #^m ; Record return address movq #01,-(sp) ; Initialize movq 8+4(sp),-(sp) ; Copy U to top of stack for speed tstl 8+8(sp) ; Only handle n greater than 0 beqlu 30$ 10$: blbc 8+8(sp),20$ movq (sp),-(sp) ; Copy the current power of U movq 8+8(sp),-(sp) ; Multiply with current value bsbb PQMUL_R2 movq (sp)+,b^08(sp) ; Replace with current value cmpzv #1,#31,8+8(sp),#0 beqlu 30$ 20$: movq (sp),-(sp) ; Proceed to next power of U bsbb PQMUL_R2 extzv #1,#31,8+8(sp),8+8(sp) brb 10$ 30$: movq 8(sp),8+8+4(sp) ; Copy the return value movaq 8+8+4(sp),sp ; Discard the exponent jmp (r3) ; return .dsabl LSB u=0 ; Low longword of U v=u+4 ; High longword of U y=u+8 ; Low longword of Y z=y+4 ; High longword of Y PQMOD_R0: .enabl LSB ; Replaces the quadword U on the stack with U mod P where P is of the ; form P = 2^64 - a. popr #^m ; Record return address cmpl v(sp),#-1 ; Replace U with U mod P blssu 10$ cmpl u(sp),#-a blssu 10$ addl2 #a,u(sp) adwc #0,v(sp) 10$: jmp (r0) ; return .dsabl LSB PQMUL_R2: ; Computes the product U*Y mod P where P is of the form P = 2^64-a. ; U, Y are quadwords less than P. The product replaces U and Y on the stack. ; ; The product may be formed as the sum of four longword multiplications ; which are scaled by powers of 2^32 by evaluating: ; 2^64*v*z + 2^32*(v*y + u*z) + u*y ; The result is computed such that division by the modulus P is avoided. popr #^m ; Record return address movl sp,r2 ; Record initial stack value pushl z(r2) pushl v(r2) bsbb EMULQ bsbb PQMOD_R0 bsbb PQLSH_R0 ; Obtain 2^32*v*z pushl y(r2) pushl v(r2) bsbb EMULQ bsbb PQMOD_R0 pushl z(r2) pushl u(r2) bsbb EMULQ bsbb PQMOD_R0 bsbb PQADD_R0 ; Obtain (v*y + u*z) bsbb PQADD_R0 ; Add in 2^32*v*z bsbb PQLSH_R0 ; Obtain first two terms pushl y(r2) pushl u(r2) bsbb EMULQ bsbb PQMOD_R0 ; Obtain third term: u*y bsbb PQADD_R0 ; Add it in movq (sp)+,Y(r2) ; Copy the return value movaq y(r2),sp ; Point the stack to the return value jmp (r1) ; return EMULQ: .enabl LSB ; This routine knows how to multiply two unsigned longwords, replacing them ; with the unsigned quadword product on the stack. emul 4(sp),8(sp),#0,-(sp) clrl -(sp) tstl 4+8+4(sp) ; Check both longwords to see if we must bgeq 10$ ; compensate for the unsigned bias. addl2 4+8+8(sp),(sp) 10$: tstl 4+8+8(sp) bgeq 20$ addl2 4+8+4(sp),(sp) 20$: addl2 (sp)+,4(sp) ; Add in compensation movq (sp)+,4(sp) ; Replace the longwords with their product rsb .dsabl LSB PQLSH_R0: .enabl LSB ; Computes the product 2^32*U mod P where P is of the form P = 2^64 - a. ; U is a quadword less than P. The product replaces U on the stack. ; This routine is used by PQMUL in the formation of quadword products in ; such a way as to avoid division by the modulus P. ; The product 2^64*v + 2^32*u is congruent a*v + 2^32*u mod P (where u, v ; are longwords). popr #^m ; Record return address pushl v(sp) pushl #a bsbb EMULQ ; Puah a*v ashq #32,y(sp),y(sp) ; Form Y = 2^32*u brb 10$ ; Return the sum U + Y mod P PQADD_R0: ; Computes the sum U + Y mod P where P is of the form P = 2^64 - a. ; U, Y are quadwords less than P. The sum replaces U and Y on the stack. popr #^m ; Record the return address 10$: addl2 u(sp),y(sp) ; Add the low longwords adwc v(sp),z(sp) ; Add the high longwords with the carry bcs 20$ ; If the result is greater than a quadword cmpl z(sp),#-1 blssu 30$ cmpl y(sp),#-a ; or simply greater than or equal to P blssu 30$ 20$: addl2 #a,y(sp) ; we must subtract P. adwc #0,z(sp) 30$: movaq y(sp),sp ; Point the stack to the return value jmp (r0) ; Return .dsabl LSB .end