**
** Program . . : CBX1291V
** Description : Add profile authorization code - VCP
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : January 20, 2005
**
**
** Program description:
** This program checks the existence of the specified user profile
** and group profile, verifies the QSECOFR ownership of the utility
** validation list, the existence of the system audit journal QAUDJRN
** as well as the validity of the specified replace option for the
** authorization code.
**
**
** Compile options:
** CrtRpgMod Module( CBX1291V )
** DbgView( *NONE )
** Aut( *USE )
**
** CrtPgm Pgm( CBX1291V )
** Module( CBX1291V )
** ActGrp( *NEW )
** UsrPrf( *OWNER )
** Aut( *USE )
**
** ChgObjOwn Obj( CBX1291V )
** ObjType( *PGM )
** NewOwn( QSECOFR )
**
** ChgPgm Pgm( CBX1291V )
** 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 SPC_NAM_Q c 'CBX128U QTEMP'
D VLD_LST c 'CBX128L'
D QSY_IN_VLDL c 0
D QSY_SYSTEM_ATTR...
D c 0
**-- Global variables:
D AtrDta Ds Qualified
D CrtDat 8a
D LstVfyDat 8a
D PwdChgDat 8a
D InvPwdCnt 10i 0
**
D UsrDta s 128a
D PrfTkn s 32a
**
D UsrSpc Ds Qualified Based( pUsrSpc )
D DtaId 10a
D DtaLen 10i 0
D Dta Like( PrfTkn )
**-- 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
**-- 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 JrnEntA0 Ds Qualified
D UsrPrf 10a
D GrpPrf 10a
D AutCod 10a
D RplCod 1a
D VldTim 5s 0
D Reason 256a
**-- Retrieve user information:
D RtvUsrInf Pr ExtPgm( 'QSYRUSRI' )
D RuRcvVar 32767a Options( *VarSize )
D RuRcvVarLen 10i 0 Const
D RuFmtNam 10a Const
D RuUsrPrf 10a Const
D RuError 32767a Options( *VarSize )
**-- Retrieve object description:
D RtvObjD Pr ExtPgm( 'QUSROBJD' )
D RoRcvVar 32767a Options( *VarSize )
D RoRcvVarLen 10i 0 Const
D RoFmtNam 8a Const
D RoObjNamQ 20a Const
D RoObjTyp 10a Const
D RoError 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 )
**-- Find validation list entry:
D FndVldLst Pr 10i 0 ExtProc( 'QsyFindValidation+
D LstEntry' )
D FvLstNam 20a Const
D FvEntId * Value
D FvRtnDta * Value
**-- Find validation list entry attributes:
D FndVldLstAtr Pr 10i 0 ExtProc( 'QsyFindValidation+
D LstEntryAttrs' )
D FvLstNam 20a Const
D FvEntId * Value
D FvRtnDta * Value
D FvAtrInf * Value
**-- Verify validation list entry:
D VfyVldLst Pr 10i 0 ExtProc( 'QsyVerifyValidation+
D LstEntry' )
D VvLstNam 20a Const
D VvEntId * Value
D VvEncDta * Value
**-- Get profile owner attribute:
D GetPrfOwnA Pr 10a
D PxUsrPrf 10a Value
**-- Check object existence:
D ChkObj Pr 10a
D RaObjNam 10a Const
D RaObjLib 10a Const
D RaObjTyp 10a Const
**-- Get object owner:
D GetObjOwn Pr 10a
D PxObjNam 10a Const
D RaObjLib 10a Const
D PxObjTyp 10a Const
**-- Verify validation list entry:
D VfyVldLstEnt Pr 10i 0
D PxVldLst 10a Const
D PxVldLstLib 10a Const
D PxUsrId 20a Const
**-- Send diagnostic message:
D SndDiagMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgDta 512a Const Varying
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgDta 512a Const Varying
**-- Entry parameters:
D CBX1291V Pr
D PxUsrPrf 10a
D PxGrpPrf 10a
D PxAutCod 10a
D PxReason 256a Varying
D PxVldTim 5i 0
D PxRplCod 1a
**
D CBX1291V Pi
D PxUsrPrf 10a
D PxGrpPrf 10a
D PxAutCod 10a
D PxReason 256a Varying
D PxVldTim 5i 0
D PxRplCod 1a
/Free
JrnEntInf.InfDta = 'A0';
JrnEntA0.UsrPrf = PxUsrPrf;
JrnEntA0.GrpPrf = PxGrpPrf;
JrnEntA0.AutCod = PxAutCod;
JrnEntA0.RplCod = PxRplCod;
JrnEntA0.VldTim = PxVldTim;
JrnEntA0.Reason = PxReason;
SndJrnE( 'QAUDJRN *LIBL '
: JrnEntInf
: JrnEntA0
: %Size( JrnEntA0 )
: ERRC0100
);
Select;
/If Defined( *V5R2M0 )
/Else
When GetPrfOwnA( PxUsrPrf ) = '*GRPPRF';
SndDiagMsg( 'CPD0006': '0000Group profile cannot be object owner.' );
SndEscMsg( 'CPF0002': '' );
/EndIf
When ChkObj( PxUsrPrf: '*LIBL': '*USRPRF' ) = *Off;
SndDiagMsg( 'CPD0006': '0000User profile does not exist.' );
SndEscMsg( 'CPF0002': '' );
When ChkObj( PxGrpPrf: '*LIBL': '*USRPRF' ) = *Off;
SndDiagMsg( 'CPD0006': '0000Group profile does not exist.' );
SndEscMsg( 'CPF0002': '' );
When ChkObj( 'QAUDJRN': '*LIBL': '*JRN' ) = *Off;
SndDiagMsg( 'CPD0006': '0000Invalid configuration. Error code 01.' );
SndEscMsg( 'CPF0002': '' );
When GetObjOwn( VLD_LST: '*LIBL': '*VLDL' ) <> 'QSECOFR';
SndDiagMsg( 'CPD0006': '0000Invalid configuration. Error code 02.' );
SndEscMsg( 'CPF0002': '' );
Other;
ExSr ChkVldLst;
EndSl;
*InLr = *On;
Return;
BegSr ChkVldLst;
If PxRplCod = 'N';
If VfyVldLstEnt( VLD_LST: '*LIBL': PxUsrPrf + PxGrpPrf ) = *Zero;
SndDiagMsg( 'CPD0006': '0000Authorization code already exists.' );
SndEscMsg( 'CPF0002': '' );
EndIf;
EndIf;
EndSr;
/End-Free
**-- Get profile owner attribute: --------------------------------------**
P GetPrfOwnA B Export
D Pi 10a
D PxUsrPrf 10a Value
**
D USRI0200 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D UsrPrf 10a
D PrfOwnA 10a Overlay( USRI0200: 54 )
/Free
RtvUsrInf( USRI0200
: %Size( USRI0200 )
: 'USRI0200'
: PxUsrPrf
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return *Blanks;
Else;
Return USRI0200.PrfOwnA;
EndIf;
/End-Free
P GetPrfOwnA E
**-- Check object existence: -------------------------------------------**
P ChkObj B Export
D Pi 10a
D RaObjNam 10a Const
D RaObjLib 10a Const
D RaObjTyp 10a Const
**
D OBJD0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D ObjNam 10a
D ObjLib 10a
D ObjTyp 10a
/Free
RtvObjD( OBJD0100
: %Size( OBJD0100 )
: 'OBJD0100'
: RaObjNam + RaObjLib
: RaObjTyp
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return *Off;
Else;
Return *On;
EndIf;
/End-Free
P ChkObj E
**-- Get object owner: -------------------------------------------------**
P GetObjOwn B Export
D Pi 10a
D RaObjNam 10a Const
D RaObjLib 10a Const
D PxObjTyp 10a Const
**
D OBJD0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D ObjNam 10a
D ObjLib 10a
D ObjTyp 10a
D ObjLibRt 10a
D ObjASP 10i 0
D ObjOwn 10a
D ObjDmn 2a
/Free
RtvObjD( OBJD0100
: %Size( OBJD0100 )
: 'OBJD0100'
: RaObjNam + RaObjLib
: PxObjTyp
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return *Blanks;
Else;
Return OBJD0100.ObjOwn;
EndIf;
/End-Free
P GetObjOwn E
**-- Send diagnostic message: ------------------------------------------**
P SndDiagMsg B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( PxMsgId
: '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 PxMsgId 7a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( PxMsgId
: '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
**-- Verify validation list entry: -------------------------------------**
P VfyVldLstEnt B Export
D Pi 10i 0
D PxVldL 10a Const
D PxVldLlib 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 FndVldLst( PxVldL + PxVldLlib
: %Addr( Qsy_Entry_ID_Info_T )
: %Addr( Qsy_Rtn_Vld_Lst_Ent_T )
);
/End-Free
P VfyVldLstEnt E
阅读(1703) | 评论(0) | 转发(0) |
