$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 11-JAN-1991 22:34:25.50   By user TNIELAND 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.TXT;1
$!       2. ADD_DICTIONARY.FOR;1
$!       3. BUILD_PASSWORD_POLICY.COM;1
$!       4. PASSWORDS.DAT;1
$!       5. VMS$PASSWORD-POLICY-WORDS.FDL;1
$!       6. VMS$PASSWORD_POLICY.FOR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XThis is a VMS Password Policy Module to screen passwords before they are set
V.
X
XThis code will only work with VMS 5.4 or greater.
X
XThis module does not allow the password to be the following:
X
X`09The username and variations on such
X`09The account name from the UAF and variations on such.
X`09Variations of the owner field from the UAF
X`09Any word in a data file supplemental to the VMS provided dictionary.
X
XTo build and install this module, execute the command procedure
XBUILD_PASSWORD_POLICY.COM.  Afterwards, make sure you add the following line
V:
X
X`09$ INSTALL ADD SYS$LIBRARY:VMS$PASSWORD_POLICY.EXE
X
Xto you SYS$MANAGER:SYSTARTUP_V5.COM file.
X
XAn auxilary program is ADD_DICTIONARY which will allow you to add words
Xto the supplemental dictionary.  It will add words that are not already in
Xthe VMS dictionary or the supplementary dictionary.
X
XIf you have a large number of words you would like to add to the supplementa
Vl`20
Xdictionary, put them into a flat data file, one word to a line, ASSIGN the`2
V0
Xfile to SYS$INPUT: and then run the ADD_DICTIONARY program.  It will read al
Vl`20
Xthe words from the file and add them, if needed to the supplemental`20
Xdictionary.  The ADD_DICTIONARY program can also be run interactively.
X
X(The supplement dictionary is used rather than adding words to the VMS`20
Xprovided dictionary to prevent those changes from being lost in future`20
Xupgrades/updates of the operating system.)
X
X
XTed Nieland
Xted@nieland.dayton.oh.us
X
XControl Data Corporation
X(513) 427-6355
$ CALL UNPACK AAAREADME.TXT;1 1581035052
$ create 'f'
XC***********************************************************************
XC System Name:   VMS Password Policy
XC
XC Module Name:   Add_Dictionary
XC
XC Version:`09 1.0
XC
XC Programmer:    M. Edward (Ted) Nieland
XC
XC Date Created:  January 1991
XC
XC Brief Description of Module Function:
XC
XC Adds words to a supplementary dictionary for use by the`20
XC associated VMS Password Policy module to reference.
XC
XC This program will only add the word if the word is not in the
XC VMS password dictionary or in the supplemental password
XC dictionary
XC
XC
XC Revision History:
XC---------------------------------------------------------------------------
V----
XC`7C Date      `7C Name            `7C Reason  (SPR # if applicable)     `7C
V Version # `7C
XC---------------------------------------------------------------------------
V----
XC`7C           `7C                 `7C                                   `7C
V           `7C
XC---------------------------------------------------------------------------
V----
XC
XC Data Dictionary:  `20
XC
XC Inputs:`09File SYS$LIBRARY:VMS$PASSWORD-POLICY-WORDS.DATA
XC               File SYS$LIBRARY:VMS$PASSWORD_DICTIONARY.DATA
XC
XC
XC Outputs:     `20
XC
XC Local Variables:   `20
XC                     Stat     I - Return status
XC                     L        I - String Length of WORD
XC                     K        I - Indice Counter
XC                     WORD     C - Password to check
XC                     READWORD C - Word read from file
XC                     SAMEWORD B - Array equivalenced to WORD
XC`20
XC Global Variables:
XC
XC Functions called:     LENSTR         I - Character string length
XC                       STR$UPCASE     I - Change a string to uppercase   `2
V0
XC                                                                        `20
V     `20
XC
XC Subroutines called:   LIB$SIGNAL  - Signal error
XC
XC***********************************************************************
XC
X
X`09program edit_dict
X
X
X`09implicit none
X`09integer stat, l, lenstr, k, str$case_blind_compare
X`09character*32 word, readword
X`09byte sameword(32)
X
X
X`09equivalence (word,sameword)
X
XC
XC Open input and output data streams
XC
X
X`09OPEN(UNIT=5,FILE='SYS$INPUT:',STATUS='OLD')
X`09OPEN(UNIT=6,FILE='SYS$OUTPUT:',STATUS='OLD')
X
XC
XC  Open up system provided dictionary
XC
X
X`09open(unit=12,status='old',shared,
X`091`09readonly, access='KEYED',form='UNFORMATTED',
X`091`09file='sys$library:vms$password_dictionary.data')
X
XC
XC Open supplementary dictionary.  Need to be able to write to this one.
XC
X`09open(unit=15,status='old',access='KEYED',form='UNFORMATTED',
X`091`09FILE='SYS$LIBRARY:VMS$PASSWORD-POLICY-WORDS.DATA')
X
X`09Write(6,3)`20
X
X3`09FORMAT(' VMS Password Policy -- Add words to',
X`091`09' Supplemental Dictionary'//)
X
XC
XC Request the first word
XC
X
X1`09Write(6,5)
X5`09Format(' Enter word to be added (CTRL-Z to exit): ',$)
X
X`09READ(5,10,END=999) word
X10`09Format(a)
X
XC
XC Get the length of the word
XC
X`09l = lenstr(word)
X
XC
XC Convert the word to lowercase`20
XC
X`09do k=1,l
X`09`09sameword(k) = sameword(k).or.32
X`09enddo
XC
XC bad the rest of the array with null characters
XC
X`09do k=l+1,32
X`09`09sameword(k) = 0
X`09enddo
X
XC
XC Do a lookup on the word in the system provided dictionary
XC
X`09read(12,key=word(1:l),iostat=stat) readword
XC
XC If a word was found make sure it is the actual word and not a`20
XC fragment.  If the word was found notify the user.
XC
X
X`09If ((STR$CASE_BLIND_COMPARE(readword,word).eq.0).AND.
X`091`09(stat.eq.0)) THEN
X
X`09`09Type *, ' Word: ',word(1:l),
X`091`09`09' is in the VMS provided Dictionary.'
X
X`09`09goto 1
X`09ENDIF
X
XC
XC Do a lookup on the word in the supplemental dictionary
XC
X
X100`09read(15,key=word(1:l),iostat=stat) readword
X`09
XC
XC If a word was found make sure it is the actual word and not a`20
XC fragment.  If the word was found notify the user.
XC
X`09If ((STR$CASE_BLIND_COMPARE(readword,word).eq.0).AND.
X`091`09(stat.eq.0)) THEN
X
X`09`09Type *, ' Word: ',word(1:l),
X`091`09`09 ' is in the Password Policy Dictionary.'
X
X`09`09goto 1
X`09ENDIF
X
XC
XC The owrd is not in either dictionary so add it to the supplemental
XC dictionary.
XC
X
X200`09write(15,iostat=stat) word
X
X`09write(6,25) word
X25`09Format(' The word "',a,'" has been placed in the ',
X`091`09'Password Policy Dictionary.')
X
XC
XC Go get a another word
XC
X`09goto 1
X
X
X999`09end
X
X
X`09INTEGER FUNCTION LENSTR(STRING)
XC***********************************************************************
XC   Function to accept string  STRING  and calculate its length  LENSTR.`20
XC   Here LENSTR does not equal X for a CHARACTER*X character string, but
XC   rather is the last position in  STRING  with a non-blank character.
XC***********************************************************************
X        IMPLICIT NONE`20
X        INTEGER*4     I,ILENGTH
X`09CHARACTER*(*) STRING,SPACE,NULL
X`09PARAMETER (SPACE=CHAR(32), NULL=CHAR(0))
X`09LENSTR = 0
X`09ILENGTH=LEN(STRING)
X`09DO   I = ILENGTH,1,-1
X`09  IF ((STRING(I:I).NE.SPACE).AND.(STRING(I:I).NE.NULL)) THEN
X`09`09LENSTR = I
X`09 `09RETURN
X`09  ENDIF
X`09ENDDO
X`09RETURN
X`09END
$ CALL UNPACK ADD_DICTIONARY.FOR;1 1613539247
$ create 'f'
X$ Type SYS$INPUT
X
XThis procedure will compile, link and install this VMS Password Policy modul
Ve. `20
X
X
XIt will create the module and copy it to SYS$LIBRARY.  It will install the
Xmodule.  You will need to add a line to SYS$MANAGER:SYSTARTUP_V5.COM to
Xreinstall the module after a reboot.  The line needed is:
X
X`09$ INSTALL ADD SYS$LIBRARY:VMS$PASSWORD_POLICY.EXE
X
XThe module will also create a supplementary dictionary file in SYS$LIBRARY
Xcalled VMS$PASSWORD-POLICY-WORDS.DATA.  You can add words to this dictionary
Xby using the program ADD_DICTIONARY which is included in this package.
X
X$ inquire junk "Press return to continue"
X$ Type SYS$INPUT
X
XAfter this has been completed, the program will change the SYSGEN parameter
XLOAD_PWD_POLICY to a value of 1.  The Commands executed are:
X
X`09$ MCR SYSGEN
X`09SYSGEN> USE CURRENT
X`09SYSGEN> SET LOAD_PWD_POLICY 1
X`09SYSGEN> WRITE CURRENT
X`09SYSGEN> USE ACTIVE
X`09SYSGEN> SET LOAD_PWD_POLICY 1
X`09SYSGEN> WRITE ACTIVE
X
X
X$ FORTRAN/EXTEND VMS$PASSWORD_POLICY
X$ FORTRAN/EXTEND ADD_DICTIONARY
X$ LINK ADD_DICTIONARY
X$`09LINK/SHAREABLE VMS$PASSWORD_POLICY+SYS$SYSTEM:SYS.STB/SEL+SYS$INPUT:/OPT
VIONS
XUNIVERSAL=POLICY_PLAINTEXT
XUNIVERSAL=POLICY_HASH
X$ COPY VMS$PASSWORD_POLICY.EXE SYS$COMMON:`5BSYSLIB`5D*.*/LOG
X$ CONVERT/FDL=VMS$PASSWORD-POLICY-WORDS.FDL passwords.dat -
X sys$common:`5Bsyslib`5DVMS$PASSWORD-POLICY-WORDS.DATA
X$ type SYS$INPUT
XVMS$PASSWORD-POLICY-WORDS.DATA has been put in SYS$LIBRARY
X
XNow installing the module and changing the SYSGEN parameter LOAD_PWD_POLICY
X$ INSTALL ADD SYS$LIBRARY:VMS$PASSWORD_POLICY.EXE
X$ MCR SYSGEN
XUSE CURRENT
XSET LOAD_PWD_POLICY 1
XWRITE CURRENT
XUSE ACTIVE
XSET LOAD_PWD_POLICY 1
XWRITE ACTIVE
X$ type SYS$INPUT
X
XThe system has now been installed and is currently active.
XRemember to add the line to SYSTARTUP_V5.COM to reinstall the
Xmodule.
X$ EXIT
$ CALL UNPACK BUILD_PASSWORD_POLICY.COM;1 2070026544
$ create 'f'
Xcheckitout`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
Xguessit`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
V`00`00
Xscrewthesystemmanager`00`00`00`00`00`00`00`00`00`00`00
Xtestingthesystem`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
XIM4THE$`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
V`00`00
Xasshole`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
V`00`00
Xbadass`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`
V00`00`00
Xcompareall`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
Xcondom`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`
V00`00`00
Xdebbie`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`
V00`00`00
Xdeborah`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
V`00`00
Xeatme`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`0
V0`00`00`00
Xmogul`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`0
V0`00`00`00
Xreagan`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`
V00`00`00
Xthisisatest`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00`00
$ CALL UNPACK PASSWORDS.DAT;1 1174605420
$ create 'f'
X
XFILE
X`09BEST_TRY_CONTIGUOUS     yes
X`09BUCKET_SIZE             12
X`09CLUSTER_SIZE            3
X`09CONTIGUOUS              yes
X`09FILE_MONITORING         no
X`09GLOBAL_BUFFER_COUNT     0
X`09NAME                    "SYS$COMMON:`5BSYSLIB`5DVMS$PASSWORD-POLICY-WORDS
V.DATA"
X`09ORGANIZATION            indexed
X`09OWNER                   `5BSYSTEM`5D
X`09PROTECTION              (system:RE, owner:RE, group:, world:)
X
XRECORD
X`09BLOCK_SPAN              yes
X`09CARRIAGE_CONTROL        carriage_return
X`09FORMAT                  fixed
X`09SIZE                    32
X
XAREA 0
X`09BEST_TRY_CONTIGUOUS     yes
X`09BUCKET_SIZE             12
X
XAREA 1
X`09BEST_TRY_CONTIGUOUS     yes
X`09BUCKET_SIZE             12
X
XKEY 0
X`09CHANGES                 no
X`09DATA_KEY_COMPRESSION    yes
X`09DATA_RECORD_COMPRESSION no
X`09DATA_AREA               0
X`09DATA_FILL               100
X`09DUPLICATES              no
X`09INDEX_AREA              1
X`09INDEX_COMPRESSION       yes
X`09INDEX_FILL              100
X`09LEVEL1_INDEX_AREA       1
X`09NAME                    ""
X`09NULL_KEY                no
X`09PROLOG                  3
X`09SEG0_LENGTH             32
X`09SEG0_POSITION           0
X`09TYPE                    string
X
XANALYSIS_OF_AREA 0
X`09RECLAIMED_SPACE         0
X
XANALYSIS_OF_AREA 1
X`09RECLAIMED_SPACE         0
X
XANALYSIS_OF_KEY 0
X`09DATA_FILL               99
X`09DATA_KEY_COMPRESSION    82
X`09DATA_RECORD_COMPRESSION 0
X`09DATA_RECORD_COUNT       42979
X`09DATA_SPACE_OCCUPIED     1416
X`09DEPTH                   1
X`09INDEX_COMPRESSION       64
X`09INDEX_FILL              23
X`09INDEX_SPACE_OCCUPIED    12
X`09LEVEL1_RECORD_COUNT     118
X`09MEAN_DATA_LENGTH        32
X`09MEAN_INDEX_LENGTH       34
$ CALL UNPACK VMS$PASSWORD-POLICY-WORDS.FDL;1 541199032
$ create 'f'
XC***********************************************************************
XC System Name:   VMS Password Policy`20
XC
XC Module Name:   VMS$Password_Policy
XC
XC Version:`09 1.0
XC
XC Programmer:    M. Edward (Ted) Nieland
XC
XC Date Created:  January 1990
XC
XC Brief Description of Module Function:
XC
XC Hooks into VMS SET PASSWORD program (in VMS 5.4 or later) to filter
XC passwords before they are set.  The system will not all passwords`20
XC is they are:
XC`09  (1)  USERNAME  or variations thereof
XC         (2)  The "Owner's" name (from SYSUAF.DAT) or variations thereof
XC         (3)  A list of suspect passwords`20
XC
XC The suspect passwords is in addition to the checking of a system
XC dictionary already done by VMS.
XC
XC This program is based on my original CHECKPASS program that checked
XC passwords on prev VMS 5.4 systems. `20
XC
XC
XC Revision History:
XC---------------------------------------------------------------------------
V----
XC`7C Date      `7C Name            `7C Reason  (SPR # if applicable)     `7C
V Version # `7C
XC---------------------------------------------------------------------------
V----
XC`7C           `7C                 `7C                                   `7C
V           `7C
XC---------------------------------------------------------------------------
V----
XC
XC Data Dictionary:   $UAIDEF from SYS$LIBRARY:FORSYSDEF.TLB
XC`09`09     $SSDEF from SYS$LIBRARY:FORSYSDEF.TLB
XC
XC Inputs:`09Files SYS$LIBRARY:VMS$PASSWORD-POLICY-WORDS.DATA
XC`09`09Variables PASSWORD - PASSWORD to be checked
XC`09`09`09  USERNAME - Username of account`20
XC
XC Outputs:      Returns a status`20
XC
XC Local Variables:   `20
XC                     I        I - Integer Counter
XC`09`09      I1       I - Integer Counter
XC`09`09      I2       I - Integer Counter
XC`09`09      I3       I - Integer Counter
XC                     II       I - Integer Counter
XC                     IMAX     I - Integer Counter
XC                     III      I - Integer Counter
XC                     LO       I - Lenght of OWNER pieces arrays
XC                     ALEN     I - Lenth of account string
XC                     NAMELEN  I - Lenth of username string
XC                     PLEN     I - Lenth of password string
XC                     OWNER    C - Owner Field from UAF
XC                     ACCOUNTNAME C - Account Field from UAF
XC                     WORD     C - String for dictionary lookup
XC                     LP       I - Limit to print
XC                     MAX      I - Maximum count
XC                     N        I - Integer Counter
XC                     STAT     I - Function Status
XC                     P        I - Password String Length
XC                     PASS     C - Password to check
XC                     LP       B - Array equivalnced to PASS for numerical u
Vse
XC                     OWNER_FIELD C - Array of words from Owner Field of UAF
XC                     LEN_OWNER_FIELD I - Array of lengths corresponding to
V OWNER_FIELD
XC                     ALPHA    C - Alpha characters
XC                     DIGITS   C - Digit characters
XC                     BADCHAR  C - characters not allowed in certain cases
XC                     ITM      S - Array of Structure used to extract  `20
XC                                  data from the UAF file
XC                         BUFLEN       I - BufferLength
XC                         ITMCOD       I - Item Code       `20
XC                         BUFADR       I - Buffer Address
XC                         RETADR       I - Return Address
XC                         END_LIST     I - End of list indicator
XC`20
XC Global Variables:
XC
XC Functions called:     LENSTR         I - Character string length
XC                       LIB$LOCC       I
XC                       STR$TRIM       I - Strip trailing blanks/tabs
XC                       STR$find_first_in_set
V                                  `20
XC                       SYS$GETUAI     I - Get UAF information
V                 `20
XC                       STR$CASE_BLIND_COMPARE I - Compare strings
XC                       CYCLE          I - Cycle through some checks
XC                                                                        `20
V     `20
XC
XC Subroutines called:   LIB$SIGNAL  - Signal error
XC                       INVERT - Invert a string
XC
XC***********************************************************************
X
X`09integer function policy_plaintext (password, username)
X`09implicit none
X`09character*(*) password,username
X
X      INCLUDE '($UAIDEF)/NOLIST'
X      INCLUDE '($SSDEF)/NOLIST'
XC
X      STRUCTURE  /ITMLST/
X       UNION
X        MAP
X         INTEGER*2  BUFLEN , ITMCOD
X         INTEGER*4  BUFADR , RETADR
X        END MAP
X        MAP
X         INTEGER*4  END_LIST
X        END MAP
X       END UNION
X      END STRUCTURE
XC
X      RECORD /ITMLST/ ITM(3)
X
X`09Character*32 owner, accountname, word
X`09Character*32 pass
X`09INTEGER`09STR$CASE_BLIND_COMPARE,STR$FIND_FIRST_IN_SET, LENSTR
X`09INTEGER LO, CYCLE
X`09PARAMETER                   (LO=5)
X        CHARACTER*31     OWNER_FIELD(LO)
X        INTEGER*4    LEN_OWNER_FIELD(LO)
X`09CHARACTER*52 ALPHA
X`09CHARACTER*10 DIGIT
X`09CHARACTER*30 BADCHAR
X`09Integer stat, sys$getuai, n, I, I1, I2, I3, LIB$LOCC, IMAX
X`09Integer ownerlen, namelen, plen, rstat, III, P, alen
X`09byte lp(32)
X
X`09equivalence (lp,pass)
X`09DATA ALPHA
X     X /'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'/
X`09DATA DIGIT/'0123456789'/
X`09DATA BADCHAR/',._!@#$%`5E&*()+=-`7B`7D`5B`5D`7C\"'':;?/`7E`60'/
X
X
X
XC
XC Get the length of the password
XC
X`09plen = LENSTR(password)
X
XC
XC Create a lowercase version of the password and pad the string
XC with null characters for the exteneded dictionary lookup
XC
X
X`09Do i = 1,plen
X`09`09pass(i:i) = password(i:i)
X`09`09lp(i) = lp(i) .or.32
X`09enddo
X
X`09do i=plen+1,32
X`09`09lp(i) = 0
X`09enddo
XC
XC Get the Owner and Account field information from the UAF.  These fields
XC will be used as part of the password checking.
XC
XC  The "owner" field.
XC
X      ITM(1).BUFLEN = 31
X      ITM(1).ITMCOD = UAI$_OWNER
X      ITM(1).BUFADR = %LOC(OWNER)
X      ITM(1).RETADR = 0
XC
XC  The "account" field.
XC
X      ITM(2).BUFLEN = 31
X      ITM(2).ITMCOD = UAI$_ACCOUNT
X      ITM(2).BUFADR = %LOC(accountname)
X      ITM(2).RETADR = 0
XC
X      ITM(3).END_LIST = 0
XC
XC  Now to get the UAF info.
XC
X      STAT = SYS$GETUAI (,, username, ITM ,,,)
XC
XC Calculate the length of the owner and account strings
XC
X`09ownerlen = LENSTR(owner)
X`09alen = LENSTR(accountname)
X`09namelen = LENSTR(username)
X
XC
XC Open up the extended dictionary and make sure the selected
XC password is not in that dictionary.  This test supplements
XC the testing already done by VMS.
XC
X`09OPEN(UNIT=21,STATUS='OLD',ACCESS='KEYED',FORM='UNFORMATTED',
X`091`09READONLY,SHARED,
X`091`09FILE='SYS$LIBRARY:VMS$PASSWORD-POLICY-WORDS.DATA')
X
XC
XC check the dictionary
XC`09
X`09READ(21, KEY=pass(1:plen), iostat=rstat) word
XC
XC Close the dictionary file
XC
X`09CLOSE(unit=21)
XC
XC  If rstat is 0 then a word was found based on the key.
XC  Check that word to see if it was the full word and not a`20
XC  chance fragment.  (if the key was "testin", it would find the
XC  word "testing".
XC
X`09IF ((rstat.eq.0).and.
X`091  (STR$CASE_BLIND_COMPARE(word,pass).eq.0)) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X
XC
XC decode the "OWNER" field in the AUTHORIZE file
XC We need to split apart the various words in that field
XC
X`09n=str$find_first_in_set(owner(1:31),ALPHA)
X`09do i=1,LO
X`09    len_owner_field(i)=0
X`09end do
XC
X`09do i=1,LO
X`09    len_owner_field(i)=lib$locc(' ',owner(n:31))-1
X`09    if( len_owner_field(i).lt.1 )  go to 185
X`09    owner_field(i)(1:len_owner_field(i)) =
X     X              owner(n:n+len_owner_field(i))
X            n = n + len_owner_field(i)+1
X`09    if( n.gt.31 )  go to 185
X            n=n+str$find_first_in_set(owner(n:31),ALPHA)-1
X`09    if( n.gt.31 )  go to 185
X`09end do
XC                                                                      `20
X185`09continue
XC
X`09do i=1,LO
X`09if( len_owner_field(i).lt.1 )  go to 187
X            do i1=1,30
X`09    if( owner_field(i)(len_owner_field(i):len_owner_field(i))
X     X          .eq.badchar(i1:i1) )  then
X                               len_owner_field(i)=len_owner_field(i) - 1
X                               if( len_owner_field(i).lt.1 )  go to 187
X            endif
X            end do
X186`09if( len_owner_field(i).lt.1 )  go to 187
X            n=str$find_first_in_set(owner_field(i)(1:len_owner_field(i))
X     X                              ,BADCHAR )
X            if( n.eq.1 )  then
X`09`09len_owner_field(i)=len_owner_field(i) - 1
X`09`09    owner_field(i)=    owner_field(i)(2:)
X`09`09go to 186
X`09    endif
X            if( (n.gt.1).and.(n.le.len_owner_field(i)) )  then
XC
XC So split these into two words
XC
X               do iii=i+1,LO-1
X               len_owner_field(LO+i+1-iii)=len_owner_field(LO+i+1-iii-1)
X                   owner_field(LO+i+1-iii)=    owner_field(LO+i+1-iii-1)
X               end do
X               len_owner_field(i+1)    =len_owner_field(i) - n
X                   owner_field(i+1)    =owner_field(i)(n+1:)
X               len_owner_field(i)      =n-1
X                   owner_field(i)      =owner_field(i)(1:n-1)
X`09    endif
X`09if( len_owner_field(i).lt.1 )  go to 187
X`09end do
XC
XC Now count the number of names found in the "owner" field
XC
X187`09IMAX=0
X`09do i=1,LO
X`09if( len_owner_field(i).ge.1 )   then
X          IMAX=IMAX + 1
X`09endif
X`09end do
XC
XC       Try combinations of names and initials (up to 26 combinations)
XC
X`09if( imax.lt.2)  go to 195
X`09do i1=1,3
X`09do i2=1,3
X`09do i3=1,3
X`09if( i1.eq.1 )  then
X`09`09pass= owner_field(1)(1:len_owner_field(1))
X`09`09p   = len_owner_field(1)
X`09else if( i1.eq.2 )  then
X`09`09pass= owner_field(1)(1:1)
X`09`09p   = 1
X`09else
X`09`09pass = ' '
X`09`09p   = 0
X`09endif
X`09if( i2.eq.1 )  then
X                pass(p+1:)=         owner_field(2)(1:len_owner_field(2))
X                p         = p + len_owner_field(2)
X`09else if( i2.eq.2 )  then
X                pass(p+1:)=         owner_field(2)(1:1)
X                p         = p + 1
X`09endif
X        if( (imax.lt.3).and.(i3.gt.1) )  go to 192
X        if(  imax.lt.3                )  go to 191
X`09if( i3.eq.1 )  then
X                pass(p+1:)=         owner_field(3)(1:len_owner_field(3))
X                p         = p + len_owner_field(3)
X`09else if( i3.eq.2 )  then
X                pass(p+1:)=         owner_field(3)(1:1)
X                p         = p + 1
X`09endif
X191`09if( p.eq.0 )  go to 192
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X
XC
X192`09continue
X`09end do
X`09end do
X`09end do
XC
XC 4*(1-26)  Try first name + any letter
XC
XC
X195`09if( imax.lt.1)  go to 199
XC
X`09pass= owner_field(1)(1:len_owner_field(1))
X`09p   = len_owner_field(1)`20
X`09If (CYCLE( PASS,P,PASSWORD ) .ne. ss$_normal) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09if( imax.lt.2)  go to 199
XC
XC 4*(1-26)  Try second name + any letter
XC
X`09pass= owner_field(2)(1:len_owner_field(2))
X`09p   = len_owner_field(2)`20
X`09If (CYCLE( PASS,P,PASSWORD ) .ne. ss$_normal) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09if( imax.lt.3)  go to 199
XC
XC 4*(1-26)  Try third name + any letter
XC
X`09pass= owner_field(3)(1:len_owner_field(3))
X`09p   = len_owner_field(3)`20
X`09If (CYCLE( PASS,P,PASSWORD ) .ne. ss$_normal) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09if( imax.lt.4)  go to 199
XC
XC 4*(1-26)  Try fourth name + any letter
XC
X`09pass= owner_field(4)(1:len_owner_field(4))
X`09p   = len_owner_field(4)`20
X`09If (CYCLE( PASS,P,PASSWORD ) .ne. ss$_normal) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC
X199`09continue
XC
XC
XC
XC
XC
XC 1.`09Check the USERNAME as the password`20
XC
X`09PASS = ' '
X`09PASS = USERNAME(1:namelen)
X`09p    = namelen
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC 2.`09Try to check the Person's Last Name as the password`20
XC
X
X`09PASS = ' '
X`09IF( (USERNAME(namelen-1:namelen-1) .EQ. '_').OR.
X     x      (USERNAME(namelen-1:namelen-1) .EQ. '$')    )  THEN
X`09`09PASS = USERNAME(1:namelen-2)
X            p    = namelen - 2
X `09ELSE
X            PASS = USERNAME(2:namelen)
X            p    = namelen - 1
X`09ENDIF
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC 3.`09Try again to check the Person's Last Name as the password`20
XC
X
X`09PASS = ' '
X`09IF( (USERNAME(2:2) .EQ. '_').OR.
X     x      (USERNAME(2:2) .EQ. '$')    )  THEN
X            PASS = USERNAME(3:namelen)
X            p    = namelen - 2
X`09ELSE
X            PASS = USERNAME(1:namelen-1)
X            p    = namelen - 1
X`09ENDIF
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC 4.`09Cycle through  USERNAME + any letter etc.
XC
X        CALL STR$TRIM(PASS,USERNAME(1:namelen),namelen)
X`09p   = namelen
X`09If (CYCLE( PASS,P,PASSWORD ) .ne. ss$_normal) then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC
XC 5.`09Check the Accoount as the password`20
XC
X`09PASS = ' '
X`09PASS = ACCOUNTNAME(1:alen)
X`09p    = alen
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then
X`09`09policy_plaintext = ss$_pwdweak
X`09`09return
X`09ENDIF
X
X
X
X`09policy_plaintext = ss$_normal
X`09return`20
X`09end
X
X
X`0C
XC
XC No checking is done on the hash value at this time
XC
X`09integer function policy_hash (hash, username)
X
X`09IMPLICIT NONE
X`09INCLUDE '($SSDEF)/NOLIST'
X
X`09character*(*) username
X`09integer hash(2)
X
X
X`09policy_hash = ss$_normal
X`09return`20
X`09end
X
X`0C
X`09INTEGER FUNCTION LENSTR(STRING)
XC***********************************************************************
XC   Function to accept string  STRING  and calculate its length  LENSTR.`20
XC   Here LENSTR does not equal X for a CHARACTER*X character string, but
XC   rather is the last position in  STRING  with a non-blank character.
XC***********************************************************************
X        IMPLICIT NONE`20
X        INTEGER*4     I,ILENGTH
X`09CHARACTER*(*) STRING,SPACE,NULL
X`09PARAMETER (SPACE=CHAR(32), NULL=CHAR(0))
X`09LENSTR = 0
X`09ILENGTH=LEN(STRING)
X`09DO   I = ILENGTH,1,-1
X`09  IF ((STRING(I:I).NE.SPACE).AND.(STRING(I:I).NE.NULL)) THEN
X`09`09LENSTR = I
X`09 `09RETURN
X`09  ENDIF
X`09ENDDO
X`09RETURN
X`09END
XC***********************************************************************
X`09SUBROUTINE INVERT( PASS,P )
X`09IMPLICIT NONE
XC
XC Reverse the order of the letters in PASS
XC
X`09CHARACTER*(*) PASS
X`09CHARACTER*32  TEMP
X`09INTEGER*2     P,II
XC
X`09TEMP=PASS
X`09DO II=1,P
X`09    PASS(II:II)=TEMP(P+1-II:P+1-II)
X`09END DO
X`09RETURN
X`09END
XC
XC***********************************************************************
XC
X`09INTEGER FUNCTION CYCLE( PASS,P,PASSWORD)
X`09IMPLICIT NONE
X      INCLUDE '($UAIDEF)/NOLIST'
X      INCLUDE '($SSDEF)/NOLIST'
XC Cycle prepending & postpending: a single character
XC                                 "underscore" character
XC                                 "dollar sign" character
XC                                 $_letter
XC                                 _$letter
XC                                 $_$letter
XC                                 _$_letter
XC                      Also try:  wordword, word_word,word$word,word$_word,
XC                                 word_$word,word$_$word, & word_$_word
X`09CHARACTER*(*)       PASS,PASSWORD
X`09INTEGER*2           P,PTEMP,U,NALPHA,I1
X`09CHARACTER*32        TEMP
X`09PARAMETER (NALPHA=36)
X`09CHARACTER*(NALPHA)  ALPHA
X`09INTEGER`09STR$CASE_BLIND_COMPARE
XC
XC
X`09DATA ALPHA /'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'/
XC
X`09CYCLE = 0`20
X`09 TEMP = PASS
X`09PTEMP = P
XC
XC 2       Try    PASS  itself
XC
X`09pass=  TEMP(1:PTEMP)
X`09p   = PTEMP
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
XC 7*2*36  Try    PASS + any letter  etc.
XC
X`09if( ptemp.gt.27 )  go to 9000
X`09do i1=1,NALPHA
X`09pass=  TEMP(1:PTEMP)//alpha(i1:i1)
X`09p   = PTEMP + 1
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'_'//alpha(i1:i1)
X`09p   = PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'$'//alpha(i1:i1)
X`09p   = PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'$_'//alpha(i1:i1)
X`09p   = PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'_$'//alpha(i1:i1)
X`09p   = PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'$_$'//alpha(i1:i1)
X`09p   = PTEMP + 4
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass=  TEMP(1:PTEMP)//'_$_'//alpha(i1:i1)
X`09p   = PTEMP + 4
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09end do
XC
XC 7*2*36  Try    any letter + PASS   etc.
XC
X`09do i1=1,NALPHA
X`09pass= alpha(i1:i1)// TEMP(1:PTEMP)
X`09p   = PTEMP + 1
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'_'// TEMP(1:PTEMP)
X`09p   = PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'$'// TEMP(1:PTEMP)
X`09p   = PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'$_'// TEMP(1:PTEMP)
X`09p   = PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'_$'// TEMP(1:PTEMP)
X`09p   = PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'$_$'// TEMP(1:PTEMP)
X`09p   = PTEMP + 4
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09pass= alpha(i1:i1)//'_$_'// TEMP(1:PTEMP)
X`09p   = PTEMP + 4
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09end do
XC
XC 7*2     Try  PASSxxxPASS,  where   (xxx= , _, $, $_, _$, $_$, _$_ )
XC
X`09if( ptemp.gt.15 )  go to 9000
X        pass= TEMP(1:PTEMP)//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X        pass= TEMP(1:PTEMP)//'_'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 1
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X        pass= TEMP(1:PTEMP)//'$'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 1
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09if( ptemp.gt.14 )  go to 9000
X        pass= TEMP(1:PTEMP)//'$_'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X        pass= TEMP(1:PTEMP)//'_$'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 2
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X        pass= TEMP(1:PTEMP)//'$_$'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X        pass= TEMP(1:PTEMP)//'_$_'//TEMP(1:PTEMP)
X        p   =PTEMP + PTEMP + 3
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
X`09call invert( pass,p )
X`09If (STR$CASE_BLIND_COMPARE(pass,password).eq.0)  then`20
X`09`09cycle = ss$_pwdweak
X`09`09return
X`09ENDIF
XC
X`09cycle = ss$_normal
X9000`09RETURN`20
X`09END
X
$ CALL UNPACK VMS$PASSWORD_POLICY.FOR;1 1495310596
$ v=f$verify(v)
$ EXIT