.TITLE VMS$PASSWORD_POLICY
;
;  Sample site password policy module
;
;  Analyzes plaintext password, counting character types.
;  Resultant variables:
;
;    CountSpecial, CountUpper, CountLower, CountNumeric
;
;  countain counts of each type of character.
;
;    PresSpecial, PresUpper, CountPres, CountPres
;
;  are presence flags, 0 if there are none of that type 
;  of character in the string, 1 if there are.
;
;  There are also counts and flags for Control characters and
;  Invalid characters. These should not occur as the normal
;  OpenVMS filtering should reject them before this module
;  is invoked.
;
;  Results can be used to test password against a complexity
;  policy. In this example, there is commented code which
;  checks that one of each type of character is presence. The
;  working path checks that at least 3 of the 4 possible types
;  are present.
;  
;  Author: John Gillings
;
;  Usage:
;
;  $ MACRO VMS$PASSWORD_POLICY
;  $ LINK/SHAREABLE/SYSEXE VMS$PASSWORD_POLICY+SYS$INPUT:/OPTIONS
;SYMBOL_VECTOR = ( -
;POLICY_PLAINTEXT=PROCEDURE,-
;POLICY_HASH=PROCEDURE)
;
;  $ COPY VMS$PASSWORD_POLICY.EXE SYS$COMMON:[SYSLIB]/PROT=(W:RE)
;  $ INSTALL ADD SYS$LIBRARY:VMS$PASSWORD_POLICY/OPEN/HEAD/SHARE
;  $ MCR SYSGEN
;SYSGEN> USE ACTIVE
;SYSGEN> SET LOAD_PWD_POLICY 1
;SYSGEN> WRITE ACTIVE
;
;  Note - it's recommended that the CURRENT parameter for LOAD_PWD_POLICY
;  be 0. The USE ACTIVE, SET, WRITE ACTIVE sequence should be included in
;  the startup procedure after INSTALL ADD is confirmed to have worked.
;  Leaving it all to happen automatically may disable changing passwords
;  altogether.
;

	$SSDEF

	.PSECT $RWDATA,RD,WRT,NOEXE
CountTab:.LONG ; Counter table, will get counts of each character type
	CountControl: .LONG
	CountSpecial: .LONG
	CountNumeric: .LONG
	CountUpper:   .LONG
	CountLower:   .LONG
	CountInvalid: .LONG
PresTab:.LONG  ; presence table, will get flags set to 1 if present
	PresControl: .LONG
	PresSpecial: .LONG
	PresNumeric: .LONG
	PresUpper:   .LONG
	PresLower:   .LONG
	PresInvalid: .LONG

	.PSECT $RODATA,RD,NOWRT,NOEXE
CharTab:  ; ASCII table, defines character types
          ;  I'm fairly sure this is correct, but please 
          ;  check before deployment.
          ;  1 = Control
          ;  2 = Special
          ;  3 = Numeric
          ;  4 = Uppercase
          ;  5 = Lowercase
          ;  6 = Invalid
	.BYTE 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;   1-15
	.BYTE 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ;  16-31
	.BYTE 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2 ;  32-47
	.BYTE 3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2 ;  42-63
	.BYTE 2,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4 ;  64-79
	.BYTE 4,4,4,4,4,4,4,4,4,4,4,3,3,3,3,3 ;  80-95
	.BYTE 3,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5 ;  96-111
	.BYTE 5,5,5,5,5,5,5,5,5,5,5,3,3,3,3,6 ; 112-127
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6 ; 128-255 invalid
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6
	.BYTE 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6

	; Message to output if password string fails policy check
badpwd: .ASCID -
  /%SYSTEM-F-PWDPOLICY, Password does not conform to security policy/

	.PSECT $CODE,RD,EXE,NOWRT

	.ENTRY POLICY_HASH,^M<>	; no need to mess with the hash value
	MOVL #SS$_NORMAL,R0	; always success
	RET

	.ENTRY POLICY_PLAINTEXT,^M<R3,R4,R7,R8>
	MOVAQ  @4(AP),R3	; Get address of descriptor for plaintext password
	MOVZWL   (R3),R7	; Get password length
	MOVL    4(R3),R8	; Get pointer to start of string

;
;  Clear character type counters and presence flags
	CLRL CountControl
	CLRL CountSpecial
	CLRL CountNumeric
	CLRL CountUpper
	CLRL CountLower
	CLRL CountInvalid

	CLRL PresControl
	CLRL PresSpecial
	CLRL PresNumeric
	CLRL PresUpper
	CLRL PresLower
	CLRL PresInvalid

;  Now step through the password counting character types

nloop:	MOVZBL (R8)+,R4		; Get next character		
	MOVB CharTab[R4],R4	; Get character type
	INCL CountTab[R4]	; Increment type counter
	MOVL #1,PresTab[R4]	; Set presence flag
	SOBGTR R7,nloop         ; countdown loop

;	TSTL CountSpecial
;	BEQL bad
;	TSTL CountNumeric
;	BEQL bad
;	TSTL CountUpper
;	BEQL bad
;	TSTL CountLower
;	BEQL bad

	MOVL PresSpecial,R4	; take sum of presence flags
	ADDL PresNumeric,R4
	ADDL PresUpper,R4
	ADDL PresLower,R4
	CMPL R4,#3		; Require at least 3 different types
	BLSS bad

ok:	MOVL #SS$_NORMAL,R0	; return OK
	RET

bad:    PUSHAB badpwd		; issue message
	CALLS #1,G^LIB$PUT_OUTPUT	
	MOVL #SS$_PWDWEAK,R0	; return "password weak"
	RET

	.END