| 
// A partir d'un exemple trouvé sur le NET // http://forums.iprodeveloper.com/forums/aft/147271 // adapté aux spécificités VOLUBIS H DFTACTGRP(*NO) ACTGRp(*caller) *--------------------------------------------------------------------- * - CRTRPGMOD MODULE(QTEMP/*CTLSPEC) SRCMBR(EIM01) * - CRTPGM PGM(EIM01) MODULE(QTEMP/EIM01) BNDSRVPGM((QSYEIM)) * ACTGRP(*CALLER) AUT(*EXCLUDE) USRPRF(*OWNER) *--------------------------------------------------------------------- * This Program create an EIM Identifier and Association in EIM * It Receive parameters : the User (10a) and an Action (3a) * The Action can be 'CRT', 'CHG' or 'DLT' * 'ADD' & 'CHG' have the same behaviour. *--------------------------------------------------------------------- *--------------------------------------------------------------------- * Header File Name: eim.h * Enterprise Identity Mapping (EIM) APIs *--------------------------------------------------------------------- *Description: * * Defines prototypes, macros, variables, and * structures to be used with the EIM APIs. * *------------ * EIMHandle *------------ DEIMANDLE DS * EIMHandle D EIMANDLE00 1 16 * handle *--------------------------------------------* *eimErr2String -- errrc to string message *--------------------------------------------* deimErr2String pr * extproc('eimErr2String') d rtcdds like(eimrc) *--------------------------------------------* * Variables for eimErr2String *--------------------------------------------* d errMsg£ s * d errMsg ds 256 based(errMsg£) d RtnMsg s 256 *-------------------------- |
|
* Eim Connect Information *-------------------------- DEIMSCI DS * EimSimpleConnectInfo D EIMOTECT 1 4B 0 * protect D EIMBD 17 32* * bindDn D EIMBP 33 48* * bindPw DEIMCI DS * EimConnectInfo D EIMTYPE 1 4B 0 * type D EIMERVED00 5 16 * Reserved D EIMCREDS 17 64 * CREDS * GSS-CRED-ID-T-EIM-R REDEFINES CREDS D EIMGCI 17 32* * gss cred id t * SIMPLECREDS REDEFINES CREDS D EIMOTECT00 17 20B 0 * protect D EIMBD00 33 48* * bindDn D EIMBP00 49 64* * bindPw D EIMSSL 65 80* * ssl *---------------------- *Return code structure *---------------------- DEIMRC DS * EimRC D EIMMPBC 1 4U 0 * Input: Size of the entire RC * structure. This is filled in by * the caller. This is used to tell * the API how much space was provided * for substitution text D EIMMRTRD 5 8U 0 * Output: Filled in by API |
|
* to tell caller how much data could * have been returned. Caller can then * determine if the caller provided * enough space (i.e. if the entire * substitution string was able to be * copied to this structure. D EIMRC00 9 12B 0 * Same as the errno returned as the * rc for the API D EIMMCSN 13 16B 0 * Message catalog set number D EIMMCMID 17 20B 0 * Message catalog message id D EIMLE 21 24B 0 * ldap error, if available D EIMSE 25 28B 0 * SLL error, if available D EIMERVED01 29 44 * Reserved for future use D EIMSTL 45 48U 0 * Length of substitution text * excluding a null-terminator which * may or may not be present D EIMST 49 49 * further info describing the * error. D*-------------------------------------------------------------------- D*EimIdentifierInfo D*-------------------------------------------------------------------- D EIMUSER s 11 DEIMII00 DS D* EimIdentifierInfo D EIMID 1 16 D* ID D* UNIQUENAME-EIM-R REDEFINES ID-FIELD D EIMUN 1 16* D* uniqueName D* ENTRYUUID-EIM-R REDEFINES ID-FIELD D EIMEUUID 1 16* D* entryUUID D* NAME-EIM-R REDEFINES ID-FIELD D EIMNAME 1 16* D* name D EIMDTYPE 17 20B 0 |
|
D* idtype
*--------------------------------------------*
* Varibles for EIM Handles (create & destroy)
*--------------------------------------------*
d handle s like(eimandle)
**
d rtcd s like(EIMMPBC)
d null c x'00'
d pwdl s 10
* EimConnect
d BindDn s 80
d BindPw s 80
*--------------------------------------------*
*eimCreateHandle -- create eim handle
*--------------------------------------------*
deimCreateHandle pr 10U 0 extproc('eimCreateHandle')
d handle like(eimandle)
d * value
d rtcdds like(eimrc)
*--------------------------------------------*
*eimDestHandle -- destroy handle and connection
*--------------------------------------------*
deimDestHandle pr 10U 0 extproc('eimDestroyHandle')
d handle like(eimandle)
d rtcdds like(eimrc)
*--------------------------------------------*
*eimConnect -- connect to eim directory
*--------------------------------------------*
deimConnect pr 10U 0 extproc('eimConnect')
d handle like(eimandle)
d conInfo like(eimci) value
d rtcdds like(eimrc)
*--------------------------------------------*
*eimAddIdentifier - Add new user
*--------------------------------------------*
* Variables for the API
d EIM_FAIL c 0
*
d eimRemoveIdentifier...
d pr 10U 0 extproc('eimRemoveIdentifier')
d Handle like(eimandle)
d Identifier * value
|
|
d rtcdds like(eimrc)
*
d eimAddIdentifier...
d pr 10U 0 extproc('eimAddIdentifier')
d Handle like(eimandle)
d Identifier * value
d Action 4b 0 value
d * value
d * value
d Description * value
d rtcdds like(eimrc)
*--------------------------------------------*
*eimAddAssociation - Add Eim Association
*--------------------------------------------*
* Variables for the API
d EIM_TARGET c 1
d EIM_SOURCE c 2
d EIM_SOURCE_AND_TARGET...
d c 3
d EIM_ADMIN c 4
d EIM_ENTRY_UUID c 2
*
d Domain s 80 Varying
d Source s 80
d Target s 80
d eimAddAssociation...
d pr 10U 0 extproc('eimAddAssociation')
d Handle like(eimandle)
d Action 4b 0 value
d Identifier * value
d RegName * value
d RegUserName * value
d rtcdds like(eimrc)
*---------------------------------------------------------------------
* Api for the RTVNETA to get back the SYSTEM NAME
*---------------------------------------------------------------------
D SystemName PR 8A
*---------------------------------------------------------------------
* Api for get user profile informations
*---------------------------------------------------------------------
D GetUserInfo PR ExtPgm('QSYRUSRI')
d 32767a Options(*VarSize)
d 10I 0
d 8A
|
|
d 10A
d 256A
* User Profile Information data structure
d UsrInfo DS
d ByteRtrn 10I 0 inz
d ByteAvail 10I 0 inz
d UserName 50A overlay(UsrInfo:199)
* Misc variables
D wsize S 10I 0 Inz(%size(UsrInfo))
D FormatName S 8A Inz('USRI0300')
D ldapurl S 256A
* Error data structure
d dsError DS 256
d ErrSize 10I 0 inz(116)
d overlay(dsError:1)
d ErrBytes 10I 0 inz(0)
d overlay(dsError:5)
d ErrMsgID 7A
d overlay(dsError:9)
d Err 1A
d overlay(dsError:16)
d ErrMsgTxt 100A
d overlay(dsError:17)
*---------------------------------------------------------------------
* Entry Point
*---------------------------------------------------------------------
c *entry plist
c parm User 10
c parm Action 3
c parm ppwd 10
*
* Action : CRT, CHG, DLT.
*
*---------------------------------------------------------------------
* Main Program
*---------------------------------------------------------------------
/free
If not(%subst(User :1 :1) = 'Q');
BindDn = 'cn=administrateur' + null ;
if %parms() < 3;
dsply 'mot de passe ?' 'QSYSOPR' pwd;
|
|
else; pwd = ppwd; ENDIF; BindPw = %trim(pwd) + null ; Domain = 'VOLUBIS.INTRA'; Source = 'DOMAINENT' + '.' + Domain + null; Target = %trim(SystemName()) + '.' + Domain + null; // ------------------------- // - Create Handle for EIM - // ------------------------- eimmpbc = 256; rtcd = eimCreateHandle(handle:*NULL:eimrc); ou ldapurl = 'ldap://as400.volubis.intra:389/ibm-eimDomainName=VOLUBIS+ ,dc=as400,dc=volubis,dc=fr' + null; rtcd=eimCreateHandle(handle:%addr(ldapurl):eimrc); // ------------------ // - Connect to EIM - // ------------------ // It is not good practice to store unencrypted user names // and passwords in programs. It is reccomended that you // some other method. eimtype = *zero ; eimotect00 = *zero ; eimotect = *zero ; eimbd00 = %addr(BindDn) ; eimbp00 = %addr(BindPw) ; rtcd = eimConnect(handle:eimci:eimrc); Exsr RtvErr; EimUser = %trim(User) + null; EIMUN = %addr(EimUser); EIMDTYPE = EIM_ENTRY_UUID; //-------------------------------------------- // Remove EIM Identifier //-------------------------------------------- |
|
rtcd = eimRemoveIdentifier(handle :%addr(EIMII00) : eimrc); Exsr RtvErr; If not (Action = 'DLT'); //-------------------------------------------- // Retreive the User Profile Text Description //-------------------------------------------- GetUserInfo(UsrInfo:wSize:FormatName:User:dsError); UserName = %trim(Username) + null; //-------------------------------------------- // Add EIM Identifier //-------------------------------------------- rtcd = eimAddIdentifier(handle: EIMUN :EIM_FAIL : *null : *null : %addr(UserName) : eimrc); Exsr RtvErr; //-------------------------------------------- // Add Association *SOURCE //-------------------------------------------- rtcd = eimAddAssociation(handle: EIM_SOURCE :%addr(EIMII00) :%addr(Source) : EIMUN : eimrc); Exsr RtvErr; //-------------------------------------------- // Add Association *TARGET //-------------------------------------------- rtcd = eimAddAssociation(handle: EIM_TARGET :%addr(EIMII00) :%addr(Target) : EIMUN : eimrc); Exsr RtvErr; Endif; //-------------------------------------------- // Detroy Handle //-------------------------------------------- rtcd = eimDestHandle(handle:eimrc); |
|
Endif;
*inlr = *on;
//*--------------------------------------------*
//* Retrieve Error (for debug)
//*--------------------------------------------*
Begsr RtvErr;
errMsg£ = eimErr2String(eimrc);
RtnMsg = %str(errMsg£:%size(errMsg));
Endsr;
/end-free
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Retrieve System Name procedure: SystemName()
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P SystemName B
D SystemName PI 8A
D QWCRNETA PR ExtPgm('QWCRNETA')
D RcvVar 32766A OPTIONS(*VARSIZE)
D RcvVarLen 10I 0 const
D NbrNetAtr 10I 0 const
D AttrNames 10A const
D ErrorCode 256A
D* Receiver variable for QWCRNETA with only one attribute
D RV ds
D* Number of Attrs returned
D RV_Attrs 10I 0
D* Offset to first attribute
D RV_Offset 10I 0
D* Add'l data returned.
D RV_Data 1A DIM(1000)
D* Network attribute structure
D p_NA S *
D NA ds based(p_NA)
D* Attribute Name
D NA_Attr 10A
D* Type of Data. C=Char, B=Binary
D NA_Type 1A
D* Status. L=Locked, Blank=Normal
D NA_Status 1A
D* Length of Data
D NA_Length 10I 0
|
|
D* Actual Data (in character) D NA_DataChr 1000A D* Actual Data (in binary) D NA_DataInt 10I 0 overlay(NA_DataChr:1) /free |
