AS/400 Journal ODBC Exit Program

Following code from AS/400 Journal ODBC Security

Attach this program to QIBM_QZDA_INIT exit point.?This program handles the ODBC security by rejecting request to users who are not authorized to the ODBC *AUTL.?Make sure you create the ODBC authorization list first.

/*------------------------------------------------------------------*/
/*                                                                  */
/*  System name  . . . :‚  Technical Support                       €*/
/*  Module/Program . . :‚  EXTDBSE                                 €*/
/*  Text . . . . . . . :‚  Exit program for Database Server entry  €*/
/*                                                                  */
/*  Author . . . . . . :‚  Alex Nubla                              €*/
/*  Creation date. . . :‚  10/13/98                                €*/
/*  Description  . . . :   This is the exit point program for       */
/*                         QIBM_QZDA_INIT.                          */
/*                         This program handles the ODBC security   */
/*                         by rejecting requests from users who     */
/*                         are not authorized in ODBC authorization */
/*                         list                                     */
/*                                                                  */
/*------------------------------------------------------------------*/
             pgm        (&Okay         /* 1=Allow; 0=Reject     */   +
                         &Request  )   /* Parameter Structure   */

/*--------------------------------------------------------*/
/*  declaration                                           */
/*--------------------------------------------------------*/
             dcl        &Okay      *char    1
             dcl        &Request   *char   34

             dcl        &User      *char   10
             dcl        &SvrId     *char   10
             dcl        &Format    *char    8
             dcl        &Func      *char    4

/*--------------------------------------------------------*/
/*  error message variables                               */
/*--------------------------------------------------------*/
             dcl        &error     *lgl                   /* std err */
             dcl        &msgid     *char    7             /* std err */
             dcl        &msgkey    *char    4             /* std err */
             dcl        &msgdta    *char  100             /* std err */
             dcl        &msgf      *char   10             /* std err */
             dcl        &msgflib   *char   10             /* std err */
             dcl        &msgtyp    *char   10  '*DIAG'    /* std err */
             dcl        &msgtypctr *char    4 X'00000001' /* std err */
             dcl        &pgmmsgq   *char   10  '*'        /* std err */
             dcl        &stkctr    *char    4 X'00000001' /* std err */
             dcl        &errbytes  *char    4 X'00000000' /* std err */

             monmsg     msgid(cpf0000) exec(goto error)

             chgvar     &User      %sst(&Request    1   10)
             chgvar     &SvrId     %sst(&Request   11   10)
             chgvar     &Format    %sst(&Request   21    8)
             chgvar     &Func      %sst(&Request   28    4)

/*--------------------------------------------------------*/
/*  Check if user has *USE authority to ODBC              */
/*--------------------------------------------------------*/
             chgvar     &Okay      '1'

             addlible   techlib    *last
             monmsg     cpf0000

             chkaut     user(&User)         +
                         obj(ODBC)          +
                         objtype(*AUTL)     +
                         aut(*USE)
             monmsg     cpf9802             exec(do)
               chgvar     &Okay      '0'
             enddo

             Goto       End

/*--------------------------------------------------------*/
/*  error routine:                                        */
/*--------------------------------------------------------*/
 error:
             if         &error     (goto errordone)
               else      chgvar       &error  '1'
          /*----------------------------------------------*/
          /*  move all *DIAG message to *PRV program queue*/
          /*----------------------------------------------*/
             call       QMHMOVPM   (&msgkey      +
                                    &msgtyp      +
                                    &msgtypctr   +
                                    &pgmmsgq     +
                                    &stkctr      +
                                    &errbytes)
          /*----------------------------------------------*/
          /*  resend the last *ESCAPE message             */
          /*----------------------------------------------*/
 errordone:
             call       QMHRSNEM   (&msgkey      +
                                    &errbytes)
             monmsg     cpf0000    exec(do)
               sndpgmmsg  msgid(cpf3cf2) msgf(QCFPMSG) +
                            msgdta('QMHRSNEM') msgtype(*escape)
               monmsg     cpf0000
             enddo
 end:        endpgm