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
