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
Still have questions? We can help. Submit a case to Technical Support.