midrange.com code scratchpad
Name:
Password Validation program
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
09/11/2009 09:57:35 pm
IP:
Logged
Description:
When this code is executed as a result of using CHGPWD on a green screen, the value of variable LenOFNEW is correct. For example, if I use CHGPWD and specify my existing password along with a new password of AAAAAAAA and verify with AAAAAAAA, the value of LenOFNEW is 8.

However, if I use the GUI panel from the iSeries Navigator to change my password (specifying the same value of AAAAAAAA as the new password), the value of LenOFNEW is 16, which is incorrect.
Code:
  1. ==========================================================
  2. System value QPWDVLDPGM = *REGFAC
  3.  
  4. This CL program is registered as the system password validation program
  5. (exit point QIBM_QSY_VLD_PASSWRD)
  6.  
  7. ==========================================================
  8.  
  9.  
  10. /*********************************************************************/
  11. /*                                                                   */
  12. /*  Program. . . . . . . PWDVLDC                                      */
  13. /*                                                                   */
  14. /*  Description. . . . . Password Validation Controls - Exit Program */
  15. /*                                                                   */
  16. /*  Program Revision Log                                             */
  17. /*  --------------------                                             */
  18. /*                                                                   */
  19. /*********************************************************************/
  20.  
  21. PWDVLDC:     PGM        PARM(&EXITINF &RTNIND)
  22.  
  23. /*                                                                   */
  24. /* --------- Define program file(s) and variable(s). --------------- */
  25. /*                                                                   */
  26.  
  27.              DCL        VAR(&EXITINF)  TYPE(*CHAR)   LEN(1070)
  28.              DCL        VAR(&RTNIND) TYPE(*CHAR) LEN(01) VALUE('0')
  29.              DCL        VAR(&JOBTYPE)  TYPE(*CHAR)   LEN(01)
  30.              DCL        VAR(&MSGDAT1)  TYPE(*CHAR)   LEN(512)
  31.              DCL        VAR(&MSGDAT2)  TYPE(*CHAR)   LEN(512)
  32.              DCL        VAR(&MSGRPY )  TYPE(*CHAR)   LEN(1)  /* sjl */
  33.  
  34. /*                                                                   */
  35. /* --------- Retrieve job type from job attributes ---------------- */
  36. /*                                                                   */
  37.  
  38.              RTVJOBA    TYPE(&JOBTYPE)
  39.  
  40. /*                                                                   */
  41. /* --------- Remove SEC from the ----------------------------- */
  42. /* --------- user portion of the library list ---------------------- */
  43. /*                                                                   */
  44.              RMVLIBLE   LIB(SEC)
  45.              MONMSG     MSGID(CPF0000)
  46. /*                                                                   */
  47. /* --------- Add SEC to the first position in the ------------- */
  48. /* --------- user portion of the library list ---------------------- */
  49. /*                                                                   */
  50.              ADDLIBLE   LIB(SEC)
  51. /*                                                                   */
  52. /* --------- Begin Processing -------------------------------------- */
  53. /*                                                                   */
  54.  
  55.              CALL       PGM(PWDVLDR) PARM(&EXITINF &RTNIND)
  56.  
  57.              IF         COND(&RTNIND *EQ '1') THEN(GOTO CMDLBL(ABEND))
  58.  
  59. /*                                                                   */
  60. /* --------- Branch to normal EOJ ---------------------------------- */
  61. /*                                                                   */
  62.              GOTO       CMDLBL(EOJ)
  63. /*                                                                   */
  64. /* --------- Force job to end abnormally if abend process ---------- */
  65. /* --------- executed.                                    ---------- */
  66. /*                                                                   */
  67.  ABEND:
  68.  
  69.  EOJ:        ENDPGM
  70.  
  71.  
  72. ==========================================================
  73. RPG program called by PWDVLDC
  74. ==========================================================
  75.  
  76.  
  77.      **********************************************************************
  78.       *
  79.       * ----------------------------------------------------------------
  80.       * Program Description:   Custom user pasword validation exit program.
  81.       *                        User Profile Exit Program
  82.       *                        Called when User Changes Their Password
  83.       *
  84.       *
  85.       *
  86.       *
  87.       **********************************************************************
  88.       *
  89.       *  -------------
  90.       *  PROGRAM FILES
  91.       *  -------------
  92.       *
  93.       *  Password Validation Controls (by effective through date)
  94.      ffsa800    if   e           k disk
  95.       *
  96.       *****************************************************************
  97.       *
  98.       *  ----------
  99.       *  PROTOTYPES
  100.       *  ----------
  101.       *
  102.       *  Prototype for call to Check Password Characters
  103.       *
  104.      d ChkPwdChar      PR             1N
  105.      d  pPassword                   128A   CONST
  106.      d  pTypeChk                      1A   CONST
  107.      d  pReqChar                      3S 0 CONST
  108.       *
  109.       *  Prototype for call to Check Password Repeating Characters
  110.       *
  111.      d ChkPwdRepChar   PR             1N
  112.      d  pPasswordRep                128A   CONST
  113.      d  pAlwRepChar                   1A   CONST
  114.       *
  115.       *  Entry parameter list
  116.       *
  117.      D PSA801          PR
  118.      D  epExitInf                  1070A
  119.      D  epRtnInd                      1A
  120.       *
  121.      D PSA801          PI
  122.      D  epExitInf                  1070A
  123.      D  epRtnInd                      1A
  124.       *
  125.       *  Global variables & constants                                       --**
  126.       *
  127.      d $$NumOfPasses   S              3s 0 inz
  128.      d $$RecordFound   S              1a   inz('N')
  129.      d $$OldPassword   S            128A
  130.      d $$NewPassword   S            128A
  131.      d LenOfNwPass     S             10  0
  132.      d spRtnInd        S              1N   inz('0')
  133.      d $$upmd          S               d   inz(*sys)
  134.       *
  135.       *  Program Named Constants
  136.       *
  137.      D LO              C                   CONST('abcdefghijklmnopqrstuvwxyz')
  138.      D UP              C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  139.      D NUM             C                   CONST('0123456789')
  140.      D SPC             C                   CONST('`~!@#$%¢&*()_-+="{¬}¦| -
  141.      D                                            ''\:;<,>.?/')
  142.      D REP             C                   CONST('AA BB CC DD EE FF -
  143.      D                                            GG HH II JJ KK LL MM -
  144.      D                                            NN OO PP QQ RR SS -
  145.      D                                            TT UU VV WW XX YY ZZ -
  146.      D                                            00 11 22 33 44 55 -
  147.      D                                            66 77 88 99 -
  148.      D                                            `` ~~ !! @@ ## $$ -
  149.      D                                            %% ¢¢ && ** (( )) __ -
  150.      D                                            -- ++ == "" {{ ¬¬ -
  151.      D                                            }} ¦¦ || '''' \\ -
  152.      D                                            :: ;; << ,, >> .. ?? // ')
  153.       *
  154.      D ibmIConvOpen    Pr            52a   extproc('QtqIconvOpen')
  155.      D  fromcode                       *   value
  156.      D  tocode                         *   value
  157.       *
  158.      D ibmIConv        Pr            10i 0 extproc('iconv')
  159.      D  cd                           52a   value
  160.      D  inbuf                          *
  161.      D  inbytesleft                  10i 0
  162.      D  outbuf                         *
  163.      D  outbytesleft                 10i 0
  164.       *
  165.      D ibmIconvClose   Pr            10i 0 extproc('iconv_close')
  166.      D  cd                           52a   value
  167.       *
  168.      D iconv_t         Ds
  169.      D  t_rtnval                     10i 0
  170.      D  t_cd
  171.      D  t_cdi                        10i 0 Dim(12) Overlay(t_cd)
  172.       *
  173.      D fromcode        DS                  likeds(QTQCODE) inz
  174.      D tocode          DS                  likeds(QTQCODE) inz
  175.       *
  176.      D inputPtr        S               *
  177.      D inputLen        S             10I 0
  178.       *
  179.      D outputPtr       S               *
  180.      D outputLen       S             10I 0
  181.       *
  182.      D input           S           1070A
  183.      D output          S           1070A
  184.       *
  185.      Drc               S             10I 0
  186.       *
  187.       /copy QSYSINC/QRPGLESRC,QTQICONV
  188.       *
  189.       *****************************************************************
  190.       *
  191.       *  ------------------------------------------------
  192.       *  PROGRAM INPUT SPECIFICATIONS AND DATA STRUCTURES
  193.       *  ------------------------------------------------
  194.       *
  195.       *  Validate Password Exit Information Structure
  196.       *
  197.      D ExitInfo        DS          1070    inz
  198.       *
  199.       *    Exit Point Name
  200.      D ExitPN                        20A
  201.       *
  202.       *    Exit Point Format Name
  203.      D ExitPF                         8A
  204.       *
  205.       *    Password Level
  206.      D PWDLVL                        10i 0
  207.       *
  208.       *    User Profile Name
  209.      D UserProf                      10a
  210.       *
  211.       *    Reserved
  212.      D Rsvd                           2a
  213.       *
  214.       *    Offset to Old Password
  215.      D OffTOOLD                      10i 0
  216.       *
  217.       *    Length of Old Password
  218.      D LenOFOLD                      10i 0
  219.       *
  220.       *    CCSID of Old Password
  221.      D CCSIDofOldPwd                 10i 0
  222.       *
  223.       *    Offset to New Password
  224.      D OffTONEW                      10i 0
  225.       *
  226.       *    Length of New Password
  227.      D LenOFNEW                      10i 0
  228.       *
  229.       *    CCSID of New Password
  230.      D CCSIDofNewPwd                 10i 0
  231.       *
  232.       *    Password Data
  233.      D PasswordData                1000a
  234.       *
  235.       **********************************************************************
  236.       *
  237.       *  --------------
  238.       *  Begin MAINLINE
  239.       *  --------------
  240.       *
  241.       *****************************************************************
  242.       /free
  243.  
  244.        // Accept Entry Parameter List
  245.  
  246.        Eval ExitInfo = epExitInf;
  247.  
  248.        // Convert New Password to CCSID of Job
  249.  
  250.        fromcode.QTQCCSID = CCSIDofNewPwd;
  251.        tocode.QTQCCSID = 0;
  252.        fromcode.QTQERVED02 = *allx'00';
  253.        tocode.QTQERVED02 = *allx'00';
  254.        iconv_t = ibmIconvOpen(%addr(tocode) : %addr(fromcode));
  255.  
  256.        input = %Subst(PasswordData : (OffToNew - 68) + 1 : LenOfNew);
  257.        inputPtr = %addr(input);
  258.        inputLen = %len(%trimr(input));
  259.        outputPtr = %addr(output);
  260.        outputLen = inputLen;
  261.  
  262.        rc = ibmIConv(iconv_t :
  263.           inputPtr  : inputLen:
  264.           outputPtr : outputLen);
  265.  
  266.        rc = ibmIconvClose( iconv_t );
  267.  
  268.        $$NewPassword = output;
  269.  
  270.        epRtnInd = '0';
  271.  
  272.        // ==================================================================
  273.  
  274.        // Locate Active Password Validation Controls Record
  275.  
  276.        setll(e) ($$upmd)fsa800;
  277.        read(e) fsa800;
  278.        DoW not %eof and
  279.            $$upmd <= pcefft;
  280.          If $$upmd >= pcefff;
  281.            $$RecordFound = 'Y';
  282.            Leave;
  283.          EndIf;
  284.          read(e) fsa800;
  285.        EndDo;
  286.  
  287.        // ==================================================================
  288.  
  289.        LenOfNwPass = *Zeros;
  290.        LenOfNwPass = %len(%trimr($$NewPassword));
  291.  
  292.        // ==================================================================
  293.  
  294.        // Minimum Password Length?
  295.  
  296.        If pcminl <> *Zero;
  297.        //If LenOfNew < pcminl;
  298.          If LenOfNwPass < pcminl;
  299.            epRtnInd = '1';
  300.            *Inlr = *On;
  301.            Return;
  302.          EndIf;
  303.        EndIf;
  304.  
  305.        // ==================================================================
  306.  
  307.        // Maximum Password Length?
  308.  
  309.        If pcmaxl <> *Zero;
  310.        //If LenOfNew > pcmaxl;
  311.          If LenOfNwPass > pcmaxl;
  312.            epRtnInd = '1';
  313.            *Inlr = *On;
  314.            Return;
  315.          EndIf;
  316.        EndIf;
  317.  
  318.        // ==================================================================
  319.  
  320.        // Allow Repeating Characters?
  321.  
  322.        If pcalwr <> 'Y';
  323.          spRtnInd = ChkPwdRepChar( $$NewPassword : pcalwr);
  324.          If spRtnInd = *On;
  325.            epRtnInd = '1';
  326.            *Inlr = *On;
  327.            Return;
  328.          EndIf;
  329.        EndIf;
  330.  
  331.        // ==================================================================
  332.  
  333.        // Required UpperCase Characters? (Pass=Return Indicator is *Off)
  334.  
  335.        If pcrupc <> *Zero;
  336.          spRtnInd = ChkPwdChar( $$NewPassword : 'U' : pcrupc);
  337.          If spRtnInd = *Off;
  338.          $$NumOfPasses += 1;
  339.          EndIf;
  340.        EndIf;
  341.  
  342.        // ==================================================================
  343.  
  344.        // Required LowerCase Characters? (Pass=Return Indicator is *Off)
  345.  
  346.        If pcrloc <> *Zero;
  347.          spRtnInd = ChkPwdChar( $$NewPassword : 'L' : pcrloc);
  348.          If spRtnInd = *Off;
  349.          $$NumOfPasses += 1;
  350.          EndIf;
  351.        EndIf;
  352.  
  353.        // ==================================================================
  354.  
  355.        // Required Number of Numeric Characters?
  356.        // (Pass=Return Indicator is *Off)
  357.  
  358.        If pcnumc <> *Zero;
  359.          spRtnInd = ChkPwdChar( $$NewPassword : 'N' : pcnumc);
  360.          If spRtnInd = *Off;
  361.          $$NumOfPasses += 1;
  362.          EndIf;
  363.        EndIf;
  364.  
  365.        // ==================================================================
  366.  
  367.        // Required Number of Special Characters?
  368.        // (Pass=Return Indicator is *Off)
  369.  
  370.        If pcspcc <> *Zero;
  371.          spRtnInd = ChkPwdChar( $$NewPassword : 'S' : pcspcc);
  372.          If spRtnInd = *Off;
  373.          $$NumOfPasses += 1;
  374.          EndIf;
  375.        EndIf;
  376.  
  377.        // ==================================================================
  378.  
  379.        // Check if Number of Conditions to Satisfy has Been Met
  380.  
  381.        If pcncts <> *Zero and
  382.           $$NumOfPasses < pcncts;
  383.          epRtnInd = '1';
  384.        EndIf;
  385.  
  386.        *Inlr = *On;
  387.        Return;
  388.  
  389.       /end-free
  390.       *
  391.       **********************************************************************
  392.       *
  393.       *  ------------
  394.       *  End MAINLINE
  395.       *  ------------
  396.       *
  397.  
  398.       ******************************************************************
  399.       *
  400.       *    SUBPROCEDURE: ChkPwdChar
  401.       *
  402.       *    Simple procedure to check the characters in a supplied password
  403.       *    the allowed values stored in the control file FSA800.
  404.       *    Returns an indicator for pass (*off) or fail (*on)
  405.       *
  406.       *    pPassword - contains the new password
  407.       *    pTypeChk  - contains the type of check to be performed
  408.       *                U - Check for Upper Case Characters
  409.       *                L - Check for Lower Case Characters
  410.       *                N - Check for Numeric Characters
  411.       *                S - Check for Special Characters
  412.       *    pReqChar  - contains the number of required characters
  413.       *                retrieved from the password validation controls
  414.       *
  415.      P ChkPwdChar      B
  416.  
  417.      D ChkPwdChar      PI             1N                                        returns 24 alpha
  418.      D   pPassword                  128A   CONST
  419.      D   pTypeChk                     1A   CONST
  420.      D   pReqChar                     3S 0 CONST
  421.  
  422.       *  Locally defined vars
  423.       *
  424.      D cResult         S              1N   inz(*off)
  425.      D iNbrChar        S              3S 0
  426.      D iStartPos       S             10  0
  427.      D iIndex          S             10  0
  428.  
  429.       /FREE
  430.  
  431.        iIndex = *Zero;
  432.        iStartPos = 1;
  433.        iNbrChar = *Zero;
  434.  
  435.        // Passwords can contain blank spaces, so must read entire 128
  436.        // Fixed this during testing 
  437.  
  438.        //Dow iStartPos <= 128 and
  439.        //    %Subst(pPassword : iStartPos : 1) <> *Blank;
  440.        //Dow iStartPos <= 128;
  441.        //Dow iStartPos <= LenOfNew;
  442.          Dow iStartPos <= LenOfNwPass;
  443.  
  444.          Select;
  445.            When pTypeChk = 'U';
  446.              iIndex = %scan(%Subst(pPassword : iStartPos : 1) : UP);
  447.            When pTypeChk = 'L';
  448.              iIndex = %scan(%Subst(pPassword : iStartPos : 1) : LO);
  449.            When pTypeChk = 'N';
  450.              iIndex = %scan(%Subst(pPassword : iStartPos : 1) : NUM);
  451.            When pTypeChk = 'S';
  452.              iIndex = %scan(%Subst(pPassword : iStartPos : 1) : SPC);
  453.          EndSl;
  454.  
  455.          iStartPos += 1;
  456.  
  457.          If iIndex > *Zero;
  458.            iNbrChar += 1;
  459.          EndIf;
  460.  
  461.        EndDo;
  462.  
  463.        If iNbrChar >= pReqChar;
  464.           cResult = *Off;
  465.        Else;
  466.           cResult = *On;
  467.        EndIf;
  468.  
  469.        Return  cResult;
  470.  
  471.       /END-FREE
  472.  
  473.      P ChkPwdChar      E
  474.  
  475.       ******************************************************************
  476.       *
  477.       *    SUBPROCEDURE: ChkPwdRepChar
  478.       *
  479.       *    Simple procedure to check for repeating characters
  480.       *    in a supplied password against whether repeating characters
  481.       *    are allowed as stored in the control file FSA800.
  482.       *    Returns an indicator for pass (*off) or fail (*on)
  483.       *
  484.      P ChkPwdRepChar   B
  485.  
  486.      D ChkPwdRepChar   PI             1N                                        returns 24 alpha
  487.      D   pPassword                  128A   CONST
  488.      D   pAlwRepChar                  1A   CONST
  489.  
  490.       *  Locally defined vars
  491.       *
  492.      D cResult         S              1N   inz(*off)
  493.      D iNbrSpcChar     S              3S 0
  494.      D iStartPos       S             10  0
  495.      D iIndex          S             10  0
  496.      D iPassword       S            128A
  497.  
  498.       /FREE
  499.  
  500.        iPassword = %xlate(lo:up:pPassword);
  501.  
  502.        cResult = *Off;
  503.  
  504.        iIndex = *Zero;
  505.        iNbrSpcChar = *Zero;
  506.        iStartPos = 1;
  507.  
  508.        // Passwords can contain blank spaces, so must read entire 128
  509.        // Fixed this during testing 
  510.  
  511.        //Dow iStartPos <= 127 and
  512.        //  %Subst(iPassword : iStartPos : 1) <> *Blank;
  513.  
  514.        Dow iStartPos <= 127;
  515.  
  516.          If %Subst(iPassword : iStartPos + 1 : 1 ) = *Blank;
  517.            Leave;
  518.          EndIf;
  519.  
  520.          iIndex = %scan(%Subst(iPassword : iStartPos : 2) : REP);
  521.  
  522.          iStartPos += 1;
  523.  
  524.          If iIndex > *Zero and
  525.             pAlwRepChar <> 'Y';
  526.            cResult = *On;
  527.            Leave;
  528.          EndIf;
  529.  
  530.        EndDo;
  531.  
  532.        Return  cResult;
  533.  
  534.       /END-FREE
  535.  
  536.      P ChkPwdRepChar   E
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css