Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1298602
  • 博文数量: 287
  • 博客积分: 11000
  • 博客等级: 上将
  • 技术积分: 3833
  • 用 户 组: 普通用户
  • 注册时间: 2007-08-16 08:43
文章分类
文章存档

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-21 17:42:47

QSYCUSRS & QSY. Check User Special Authorities (2)
 
Program . . : CBX1291
 
     **
     **  Program . . : CBX1291
     **  Description : Add profile authorization code - CPP
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : January 20, 2005
     **
     **
     **  Program description:
     **
     **
     **  Compile options:
     **    CrtRpgMod   Module( CBX1291 )
     **                DbgView( *NONE )
     **                Aut( *USE )
     **
     **    CrtPgm      Pgm( CBX1291 )
     **                Module( CBX1291 )
     **                ActGrp( *NEW )
     **                UsrPrf( *OWNER )
     **                Aut( *USE )
     **
     **    ChgObjOwn   Obj( CBX1291 )
     **                ObjType( *PGM )
     **                NewOwn( QSECOFR )
     **
     **    ChgPgm      Pgm( CBX1291 )
     **                RmvObs( *ALL )
     **
     **
     **
     **-- Control specification:  --------------------------------------------**
     H Option( *SrcStmt )
     **-- System information:
     D PgmSts         SDs                  Qualified
     D  PgmNam           *Proc
     D  CurJob                       10a   Overlay( PgmSts: 244 )
     D  UsrPrf                       10a   Overlay( PgmSts: 254 )
     D  JobNbr                        6a   Overlay( PgmSts: 264 )
     D  CurUsr                       10a   Overlay( PgmSts: 358 )
     **-- API error data structure:
     D ERRC0100        Ds                  Qualified
     D  BytPrv                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      512a
     **-- Global constants:
     D VLD_LST         c                   'CBX128L'
     D QSY_IN_VLDL     c                   0
     D QSY_SYSTEM_ATTR...
     D                 c                   0
     D ADP_PRV_INVLVL  c                   1
     **-- Validation list API structures:
     D Qsy_Vfy_Only    s              1a   Inz( '0' )
     **-- Validation list attribute data:
     D Qsy_Attr_Info_T...
     D                 Ds                  Qualified
     D  Number_Attrs                 10i 0 Inz( 1 )
     D  Res_align                    12a
     D  Attr_Descr                         LikeDs( Qsy_Attr_Descr_T )
     D                                     Inz( *LikeDs )
     **
     D Qsy_Attr_Descr_T...
     D                 Ds                  Qualified
     D  Attr_Location                10i 0 Inz( QSY_IN_VLDL )
     D  Attr_Type                    10i 0 Inz( QSY_SYSTEM_ATTR )
     D  Attr_Res                      8a   Inz( *Allx'00' )
     D  Attr_ID_p                      *
     D  Attr_Other_Descr...
     D                               32a   Inz( *Allx'00' )
     D  Attr_Data_Info...
     D                               96a
     D   Attr_VLDL                         LikeDs( Qsy_In_VLDL_T )
     D                                     Overlay( Attr_Data_Info: 1 )
     D                                     Inz( *LikeDs )
     D   Attr_In_Other...
     D                               96a   Overlay( Attr_Data_Info: 1 )
     D                               64a   Overlay( Attr_In_Other: 33 )
     D                                     Inz( *Allx'00' )
     D  Attr_Other_Data...
     D                               32a   Inz( *Allx'00' )
     **
     D Qsy_In_VLDL_T   Ds                  Qualified
     D  Attr_CCSID                   10i 0 Inz( -1 )
     D  Attr_Len                     10i 0 Inz( 1 )
     D  Attr_Res_1                    8a   Inz( *Allx'00' )
     D  Attr_Value_p                   *
     **
     D Qsy_Rtn_VLDL_Attr_T...
     D                 Ds                  Qualified
     D  Bytes_Returned...
     D                               10i 0
     D  Bytes_Available...
     D                               10i 0
     D  Attr_Len                     10i 0
     D  Attr_CCSID                   10u 0
     D  Attr_Data                          LikeDs( Qsy_Rtn_Entry_Usage_Attr_T )
     **
     D Qsy_Rtn_Entry_Usage_Attr_T...
     D                 Ds                  Qualified
     D  Create_Date                   8a
     D  Last_Used_Date...
     D                                8a
     D  Encr_Data_Chg_Date...
     D                                8a
     D  Not_Valid_Verify_Count...
     D                               10i 0
     **-- Validation list return data:
     D Qsy_Rtn_Vld_Lst_Ent_T...
     D                 Ds                  Qualified
     D  Entry_ID_Info                      LikeDs( Qsy_Entry_ID_Info_T )
     D  Encr_Data_Info...
     D                                     LikeDs( Qsy_Entry_Encr_Data_Info_T )
     D  Entry_Data_Info...
     D                                     LikeDs( Qsy_Entry_Data_Info_T )
     D                                4a
     D  AtrPtr                         *
     **
     D Qsy_Entry_ID_Info_T...
     D                 Ds                  Qualified
     D  Entry_ID_Len                 10i 0
     D  Entry_ID_CCSID...
     D                               10i 0 Inz( 65535 )
     D  Entry_ID                    100a
     **
     D Qsy_Entry_Encr_Data_Info_T...
     D                 Ds                  Qualified
     D  Encr_Data_Len                10i 0
     D  Encr_Data_CCSID...
     D                               10i 0 Inz( 65535 )
     D  Encr_Data                   600a
     **
     D Qsy_Entry_Data_Info_T...
     D                 Ds                  Qualified
     D  Entry_Data_Len...
     D                               10i 0
     D  Entry_Data_CCSID...
     D                               10i 0
     D  Entry_Data                 1000a
     **-- Global variables:
     D AutFlg          s              1a
     D RtnCod          s              1a
     **-- Journal entry:
     D JrnEntInf       Ds                  Qualified
     D  InfEntRcds                   10i 0 Inz( 1 )
     D  InfKey                       10i 0 Inz( 1 )
     D  InfLen                       10i 0 Inz( %Size( JrnEntInf.InfDta ))
     D  InfDta                        2a
     **
     D JrnEntA1        Ds                  Qualified
     D  UsrPrf                       10a
     D  GrpPrf                       10a
     D  AutCod                       10a
     D  RtnCod                        1a
     **-- Check special authority
     D ChkSpcAut       Pr                  ExtPgm( 'QSYCUSRS' )
     D  CsAutInf                      1a
     D  CsUsrPrf                     10a   Const
     D  CsSpcAut                     10a   Const  Dim( 8 )  Options( *VarSize )
     D  CsNbrAut                     10i 0 Const
     D  CsCalLvl                     10i 0 Const
     D  CsError                   32767a          Options( *VarSize )
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  SpMsgId                       7a   Const
     D  SpMsgFq                      20a   Const
     D  SpMsgDta                    128a   Const
     D  SpMsgDtaLen                  10i 0 Const
     D  SpMsgTyp                     10a   Const
     D  SpCalStkE                    10a   Const  Options( *VarSize )
     D  SpCalStkCtr                  10i 0 Const
     D  SpMsgKey                      4a
     D  SpError                    1024a          Options( *VarSize )
     **-- Send journal entry:
     D SndJrnE         Pr                  ExtPgm( 'QJOSJRNE' )
     D  SjJrnNamQ                    20a   Const
     D  SjJrnEntInf                4096a   Const  Options( *VarSize )
     D  SjEntDta                  32766a   Const  Options( *VarSize )
     D  SjEntDtaLen                  10i 0 Const
     D  SjError                   32767a          Options( *VarSize )
     **-- Add validation list entry:
     D AddVldLstE      Pr            10i 0 ExtProc( 'QsyAddValidation+
     D                                     LstEntry' )
     D  AvLstNam                     20a   Const
     D  AvEntId                        *   Value
     D  AvEncDta                       *   Value
     D  AvEntDta                       *   Value
     D  AvAtrDta                       *   Value
     **-- Remove validation list entry:
     D RmvVldLstE      Pr            10i 0 ExtProc( 'QsyRemoveValidation+
     D                                     LstEntry' )
     D  RvLstNam                     20a   Const
     D  RvEntId                        *   Value
     **-- Add user password:
     D AddUsrPwd       Pr            10i 0
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUrsId                      20a   Const
     D  PxAutCod                     10a   Const
     D  PxUsrDsc                     50a   Const
     **-- Remove user password:
     D RmvUsrPwd       Pr            10i 0
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
     **-- Send diagnostic message:
     D SndDiagMsg      Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send completion message:
     D SndCmpMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Entry parameters:
     D CBX1291         Pr
     D  PxUsrPrf                     10a
     D  PxGrpPrf                     10a
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxVldTim                      5i 0
     D  PxRplCod                      1a
     **
     D CBX1291         Pi
     D  PxUsrPrf                     10a
     D  PxGrpPrf                     10a
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxVldTim                      5i 0
     D  PxRplCod                      1a
      /Free
        RtnCod = '0';
        If  PxUsrPrf = PgmSts.UsrPrf;
          RtnCod = '1';
          SndDiagMsg( 'Self authorization is not allowed.' );
        Else;
          ChkSpcAut( AutFlg
                   : PgmSts.UsrPrf
                   : '*SECADM'
                   : 1
                   : ADP_PRV_INVLVL
                   : ERRC0100
                   );
          If  ERRC0100.BytAvl > *Zero  Or AutFlg = 'N';
            RtnCod = '2';
            SndDiagMsg( 'Special authority *SECADM required.' );
          Else;
            If  PxRplCod = 'Y';
              RmvUsrPwd( VLD_LST: '*LIBL': PxUsrPrf + PxGrpPrf );
            EndIf;
            If AddUsrPwd( VLD_LST
                        : '*LIBL'
                        : PxUsrPrf + PxGrpPrf
                        : PxAutCod
                        : %Char( %Timestamp() + %Minutes( PxVldTim ))
                        ) = *Zero;
              SndCmpMsg( 'Authorization code added.' );
            Else;
              RtnCod = '3';
              SndDiagMsg( 'Unexpected error occurred.' );
            EndIf;
          EndIf;
        EndIf;
        JrnEntInf.InfDta = 'A1';
        JrnEntA1.UsrPrf  = PxUsrPrf;
        JrnEntA1.GrpPrf  = PxGrpPrf;
        JrnEntA1.AutCod  = PxAutCod;
        JrnEntA1.RtnCod  = RtnCod;
        SndJrnE( 'QAUDJRN   *LIBL '
               : JrnEntInf
               : JrnEntA1
               : %Size( JrnEntA1 )
               : ERRC0100
               );
        If  RtnCod > '0';
          SndEscMsg( 'ADDPRFAUT command ended in error' );
        EndIf;
        *InLr = *On;
        Return;
      /End-Free
     **-- Send diagnostic message:  ------------------------------------------**
     P SndDiagMsg      B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a
      /Free
        SndPgmMsg( 'CPF9897'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*DIAG'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );
        If  ERRC0100.BytAvl > *Zero;
          Return  -1;
        Else;
          Return   0;
        EndIf;
      /End-Free
     P SndDiagMsg      E
     **-- Send escape message:  ----------------------------------------------**
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a
      /Free
        SndPgmMsg( 'CPF9898'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*ESCAPE'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );
        If  ERRC0100.BytAvl > *Zero;
          Return  -1;
        Else;
          Return  0;
        EndIf;
      /End-Free
     P SndEscMsg       E
     **-- Send completion message:  ------------------------------------------**
     P SndCmpMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a
      /Free
        SndPgmMsg( 'CPF9897'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*COMP'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );
        If  ERRC0100.BytAvl > *Zero;
          Return  -1;
        Else;
          Return  0;
        EndIf;
      /End-Free
     **
     P SndCmpMsg       E
     **-- Add user password:  ------------------------------------------------**
     P AddUsrPwd       B                   Export
     D                 Pi            10i 0
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
     D  PxUsrPwd                     10a   Const
     D  PxUsrDsc                     50a   Const
      /Free
        Reset  Qsy_Entry_ID_Info_T;
        Reset  Qsy_Entry_Encr_Data_Info_T;
        Reset  Qsy_Entry_Data_Info_T;
        Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
        Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );
        Qsy_Entry_Encr_Data_Info_T.Encr_Data = PxUsrPwd;
        Qsy_Entry_Encr_Data_Info_T.Encr_Data_Len = %Len( %TrimR( PxUsrPwd ));
        Qsy_Entry_Data_Info_T.Entry_Data = PxUsrDsc;
        Qsy_Entry_Data_Info_T.Entry_Data_Len = %Len( %TrimR( PxUsrDsc ));
        Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p = %Alloc( 15 );
        %Str( Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p: 15 ) = 'QsyEncryptData';
        Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Len = %Size( Qsy_Vfy_Only );
        Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Value_p =
                                                        %Addr( Qsy_Vfy_Only );
        Return    AddVldLstE( PxVldLst + PxVldLstLib
                            : %Addr( Qsy_Entry_ID_Info_T )
                            : %Addr( Qsy_Entry_Encr_Data_Info_T )
                            : %Addr( Qsy_Entry_Data_Info_T )
                            : %Addr( Qsy_Attr_Info_T )
                            );
      /End-Free
     P AddUsrPwd       E
     **-- Remove user password:  ---------------------------------------------**
     P RmvUsrPwd       B                   Export
     D                 Pi            10i 0
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
      /Free
        Reset  Qsy_Entry_ID_Info_T;
        Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
        Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );
        Return    RmvVldLstE( PxVldLst + PxVldLstLib
                            : %Addr( Qsy_Entry_ID_Info_T )
                            );
      /End-Free
     P RmvUsrPwd       E
阅读(1808) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~