This exit program shows an example of a PL/I exit program that allows all DRDA® operations and all DRDA connections except when the user ID is ALIEN.
/**********************************************************************/
/* */
/* PROGRAM NAME: UEPALIEN */
/* */
/* FUNCTION: USER EXIT PROGRAM THAT IS DESIGNED TO */
/* RETURN AN UNSUCCESSFUL RETURN CODE WHEN */
/* USERID 'ALIEN' ATTEMPTS A DRDA CONNECTION. */
/* IT ALLOWS ALL TYPES OF DDM OPERATIONS. */
/* */
/* EXECUTION: CALLED WHEN ESTABLISHED AS THE USER EXIT */
/* PROGRAM. */
/* */
/* ALL PARAMETER VARIABLES ARE PASSED IN EXCEPT: */
/* */
/* RTNCODE - USER EXIT RETURN CODE ON WHETHER FUNCTION IS */
/* ALLOWED: '1' INDICATES SUCCESS; '0' FAILURE. */
/* */
/**********************************************************************/
UEPALIEN: PROCEDURE (RTNCODE,CHARFLD);
DECLARE RTNCODE CHAR(1); /* DECLARATION OF THE EXIT */
/* PROGRAM RETURN CODE. IT */
/* INFORMS REQUEST HANDLER */
/* WHETHER REQUEST IS ALLOWED. */
DECLARE /* DECLARATION OF THE CHAR */
1 CHARFLD, /* FIELD PASSED IN ON THE CALL. */
2 USER CHAR(10), /* USER PROFILE OF DDM/DRDA USER */
2 APP CHAR(10), /* APPLICATION NAME */
2 FUNC CHAR(10), /* REQUESTED FUNCTION */
2 OBJECT CHAR(10), /* FILE NAME */
2 DIRECT CHAR(10), /* LIBRARY NAME */
2 MEMBER CHAR(10), /* MEMBER NAME */
2 RESERVED CHAR(10), /* RESERVED FIELD */
2 LNGTH PIC '99999', /* LENGTH OF USED SPACE IN REST */
2 REST, /* REST OF SPACE = CHAR(2000) */
3 LUNAME CHAR(10), /* REMOTE LU NAME (IF SNA) */
3 SRVNAME CHAR(10), /* REMOTE SERVER NAME */
3 TYPDEFN CHAR(9), /* TYPE DEF NAME OF DRDA AR */
3 PRDID, /* PRODUCT ID OF DRDA AR */
5 PRODUCT CHAR(3), /* PRODUCT CODE */
5 VERSION CHAR(2), /* VERSION ID */
5 RELEASE CHAR(2), /* RELEASE ID */
5 MOD CHAR(1), /* MODIFICATION LEVEL */
5 RDBNAME CHAR(18), /* RDB NAME */
5 REMAING CHAR(1965), /* REMAINING VARIABLE SPACE */
START:
IF (USER = 'ALIEN' & /* IF USER IS 'ALIEN' AND */
FUNC = 'SQLCNN') THEN /* FUNCTION IS DRDA CONNECT */
RTNCODE = '0'; /* SET RETURN CODE TO UNSUCCESSFUL */
ELSE /* IF ANY OTHER USER, OR DDM */
RTNCODE = '1'; /* SET RETURN CODE TO SUCCESSFUL */
END UEPALIEN;