Return to the iSSecurity Tips
AS400 database security access via ODBC
Contributed by: tan-tai HUYNH
Please find enclosed a little contribution in as400 database security access
via ODBC. It includes :
2 CLP's ODBC01C and ODBC03C
1 Physical file ODBCP
1 RPG pgm ODBC01R
Thanks to Jorge MORENO for the first CLP ODBC01C. I have adapted his script
for our own purpose.
Thanks to the author of the CLP ODBC03C (general purpose)
The CLP ODBC03C is to put in IBM Exit Point QIBM_QZDA_INIT. It calls the
RPG ODBC01R to check the user in file ODBCP.
If the user is not found, he will not be able to retrieve as400 database via
Excel spreadsheet nor via ODBC (such as MS ACCESS)
The CLP ODBC01C is to put in IBM exit point QIBM_QZDA_SQL1. It checks
whether the user is allowed to update, retrieve or delete as400 database
records via ODBC connection.
Besides the user name in ODBCP file there are 2 more fields : Type of
connection and limit date (SYYMMDD)
If type = 'E' it means that the user is excluded.
if type = 'R' the user can only make a read
if type = 'U' the user can update
if limit date < today date , the user is excluded
One more thing : the ODBC connection parameters on Client side (eg Windows
must match with the type in ODBCP file)
ODBC on Client side = read/update Type = 'U'
!! read Type = R'
Otherwise the user is not allowed to perform any sql statement.
Note : all objects are to be put in library QGPL
Hope this helps.
CLP ODBC01C
/*------------------------------------------------------------------------*/
/* EXIT POINT - ODBC */
/*------------------------------------------------------------------------*/
/* JORGE MORENO */
/* SYSTEMS ANALYST */
/* WOODBURY, NEW YORK */
/*------------------------------------------------------------------------*/
/* MODIFIE PAR HUYNH 24/08/04 */
/* APPEL PROGRAMME ODBC01R */
/*------------------------------------------------------------------------*/
PGM PARM(&P1 &P2)
DCL VAR(&P1) TYPE(*CHAR) LEN(1)
DCL VAR(&P2) TYPE(*CHAR) LEN(607)
DCL VAR(&DQLNTH) TYPE(*DEC) LEN(5 0) VALUE(667)
DCL VAR(&DQDATA) TYPE(*CHAR) LEN(667)
DCL VAR(&MATCHES) TYPE(*CHAR) LEN(1)
DCL VAR(&EZDSQLST) TYPE(*CHAR) LEN(512)
DCL VAR(&EZUSER ) TYPE(*CHAR) LEN( 10)
DCL VAR(&LENCHAR) TYPE(*DEC) LEN(3 0)
DCL VAR(&STRPOS ) TYPE(*DEC) LEN(3 0)
DCL VAR(&SELECT) TYPE(*CHAR) LEN(6) VALUE('SELECT')
DCL VAR(&INSERT) TYPE(*CHAR) LEN(6) VALUE('INSERT')
DCL VAR(&UPDATE) TYPE(*CHAR) LEN(6) VALUE('UPDATE')
DCL VAR(&DELETE) TYPE(*CHAR) LEN(6) VALUE('DELETE')
DCL VAR(&PATTRN ) TYPE(*CHAR) LEN(6)
DCL VAR(&LENPAT ) TYPE(*DEC) LEN(3 0)
DCL VAR(&XLATE ) TYPE(*CHAR) LEN(1)
DCL VAR(&TRIM ) TYPE(*CHAR) LEN(1)
DCL VAR(&WILD ) TYPE(*CHAR) LEN(1)
DCL VAR(&RESULT ) TYPE(*DEC) LEN(3 0)
/*------------------------------------------------------------------------*/
DCL VAR(&CSFMT) TYPE(*CHAR) LEN(8)
DCL VAR(&TYP) TYPE(*CHAR) LEN(1)
DCL VAR(&STA) TYPE(*CHAR) LEN(1) VALUE('1')
DCL VAR(&SYST) TYPE(*CHAR) LEN(10)
/*------------------------------------------------------------------------*/
ADDLIBLE LIB(QGPL) POSITION(*LAST)
MONMSG MSGID(CPF0000)
/*------------------------------------------------------------------------*/
CHGVAR VAR(&P1) VALUE('1')
/*------------------------------------------------------------------------*/
CHGVAR VAR(&CSFMT) VALUE(%SST(&P2 21 8))
CHGVAR VAR(&EZDSQLST) VALUE(%SST(&P2 96 512))
CHGVAR VAR(&MATCHES) VALUE('0')
CHGVAR VAR(&EZUSER) VALUE(%SST(&P2 1 10))
/*------------------------------------------------------------------------*/
/* APPEL PROGRAMME ODBC01R POUR CONTROLE */
IF COND(&CSFMT *NE 'ZDAD0100') THEN(GOTO +
CMDLBL(EXIT))
CALL PGM(QGPL/ODBC01R) PARM(&STA &EZUSER &TYP)
/* SI STATUS = 0 ----> KO */
IF COND(&STA *EQ '0') THEN(DO)
CHGVAR VAR(&P1) VALUE('0')
GOTO CMDLBL(EXIT)
ENDDO
/*------------------------------------------------------------------------*/
UPDATE_CHK:
CHGVAR VAR(&LENCHAR) VALUE(512)
CHGVAR VAR(&STRPOS ) VALUE(001)
CHGVAR VAR(&LENPAT ) VALUE(006)
CHGVAR VAR(&XLATE ) VALUE('1')
CHGVAR VAR(&TRIM ) VALUE('1')
CHGVAR VAR(&WILD ) VALUE('*')
CHGVAR VAR(&RESULT ) VALUE(000)
CALL PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR &STRPOS +
&UPDATE &LENPAT &XLATE &TRIM &WILD &RESULT)
IF (&RESULT *GT 0) DO
CHGVAR VAR(&MATCHES) VALUE('1')
GOTO CMDLBL(MATCHES)
ENDDO
/*------------------------------------------------------------------------*/
DELETE_CHK:
CHGVAR VAR(&LENCHAR) VALUE(512)
CHGVAR VAR(&STRPOS ) VALUE(001)
CHGVAR VAR(&LENPAT ) VALUE(006)
CHGVAR VAR(&XLATE ) VALUE('1')
CHGVAR VAR(&TRIM ) VALUE('1')
CHGVAR VAR(&WILD ) VALUE('*')
CHGVAR VAR(&RESULT ) VALUE(000)
CALL PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR &STRPOS +
&DELETE &LENPAT &XLATE &TRIM &WILD &RESULT)
IF (&RESULT *GT 0) DO
CHGVAR VAR(&MATCHES) VALUE('1')
GOTO CMDLBL(MATCHES)
ENDDO
/*------------------------------------------------------------------------*/
INSERT_CHK:
CHGVAR VAR(&LENCHAR) VALUE(512)
CHGVAR VAR(&STRPOS ) VALUE(001)
CHGVAR VAR(&LENPAT ) VALUE(006)
CHGVAR VAR(&XLATE ) VALUE('1')
CHGVAR VAR(&TRIM ) VALUE('1')
CHGVAR VAR(&WILD ) VALUE('*')
CHGVAR VAR(&RESULT ) VALUE(000)
CALL PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR &STRPOS +
&INSERT &LENPAT &XLATE &TRIM &WILD &RESULT)
IF (&RESULT *GT 0) DO
CHGVAR VAR(&MATCHES) VALUE('1')
ENDDO
/*------------------------------------------------------------------------*/
/* SI PROFIL A DROIT (UPDATE --> OK ) */
/*------------------------------------------------------------------------*/
MATCHES:
CHGVAR VAR(&P1) VALUE('0')
/* SI PROFIL A DROIT (UPDATE --> OK ) */
IF COND(&MATCHES *EQ '1') THEN(DO)
IF COND(&TYP = 'U') THEN(DO)
CHGVAR VAR(&P1) VALUE('1')
ENDDO
ENDDO
/* SI PROFIL A DROIT LECTURE --> OK ) */
IF COND(&MATCHES *EQ '0') THEN(DO)
IF COND(&TYP = 'R') THEN(DO)
CHGVAR VAR(&P1) VALUE('1')
ENDDO
ENDDO
EXIT:
ENDPGM
CLP ODBC03C
/*------------------------------------------------------------------------*/
/* EXIT POINT POUR LE TRANSFERT DE FICHIER */
/*------------------------------------------------------------------------*/
/* */
/* ISERIES SERVERS- SAMPLE USER EXIT PROGRAM */
/* */
/* THE FOLLOWING CL PROGRAM UNCONDITIONALLY */
/* ACCEPTS ALL REQUESTS. IT CAN BE USED AS A SHELL FOR DEVELOPING */
/* EXIT PROGRAMS TAILORED FOR YOUR OPERATING ENVIRONMENT. */
/* */
/* QIBM_QZDA_INIT - FORMAT ZDAI0100 */
/* MODIFIE PAR HUYNH 26/08/04 */
/* APPEL PROGRAMME ODBC01R */
/*------------------------------------------------------------------------*/
PGM PARM(&STATUS &REQUEST)
/*------------------------------------------------------------------------*/
/* PARAMETER DECLARES */
/*------------------------------------------------------------------------*/
DCL VAR(&STATUS) TYPE(*CHAR) LEN(1)
DCL VAR(&USER ) TYPE(*CHAR) LEN(10)
DCL VAR(&TYPE ) TYPE(*CHAR) LEN(1)
DCL VAR(&REQUEST) TYPE(*CHAR) LEN(9999)
/*------------------------------------------------------------------------*/
ADDLIBLE LIB(QGPL) POSITION(*LAST)
MONMSG MSGID(CPF0000)
/*------------------------------------------------------------------------*/
CHGVAR VAR(&STATUS) VALUE('1')
CHGVAR VAR(&USER) VALUE(%SST(&REQUEST 1 10))
/*------------------------------------------------------------------------*/
CALL PGM(QGPL/ODBC01R) PARM(&STATUS &USER &TYPE)
EXIT: ENDPGM
RPG ODBC01R
***********************************************************************
**
** Gestion des utilisateurs ODBC
**
**---------------------------------------------------------------------
Fodbcp if e k disk
**---------------------------------------------------------------------
D ds
Dwamj 1 7 0
Dws 1 1 0
Dwa 2 3 0
Dwm 4 5 0
Dwj 6 7 0
**---------------------------------------------------------------------
C *entry plist
C parm pstat 1
C parm puser 10
C parm ptype 1
**---------------------------------------------------------------------
C clear wamj
C move uday wj
C move umonth wm
C move uyear wa
C move 1 ws
**---------------------------------------------------------------------
C eval pstat = '1'
C puser chain odbcp
**---------------------------------------------------------------------
** utilisateur trouv'
C if %found(odbcp)
C move odbtyp ptype
** utilisateurs exclus
C if odbtyp = 'E'
C eval pstat = '0'
C endif
** limite date
C if wamj > odbdat
C eval pstat = '0'
C endif
C endif
**---------------------------------------------------------------------
** utilisateur non trouv'
C if not %found(odbcp)
C eval pstat = '0'
C endif
**---------------------------------------------------------------------
C eval *inlr = *on
PHYSICAL FILE ODBCP
22/11/2004
!================================================================!
!File ODBCP UTILISATEURS ODBC !
!Library QGPL !
!Format ODBCPF !
!================================================================!
! !
!ODBUTI UTILISATEUR 10 A 1 10!
!ODBTYP TYPE 1 A 11 11!
!ODBDAT DATE LIMITE 7 0 S 12 18!
!Unique key: YES !
! !
!Key : !
! ODBUTI !
!----------------------------------------------------------------!
tan-tai HUYNH
AS400 Paris
Egg Banking Plc. (FR)
Tel : +33(0) 1 44 89 30 51
Email : tan-tai (dot) huynh (at) egg.com
[report a broken link by clicking here]