Example: ILE RPG program for obtaining a master key share

Change this program example to suit your needs for obtaining a master key share.

Note: Read the Code license and disclaimer information for important legal information.
     D*************************************************************
     D* GETSHARE
     D*
     D* Sample program to obtain a master key share as part of the
     D* master key cloning process.
     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: Share number
     D*             Name of share sender private key
     D*             Name of certifying key
     D*             Path name of stream file containing receiver certificate
     D*
     D* Example:
     D*   CALL PGM(GETSHARE) PARM(2 SENDR SAKEY RECVR.PUB)
     D*
     D* Use these commands to compile this program on the system:
     D* CRTRPGMOD MODULE(GETSHARE) SRCFILE(SAMPLE)
     D* CRTPGM  PGM(GETSHARE) MODULE(GETSHARE)
     D*         BNDDIR(QCCA/QC6BNDDIR)
     D*
     D* Note: Authority to the CSUAMKD service program
     D*       in the QCCA library is assumed.
     D*
     D* The Common Cryptographic Architecture (CCA) verbs used is
     D* Master_Key_Distribution (CSUAMKD).
     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*                **  Token length
     DTOKENLEN         S              9B 0 INZ(2500)
     D*                **  Token and array for subscripting
     DTOKEN            DS          2500
     DTOKENARRAY                      1    DIM(2500)
     D*                **  Private key name
     DPRVNAME          S             64
     D*                **  Certifying key name
     DCERTKEY          S             64
     D*
     DLSTRUCT          DS
     D*                **  Clone KEK length - one is binary form and the
     D*                **  other is used for reading the value from a file
     DCLONEKEKL                       9B 0 INZ(500)
     DCLONEKEKLC               1      4
     D*                **  Clone info length - one is binary form and the
     D*                **  other is used for reading the value from a file
     DCLONEINFOLEN                    9B 0 INZ(400)
     DCLONEINFOLENC            5      8
     D*                **  Cloning key-encrypting-key
     DCLONEKEK         S            500
     D*                **  Cloning info
     DCLONEINFO        S            400
     D*                **  Share index
     DSHAREIDX         S              9B 0
     D*                **  Data structure for aligning 2 bytes into
     D*                **  a 2 bytes integer
     DLENSTRUCT        DS             2
     DMSB                      1      1
     DLSB                      2      2
     DLENGTH                   1      2B 0
     D*                **  Certificate section length
     DCRTSECLEN        S              9B 0
     D*                **  Public key section length
     DPUBSECLEN        S              9B 0
     D*                **  Index into Token array
     DTKNINDEX         S              9B 0
     D*                **  Number of bytes to write out to a file
     DOUTLEN           S              9B 0
     D*                **  File descriptor
     DFILED            S              9B 0
     D*                **  File path and length
     DPSTRUCT          DS
     DPATH                           80    INZ(*ALLX'00')
     DSIDX                    11     12B 0
     DPATHLEN          S              9B 0
     D*                ** Open Flag - Open for Read only
     DOFLAGR           S             10I 0 INZ(1)
     D*                ** Open flag - Create on open, open for writing,
     D*                **             and clear if exists
     DOFLAGW           S             10I 0 INZ(X'4A')
     D*                ** Base name of file to store cloning share
     DSHAREFILE        S             12    INZ('cloneShare00')
     D*
     D**********************************************************
     D* Prototype for Master_Key_Distribution (CSUAMKD)
     D**********************************************************
     DCSUAMKD          PR
     DRETCOD                          9B 0
     DRSNCOD                          9B 0
     DEXTDTALN                        9B 0
     DEXTDT                           4
     DRARRYCT                         9B 0
     DRARRY                          16
     DSHRINDX                         9B 0
     DKYNAM                          64
     DCRTKYNAM                       64
     DCRTL                            9B 0
     DCRT                          2500    OPTIONS(*VARSIZE)
     DCLNKEKL                         9B 0
     DCLNKEK                       1200    OPTIONS(*VARSIZE)
     DCLNL                            9B 0
     DCLN                           400    OPTIONS(*VARSIZE)
     D*
     D**********************************************************
     D* Prototype for open()
     D**********************************************************
     D*    value returned = file descriptor (OK), -1 (error)
     Dopen             PR             9B 0 EXTPROC('open')
     D*    path name of file to be opened.
     D                              128    OPTIONS(*VARSIZE)
     D*    Open flags
     D                                9B 0 VALUE
     D*    (OPTIONAL) mode - access rights
     D                               10U 0 VALUE OPTIONS(*NOPASS)
     D*    (OPTIONAL) codepage
     D                               10U 0 VALUE OPTIONS(*NOPASS)
     D*
     D*********************************************************************
     D* Prototype for write()
     D**********************************************************
     D*    value returned = number of bytes written, or -1
     Dwrite            PR             9B 0 EXTPROC('write')
     D*    File descriptor returned from open()
     D                                9B 0 VALUE
     D*    Output buffer
     D                             2500    OPTIONS(*VARSIZE)
     D*    Length of data to be written
     D                                9B 0 VALUE
     D*
     D*********************************************************************
     D* Prototype for read()
     D**********************************************************
     D*    value returned = number of bytes actually read, or -1
     Dread             PR             9B 0 EXTPROC('read')
     D*    File descriptor returned from open()
     D                                9B 0 VALUE
     D*    Input buffer
     D                             2500    OPTIONS(*VARSIZE)
     D*    Length of data to be read
     D                                9B 0 VALUE
     D*
     D*********************************************************************
     D* Prototype for close()
     D*********************************************************************
     D*    value returned = 0 (OK), or -1
     Dclose            PR             9B 0 EXTPROC('close')
     D*    File descriptor returned from open()
     D                                9B 0 VALUE
     D*
     D*-------------------------------------------------------------
     D*                **  Declares for sending messages to the
     D*                **  job log using the QMHSNDPM API
     D*-------------------------------------------------------------
     DMSG              S             75    DIM(6) CTDATA PERRCD(1)
     DMSGLENGTH        S              9B 0 INZ(80)
     D                 DS
     DMSGTEXT                  1     80
     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     *ENTRY        PLIST
     C                   PARM                    SINDEX           15 5
     C                   PARM                    PRVKEY           32
     C                   PARM                    SAKEY            32
     C                   PARM                    FILEPARM         32
     C**************************************************************
     C* Open certificate file
     C**************************************************************
     C*   *---------------------*
     C*   ** Build path name    *
     C*   *---------------------*
     C                   EVAL      PATHLEN = %LEN(%TRIM(FILEPARM))
     C     PATHLEN       SUBST     FILEPARM:1    PATH
     C*   *---------------------*
     C*   * Open the file       *
     C*   *---------------------*
     C                   EVAL      FILED = open(PATH: OFLAGR)
     C*   *----------------------*
     C*   * Check if open worked *
     C*   *----------------------*
     C     FILED         IFEQ      -1
     C*     *------------------------------------*
     C*     * Open failed, send an error message *
     C*     *------------------------------------*
     C                   MOVEL     MSG(1)        MSGTEXT
     C                   EXSR      SNDMSG
     C                   RETURN
     C*
     C                   ENDIF
     C*     *----------------------------------------------*
     C*     * Open worked, read certificate and close file *
     C*     *----------------------------------------------*
     C                   EVAL      TOKENLEN = read(FILED: TOKEN: TOKENLEN)
     C                   CALLP     close         (FILED)
     C*
     C*     *--------------------------------------*
     C*     * Check if read operation was OK       *
     C*     *--------------------------------------*
     C     TOKENLEN      IFEQ      -1
     C                   MOVEL     MSG(2)        MSGTEXT
     C                   EXSR      SNDMSG
     C                   ENDIF
     C*
     C*     *--------------------------------------*
     C*     * Check if certificate length is valid *
     C*     * The length bytes start at position 3 *
     C*     *--------------------------------------*
     C                   EVAL      MSB = TOKENARRAY(3)
     C                   EVAL      LSB = TOKENARRAY(4)
     C     LENGTH        IFLT      TOKENLEN
     C*        *-----------------------------------*
     C*        * Certificate length is not valid   *
     C*        *-----------------------------------*
     C                   MOVEL     MSG(3)        MSGTEXT
     C                   EXSR      SNDMSG
     C                   RETURN
     C                   ENDIF
     C*
     C**************************************************************
     C* Find the certificate in the token
     C*
     C* The layout of the token is
     C*
     C* - Token header - 8 bytes - including 2 length bytes
     C* - Public key section - length bytes at position 3 (11 overall)
     C* - Private key name - 68 bytes
     C* - Certificate section
     C*
     C* Note: 1 is added because RPG arrays start at 1.
     C**************************************************************
     C                   EVAL      MSB = TOKENARRAY(11)
     C                   EVAL      LSB = TOKENARRAY(12)
     C                   EVAL      PUBSECLEN = LENGTH
     C                   EVAL      TKNINDEX = PUBSECLEN + 68 + 8 + 1
     C*
     C*     *-----------------------------------------*
     C*     * Determine length of certificate section *
     C*     * Length bytes are at position 2 of the   *
     C*     * section.
     C*     *-----------------------------------------*
     C                   EVAL      MSB = TOKENARRAY(TKNINDEX + 2)
     C                   EVAL      LSB = TOKENARRAY(TKNINDEX + 3)
     C                   EVAL      CRTSECLEN = LENGTH
     C*
     C**************************************************************
     C* Obtain a certificate
     C**************************************************************
     C*   *------------------------------------------*
     C*   * Set share index number                   *
     C*   * (Convert from packed 15 5 to binary)     *
     C*   *------------------------------------------*
     C                   Z-ADD     SINDEX        SHAREIDX
     C*   *------------------------------------------*
     C*   * Set private key name                     *
     C*   *------------------------------------------*
     C                   EVAL      LENGTH = %LEN(%TRIM(PRVKEY))
     C     LENGTH        SUBST     PRVKEY:1      PRVNAME
     C*   *------------------------------------------*
     C*   * Set certifying key name                  *
     C*   *------------------------------------------*
     C                   EVAL      LENGTH = %LEN(%TRIM(SAKEY))
     C     LENGTH        SUBST     SAKEY:1       CERTKEY
     C*   *------------------------------------------*
     C*   * Set the keywords in the rule array       *
     C*   *------------------------------------------*
     C                   MOVEL     'OBTAIN  '    RULEARRAY
     C                   Z-ADD     1             RULEARRAYCNT
     C*   *------------------------------------*
     C*   * Call Master Key Distribution SAPI  *
     C*   *------------------------------------*
     C                   CALLP     CSUAMKD       (RETURNCODE:
     C                                            REASONCODE:
     C                                            EXITDATALEN:
     C                                            EXITDATA:
     C                                            RULEARRAYCNT:
     C                                            RULEARRAY:
     C                                            SHAREIDX:
     C                                            PRVNAME:
     C                                            CERTKEY:
     C                                            CRTSECLEN:
     C                                            TOKENARRAY(TKNINDEX):
     C                                            CLONEKEKL:
     C                                            CLONEKEK:
     C                                            CLONEINFOLEN:
     C                                            CLONEINFO)
     C*  *------------------------*
     C*  * Check the return code  *
     C*  *------------------------*
     C     RETURNCODE    IFGT      0
     C*     *-----------------------*
     C*     *  Send failure message *
     C*     *-----------------------*
     C                   MOVEL     MSG(4)        MSGTEXT
     C                   MOVE      RETURNCODE    FAILRETC
     C                   MOVE      REASONCODE    FAILRSNC
     C                   MOVEL     'CSUAMKD'     SAPI
     C                   EXSR      SNDMSG
     C                   RETURN
     C                   ENDIF
     C*
     C**************************************************************
     C* Write share out to a file
     C**************************************************************
     C*    ** Build path name
     C                   MOVEL     *ALLX'00'     PATH
     C                   MOVEL     SHAREFILE     PATH
     C     SIDX          ADD       SHAREIDX      SIDX
     C     SHAREIDX      IFGE      10
     C     SIDX          ADD       246           SIDX
     C                   ENDIF
     C*
     C*    ** Open the file
     C*
     C                   EVAL      FILED = open(PATH: OFLAGW)
     C*
     C*    ** Check if open worked
     C*
     C     FILED         IFEQ      -1
     C*
     C*      ** Open failed, send an error message
     C*
     C                   MOVEL     MSG(5)        MSGTEXT
     C                   EXSR      SNDMSG
     C*
     C                   ELSE
     C*
     C*      ** Open worked, write certificate out to file and close file
     C*
     C                   Z-ADD     4             OUTLEN
     C                   CALLP     write         (FILED:
     C                                            CLONEKEKLC:
     C                                            OUTLEN)
     C                   CALLP     write         (FILED:
     C                                            CLONEKEK:
     C                                            CLONEKEKL)
     C                   CALLP     write         (FILED:
     C                                            CLONEINFOLENC:
     C                                            OUTLEN)
     C                   CALLP     write         (FILED:
     C                                            CLONEINFO:
     C                                            CLONEINFOLEN)
     C                   CALLP     close         (FILED)
     C*
     C*      ** Send completion message
     C*
     C                   MOVEL     MSG(6)        MSGTEXT
     C                   EVAL      %SUBST(MSGTEXT: 32: 12) =
     C                                     %SUBST(PATH: 1: 12)
     C                   EXSR      SNDMSG
     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*
**
The input file could not be opened.
There was an error reading from the file.
The length of the certificate is not valid.
CSUAMKD failed with return/reason codes 9999/9999.
The output file could not be opened.
The share was written to file