Example: FTP client or server Request Validation exit program in CL code
This is an example of a simple File Transfer Protocol (FTP) Request Validation exit program. It is written in control language (CL). This code is not complete, but provides a starting point to help you create your own program for the client or server exit point.
Note: By using the code examples, you agree to the terms of the Code license and disclaimer information.
(Preformatted text in the following example will flow outside the frame.)
/******************************************************************************/
/* */
/* Sample FTP Server Request Validation exit program for anonymous FTP. */
/* Note: This program is a sample only and has NOT undergone any formal */
/* review or testing. */
/* */
/* Additional notes: */
/* 1. When the application ID is 1 (FTP server) AND the operation ID is */
/* 0 (session initialization), the job is running under the QTCP */
/* user profile when the exit program is called. In ALL other cases, */
/* the job is running under the user's profile. */
/* 2. It is highly recommended that the exit program be created in a library */
/* with *PUBLIC authority set to *EXCLUDE, and the exit program itself */
/* be given a *PUBLIC authority of *EXCLUDE. The FTP server adopts */
/* authority necessary to call the exit program. */
/* 3. It is possible to use the same exit program for both the FTP client */
/* and server request validation exit points. However, this program */
/* does not take the client case into account. */
/* */
/******************************************************************************/
TSTREQCL: PGM PARM(&APPIDIN &OPIDIN &USRPRF&IPADDRIN +
&IPLENIN &OPINFOIN &OPLENIN &ALLOWOP)
/* Declare input parameters */
DCL VAR(&APPIDIN) TYPE(*CHAR) LEN(4) /* Application ID */
DCL VAR(&OPIDIN) TYPE(*CHAR) LEN(4) /* Operation ID */
DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10) /* User profile */
DCL VAR(&IPADDRIN) TYPE(*CHAR) /* Remote IP address */
DCL VAR(&IPLENIN) TYPE(*CHAR) LEN(4) /* Length of IP address */
DCL VAR(&OPLENIN) TYPE(*CHAR) LEN(4) /* Length of operation-specific info. */
DCL VAR(&OPINFOIN) TYPE(*CHAR) +
LEN(9999) /* Operation-specific information */
DCL VAR(&ALLOWOP) TYPE(*CHAR) LEN(4) /* allow (output) */
/* Declare local copies of parameters (in format usable by CL) */
DCL VAR(&APPID) TYPE(*DEC) LEN(1 0)
DCL VAR(&OPID) TYPE(*DEC) LEN(1 0)
DCL VAR(&IPLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&IPADDR) TYPE(*CHAR)
DCL VAR(&OPLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&OPINFO) TYPE(*CHAR) LEN(9999)
DCL VAR(&PATHNAME) TYPE(*CHAR) LEN(9999) /* Uppercased path name */
/* Declare values for allow(1) and noallow(0) */
DCL VAR(&ALLOW) TYPE(*DEC) LEN(1 0) VALUE(1)
DCL VAR(&NOALLOW) TYPE(*DEC) LEN(1 0) VALUE(0)
/* Declare request control block for QLGCNVCS (convert case) API:*/
/* convert to uppercase based on job CCSID */
DCL VAR(&CASEREQ) TYPE(*CHAR) LEN(22) +
VALUE(X'00000001000000000000000000000000000+
000000000')
DCL VAR(&ERROR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000000')
/* Assign input parameters to local copies */
CHGVAR VAR(&APPID) VALUE(%BINARY(&APPIDIN))
CHGVAR VAR(&OPID) VALUE(%BINARY(&OPIDIN))
CHGVAR VAR(&IPLEN) VALUE(%BINARY(&IPLENIN))
CHGVAR VAR(&IPADDR) VALUE(%SUBSTRING(&IPADDRIN 1 &IPLEN))
CHGVAR VAR(&OPLEN) VALUE(%BINARY(&OPLENIN))
/* Handle operation specific info field (which is variable length) */
IF COND(&OPLEN = 0) THEN(CHGVAR VAR(&OPINFO) +
VALUE(' '))
ELSE CMD(CHGVAR VAR(&OPINFO) VALUE(%SST(&OPINFOIN +
1 &OPLEN)))
/* Operation id 0 (incoming connection): reject if connection is coming */
/* through interface 9.8.7.6, accept otherwise. (The address is just an */
/* example.) This capability could be used to only allow incoming connections */
/* from an internal network and reject them from the "real" Internet, if */
/* the connection to the Internet were through a separate IP interface. */
/* NOTE: For FTP server, operation 0 is ALWAYS under QTCP profile. */
IF COND(&OPID = 0) THEN(DO)
IF COND(&OPINFO = '9.8.7.6') THEN(CHGVAR +
VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW))
ELSE CMD(CHGVAR VAR(%BINARY(&ALLOWOP)) +
VALUE(&ALLOW))
GOTO CMDLBL(END)
ENDDO
/* Check for ANONYMOUS user */
IF COND(&USRPRF = 'ANONYMOUS ') THEN(DO)
/* Don't allow the following operations for ANONYMOUS user: */
/* 1 (Directory/library creation); 2 (Directory/library deletion); */
/* 5 (File deletion); 7 (Receive file); 8 (Rename file); 9 (Execute CL cmd) */
IF COND(&OPID = 1 | &OPID = 2 | +
&OPID = 5 | &OPID = 7 | &OPID = 8 | +
&OPID = 9) THEN(CHGVAR +
VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW))
ELSE CMD(DO)
/* For operations 3 (change directory), 4 (list directory) and 6 (send file), */
/* only allow if in PUBLIC library OR "/public" directory. Note that all */
/* path names use the Integrated File System naming format. */
IF COND(&OPID = 3 | &OPID = 4 | &OPID = 6) THEN(DO)
/* First, convert path name to uppercase (since names in "root" and library */
/* file systems are not case sensitive). */
CALL PGM(QLGCNVCS) PARM(&CASEREQ &OPINFO &PATHNAME +
&OPLENIN &ERROR)
/* Note: must check for "/public" directory by itself and path names starting */
/* with "/public/". */
IF COND((%SUBSTRING(&PATHNAME 1 20) *NE +
'/QSYS.LIB/PUBLIC.LIB') *AND +
(&PATHNAME *NE '/PUBLIC') *AND +
(%SUBSTRING(&PATHNAME 1 8) *NE '/PUBLIC/')) +
THEN(CHGVAR +
VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW))
ELSE CMD(CHGVAR VAR(%BINARY(&ALLOWOP)) +
VALUE(&ALLOW))
ENDDO
ENDDO
ENDDO
/* Not ANONYMOUS user: allow everything */
ELSE CMD(CHGVAR VAR(%BINARY(&ALLOWOP)) +
VALUE(&ALLOW))
END: ENDPGM