RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

A FTP Exit Program Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   

 

 H debug(*yes)
 H copyright('Copyright (c) 1998, 2003 Craig Pelkie')
  **********************************************************************
  *  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) 1998, 2003 Craig Pelkie
  *  ALL RIGHTS RESERVED
  *
  *  Craig Pelkie
  *  Rochester Initiative
  *  
 
 

  **********************************************************************
  *
  *  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
 

User Comments

Please login or register to add comments

<Previous   Next>