The CL Program listed below can be used to secure the AS/400 FTP server so only WinSpool/400 commands can be run and only the WinSpool/400 work file can be downloaded at run time via FTP. The program has been updated to allow selected users to have FULL FTP access.

/******************************************************************************/
/*                                                                            */
/*  FTP SERVER REQUEST VALIDATION EXIT PROGRAM FOR WINSPOOL/400.              */
/*                                                                            */
/*  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 that the exit program      */
/*     itself be given a *PUBLIC authority of *EXCLUDE.  The FTP server       */
/*     adopts the 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) /* +
                    Uppercase 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')
 /* ON UNHANDLED ERRORS, EXIT PROGRAM AND REFUSE FTP OPERATION */
       MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORS))

 /* 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 information 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

 /* REJECT DIRECTORY/LIBRARY CREATION OPERATION */
            IF     COND(&OPID = 1) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT DIRECTORY/LIBRARY DELETION OPERATION */
            IF     COND(&OPID = 2) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT CHANGE DIRECTORY OPERATION */
            IF     COND(&OPID = 3) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT LIST DIRECTORY OPERATIONS */
            IF     COND(&OPID = 4) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT FILE DELETION OPERATION */
            IF     COND(&OPID = 5) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT RECEIVE FILE FROM SERVER OPERATION */
 /* EXCEPT FOR THE WINSPOOL/4000 WORK FILE    */
            IF     COND(&OPID = 6) THEN(DO)

                   /* IF FILE IS WINOUTQ IN QTEMP, ALLOW DOWNLOAD */
                   IF         COND(&OPINFO *EQ +
                      '/QSYS.LIB/QTEMP.LIB/WINOUTQ.FILE') THEN(DO)
                       CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&ALLOW)
                   RETURN
                   ENDDO

                   /* IF FILE NOT WINOUTQ IN QTEMP, REJECT DOWNLOAD */
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN

            ENDDO

 /* REJECT SEND FILE TO SERVER OPERATIONS */
            IF     COND(&OPID = 7) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* REJECT RENAME FILE OPERATIONS */
            IF     COND(&OPID = 8) THEN(DO)
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

 /* ALLOW WINSPOOL/400 CL COMMAND EXECUTION OPERATIONS */
            IF     COND(&OPID = 9) THEN(DO)
       SNDMSG     MSG(&OPINFO) TOUSR(RSCHOEN)
                   /* IF COMMAND IS A WINSPOOL COMMAND, ALLOW IT */
                   IF         COND(%SST(&OPINFO 1 16) *EQ +
                      'WINSPOOL/WSPL016') THEN(DO)
                       CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&ALLOW)
                   RETURN
                   ENDDO

                   IF         COND(%SST(&OPINFO 1 16) *EQ +
                      'WINSPOOL/WSPL019') THEN(DO)
                       CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&ALLOW)
                   RETURN
                   ENDDO

                   IF         COND(%SST(&OPINFO 1 16) *EQ +
                      'WINSPOOL/WSPL020') THEN(DO)
                       CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&ALLOW)
                   RETURN
                   ENDDO

                   IF         COND(%SST(&OPINFO 1 16) *EQ +
                      'WINSPOOL/WSPL021') THEN(DO)
                       CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&ALLOW)
                   RETURN
                   ENDDO

                   /* REJECT ALL NON-WINSPOOL/400 RELATED COMMANDS */
                   CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)
                   RETURN
            ENDDO

/***************************************************/
/* NORMAL END OF PROGRAM                           */
/***************************************************/
            RETURN

/***************************************************/
/* IF UNHANDLED ERRORS OCCUR, REFUSE FTP OPERATION */
/***************************************************/
ERRORS:     CHGVAR     VAR(%BINARY(&ALLOWOP)) VALUE(&NOALLOW)

END:        ENDPGM

Registering the FTP Exit Program on the AS/400

In order to register the FTP exit program on the AS/400 for use with the WinSpool/400 product family, use the following steps:
  • Create the RPG or CL exit program on the AS/400.
  • Sign on to the AS/400 as Security Officer and go to a command line.
  • Type WRKREGINF and press Enter.
  • Find the exit point titled:  QIBM_QTMF_SERVER_REQ  VLRQ0100     *YES     FTP Server Request Validation
  • Type an 8 in the option field to work with exit programs.
  • Type a 1 in the option field on the Work with Exit Programs screen and press Enter.
  • Enter the "program name" and "library name" for the exit program and press Enter to save the new setting.
  • Exit to the AS/400 command line by using the F3 key.
  • End the AS/400 FTP server by typing: ENDTCPSVR *FTP and pressing Enter.
  • Restart the AS/400 FTP server by typing: STRTCPSVR *FTP and pressing Enter.

Still have questions? We can help. Submit a case to Technical Support.

Last Modified On: December 10, 2016