Example: ILE RPG program for creating roles or profiles for your Coprocessor
Change this IBM i ILE RPG program example to suit your needs for creating roles and profiles for your Coprocessor.
Note: Read the Code license and disclaimer information for
important legal information.
If you choose to use this program example, change it to suit your specific needs. For security reasons, IBM recommends that you individualize these program examples rather than using the default values provided.
D*************************************************************
D* CRTROLEPRF
D*
D* Sample program to create 3 roles and 3 profiles in the
D* and change the authority for the default role.
D*
D*
D* COPYRIGHT 5769-SS1 (C) IBM CORP. 2000, 2007
D*
D* This material contains programming source code for your
D* consideration. These example has not been thoroughly
D* tested under all conditions. IBM, therefore, cannot
D* guarantee or imply reliability, serviceability, or function
D* of these programs. All programs contained herein are
D* provided to you "AS IS". THE IMPLIED WARRANTIES OF
D* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
D* ARE EXPRESSLY DISCLAIMED. IBM provides no program services for
D* these programs and files.
D*
D*
D* Note: Input format is more fully described in Chapter 2 of
D* IBM CCA Basic Services Reference and Guide
D* (SC31-8609) publication.
D*
D* Parameters: None
D*
D* Example:
D* CALL PGM(CRTROLEPRF)
D*
D* Use these commands to compile this program on the system:
D* CRTRPGMOD MODULE(CRTROLEPRF) SRCFILE(SAMPLE)
D* CRTPGM PGM(CRTROLEPRF) MODULE(CRTROLEPRF)
D* BNDDIR(QCCA/QC6BNDDIR)
D*
D* Note: Authority to the CSUAACI service program in the
D* QCCA library is assumed.
D*
D* The Common Cryptographic Architecture (CCA) verbs used are
D* Access_Control_Initialize (CSUAACI)
D*
D**************************************************************
D*--------------------------------------------------------
D* Declare variables used by CCA SAPI calls
D*--------------------------------------------------------
D* ** Return code
DRETURNCODE S 9B 0
D* ** Reason code
DREASONCODE S 9B 0
D* ** Exit data length
DEXITDATALEN S 9B 0
D* ** Exit data
DEXITDATA S 4
D* ** Rule array count
DRULEARRAYCNT S 9B 0
D* ** Rule array
DRULEARRAY S 16
D* ** Text length
DTEXTLEN S 9B 0
D* ** Text to hash
DTEXT S 20
D* ** Chaining vector length
DCHAINVCTLEN S 9B 0 INZ(128)
D* ** Chaining vector
DCHAINVCT S 128
D* ** Hash length
DHASHLEN S 9B 0 INZ(20)
D*-------------------------------------------------------------
D* VERBDATA1 contains the aggregate profile structure which
D* in turn contains 3 profiles.
D*-------------------------------------------------------------
DVERBDATALEN1 S 9B 0 INZ(278)
DVERBDATA1 DS 278
D* ** Define 3 Profiles
DNUMPROFS 9B 0 INZ(3)
D* ** Reserved field
DRESR1 9B 0 INZ(0)
DPROF1 90
DPROF2 90
DPROF3 90
D*
D*-------------------------------------------------------------
D* Define the profile structure
D*-------------------------------------------------------------
DPROFILESTRUCT DS
D* ** Version 1 struct
DPROFVERS 2 INZ(X'0100')
D* ** Length of profile
DPROFLEN 2 INZ(X'005A')
D* ** Description of profile
DCOMMENTP 20 INZ(' ')
D* ** Checksum is not used
DCHECKSUMP 2 INZ(X'0000')
D* ** Logon failure count
DLOGFC 1 INZ(X'00')
D* ** Reserved
DRESR2 1 INZ(X'00')
D* ** Profile name
DUSERID 8
D* ** Role used
DROLENAME 8
D* ** Activation year (2013)
DACTYEAR 2 INZ(X'07DD')
D* ** Activation month (01)
DACTMONTH 1 INZ(X'01')
D* ** Activation day (01)
DACTDAY 1 INZ(X'01')
D* ** Expiration year (2020)
DEXPYEAR 2 INZ(X'07E4')
D* ** Expiration month (12)
DEXPMONTH 1 INZ(X'0C')
D* ** Expiration day (31)
DEXPDAY 1 INZ(X'1F')
D* ** Total authentication
D* ** data length
DTOTAUTDTALEN 2 INZ(X'0024')
D* ** Field type
DFIELDTYPE 2 INZ(X'0001')
D* ** Authentication data len
DAUTDATLEN 2 INZ(X'0020')
D* ** Authentication mechanism
DMECHANISM 2 INZ(X'0001')
D* ** Mechanism strength
DSTRENGTH 2 INZ(X'0000')
D* ** Mech expiration year (2020)
DMCHEXPYEAR 2 INZ(X'07E4')
D* ** Mech expiration month (12)
DMCHEXPMONTH 1 INZ(X'0C')
D* ** Mech expiration day (31)
DMCHEXPDAY 1 INZ(X'1F')
D* ** Attributes
DATTRIBUTES 4 INZ(X'80000000')
D* ** Authentication data
DAUTHDATA 20 INZ(' ')
D*
D*-------------------------------------------------------------
D* The Default role is being replaced
D* Verb_data_2 length set to the length of the default role
D*-------------------------------------------------------------
DVERBDATALEN2 S 9B 0 INZ(335)
D*-------------------------------------------------------------
D* VERBDATA2 contains the aggregate role structure which
D* in turn contains 3 roles.
D*-------------------------------------------------------------
DVERBDATA2 DS
D* ** Define 3 Roles
DNUMROLES 9B 0 INZ(3)
D* ** Reserved field
DRESR3 9B 0 INZ(0)
DROLE1 109
DROLE2 109
DROLE3 109
D*
D*-------------------------------------------------------------
D* Define the role structure
D*-------------------------------------------------------------
DROLESTRUCT DS
D* ** Version 1 struct
DROLEVERS 2 INZ(X'0100')
D* ** Length of role
DROLELEN 2 INZ(X'006D')
D* ** Description of role
DCOMMENTR 20 INZ(' ')
D* ** Checksum is not used
DCHECKSUMR 2 INZ(X'0000')
D* ** Reserved field
DRESR4 2 INZ(X'0000')
D* ** Role Name
DROLE 8
D* ** Authentication strength is set to 0
DAUTHSTRN 2 INZ(X'0000')
D* ** Lower time is 00:00
DLWRTIMHR 1 INZ(X'00')
DLWRTIMMN 1 INZ(X'00')
D* ** Upper time is 23:59
DUPRTIMHR 1 INZ(X'17')
DUPRTIMMN 1 INZ(X'3B')
D* ** Valid days of week
DVALIDDOW 1 INZ(X'FE')
D* ** Reserved field
DRESR5 1 INZ(X'00')
D* ** 2 Access control points segments are defined
DNUMSEG 2 INZ(X'0002')
D* ** Reserved field
DRESR6 2 INZ(X'0000')
D* ** Starting bit of segment 1 is 0
DSTART1 2 INZ(X'0000')
D* ** Ending bit of segment 1 is 295 (Hex 127).
DEND1 2 INZ(X'0127')
D* ** 37 Bytes in segment 1
DNUMBYTES1 2 INZ(X'0025')
D* ** Reserved field
DRESR7 2 INZ(X'00')
D* ** Segment 1 access control pointer
DBITMAP1A 8
DBITMAP1B 8
DBITMAP1C 8
DBITMAP1D 8
DBITMAP1E 5
D* ** Starting bit of segment 2 is 512 (Hex 200)
DSTART2 2 INZ(X'0200')
D* ** Ending bit of segment 2 is 575 (Hex 23F)
DEND2 2 INZ(X'023F')
D* ** 8 Bytes in segment 2
DNUMBYTES2 2 INZ(X'0008')
D* ** Reserved field
DRESR8 2 INZ(X'0000')
D* ** Segment 2 access control points
DBITMAP2 8
D*
D* *----------------------------*
D* * DEFAULT expressed in ASCII *
D* *----------------------------*
DDEFAULT S 8 INZ(X'44454641554C5420')
D*
D**********************************************************
D* Prototype for Access_Control_Initialize (CSUAACI)
D**********************************************************
DCSUAACI PR
DRETCODE 9B 0
DRSNCODE 9B 0
DEXTDTALEN 9B 0
DEXTDTA 4
DRARRAYCT 9B 0
DRARRAY 16
DVRBDTALEN1 9B 0
DVRBDTA1 278
DVRBDTALEN2 9B 0
DVRBDTA2 335
D*
D**********************************************************
D* Prototype for One_Way_Hash (CSNBOWH)
D**********************************************************
DCSNBOWH PR
DRETCOD 9B 0
DRSNCOD 9B 0
DEXTDTALN 9B 0
DEXTDT 4
DRARRYCT 9B 0
DRARRY 16
DTXTLEN 9B 0
DTXT 20
DCHNVCTLEN 9B 0
DCHNVCT 128
DHSHLEN 9B 0
DHSH 20
D*
D*-------------------------------------------------------------
D* ** Declares for sending messages to the
D* ** job log using the QMHSNDPM API
D*-------------------------------------------------------------
DMSG S 64 DIM(3) CTDATA PERRCD(1)
DMSGLENGTH S 9B 0 INZ(64)
D DS
DMSGTEXT 1 75
DSAPI 1 7
DFAILRETC 41 44
DFAILRSNC 46 49
DMESSAGEID S 7 INZ(' ')
DMESSAGEFILE S 21 INZ(' ')
DMSGKEY S 4 INZ(' ')
DMSGTYPE S 10 INZ('*INFO ')
DSTACKENTRY S 10 INZ('* ')
DSTACKCOUNTER S 9B 0 INZ(2)
DERRCODE DS
DBYTESIN 1 4B 0 INZ(0)
DBYTESOUT 5 8B 0 INZ(0)
C*
C**************************************************************
C* START OF PROGRAM *
C* *
C*------------------------------------------------------------*
C* Set up roles in verb data 2 *
C*------------------------------------------------------------*
C* Set ROLE name (ROLE1)
C MOVEL 'ROLE1 ' ROLE
C* *--------------------------------------------------------
C* * Set Access Control Points for ROLE1
C* *
C* * DEFAULT is authorized to all access control points
C* * except for the following:
C* * 0x0018 - Load 1st part of Master Key
C* * 0x0019 - Combine Master Key Parts
C* * 0x001A - Set Master Key
C* * 0x0020 - Generate Random Master Key
C* * 0x0032 - Clear New Master Key Register
C* * 0x0033 - Clear Old Master Key Register
C* * 0x00D6 - Translate CV
C* * 0x0110 - Set Clock
C* * 0x0111 - Reinitialize device
C* * 0x0112 - Initialize access control system
C* * 0x0113 - Change user profile expiration date
C* * 0x0114 - Change authentication data (eg. passphrase)
C* * 0x0115 - Reset password failure count
C* * 0x0116 - Read Public Access Control Information
C* * 0x0117 - Delete user profile
C* * 0x0118 - Delete role
C* * 0x0119 - Load Function Control Vector
C* * 0x011A - Clear Function Control Vector
C* * 0x011B - Force User Logoff
C* * 0x0200 - Register PKA Public Key Hash
C* * 0x0201 - Register PKA Public Key, with cloning
C* * 0x0202 - Register PKA Public Key
C* * 0x0203 - Delete Retained Key
C* * 0x0204 - PKA Clone Key Generate
C* * 0x0211 - 0x21F - Clone information - obtain 1-15
C* * 0x0221 - 0x22F - Clone information - install 1-15
C* *
C* * ROLE 1 is authorized to all access control points
C* * to which the DEFAULT role is authorized plus the following:
C* *
C* * 0x0018 - Load 1st part of Master Key
C* * 0x0020 - Generate Random Master Key
C* * 0x0032 - Clear New Master Key Register
C* * 0x0053 - Load 1st part of PKA Master Key
C* * 0x0060 - Clear New PKA Master Key Register
C* * 0x0119 - Load Function Control Vector
C* * 0x0201 - Register PKA Public Key, with cloning
C* * 0x0202 - Register PKA Public Key
C* * 0x0203 - Delete Retained Key
C* * 0x0204 - PKA Clone Key Generate
C* * 0x0211 - 0x215 - Clone information - obtain 1-5
C* * 0x0221 - 0x225 - Clone information - install 1-5
C* *
C* *--------------------------------------------------------
C EVAL BITMAP1A = X'0003F09D80002000'
C EVAL BITMAP1B = X'8000100080000000'
C EVAL BITMAP1C = X'000A8000881F7110'
C EVAL BITMAP1D = X'1004031180000000'
C EVAL BITMAP1E = X'FF7F004F80'
C EVAL BITMAP2 = X'78007C007C00E60F'
C* Copy role into aggregate structure
C MOVEL ROLESTRUCT ROLE1
C* Set ROLE name (ROLE2)
C MOVEL 'ROLE2 ' ROLE
C* *--------------------------------------------------------
C* * Set Access Control Points for ROLE2
C* *
C* * ROLE 2 is authorized to all access control points
C* * to which the DEFAULT role is authorized plus the following:
C* *
C* * 0x0019 - Combine Master Key Parts
C* * 0x001A - Set Master Key
C* * 0x0033 - Clear Old Master Key Register
C* * 0x0054 - Combine PKA Master Key Parts
C* * 0x0057 - Set PKA Master Key
C* * 0x0061 - Clear Old Master Key Register
C* * 0x011A - Clear Function Control Vector
C* * 0x0200 - Register PKA Public Key Hash
C* * 0x0201 - Register PKA Public Key, with cloning
C* * 0x0203 - Delete Retained Key
C* * 0x0204 - PKA Clone Key Generate
C* * 0x0216 - 0x21A - Clone information - obtain 6-10
C* * 0x0226 - 0x22A - Clone information - install 6-10
C* *
C* *--------------------------------------------------------
C EVAL BITMAP1A = X'0003F07D80001000'
C EVAL BITMAP1B = X'8000090040000000'
C EVAL BITMAP1C = X'000A8000881F7110'
C EVAL BITMAP1D = X'1004031180000000'
C EVAL BITMAP1E = X'FF7F002F80'
C EVAL BITMAP2 = X'D80003E003E0E60F'
C* Copy role into aggregate structure
C MOVEL ROLESTRUCT ROLE2
C* Set ROLE name (ROLE3)
C MOVEL 'ROLE3 ' ROLE
C* *--------------------------------------------------------
C* * Set Access Control Points for ROLE3
C* *
C* * ROLE 3 is authorized to all access control points
C* * to which the DEFAULT role is authorized plus the following:
C* *
C* * 0x0110 - Set Clock
C* * 0x0111 - Reinitialize device
C* * 0x0112 - Initialize access control system
C* * 0x0113 - Change user profile expiration date
C* * 0x0114 - Change authentication data (eg. passphrase)
C* * 0x0115 - Reset password failure count
C* * 0x0116 - Read Public Access Control Information
C* * 0x0117 - Delete user profile
C* * 0x0118 - Delete role
C* * 0x011B - Force User Logoff
C* * 0x0200 - Register PKA Public Key Hash
C* * 0x0201 - Register PKA Public Key, with cloning
C* * 0x0203 - Delete Retained Key
C* * 0x0204 - PKA Clone Key Generate
C* * 0x021B - 0x21F - Clone information - obtain 11-15
C* * 0x022B - 0x22F - Clone information - install 11-15
C* *
C* *--------------------------------------------------------
C EVAL BITMAP1A = X'0003F01D00000000'
C EVAL BITMAP1B = X'80000000C0000000'
C EVAL BITMAP1C = X'000A8000881F7110'
C EVAL BITMAP1D = X'1004021180000000'
C EVAL BITMAP1E = X'FF7FFF9F80'
C EVAL BITMAP2 = X'D800001F001FE60F'
C* Copy role into aggregate structure
C MOVEL ROLESTRUCT ROLE3
C*------------------------------------------------------------*
C* Set up roles in verb data 1 *
C*------------------------------------------------------------*
C* Set Profile name (SECOFR1)
C MOVEL 'SECOFR1 ' USERID
C* Set Role name (ROLE1)
C MOVEL 'ROLE1 ' ROLENAME
C* Hash pass-phrase for profile 1
C SETOFF 05
C EVAL TEXT = 'Is it safe'
C Z-ADD 10 TEXTLEN
C EXSR HASHMSG
C 05 SETON LR
C* Copy profile into aggregate structure
C MOVEL PROFILESTRUCT PROF1
C* Set Profile name (SECOFR2)
C MOVEL 'SECOFR2 ' USERID
C* Set Role name (ROLE2)
C MOVEL 'ROLE2 ' ROLENAME
C* Hash pass-phrase for profile 2
C EVAL TEXT = 'I think it is safe'
C Z-ADD 18 TEXTLEN
C EXSR HASHMSG
C 05 SETON LR
C* Copy profile into aggregate structure
C MOVEL PROFILESTRUCT PROF2
C* Set Profile name (SECOFR3)
C MOVEL 'SECOFR2 ' USERID
C* Set Role name (ROLE3)
C MOVEL 'ROLE3 ' ROLENAME
C* Hash pass-phrase for profile 3
C EVAL TEXT = 'Is what safe'
C Z-ADD 12 TEXTLEN
C EXSR HASHMSG
C 05 SETON LR
C* Copy profile into aggregate structure
C MOVEL PROFILESTRUCT PROF3
C*------------------------------------------------------------*
C* Set the keywords in the rule array *
C*------------------------------------------------------------*
C MOVEL 'INIT-AC ' RULEARRAY
C MOVE 'REPLACE ' RULEARRAY
C Z-ADD 2 RULEARRAYCNT
C**************************************************************
C* Call Access_Control_Initialize SAPI
C**************************************************************
C CALLP CSUAACI (RETURNCODE:
C REASONCODE:
C EXITDATALEN:
C EXITDATA:
C RULEARRAYCNT:
C RULEARRAY:
C VERBDATALEN1:
C VERBDATA1:
C VERBDATALEN2:
C VERBDATA2)
C* *------------------------*
C* * Check the return code *
C* *------------------------*
C RETURNCODE IFGT 0
C* *------------------------*
C* * Send failure message *
C* *------------------------*
C MOVEL MSG(1) MSGTEXT
C MOVE RETURNCODE FAILRETC
C MOVE REASONCODE FAILRSNC
C MOVEL 'CSUAACI' SAPI
C EXSR SNDMSG
C RETURN
C ELSE
C* *------------------------*
C* * Send success message *
C* *------------------------*
C MOVEL MSG(2) MSGTEXT
C EXSR SNDMSG
C ENDIF
C*
C*------------------------------------------------------------*
C* Change the Default Role *
C*------------------------------------------------------------*
C* Set the Role name
C MOVEL DEFAULT ROLE
C* *--------------------------------------------------------
C* * Set Access Control Points for DEFAULT
C* *
C* *--------------------------------------------------------
C EVAL BITMAP1A = X'0003F01D00000000'
C EVAL BITMAP1B = X'8000000000000000'
C EVAL BITMAP1C = X'000A8000881F7110'
C EVAL BITMAP1D = X'1004021180000000'
C EVAL BITMAP1E = X'FF7F406B80'
C EVAL BITMAP2 = X'000000000000E60F'
C* Copy role into aggregate structure
C MOVEL ROLESTRUCT ROLE1
C*
C* Set the new verb data 2 length
C Z-ADD 117 VERBDATALEN2
C*
C* Set the verb data 1 length to 0 (No profiles)
C Z-ADD 0 VERBDATALEN1
C* Change the number of roles to 1
C Z-ADD 1 NUMROLES
C
C**************************************************************
C* Call Access_Control_Initialize SAPI
C**************************************************************
C CALLP CSUAACI (RETURNCODE:
C REASONCODE:
C EXITDATALEN:
C EXITDATA:
C RULEARRAYCNT:
C RULEARRAY:
C VERBDATALEN1:
C VERBDATA1:
C VERBDATALEN2:
C VERBDATA2)
C*-----------------------*
C* Check the return code *
C*-----------------------*
C RETURNCODE IFGT 0
C* *------------------------*
C* * Send failure message *
C* *------------------------*
C MOVEL MSG(1) MSGTEXT
C MOVE RETURNCODE FAILRETC
C MOVE REASONCODE FAILRSNC
C MOVEL 'CSUAACI' SAPI
C EXSR SNDMSG
C*
C ELSE
C* *------------------------*
C* * Send success message *
C* *------------------------*
C MOVEL MSG(3) MSGTEXT
C EXSR SNDMSG
C*
C ENDIF
C*
C SETON LR
C*
C**************************************************************
C* Subroutine to send a message
C**************************************************************
C SNDMSG BEGSR
C CALL 'QMHSNDPM'
C PARM MESSAGEID
C PARM MESSAGEFILE
C PARM MSGTEXT
C PARM MSGLENGTH
C PARM MSGTYPE
C PARM STACKENTRY
C PARM STACKCOUNTER
C PARM MSGKEY
C PARM ERRCODE
C ENDSR
C*
C**************************************************************
C* Subroutine to Hash pass-phrase
C**************************************************************
C HASHMSG BEGSR
C* *------------------------------------------*
C* * Set the keywords in the rule array *
C* *------------------------------------------*
C MOVEL 'SHA-1 ' RULEARRAY
C Z-ADD 1 RULEARRAYCNT
C* *-------------------------*
C* * Call One Way Hash SAPI *
C* *-------------------------*
C CALLP CSNBOWH (RETURNCODE:
C REASONCODE:
C EXITDATALEN:
C EXITDATA:
C RULEARRAYCNT:
C RULEARRAY:
C TEXTLEN:
C TEXT:
C CHAINVCTLEN:
C CHAINVCT:
C HASHLEN:
C AUTHDATA)
C* *------------------------*
C* * Check the return code *
C* *------------------------*
C RETURNCODE IFGT 0
C* *-----------------------*
C* * Send failure message *
C* *-----------------------*
C MOVEL MSG(1) MSGTEXT
C MOVE RETURNCODE FAILRETC
C MOVE REASONCODE FAILRSNC
C MOVEL 'CSNBOWH' SAPI
C EXSR SNDMSG
C SETON 05
C ENDIF
C*
C ENDSR
**
CSUAACI failed with return/reason codes 9999/9999.
SECOFR1, SECOFR2, and SECOFR3 profiles were successfully created.
The Default role was successfully changed.