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