H debug(*yes) H copyright('Copyright (c) 1998, Bits & Bytes Programming') ********************************************************************** * Program TCPAPPLOG - sample exit program for FTP exit point * This program can be used with the following Exit Points: * * QIBM_QTMF_SVR_LOGON * QIBM_QTMX_SVR_LOGON * * Exit Point Format Name: TCPL0100 ********************************************************************** * 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_SVR_LOGON * Exit Point: QIBM_QTMX_SVR_LOGON * Exit Point Format Name: TCPL0100 * * 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 pmusrid In User Identifier * 3 pmusridlen In Length of User Identifier * 4 pmauthstr In Authentication string * 5 pmauthlen In Length of Authentication String * 6 pmipaddr In Client IP address (dotted decimal format) * 7 pmiplen In Length of IP address * 8 pmrtncod Out Return code * 9 pmusrprf Out User profile * 10 pmpwd Out Password * 11 pminllib Out Initial current library ********************************************************************** D pmapid s 9b 0 *OpInfo length D pmusrid s 10 *CCSID D pmusridlen s 9b 0 *CCSID D pmauthstr s 50 D pmauthlen s 9b 0 *CCSID D pmipaddr s 15 *Client IP Address D pmiplen s 9b 0 D pmrtncod s 9b 0 *AllowOperation D pmusrprf s 10 D pmpwd s 10 D pminllib s 10 ********************************************************************** * 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) ********************************************************************** * * 0 AO_REJECT Reject the operation * * 1 AO_ALLOW1 Allow the operation * Use specified user ID. * Use specified authentication string. * Use initial library from user profile. * * User ID used as user profile. * Authentication string used as password. * * Output parm user profile ignored. * Output parm password ignored. * Output parm library ignored. * * For the logon to succeed, the authentication * string must match the password in the * user profile. * * 2 AO_ALLOW2 Allow the operation * Use specified user ID. * Use specified authentication string. * Override initial library with output parm. * * User ID used as user profile. * Authentication string used as password. * * Output parm user profile ignored. * Output parm password ignored. * Output parm library must be specified. * * For the logon to succeed, the authentication * string must match the password in the * user profile. * * 3 AO_ALLOW3 Allow the operation * Override user ID with output parm. * Override authentication string with output * parm. * Use initial library from user profile. * * Output parm library ignored. * * For the logon to succeed, the password * output parm must match the password in the * user profile. * * 4 AO_ALLOW4 Allow the operation * Override user ID with output parm. * Override authentication string with output * parm. * Override library with output parm. * * For the logon to succeed, the password * output parm must match the password in the * user profile. * * 5 AO_ALLOW5 Allow the operation * Override user ID with output parm. * Use initial library from user profile. * * Output parm password ignored. * Output parm library ignored. * * If running at security level 20 or higher * this return code overrides AS/400 password * processing. No further password verification * is performed. * * 6 AO_ALLOW6 Allow the operation * Override user ID with output parm. * Override initial library with output parm. * * Output parm password ignored. * * If running at security level 20 or higher * this return code overrides AS/400 password * processing. No further password verification * is performed. * ********************************************************************** * 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_OPID s 9b 0 D OI_INIT s like(OI_OPID) inz(0) D OI_CRTDL s like(OI_OPID) inz(1) D OI_DLTDL s like(OI_OPID) inz(2) D OI_SET s like(OI_OPID) inz(3) D OI_LIST s like(OI_OPID) inz(4) D OI_DLTF s like(OI_OPID) inz(5) D OI_SEND s like(OI_OPID) inz(6) D OI_RECV s like(OI_OPID) inz(7) D OI_RNM s like(OI_OPID) inz(8) D OI_EXEC s like(OI_OPID) inz(9) D DA_NEVER c 'V' D DA_REJECT c 'R' D DA_ALLOW c 'A' D DA_ALWAYS c 'L' D AO_NEVER s like(pmrtncod) inz(-1) D AO_ALLOW s like(pmrtncod) inz(1) D AO_ALWAYS s like(pmrtncod) inz(2) D AO_REJECT s like(pmrtncod) inz(0) D AO_ALLOW1 s like(pmrtncod) inz(1) D AO_ALLOW2 s like(pmrtncod) inz(2) D AO_ALLOW3 s like(pmrtncod) inz(3) D AO_ALLOW4 s like(pmrtncod) inz(4) D AO_ALLOW5 s like(pmrtncod) inz(5) D AO_ALLOW6 s like(pmrtncod) inz(6) ********************************************************************** * 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 rStatAW1 c 'Allow 1' D rStatAW2 c 'Allow 2' D rStatAW3 c 'Allow 3' D rStatAW4 c 'Allow 4' D rStatAW5 c 'Allow 5' D rStatAW6 c 'Allow 6' D rStatAY c 'Always' ********************************************************************** * Miscellaneous constants ********************************************************************** D NO c 'N' D YES c 'Y' D LOWER c 'abcdefghijklmnopqrstuvwxyz' D UPPER c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D ANONYMOUS c 'ANONYMOUS' D USRPRF c '*USRPRF' ********************************************************************** * 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 CheckOption procedure * * COOpID - operation ID to check ********************************************************************** D CheckOption pr 9b 0 D COOpID 1 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 ********************************************************************** * Exit Point program parameter list ********************************************************************** C *entry plist C parm pmapid *ApplicationID C parm pmusrid *User ID C parm pmusridlen *User ID Length C parm pmauthstr *AuthenticationStr C parm pmauthlen *LengthOfAuthStr C parm pmipaddr *ClientIPAddress C parm pmiplen *LengthOfIPAddress C parm pmrtncod *ReturnCode C parm pmusrprf *UserProfile C parm pmpwd *Password C parm pminllib *InitialLibrary ********************************************************************** * 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 ********************************************************************** C pmapid caseq AI_FTPS ftp_svr C pmapid caseq AI_REXEC rexec_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 ********************************************************************** 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 Server request ********************************************************************** C ftp_svr begsr * Check for Allow FTP Server request C eval pmrtncod = CheckOption(AppFTP) * Add unique processing for FTP Server here C if (pmrtncod = AO_ALLOW1) or C (pmrtncod = AO_ALLOW2) or C (pmrtncod = AO_ALLOW3) or C (pmrtncod = AO_ALLOW4) or C (pmrtncod = AO_ALLOW5) or C (pmrtncod = AO_ALLOW6) * Check for Anonymous FTP request. If Anonymous: * * - set returned user profile to ANONYMOUS * - set initial library to User Profile lib (rtncode = 5) * - override initial library with parm value (rtncode = 6) C *like define pmusrid UserID C LOWER:UPPER xlate pmusrid UserID C eval UserID = %subst(UserID : C 1 : C pmusridlen) C if UserID = ANONYMOUS C eval pmusrprf = ANONYMOUS C if AppLib = USRPRF C eval pmrtncod = AO_ALLOW5 C else C eval pmrtncod = AO_ALLOW6 C eval pminllib = AppLib C endif C endif C endif * Check for Dump request for FTP Server C if AppDump = 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 pmrtncod = CheckOption(AppREXEC) * Add unique processing for REXEC Server here C if (pmrtncod = AO_ALLOW1) or C (pmrtncod = AO_ALLOW2) or C (pmrtncod = AO_ALLOW3) or C (pmrtncod = AO_ALLOW4) or C (pmrtncod = AO_ALLOW5) or C (pmrtncod = AO_ALLOW6) C endif * Check for Dump request for REXEC Server C if AppDump = 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 rUsrPrf = pmusrprf C eval rIPAddr = %subst(pmipaddr : C 1 : C pmiplen) C eval rStatus = GetStatus(pmrtncod) 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' Oqsysprt e exhdr 3 O 17 ' Date Time ' O 29 ' App ID ' O 43 ' Operation ' O 55 'User Prof ' O 72 ' IP Address ' O 93 'Operation Specific ' O 104 'Information' O 132 'Status' Oqsysprt e exhdr 4 O 17 '-----------------' O 29 '----------' O 43 '------------' O 55 '----------' O 72 '---------------' O 93 '-------------------' O 104 '-----------' O 124 '--------------------' O 132 '------' Oqsysprt e exdtl 1 O rDate y 8 O rTime 17 '0 : : ' O rAppID 29 O rUsrPrf 55 O rIPAddr 72 O rStatus 132 ********************************************************************** * 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 ********************************************************************** * CheckOption procedure * * Given an FTP function type and operation identifier to check, * determine if Exit Point should allow the operation. * * COOpID - operation ID to check * returns - Allow Operation indicator * AO_REJECT * AO_ALLOW ********************************************************************** P CheckOption b D CheckOption pi 9b 0 D COOpID 1 value * Operation ID is in list of of permitted operations. * Set Allow option. C select C when COOpID = DA_REJECT C return AO_REJECT C when COOpID = DA_ALLOW C return AO_ALLOW1 C endsl P CheckOption 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 9b 0 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_REJECT C return AO_REJECT C when Option = DA_ALLOW C return AO_ALLOW 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_FTPS C return rAIFTPS C when AppID = AI_REXEC C return rAIREXEC 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_REJECT C return rStatRJ C when Status = AO_ALLOW1 C return rStatAW1 C when Status = AO_ALLOW2 C return rStatAW2 C when Status = AO_ALLOW3 C return rStatAW3 C when Status = AO_ALLOW4 C return rStatAW4 C when Status = AO_ALLOW5 C return rStatAW5 C when Status = AO_ALLOW6 C return rStatAW6 C endsl P GetStatus e