Example: ILE RPG program for loading a function control vector for your Coprocessor

Change this program example to suit your needs for loading a function control vector for your Coprocessor.

Note: Read the Code license and disclaimer information for important legal information.
     D*************************************************************
     D* LOAD_FCV
     D*
     D* Load the Function Control Vector into the  card.
     D* The Function Control Vector enables the cryptographic
     D* functions of the  card and is shipped with the
     D* Cryptographic Access Provider products.
     D*
     D* The Function Control Vector is contained within a stream
     D* file.  Before compiling and running this program, you
     D* must copy the contents of the stream file to a database
     D* member.  An example of how to do this is shown in the
     D* instructions below for compiling and running this program.
     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(LOAD_FCV)
     D*
     D* Use these commands to compile this program on the system:
     D*
     D* CRTRPGMOD MODULE(LOAD_FCV) SRCFILE(SAMPLE)
     D*
     D* CRTPGM  PGM(LOAD_FCV) MODULE(LOAD_FCV)
     D*         BNDSRVPGM(QCCA/CSUACFC)
     D*
     D* Note: Authority to the CSUACFC service program in the
     D*       QCCA library is assumed.
     D*
     D* The Common Cryptographic Architecture (CCA) verbs used are
     D* Cryptographic_Facilty_Control (CSUACFC)
     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*                **  Verb data length
     DVERBDATALEN      S              9B 0 INZ(204)
     D*                **  Verb data
     DVERBDATA         S            204
     D*--------------------------------------------------------
     D* Declare variables for working with files
     D*--------------------------------------------------------
     D*                **  File descriptor
     DFILED            S              9B 0
     D*                **  File path
     DPATH             S             80    INZ('/QIBM/ProdData/CAP/FCV.CRT')
     D*                ** Open Flag - Open for Read only
     DOFLAGR           S             10I 0 INZ(1)
     D*                **  Structure of Funciton control vector file
     DFLD1             DS
     DFLDDTA                        802
     DDESCR                  391    470
     DFNCCTLVCT              471    674
     D*                **  Length of data read from file
     DINLEN            S              9B 0
     D*                **  Declares for calling QDCXLATE API
     DXLTTBL           S             10    INZ('QEBCDIC   ')
     DTBLLIB           S             10    INZ('QSYS      ')
     DDESCLEN          S              5P 0 INZ(80)
     D*                **  Index into a string
     DINDEX            S              5B 0
     D*                **  Variable to hold temporary character value
     DCHAR             S              1
     D*
     D**********************************************************
     D* Prototype for Cryptographic_Facilty_Control (CSUACFC)
     D**********************************************************
     DCSUACFC          PR
     DRETCODE                         9B 0
     DRSNCODE                         9B 0
     DEXTDTALEN                       9B 0
     DEXTDTA                          4
     DRARRAYCT                        9B 0
     DRARRAY                         16
     DVRBDTALEN                       9B 0
     DVRBDTA                        204
     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 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             80    DIM(4) CTDATA PERRCD(1)
     DMSGLENGTH        S              9B 0 INZ(80)
     D                 DS
     DMSGTEXT                  1     80
     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* Open the FCV file                                          *
     C*------------------------------------------------------------*
     C*   *---------------------------*
     C*   ** Null terminate path name *
     C*   *---------------------------*
     C                   EVAL      %SUBST(PATH:27:1) = X'00'
     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 the FCV, and close the file    *
     C*    *--------------------------------------------------*
     C                   Z-ADD     802           INLEN
     C                   EVAL      INLEN = read(FILED: FLDDTA: INLEN)
     C                   CALLP     close         (FILED)
     C*
     C*    *--------------------------------------*
     C*    * Check if read operation was OK       *
     C*    *--------------------------------------*
     C     INLEN         IFEQ      -1
     C                   MOVEL     MSG(2)        MSGTEXT
     C                   EXSR      SNDMSG
     C                   RETURN
     C                   ENDIF
     C*
     C*------------------------------------------------------------*
     C* Copy the FCV to the verb data parameter.                   *
     C*------------------------------------------------------------*
     C                   MOVEL     FNCCTLVCT     VERBDATA
     C*------------------------------------------------------------*
     C* Convert description to EBCDIC and display it               *
     C*------------------------------------------------------------*
     C                   CALL      'QDCXLATE'
     C                   PARM                    DESCLEN
     C                   PARM                    DESCR
     C                   PARM                    XLTTBL
     C                   PARM                    TBLLIB
     C                   MOVEL     DESCR         MSGTEXT
     C                   Z-ADD     80            INDEX
     C*------------------------------------------------------------*
     C*     Replace trailing null characters in description        *
     C*     with space characters.                                 *
     C*------------------------------------------------------------*
     C                   SETOFF                                           50
     C                   DOU       *IN50
     C                   EVAL      CHAR = %SUBST(MSGTEXT:INDEX:1)
     C     CHAR          IFNE      X'00'
     C                   SETON                                            50
     C                   ELSE
     C                   EVAL      %SUBST(MSGTEXT:INDEX:1) = ' '
     C                   SUB       1             INDEX
     C     INDEX         IFEQ      0
     C                   SETON                                            50
     C                   ENDIF
     C                   ENDIF
     C                   ENDDO
     C                   EXSR      SNDMSG
     C*------------------------------------------------------------*
     C* Set the keywords in the rule array                         *
     C*------------------------------------------------------------*
     C                   MOVEL     'ADAPTER1'    RULEARRAY
     C                   MOVE      'LOAD-FCV'    RULEARRAY
     C                   Z-ADD     2             RULEARRAYCNT
     C**************************************************************
     C* Call Cryptographic Facilty Control SAPI                          */
     C**************************************************************
     C                   CALLP     CSUACFC       (RETURNCODE:
     C                                            REASONCODE:
     C                                            EXITDATALEN:
     C                                            EXITDATA:
     C                                            RULEARRAYCNT:
     C                                            RULEARRAY:
     C                                            VERBDATALEN:
     C                                            VERBDATA)
     C*  *------------------------*
     C*  * Check the return code  *
     C*  *------------------------*
     C     RETURNCODE    IFGT      0
     C*     *-----------------------*
     C*     *  Send failure message *
     C*     *-----------------------*
     C                   MOVEL     MSG(3)        MSGTEXT
     C                   MOVE      RETURNCODE    FAILRETC
     C                   MOVE      REASONCODE    FAILRSNC
     C                   EXSR      SNDMSG
     C*
     C                   ELSE
     C*
     C*     *-----------------------*
     C*     *  Send success message *
     C*     *-----------------------*
     C                   MOVEL     MSG(4)        MSGTEXT
     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
**
Error trying to open FCV file.
Error reading data from FCV file.
CSUACFC failed with return/reason codes 9999/9999.
The Function Control Vector was successfully loaded.