H debug(*yes) H copyright('Copyright (c) 1998, Bits & Bytes Programming') ********************************************************************** * Program FTPEXIT -- sample exit program for FTP exit point * This program can be used with the following Exit Points: * * QIBM_QTMF_CLIENT_REQ * QIBM_QTMF_SERVER_REQ * QIBM_QTMX_SERVER_REQ * QIGM_QTOD_SERVER_REQ * * Exit Point Format Name: VLRQ0100 ********************************************************************** * For more information on these Exit Points, see * * OS/400 TCP/IP Configuration and Reference (V4) * SC41-5420, Appendix I "TCP/IP Application User Exits" ********************************************************************** * Copyright (c) Bits & Bytes Programming, 1998 * ALL RIGHTS RESERVED * * Craig Pelkie * Bits & Bytes Programming * P.O. Box 1473 * Valley Center, CA 92082-1473 * craig@web400.com ********************************************************************** * * To use the FTP Exit Point Program: * * 1) Create the program as an RPG-ILE program * 2) Use the OS/400 WRKREGINF command to register * the program for * * Exit Point: QIBM_QTMF_CLIENT_REQ * Exit Point: QIBM_QTMF_SERVER_REQ * Exit Point: QIBM_QTMX_CLIENT_REQ * Exit Point: QIBM_QTOD_SERVER_REQ * Exit Point Format Name: VLRQ0100 * * 3) Use command CHGFTPEXT to maintain data area * DAFTPEXIT. The data area contains switch * settings for Operation Identifiers that are * allowed/disallowed. ********************************************************************** Fqsysprt o f 132 printer oflind(*inof) F usropn ********************************************************************** * *ENTRY PLIST field definitions * * Parm Field In/Out Description * 1 pmapid In Application Identifier * 2 pmopid In Operation Identifier * 3 pmusrprf In User Profile * 4 pmipaddr In Client IP address (dotted decimal format) * 5 pmiplen In Length of IP address * 6 pmopinfo In Operation specific information * 7 pmoplen In Length of operation specific information * 8 pmallow Out Allow operation ********************************************************************** D pmapid s 9b 0 *OpInfo length D pmopid s 9b 0 D pmusrprf s 10 *CCSID D pmipaddr s 15 *Client IP Address D pmiplen s 9b 0 D pmopinfo s 1024 D pmoplen s 9b 0 D pmallow s 9b 0 *AllowOperation ********************************************************************** * Data Area DAFTPEXIT - allow/disallow Operation Identifiers * * DAPrint - print FTP Exit Point activity log * DAFile - write FTP Exit Point activity to file * DAINLR - return with *INLR On * * FTPServer - FTP Server options * FTPAnon - Anonymous FTP Server options * FTPClient - FTP Client options * REXEC - REXEC options * TFTPServer - TFTP Server options * APPLogon - Application Server Logon options * AppDump - enable DUMP option for Application Server Logon * AppFTP - enable FTP Server logon * AppAnon - enable Anonymous FTP Server Logn * AppREXEC - enable REXEC Server logon * AppLib - library for Anonymous FTP * AppDir - directory for Anonymous FTP ********************************************************************** D FTPEXIT ds 150 D DAPrint 1 1 D DAFile 2 2 D DAINLR 3 3 D FTPServer 11 21 D FTPAnon 31 41 D FTPClient 51 56 D REXEC 61 63 D TFTPServer 71 73 D APPLogon 81 84 D AppDump 1 overlay(AppLogon : 1) D AppFTP 1 overlay(AppLogon : 2) D AppAnon 1 overlay(AppLogon : 3) D AppREXEC 1 overlay(AppLogon : 4) D AppLib 91 100 D AppDir 101 150 ********************************************************************** * Options in Data Area parameter fields * ********************************************************************** * FTP Server and Anonymous FTP Options ********************************************************************** * * Pos Description Op ID * --- ------------------------ ----- * 1 dump request D * 2 initialize session 0 * 3 create directory/library 1 * 4 delete directory/library 2 * 5 set current directory 3 * 6 list directory/library 4 * 7 delete file 5 * 8 send file 6 * 9 receive file 7 * 10 rename file 8 * 11 execute CL commands 9 * ********************************************************************** * FTP Client options ********************************************************************** * * Pos Description Op ID * --- ------------------------ ----- * 1 dump request D * 2 initialize session 0 * 3 set current directory 3 * 4 send file 6 * 5 receive file 7 * 6 execute CL commands 9 * ********************************************************************** * REXEC options ********************************************************************** * * Pos Description Op ID * --- ------------------------ ----- * 1 dump request D * 2 initialize session 0 * 3 execute CL commands 9 * ********************************************************************** * TFTP Server options ********************************************************************** * * Pos Description Op ID * --- ------------------------ ----- * 1 dump request D * 2 send file 6 * 3 receive file 7 ********************************************************************** D FTPS_Ops s 11 inz('D0123456789') D FTPC_Ops s 6 inz('D03679') D REXEC_Ops s 3 inz('D09') D TFTP_Ops s 3 inz('D67') ********************************************************************** * Exit Point program constants * ********************************************************************** * Application Identifier ********************************************************************** * * 0 AI_FTPC FTP client program * 1 AI_FTPS FTP server program (also Anonymous FTP) * 2 AI_REXEC REXEC server program * 3 AI_TFTP TFTP server program * ********************************************************************** * Operation Identifier ********************************************************************** * * 0 OI_INIT Initialize session * 1 OI_CRTDL Create Directory/Library * 2 OI_DLTDL Delete Directory/Library * 3 OI_SET Set current directory * 4 OI_LIST List Directory/Library * 5 OI_DLTF Delete file * 6 OI_SEND Send file * 7 OI_RECV Receive file * 8 OI_RNM Rename file * 9 OI_EXEC Execute CL commands * ********************************************************************** * Allow Operation (return code) ********************************************************************** * * -1 AO_NEVER Never allow this operation identifier * - unconditionally reject for remainder * of current session * - exit program not called again for * this operation identifier * 0 AO_REJECT Reject the operation * 1 AO_ALLOW Allow the operation * 2 AO_ALWAYS Always allow this operation identifier * - operation identifier allowed * unconditionally for remainder of * current session * - exit program not called again for * this operation identifier * ********************************************************************** * Allow Operation (from Data Area) ********************************************************************** * * V DA_NEVER Never allow this operation identifier * R DA_REJECT Reject the operation * A DA_ALLOW Allow the operation * L DA_ALWAYS Always allow this operation identifier ********************************************************************** D AI_FTPC s like(pmapid) inz(0) D AI_FTPS s like(pmapid) inz(1) D AI_REXEC s like(pmapid) inz(2) D AI_TFTP s like(pmapid) inz(3) D OI_INIT s like(pmopid) inz(0) D OI_CRTDL s like(pmopid) inz(1) D OI_DLTDL s like(pmopid) inz(2) D OI_SET s like(pmopid) inz(3) D OI_LIST s like(pmopid) inz(4) D OI_DLTF s like(pmopid) inz(5) D OI_SEND s like(pmopid) inz(6) D OI_RECV s like(pmopid) inz(7) D OI_RNM s like(pmopid) inz(8) D OI_EXEC s like(pmopid) inz(9) D AO_NEVER s like(pmallow) inz(-1) D AO_REJECT s like(pmallow) inz(0) D AO_ALLOW s like(pmallow) inz(1) D AO_ALWAYS s like(pmallow) inz(2) D DA_NEVER c 'V' D DA_REJECT c 'R' D DA_ALLOW c 'A' D DA_ALWAYS c 'L' ********************************************************************** * Variables for report ********************************************************************** D rAppID s 10 D rDate s 6 0 D rIPAddr s 15 D rOp s 12 D rOpInfo s 50 D rStatus s 6 D rTime s 6 0 D rTimeDate s 12 0 D rUsrPrf s 10 D rEnFTP s like(rStatus) D rEnAnon s like(rStatus) D rEnRexec s like(rStatus) ********************************************************************** * Arrays for report - print Option Settings ********************************************************************** D aOpFTPS s 20 dim(11) D aOpFTPA s like(aOpFTPS) dim(%elem(aOpFTPS)) D aOpFTPC s like(aOpFTPS) dim(%elem(aOpFTPS)) D aOpREXEC s like(aOpFTPS) dim(%elem(aOpFTPS)) D aOpTFTP s like(aOpFTPS) dim(%elem(aOpFTPS)) ********************************************************************** * Miscellaneous variables ********************************************************************** D K s 5 0 D N s 5 0 ********************************************************************** * Constants for report ********************************************************************** D rAIFTPS c 'FTP Server ' D rAIFTPA c 'Anonymous FTP ' D rAIFTPC c 'FTP Client ' D rAIREXEC c 'REXEC ' D rAITFTP c 'TFTP Server ' D rAIHdg c '----------------------' D rOpInit c 'Init Session' D rOpCrtDL c 'Crt Dir/Lib ' D rOpDltDL c 'Dlt Dir/Lib ' D rOpSet c 'Set Cur Dir ' D rOpList c 'List Dir/Lib' D rOpDltF c 'Delete File ' D rOpSend c 'Send File ' D rOpRcv c 'Receive File' D rOpRnm c 'Rename File ' D rOpExec c 'Exec CL ' D rStatNV c 'Never ' D rStatRJ c 'Reject' D rStatAW c 'Allow ' D rStatAY c 'Always' ********************************************************************** * Miscellaneous constants ********************************************************************** D ANONYMOUS c 'ANONYMOUS' D NO c 'N' D YES c 'Y' ********************************************************************** * Prototype for CheckDir procedure * * OpInfo - operation specific information (Library or Directory) * OpInfoLen - length of OpInfo * * Returns * allow_op - allow / reject operation ********************************************************************** D CheckDir pr 9b 0 D OpInfo 50 value D OpInfoLen 9b 0 value ********************************************************************** * Prototype for CheckDump procedure * * COField - parameter field to check ********************************************************************** D CheckDump pr 1 D CDField 11 value ********************************************************************** * Prototype for CheckAllow procedure * * CAField - parameter field to check * CAOptions - options allowed for FTP function to check * CAOpID - operation ID to check ********************************************************************** D CheckAllow pr 9b 0 D CAField 11 value D CAOptions 11 value D CAOpID 9b 0 value ********************************************************************** * Prototype for FormatOpt procedure * * OptNo - option number to format * OptSet - option set to work with * OptDA - option settings in Data Area * * Returns * fmt_op - option formatted for listing ********************************************************************** D FormatOpt pr 20 D OptDA value like(FTPS_Ops) D OptSet value like(FTPS_Ops) D OptNo value like(N) ********************************************************************** * Prototype for GetAllow procedure * * DASetting - Allow/Reject setting in data area * * returns * numeric value for Allow/Reject ********************************************************************** D GetAllow pr 9b 0 D DASetting 1 value ********************************************************************** * Prototype for GetAppID procedure * * AppID - application identifier (numeric) to resolve ********************************************************************** D GetAppID pr 10 D AppID 9b 0 value ********************************************************************** * Prototype for GetOpID procedure * * OpID - operation identifier (numeric) to resolve ********************************************************************** D GetOpID pr 12 D OpID 9b 0 value ********************************************************************** * Prototype for GetStatus procedure * * Status - status returned to exit point ********************************************************************** D GetStatus pr 6 D Status 9b 0 value ********************************************************************** * Application Request Validation Operation-Specific Information * * Op ID Operation-Specific Information * ----- ----------------------------------------------------- * 0 Application ID = 0: None * 0 Application ID = 1 or 2: dotted decimal format IP * address of client host * 1-3 Absolute path name of library or directory (1,2) * 4-8 Absolute path name of file (1,2) * 9 CL command string * * Notes * (1) QSYS.LIB file system pathnames always uppercase * (2) QOpenSys file system pathnames case sensitive ********************************************************************** ********************************************************************** * FTP Client and Server Subcommands Associated with Op IDs * * Operation ID Client Subcommands Server Subcommands * ------------- ------------------ ------------------ * 0-Init Session OPEN new connection(1) * 1-Create Dir/Lib MKD, XMKD * 2-Delete Dir/Lib RMD, XRMD * 3-Set current dir LCD CWD, CDUP, XCWD, XCUP * 4-List Dir/Lib LIST, NLIST * 5-Delete files DELE * 6-Send files APPEND, PUT, MPUT(2) RETR * 7-Receive files GET, MGET(2) APPE, STOR, STOU * 8-Rename files RNFR, RNTO * 9-Exec CL cmds SYSCMD(3) RCMD, ADDM, ADDV, * CRTL, CRTP, CRTS, * DLTF, DLTL * Notes * (1) Exit program called with this OpID each time the * FTP server receives a connection request. * (2) For MGET and MPUT subcommands, exit program is called * once for each file that is sent or retrieved. * (3) If an exit program is associated with exit point * QIBM_QTMF_CLIENT_REQ, the F21 (CL command line) * key is disabled, user must use System Command * (SYSCMD) subcommand to run a CL program. ********************************************************************** ********************************************************************** * Exit Point program parameter list ********************************************************************** C *entry plist C parm pmapid *ApplicationID C parm pmopid *OperationID C parm pmusrprf *UserProfile C parm pmipaddr *RemoteIPaddr C parm pmiplen *LengthOfIPaddr C parm pmopinfo *OpSpecificInfo C parm pmoplen *LengthOfOpInfo C parm pmallow *AllowOperation ********************************************************************** * Retrieve data area QGPL/DAFTPEXIT * Contains parameters for allow/disallow each FTP operation * * **NOTE** * IN operation is used here and in *INZSR so that the data area * settings will be retrieved each time the Exit Point calls this * program. ********************************************************************** C *dtaara define DAFTPEXIT FTPEXIT C in FTPEXIT ********************************************************************** * Select processing subroutine based on Application Identifier. * Note: Anonymous FTP calls ftp_svr ********************************************************************** C pmapid caseq AI_FTPC ftp_client C pmapid caseq AI_FTPS ftp_svr C pmapid caseq AI_REXEC rexec_svr C pmapid caseq AI_TFTP tftp_svr C endcs ********************************************************************** * Print activity if requested ********************************************************************** C if DAPrint = YES C exsr print_log C endif ********************************************************************** * Check for SETON *INLR request from Data Area. * This closes the printer file so the listing is immediately * available. ********************************************************************** C if DAINLR = YES C eval *inlr = *on C endif ********************************************************************** * Normal end-of-program ********************************************************************** C return ********************************************************************** * Program initialization processing * * **NOTE** * IN operation is used here and in mainline routine. The operation * is used here to get the print setting. ********************************************************************** C *inzsr begsr C in FTPEXIT C if DAPrint = YES C open qsysprt C exsr print_opts C except exhdr C endif C endsr ********************************************************************** * Processing for FTP Client request ********************************************************************** C ftp_client begsr * Set Allow option for requested Operation ID C eval pmallow = CheckAllow(FTPClient : C FTPC_Ops : C pmopid) * Add unique processing for FTP Client here C if (pmallow = AO_ALLOW ) or C (pmallow = AO_ALWAYS) C endif * Check for Dump request for FTP Client C if CheckDump(FTPClient) = YES C dump C endif C endsr ********************************************************************** * Processing for FTP Server and Anonymous FTP Server request ********************************************************************** C ftp_svr begsr ********************************************************************** * Set Allow option for requested Operation ID * Check for ANONYMOUS FTP request ********************************************************************** C if pmusrprf = ANONYMOUS C eval pmallow = CheckAllow(FTPAnon : C FTPS_Ops : C pmopid) * If request is Change Directory and it is allowed, * check for valid change-to library or path, * reject Change Directory command if not valid change-to. C if (pmopid = OI_SET ) and C (pmallow = AO_ALLOW) C eval pmallow = CheckDir(pmopinfo : C pmoplen) C endif * Not ANONYMOUS FTP, process as Known User ID request C else C eval pmallow = CheckAllow(FTPServer : C FTPS_Ops : C pmopid) C endif * Add unique processing for FTP Server here C if (pmallow = AO_ALLOW ) or C (pmallow = AO_ALWAYS) C endif * Check for Dump request for FTP Server C if CheckDump(FTPServer) = YES C dump C endif C endsr ********************************************************************** * Processing for REXEC Server request ********************************************************************** C rexec_svr begsr * Set Allow option for requested Operation ID C eval pmallow = CheckAllow(REXEC : C REXEC_Ops : C pmopid) * Add unique processing for REXEC Server here C if (pmallow = AO_ALLOW ) or C (pmallow = AO_ALWAYS) C endif * Check for Dump request for REXEC Server C if CheckDump(REXEC) = YES C dump C endif C endsr ********************************************************************** * Processing for TFTP Server request ********************************************************************** C tftp_svr begsr * Set Allow option for requested Operation ID C eval pmallow = CheckAllow(TFTPServer : C TFTP_Ops : C pmopid) * Add unique processing for REXEC Server here C if (pmallow = AO_ALLOW ) or C (pmallow = AO_ALWAYS) C endif * Check for Dump request for REXEC Server C if CheckDump(TFTPServer) = YES C dump C endif C endsr ********************************************************************** * Print Option Settings in data area DAFTPEXIT * Ignore DUMP option (option 1) for all option sets ********************************************************************** C print_opts begsr C except exopthdr * Format options for FTP Server C eval K = %len(FTPS_Ops) C 2 do K N C eval aOpFTPS(N) = FormatOpt(FTPServer: C FTPS_Ops : C N ) C enddo * Format options for Anonymous FTP C eval K = %len(FTPS_Ops) C 2 do K N C eval aOpFTPA(n) = FormatOpt(FTPAnon : C FTPS_Ops : C N ) C enddo * Format options for FTP Client C eval K = %len(FTPC_Ops) C 2 do K N C eval aOpFTPC(n) = FormatOpt(FTPClient: C FTPC_Ops : C N ) C enddo * Format options for REXEC Server C eval K = %len(REXEC_Ops) C 2 do K N C eval aOpREXEC(n) = FormatOpt(REXEC : C REXEC_Ops : C N ) C enddo * Format options for TFTP Server C eval K = %len(TFTP_Ops) C 2 do K N C eval aOpTFTP(n) = FormatOpt(TFTPServer: C TFTP_Ops : C N ) C enddo * Print all option settings arrays C eval K = %len(FTPS_Ops) C 2 do K N C except exoptid C enddo * Print options for TCP/IP Application Server Logon Exit Point C eval rEnFTP = GetStatus(GetAllow(AppFTP)) C eval rEnAnon = GetStatus(GetAllow(AppAnon)) C eval rEnRexec = GetStatus(GetAllow(AppREXEC)) C except exoptas C endsr ********************************************************************** * Print activity log ********************************************************************** C print_log begsr C time rTimeDate C movel rTimeDate rTime C move rTimeDate rDate C eval rAppID = GetAppID(pmapid) C eval rOp = GetOpID(pmopid) C eval rUsrPrf = pmusrprf C eval rIPAddr = %subst(pmipaddr : C 1 : C pmiplen) C eval rOpInfo = %subst(pmopinfo : C 1 : C 50) C eval rStatus = GetStatus(pmallow) C except exdtl C if *inof = *on C except exhdr C eval *inof = *off C endif C endsr ********************************************************************** * Report Section - Option Settings ********************************************************************** Oqsysprt e exopthdr 1 O 'Option Settings in ' O 'Data Area DAFTPEXIT' O + 10 'Exit Point program FTPEXIT' Oqsysprt e exopthdr 2 O rAIHDG 22 O rAIHDG 46 O rAIHDG 70 O rAIHDG 94 O rAIHDG 118 Oqsysprt e exopthdr 1 O rAIFTPS 22 O rAIFTPA 46 O rAIFTPC 70 O rAIREXEC 94 O rAITFTP 118 Oqsysprt e exopthdr 1 O rAIHDG 22 O rAIHDG 46 O rAIHDG 70 O rAIHDG 94 O rAIHDG 118 Oqsysprt e exoptid 1 O aOpFTPS(n) 22 O aOpFTPA(n) 46 O aOpFTPC(n) 70 O aOpREXEC(n) 94 O aOpTFTP(n) 118 Oqsysprt e exoptas 3 O '--------------------' O '-------------------' O '----------' Oqsysprt e exoptas 1 O 'Settings for TCP/IP ' O 'Application Server ' O 'Exit Point' Oqsysprt e exoptas 1 O '--------------------' O '-------------------' O '----------' Oqsysprt e exoptas 1 O 'Enable FTP Server logon - ' O rEnFTP Oqsysprt e exoptas 1 O 'Enable Anon FTP logon - ' O rEnAnon Oqsysprt e exoptas 1 O 'Enable REXEC logon - ' O rEnRexec Oqsysprt e exoptas 1 O 'Library for Anon FTP - ' O AppLib Oqsysprt e exoptas 1 O 'Directory for Anon FTP - ' O AppDir ********************************************************************** * Report Section - activity details ********************************************************************** Oqsysprt e exhdr 1 O 'FTP Exit Point Activity' O + 10 'Exit Point program FTPEXIT' Oqsysprt e exhdr 3 O 17 ' Date Time ' O 29 'User Prof ' O 46 ' IP Address ' O 58 ' App ID ' O 72 ' Operation ' O 93 'Operation Specific ' O 104 'Information' O 132 'Status' Oqsysprt e exhdr 4 O 17 '-----------------' O 29 '----------' O 46 '---------------' O 58 '----------' O 72 '------------' O 93 '-------------------' O 104 '-----------' O 124 '--------------------' O 132 '------' Oqsysprt e exdtl 1 O rDate y 8 O rTime 17 '0 : : ' O rUsrPrf 29 O rIPAddr 46 O rAppID 58 O rOp 72 O rOpInfo 124 O rStatus 132 ********************************************************************** * Check change-to directory/library for Anonymous FTP requester * * OpInfo - operation specific information (Library or Directory) * OpInfoLen - length of OpInfo * * Returns * allow_op - allow / reject operation ********************************************************************** P CheckDir b D CheckDir pi 9b 0 D OpInfo 50 value D OpInfoLen 9b 0 value D AnonDir s 50 D AnonLib s 24 D ChangeTo s 50 D LIBPART1 c '/QSYS.LIB/' D LIBPART2 c '.LIB' D LOWER c 'abcdefghijklmnopqrstuvwxyz' D UPPER c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' * Assume Change Directory will be rejected C eval pmallow = AO_REJECT * Format requested Change To library/path C eval ChangeTo = %subst(OpInfo : C 1 : C OpInfoLen) C LOWER:UPPER xlate ChangeTo ChangeTo * Format comparison path C LOWER:UPPER xlate AppDir AnonDir * Format comparison library C eval AnonLib = LIBPART1 + C %trim(AppLib) + C LIBPART2 C LOWER:UPPER xlate AnonLib AnonLib * Check for valid library/path C if (ChangeTo = AnonLib) or C (ChangeTo = AnonDir) C eval pmallow = AO_ALLOW C endif C return pmallow P CheckDir e ********************************************************************** * CheckDump procedure * * Check for Dump request for requested server. The Dump request * option is the first byte of the server request parameter. * * CDField - parameter field from Data Area to check * returns - *ON - process DUMP request * - *OFF - do not process DUMP request ********************************************************************** P CheckDump b D CheckDump pi 1 D CDField 11 value C return %subst(CDField : 1 : 1) P CheckDump e ********************************************************************** * CheckAllow procedure * * Given an FTP function type and operation identifier to check, * determine if Exit Point should allow the operation. * * CAField - parameter field from Data Area to check * CAOptions - options permitted for FTP function * CAOpID - operation ID to check * * returns - Allow Operation indicator * AO_NEVER * AO_REJECT * AO_ALLOW * AO_ALWAYS ********************************************************************** P CheckAllow b D CheckAllow pi 9b 0 D CAField 11 value D CAOptions 11 value D CAOpID 9b 0 value D OpPos s 9b 0 D Option s 1 D RtnOption s 9b 0 * Check for Operation Id in list of permitted operations. * If not in list, reject the operation. C move CAOpID Option C eval OpPos = %scan(Option : C CAOptions) C if OpPos = 0 C return AO_REJECT C endif * Operation ID is in list of of permitted operations. * Set Allow option. C eval Option = %subst(CAField : C OpPos : C 1) C eval RtnOption = GetAllow(Option) C return RtnOption P CheckAllow e ********************************************************************** * Format Data Area options for report * * OptDA - option settings in Data Area * OptSet - option set to work with * OptNo - option number to format * * Returns * fmt_op - option formatted for listing ********************************************************************** P FormatOpt b D FormatOpt pi 20 D OptDA value like(FTPS_Ops) D OptSet value like(FTPS_Ops) D OptNo value like(N) D wOp s 12 D wReturn s 20 D wStatus s 6 D W1 s 1 D xpmopid s like(pmopid) C eval W1 = %subst(OptSet : C OptNo ) C move W1 xpmopid C eval wOp = GetOpID(xpmopid) C eval wStatus = GetStatus( C CheckAllow(OptDA : C OptSet : C xpmopid )) C eval wReturn = wOp + C '-' + C wStatus C return wReturn P FormatOpt e ********************************************************************** * GetAllow procedure - get numeric Allow/Reject value, * given the character value in the Data Area * * Option - Allow/Reject setting in data area * * returns * numeric value for Allow/Reject ********************************************************************** P GetAllow b D GetAllow pi 9b 0 D Option 1 value C select C when Option = DA_NEVER C return AO_NEVER C when Option = DA_REJECT C return AO_REJECT C when Option = DA_ALLOW C return AO_ALLOW C when Option = DA_ALWAYS C return AO_ALWAYS C endsl P GetAllow e ********************************************************************** * GetAppID procedure * * Given the numeric Application Identifier, return string value. * * AppID - numeric Application Identifier (from Exit Point) * returns - character string Application ID ********************************************************************** P GetAppID b D GetAppID pi 10 D AppID 9b 0 value C select C when AppID = AI_FTPC C return rAIFTPC C when AppID = AI_FTPS C return rAIFTPS C when AppID = AI_REXEC C return rAIREXEC C when AppID = AI_TFTP C return rAITFTP C endsl P GetAppID e ********************************************************************** * GetOpID procedure * * Given the numeric Operation Identifier, return string value. * * OpID - numeric Operation Identifier (from Exit Point) * returns - character string Operation ID ********************************************************************** P GetOpID b D GetOpID pi 12 D OpID 9b 0 value C select C when OpID = OI_INIT C return rOpInit C when OpID = OI_CRTDL C return rOpCrtDL C when OpID = OI_DLTDL C return rOpDltDL C when OpID = OI_SET C return rOpSet C when OpID = OI_LIST C return rOpList C when OpID = OI_DLTF C return rOpDltF C when OpID = OI_SEND C return rOpSend C when OpID = OI_RECV C return rOpRcv C when OpID = OI_RNM C return rOpRnm C when OpID = OI_EXEC C return rOpExec C endsl P GetOpID e ********************************************************************** * GetStatus procedure * * Given the numeric Status code, return string value. * * Status - numeric Status (determined by this program) * returns - character string status ********************************************************************** P GetStatus b D GetStatus pi 6 D Status 9b 0 value C select C when Status = AO_NEVER C return rStatNV C when Status = AO_REJECT C return rStatRJ C when Status = AO_ALLOW C return rStatAW C when Status = AO_ALWAYS C return rStatAY C endsl P GetStatus e