Example: ILE RPG program for listing retained keys

Change this program example to suit your needs for listing retained keys.

Note: Read the Code license and disclaimer information for important legal information.
     D*************************************************************
     D*
     D* List the names of the RSA private keys retained within the
     D* .
     D*
     D*
     D* COPYRIGHT 5769-SS1 (C) IBM CORP. 2000, 2000
     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(LISTRETAIN)
     D*
     D* Use these commands to compile this program on the system:
     D* CRTRPGMOD MODULE(LISTRETAIN) SRCFILE(SAMPLE)
     D* CRTPGM  PGM(LISTRETAIN) MODULE(LISTRETAIN)
     D*         BNDSRVPGM(QCCA/CSNDRKL)
     D*
     D* The Common Cryptographic Architecture (CCA) verbs used are
     D* Retained_key_List (CSNDRKL)
     D*
     D* Note: Authority to the CSNDRKL service program in the
     D*       QCCA library is assumed.
     D*
     D*
     D* Note: This program assumes the card with the profile is
     D*       already identified either by defaulting to the CRP01
     D*       device or by being explicitly named using the
     D*       Cryptographic_Resource_Allocate verb. Also this
     D*       device must be varied on and you must be authorized
     D*       to use this device description.
     D*
     D*************************************************************
     D*------------------------------------------------
     D* Declare variables for 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*                **  Key label mask
     DKEYLBLMASK       S             64
     D*                **  Key count
     DKEYCOUNT         S              9B 0
     D*                **  Label count
     DLABELCOUNT       S              9B 0
     D*                **  Label list and label array
     DLABELLIST        DS          3200
     DLABELS                         64    DIM(50)
     D*                **  Loop counter
     DI                S              9B 0
     D*
     D**********************************************************
     D* Prototype for Retained_Key_List
     D**********************************************************
     DCSNDRKL          PR
     DRETCODE                         9B 0
     DRSNCODE                         9B 0
     DEXTDTALEN                       9B 0
     DEXTDTA                          4
     DRARRAYCT                        9B 0
     DRARRAY                         16
     DKYLBLMSK                       64
     DKYCOUNT                         9B 0
     DLBLCOUNT                        9B 0
     DLBLS                           64
     D*
     D*-------------------------------------------------------------
     D*                **  Declares for sending messages to the
     D*                **  job log using the QMHSNDPM API
     D*-------------------------------------------------------------
     DMSG              S             75    DIM(4) CTDATA PERRCD(1)
     DMSGLENGTH        S              9B 0 INZ(75)
     D                 DS
     DMSGTEXT                  1     75
     DNUMKEYS                  1      3
     DNUMLABELS               25     26
     DDSPLBL                   2     65
     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)
     D*
     C**************************************************************
     C* START OF PROGRAM                                           *
     C*                                                            *
     C*------------------------------------------------------------*
     C* No rule array keywords                                     *
     C*------------------------------------------------------------*
     C                   Z-ADD     0             RULEARRAYCNT
     C*------------------------------------------------------------*
     C* Get up to 50 labels                                        *
     C*------------------------------------------------------------*
     C                   Z-ADD     50            LABELCOUNT
     C*------------------------------------------------------------*
     C* Set the mask to everything                                 *
     C*------------------------------------------------------------*
     C                   MOVEL     '*'           KEYLBLMASK
     C*------------------------------------------------------------*
     C* Call Retained Key List SAPI                                *     */
     C*------------------------------------------------------------*
     C                   CALLP     CSNDRKL       (RETURNCODE:
     C                                            REASONCODE:
     C                                            EXITDATALEN:
     C                                            EXITDATA:
     C                                            RULEARRAYCNT:
     C                                            RULEARRAY:
     C                                            KEYLBLMASK:
     C                                            KEYCOUNT:
     C                                            LABELCOUNT:
     C                                            LABELLIST)
     C*-----------------------*
     C* Check the return code *
     C*-----------------------*
     C     RETURNCODE    IFGT      4
     C*            *----------------------*
     C*            * Send error message   *
     C*            *----------------------*
     C                   MOVE      MSG(1)        MSGTEXT
     C                   MOVE      RETURNCODE    FAILRETC
     C                   MOVE      REASONCODE    FAILRSNC
     C                   EXSR      SNDMSG
     C*
     C                   ELSE
     C*
     C* *----------------------*
     C* * Check number of keys *
     C* *----------------------*
     C     LABELCOUNT    IFEQ      0
     C*            *---------------------------------------*
     C*            * Send message saying there are no keys *
     C*            *---------------------------------------*
     C                   MOVE      MSG(2)        MSGTEXT
     C                   EXSR      SNDMSG
     C*
     C                   ELSE
     C*
     C*            *----------------------------------*
     C*            * Send message with number of keys *
     C*            *----------------------------------*
     C                   MOVE      MSG(3)        MSGTEXT
     C                   MOVE      KEYCOUNT      NUMKEYS
     C                   MOVE      LABELCOUNT    NUMLABELS
     C                   EXSR      SNDMSG
     C*
     C*            *---------------------------------*
     C*            * Display each key label up to 50 *
     C*            *---------------------------------*
     C                   MOVE      MSG(4)        MSGTEXT
     C                   FOR       I=1 BY 1 TO LABELCOUNT
     C                   MOVEL     LABELS(I)     DSPLBL
     C                   EXSR      SNDMSG
     C                   ENDFOR
     C*
     C                   ENDIF
     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
**
CSNDRKL failed with return/reason codes 9999/9999
There are no retained keys
000 keys were found and 00 labels returned
[                                                                ]