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.
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. */ /*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) /*
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