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.