*T: FTP exit program *O: CRTBNDRPG DBGVIEW(*SOURCE) OPTION(*NODEBUGIO) DFTACTGRP(*NO) *O: ACTGRP(*CALLER) CVTOPT(*DATETIME) * * SYNOPSIS: This program is an FTP exit program which should be * registered to the QIBM_QTMF_SERVER_REQ exit point as * follows: * * WRKREGINF EXITPNT(QIBM_QTMF_CLIENT_REQ) * * and then by taking option 8 (Work with exit programs) and * then taking option 1 (Add). It is suggested that this * program is compiled into a 'common' library such as QGPL. * * Each record in FTPEXITP should consist of a list of 10 * '1's (allow) or '0's (reject). Each flag represents one of * the operations specified in the array coded at the bottom * of this program. * * There should be a default record in FTPEXITP with a USRPRF * value of '*DEFAULT'. If a user-specific record cannot be * found, this record is used. If this record cannot be found * all operations are rejected (as specified in the default * OpAlw array at the bottom of the program). * *===================================================================== FFTPEXITP IF E K DISK UsrOpn Extfile(sExtFile) FQSYSPRT O F 132 PRINTER Oflind(*INOA) Infsr(*PSSR) *--------------------------------------------------------------------- D ThisProgram C 'FTPEXITR' *--------------------------------------------------------------------- * *‚Program Status Data Structure * D PgmSDS SDS Qualified D MainProc 10A D Status 5S 0 D PrvSts 5S 0 D Stmt 8A D Routine 8A D Parms 3S 0 D ExcpMsg 7A D ExcpMsgPfx 3A Overlay(ExcpMsg) D ExcpMsgNbr 4A Overlay(ExcpMsg:*Next) D 4A D WorkArea 30A D PgmLib 10A D ExcpData 80A D ExcpID 4A D FileErr 10A D 6A D Date 8A D Century 2A D FileErr2 8A D FileSts 35A D QualJob 26A D JobName 10A Overlay(QualJob) D JobUser 10A Overlay(QualJob:*Next) D JobNbr 6S 0 Overlay(QualJob:*Next) D JobNbrC 6A Overlay(JobNbr) D JobDate 6S 0 D JobDateC 6A Overlay(JobDate) D RunDate 6S 0 D RunDateC 6A Overlay(RunDate) D RunTime 6S 0 D RunTimeC 6A Overlay(RunTime) D CmpDate 6S 0 D CmpDateC 6A Overlay(CmpDate) D CmpTime 6S 0 D CmpTimeC 6A Overlay(CmpTime) D CmpLvl 4A D SrcfName 10A D SrcfLib 10A D SrcfMbr 10A D OwnPgm 10A D OwnMod 10A D 76A D SrcID 5I 0 D SrcID2 5I 0 D UsrPrf 10A D 62A * D sExtFile S 21A Inz * D OpNbr C 10 D OpArr S 100A Dim(OpNbr) CTDATA Ascend D OpArr@ S * Inz(%addr(OpArr)) D DS Based(OpArr@) D OpDta Dim(OpNbr) Like(OpArr) D OpElm 1S 0 Overlay(OpDta:1) D OpAlw 1S 0 Overlay(OpDta:3) D OpMsg 96A Overlay(OpDta:5) D OpSign S 1S 0 * D A S 10I 0 Inz D Pos S 10I 0 Inz D Allowed S 10I 0 Inz D Data S 128A Varying D Line S 132A D Char S 1A D Char32 S 32A D UsrPrfDsp S N Inz D ALWFLG DS Qualified D Flag 1S 0 Dim(10) * D cReject C 0 D cAllow C 1 D DftUsrPrf S 10A Inz('*DEFAULT') * *--------------------------------------------------------------------- *‚Main procedure interface *--------------------------------------------------------------------- * D main... D PR Extpgm(ThisProgram) D ApplicationID 10I 0 Const D OperationID 10I 0 Const D UserProfile 10A Const D IPAddress 32767A Const D IPAddressLen 10I 0 Const D OperInf 32767A Const Options(*Varsize) D OperInfLen 10I 0 Const D AllowOper 10I 0 * D main... D PI D ApplicationID 10I 0 Const D OperationID 10I 0 Const D UserProfile 10A Const D IPAddress 32767A Const D IPAddressLen 10I 0 Const D OperInf 32767A Const Options(*Varsize) D OperInfLen 10I 0 Const D AllowOper 10I 0 * *===================================================================== *‚MAINLINE *===================================================================== /free Char32 = 'FTP: ' + %char( %timestamp() ); Allowed = cReject; //‚By default, no operations are allowed if OperationID = 0; UsrPrfDsp = *off; else; if UsrPrfDsp = *off; UsrPrfDsp = *on; Line = Char32 + 'User profile: &U'; exsr RplSubVar; except Output; //‚Retrieve user-specific 'allow operation' flags sExtFile = %trim( PgmSDS.PgmLib ) + '/FTPEXITP'; open(e) FTPEXITP; if not %error; chain(e) UserProfile @FTPEXIT; if not %found; chain(e) DftUsrPrf @FTPEXIT; endif; if %found; for A = 1 to OpNbr; OpAlw( A ) = ALWFLG.Flag( A ); endfor; endif; close(e) FTPEXITP; endif; endif; endif; OpSign = OperationID; A = %lookup( OpSign : OpElm ); if A > 0; Allowed = OpAlw( A ); if Allowed = cAllow; Line = Char32 + OpMsg( A ); else; Line = Char32 + 'REJECTED: ' + OpMsg( A ); //‚Rejected! endif; exsr RplSubVar; endif; except Output; AllowOper = Allowed; return; begsr RplSubVar; Pos = %scan( '&' : Line ); dow Pos > 0; Char = %subst( Line : Pos + 1 : 1 ); select; when Char = 'O'; Data = %subst( OperInf : 1 : OperInfLen ); when Char = 'U'; Data = %trim( UserProfile ); when Char = 'S'; Data = %subst( IPAddress : 1 : IPAddressLen ); other; endsl; Line = %replace( Data : Line : Pos : 2 ); Pos = %scan( '&' : Line : Pos + %len( Data ) - 2 ); enddo; endsr; begsr *pssr; AllowOper = cReject; //‚If an error occurs, reject the operation return; endsr; /end-free *===================================================================== OQSYSPRT E Output 1 O Line *===================================================================== ** CTDATA 0 1 Client session started with remote IP address '&S' 1 0 Client created library/directory '&O' 2 0 Client deleted library/directory '&O' 3 0 Client set current library/directory to '&O' 4 0 Client listed files in '&O' 5 0 Client deleted files in '&O' 6 0 Client sent file '&O' from remote system '&S' 7 0 Client received file '&O' from remote system &S 8 0 Client renamed file '&O' 9 0 Client ran CL command '&O'