星期一, 11月 27, 2023

AS/400 Journal - FTP Exit Program

Following code from AS/400 Journal https://www.oocities.org/siliconvalley/Pines/5581/ftpsec.htm

File Transfer Protocol (FTP)

File Transfer Protocol (FTP) requires the user to provide a user ID and password (in a secured environment). FTP also verifies that a user profile has authority to any file that is to be transferred. You access this function using the STRTCPFTP or FTP command, or by connecting to the AS/400 FTP Server using another system’s FTP client.

Controlling FTP Access

  • Be aware that there are security issues that comes with FTP clients who accesses the system. Our object security scheme might not provide detailed enough protection when we allow FTP to our system. For example, when a user has the authority to view a file (*USE authority), the user can also download a copy of the file to a PC or another system. I have added FTP exit programs to restrict the FTP operations that users can perform.
    Note: FTP exits are available since V3R2.
  • FTP provides a remote-command capability. The FTP subcommand is equivalent to having a command line on the system. The FTP Request Validation Exit Program for the server rejects remote-command unless properly authorized.
  • Another security glitch in FTP is that passwords are not encrypted when they are sent between the client system and the server system. Passwords may be vulnerable through line sniffing.
  • User can access objects in the IFS (integrated file system) with FTP. We must ensure that our authority scheme for the IFS is adequate.
  • The system value QMAXSIGN does not apply to FTP. Within FTP, the connections ends after 5 unsuccessful attemps, but the user can just QUIT and re-attempt to sign back on. FTP users have unlimited attempts to break in the system.

FTP Server Logon Exit Program -- FTPLOGON

The purpose of the server logon exit program is to allow or deny the users to log on based on 
the User Id, Password or Client IP Address. The FTPLOGON program validates the user id who logs 
on the server. The user must be authorized to the authorization list FTPLOGON, and have at least 
*USE authority. We are also tracking "anonymous" user id, logging their E-mail address for their 
password. The FTPLOGON program sends a message to QSYSOPR & QHST with the user id and E-mail address.

The program continues but since "ANONYMOUS" is not a valid user id, the FTP fails. We may substitute 
another user id to replace the ANONYMOUS user id.

The program also validates the Client IP address against all valid IP address found in the Host Table. 
You may access the Host table entries from the CFGTCP menu. Option 10, Work with TCP/IP host table 
entries, enables us to add host IP address and their associated host names to the host table. The host 
table is stored in member HOST of the file QATOCHOST in library QUSRSYS. The Host table must be identical 
throughout the network. The FTPLOGON program denies any client IP address not found in the host table.

The FTPLOGON program accepts 7 input parameters and returns 4 output parameters. Based on the input 
parameters, FTPLOGON determines what parameters to validate. FTPLOGON program enables the initial 
current library to be set by allowing the current library listed in the input parameter to be overriden. 
FTPLOGON sets the return code output parameter to indicate whether or not to allow the server is to 
continue logon operation. Different return codes are available to enable alternative ways of processing 
the logon and initializing the current library.

NOTE: The FTPLOGON program allows the FTP to continue from either an invalid IP address, 
or users not authorized to FTPLOGON authorization list. 
Change the program to reject (remove the *@@@@@ comment line) the logon to stop the FTP log on. 
A special user id ZFTP is used to bypass FTP security.

      /TITLE FTPLOGON  Firewall Program for FTP Server Logon
      *--------------------------------------------------------------*
      *  Programmers Group & Management Resources   Copyright  1999  *
      *                                                              *
      *                           \\\\\\\                            *
      *                          ( o   o )                           *
      *---------------------oOOO----(_)----OOOo----------------------*
      *                                                              *
      *  System name. . :  Security                                  *
      *  Module/Program :  FTPLOGON                                  *
      *  Text . . . . . :  Firewall for FTP Server Logon             *
      *                                                              *
      *  Author . . . . :  Alex Nubla                                *
      *  Description. . :  This program must be added to the exit    *
      *                    point QIBM_QTMF_SVR_LOGON for format      *
      *                    TCPL0100.                                 *
      *                                                              *
      *                   OOOOO              OOOOO                   *
      *                   (    )             (    )                  *
      *--------------------(   )-------------(   )-------------------*
      *                     (_)               (_)                    *
      *                                                              *
      * Modification Log :                                           *
      *                                                              *
      *           Task  Programmer/                                  *
      *   Date     No.  Description                                  *
      * -------- ------ -------------------------------------------- *
      * 10/15/98        Alex Nubla                                   *
      *                 Creation Date                                *
      *                                                              *
      *--------------------------------------------------------------*
      *                                                              *
      * Modules:                                                     *
      *                                                              *
      * 1. FTPLOGON   RPGLE    FTP Server Logon Exit Program         *
      *                                                              *
      * Service Programs:                                            *
      *                                                              *
      * 1. *NONE                                                     *
      *                                                              *
      * Programs:                                                    *
      *                                                              *
      * 1. *NONE                                                     *
      *                                                              *
      *--------------------------------------------------------------*
      *                                                              *
      *  APIs Used:                                                  *
      *                                                              *
      *  QSYRUSRA      Retrieve user authority to object             *
      *                                                              *
      *--------------------------------------------------------------*
     H COPYRIGHT('(C) Alex Nubla of PGMR, Inc.  1999')
      ****************************************************************
      *  F I L E   D E S C R I P T I O N   S P E C I F I C A T I O N *
      ****************************************************************
     FQATOCHOST IF   E           K DISK
      *
      *  Host Table by IP address
      *
      *--------------------------------------------------------------*
     D/EJECT
      ****************************************************************
      *       D E F I N I T I O N     S P E C I F I C A T I O N      *
      ****************************************************************

      *--------------------------------------------------------------*
      *
      *  Retrieve user authority to Object (QSYRUSRA) API
      *
     D@RtnObjAut       DS            93
     D  @UA2byte                      9B 0 Inz
     D  @UA2avail                     9B 0 Inz
     D  @UA2ObjAut                   10    Inz
      *
     D @UA2Len         S              9B 0 Inz(93)
     D @UA2Format      S              8    Inz('USRA0100')
     D @UA2User        S             10    Inz
     D @UA2Object      S             20    Inz('FTPLOGON  QSYS      ')
     D @UA2OType       S             10    Inz('*AUTL')

      *--------------------------------------------------------------*
      *
      *  TCP/IP Application Server Logon Exit Point Interface
      *
      * *------------------------------------------------------------*
      * |  1 | Application identifier      | Input  | Binary(4)      |
      * |    |                             |        |                |
      * |    |  1 = FTP server program     |        |                |
      * |    |  2 = REXEC server program   |        |                |
      * |    |                             |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  2 | User identifier             | Input  | Char(*)        |
      * |----+------------+----------------+--------+----------------|
      * |  3 | Length of user identifier   | Input  | Binary(4)      |
      * |----+------------+----------------+--------+----------------|
      * |  4 | Authentication string       | Input  | Char(*)        |
      * |----+------------+----------------+--------+----------------|
      * |  5 | Length of authentication    | Input  | Binary(4)      |
      * |    | string                      |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  6 | Client IP address           | Input  | Char(*)        |
      * |----+------------+----------------+--------+----------------|
      * |  7 | Length of client IP address | Input  | Binary(4)      |
      * |----+------------+----------------+--------+----------------|
      * |  8 | Return code                 | Output | Binary(4)      |
      * |    |                             |        |                |
      * |    |  0 = Reject Logon           |        |                |
      * |    |  1 = Continue Logon         |        |                |
      * |    |  2 = Continue Logon,        |        |                |
      * |    |      override current       |        |                |
      * |    |      library                |        |                |
      * |    |  3 = Continue Logon,        |        |                |
      * |    |      override user prf,     |        |                |
      * |    |      password               |        |                |
      * |    |  4 = Continue Logon,        |        |                |
      * |    |      override user prf,     |        |                |
      * |    |      password, current      |        |                |
      * |    |      library                |        |                |
      * |    |  5 = Accept logon with      |        |                |
      * |    |      user prf returned      |        |                |
      * |    |  6 = Accept logon with      |        |                |
      * |    |      user prf returned,     |        |                |
      * |    |      override current       |        |                |
      * |    |      library                |        |                |
      * |    |                             |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  9 | User profile                | Output | Char(10)       |
      * |----+------------+----------------+--------+----------------|
      * | 10 | Password                    | Output | Char(10)       |
      * |----+------------+----------------+--------+----------------|
      * | 11 | Initial current library     | Output | Char(10)       |
      * *------------------------------------------------------------*
      *
      *     Exit Point:  QIBM_QTMF_SVR_LOGON
      *                  QIBM_QTMX_SVR_LOGON
      *
     D AppId           S              9B 0
     D UserId          S            999
     D UserIdLen       S              9B 0
     D Authen          S            999
     D AuthenLen       S              9B 0
     D IpAddr          S             15
     D IpAddrLen       S              9B 0
     D RtnCode         S              9B 0
     D User            S             10
     D Password        S             10
     D CurrLib         S             10

     D Email           S             30
     D FTPUser         S             10
     D Message         S             52
     D FullJob         S             28

      *--------------------------------------------------------------*
      *
      *  Record structure for error code parameter
      *
     D@ErrData         DS
     D  @BytesProv                    9B 0 Inz(200)
     D  @BytesAval                    9B 0
     D  @ExcpId                       7
     D  @Reserved1                    1
     D  @ExcpData                   184

      *--------------------------------------------------------------*
      *
      *  Constants
      *
     D Special         C                   'ZFTP'
     D Anonymous       C                   'ANONYMOUS '
     D LogMsg1         C                   'ANONYMOUS ('
     D LogMsg2         C                   ') try to logon FTP'
     D LogMsg3         C                   ' logon to FTP'
     D @Sign           C                   '@'
     D Warn1           C                   ' SECURITY VIOLATION:               '
     D Warn2           C                   ' =================================-
     D                                     =================='
     D Warn3           C                   ' Invalid IP Address of FTP Logon. -
     D                                     Check the ff:'
     D Warn4           C                   ' Not authorized to FTPLOGON *AUTL.-
     D                                      Check the ff:'
     D Reject          C                   0
     D Continue        C                   1
     D Accept          C                   5
      *
     C/EJECT
      ****************************************************************
      *     C A L C U L A T I O N     S P E C I F I C A T I O N      *
      ****************************************************************
      *
     C     *Entry        Plist
      *
      * Input parameters
     C                   Parm                    AppId
     C                   Parm                    UserId
     C                   Parm                    UserIdLen
     C                   Parm                    Authen
     C                   Parm                    AuthenLen
     C                   Parm                    IpAddr
     C                   Parm                    IpAddrLen
      *
      * Return parameters
     C                   Parm                    RtnCode
     C                   Parm                    User
     C                   Parm                    Password
     C                   Parm                    CurrLib
      *
      *----------------------------------------------------*
      *  Check user id requesting the FTP                  *
      *----------------------------------------------------*
     C                   If        UserIdLen   > *Zeros
     C                   Eval      FtpUser     = %Subst(UserId: 1: UserIdLen)
     C                   EndIf
      *
     C                   Select
      *----------------------------------------------------*
      *  ANONYMOUS user log on                             *
      *----------------------------------------------------*
     C                   When      FtpUser     = Anonymous
     C                   Exsr      $Anonym
     C                   Other
      *----------------------------------------------------*
      *  Is user authorized to FTPLOGON *AUTL              *
      *----------------------------------------------------*
     C                   Exsr      $Autl
     C                   EndSl
      *
     C                   Eval      *InLR       = *On
     C                   Return
      /EJECT
      ****************************************************************
      *                    S U B R O U T I N E S                     *
      ****************************************************************
      /SPACE
      *==============================================================*
      *                                                              *
      *  Anonymous user log on                                       *
      *                                                              *
     C     $Anonym       Begsr
      *==============================================================*
      *----------------------------------------------------*
      *  We may want ANONYMOUS user id in the fututre -    *
      *  if so, create the user id use by "PUBLIC" user.   *
      *  For now, it will abend because ANONYMOUS is not a *
      *  valid AS/400 id. Read I.7 Anonymous FTP of        *
      *  OS/400 TCP/IP Configuration & Reference Manual.   *
      *----------------------------------------------------*

      *         *------------------------------------------*
      *         *  email address follows ANONYMOUS         *
      *         *------------------------------------------*
     C     @Sign         Scan      Authen:2                               88
     C                   If        *In88
      *
      *          if we allow "PUBLIC" FTP, change this code
      *            to use the "PUBLIC" user id.
      *
     C                   Eval      User        = FtpUser
     C                   Eval      RtnCode     = Accept
     C                   Eval      Email       = %Subst(Authen: 1: AuthenLen)
     C                   Eval      Message     = LogMsg1          +
     C                                           %Trimr(Email)    +
     C                                           LogMsg2
     C     Message       Dsply     'QSYSOPR'
     C                   Else
     C                   Eval      RtnCode     = Reject
     C                   EndIf
      *
      *
     C     #Anonym       Endsr
      /SPACE
      *==============================================================*
      *                                                              *
      *  Authorized to FTPLOGON *AUTL?                               *
      *                                                              *
     C     $Autl         Begsr
      *==============================================================*
      *----------------------------------------------------*
      *  User must be authorized to FTPLOGON *AUTL.        *
      *----------------------------------------------------*
     C                   Reset                   @RtnObjAut
     C                   Reset                   @UA2Len
     C                   Reset                   @UA2Format
     C                   Eval      @UA2User    = FtpUser
     C                   Call      'QSYRUSRA'
     C                   Parm                    @RtnObjAut
     C                   Parm                    @UA2Len
     C                   Parm                    @UA2Format
     C                   Parm                    @UA2User
     C                   Parm                    @UA2Object
     C                   Parm                    @UA2OType
     C                   Parm                    @ErrData
      *         *------------------------------------------*
      *         *  Not authorized to FTPLOGON *AUTL.       *
      *         *  If we want to prevent the FTP for the   *
      *         *  user, use the Reject statement instead. *
      *         *------------------------------------------*
     C                   If        @UA2ObjAut  = '*EXCLUDE'
     C                   Eval      RtnCode     = Continue
      *@@@@@@@@          Eval      RtnCode     = Reject
     C     Warn2         Dsply     'QSYSOPR'
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' USER ID INVALID'
     C     Message       Dsply     'QSYSOPR'
     C     Warn4         Dsply     'QSYSOPR'
     C                   Eval      Message     = '   User Id   : ' +  FtpUser
     C     Message       Dsply     'QSYSOPR'
     C                   Eval      Internet    = %Subst(IpAddr: 1: IpAddrLen)
     C                   Eval      Message     = '   IP Address: ' +  Internet
     C     Message       Dsply     'QSYSOPR'
     C     Warn2         Dsply     'QSYSOPR'
      *
     C                   Else
      *         *------------------------------------------*
      *         *  if authorized, validate IP              *
      *         *------------------------------------------*
     C                   Exsr      $ValidIp
     C                   EndIf
      *
     C     #Autl         Endsr
      /SPACE
      *==============================================================*
      *                                                              *
      *  Validate the FTP Client IP Address                          *
      *                                                              *
     C     $ValidIp      Begsr
      *==============================================================*
      *----------------------------------------------------*
      *  Validate the IP address the FTP request is coming *
      *  in from. The IP must be registered as one of the  *
      *  host tables.  GO CFGTCP and take option 10 to     *
      *  enter new host in the table.                      *
      *----------------------------------------------------*
      *
     C                   Eval      Internet    = %Subst(IpAddr: 1: IpAddrLen)
     C     Internet      Chain     QATOCHOST                          40
     C                   If        Not *In40
     C                   Eval      RtnCode     = Continue
     C                   If        FtpUser    <> Special
     C                   Eval      Message     = %Trimr(FtpUser)   +  LogMsg3
     C     Message       Dsply     'QSYSOPR'
     C                   EndIf
      *
     C                   Else
      *         *------------------------------------------*
      *         *  Invalid Client IP Address.              *
      *         *  If we want to prevent the FTP for the   *
      *         *  user, use the Reject statement instead. *
      *         *------------------------------------------*
     C                   Eval      RtnCode     = Continue
      *@@@@@@@@          Eval      RtnCode     = Reject
     C     Warn2         Dsply     'QSYSOPR'
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' CLIENT IP ADDRESS INVALID'
     C     Message       Dsply     'QSYSOPR'
     C     Warn3         Dsply     'QSYSOPR'
     C                   Eval      Message     = '   IP Address: ' +  Internet
     C     Message       Dsply     'QSYSOPR'
     C                   Eval      Message     = '   User Id   : ' +  FtpUser
     C     Message       Dsply     'QSYSOPR'
     C     Warn2         Dsply     'QSYSOPR'
     C                   EndIf
      *
     C     #ValidIp      Endsr


FTP Request Validation Exit Program

The FTP request validation exit program determines whether to allow or deny permission of FTP 
operation based either on user id, client IP address, operation being requested, or 
directory/file/library affected. The FTPRQSVLD program is used for this exit program for both 
client and server request.

Requested operations are permitted or denied based on the returned "Allow operation" output 
parameter. For example, the FTP application calls FTPRQSVLD with a request to PUT (write/update) 
to this file? FTPRQSVLD determines whether the request is accepted and returns the "Allow operation" 
return code to the FTP application. If it is denied, the FTP application issues a message that state 
that the operation is rejected.

The exit program may also indicate that the FTP request will always be allowed or always denied 
for a particular user. When always allowed or always denied is returned, the FTP application will 
not call the exit program again for the same request during the user session.

The FTPRQSVLD program accepts 7 input parameters and returns 1 output parameter. Based on the
input parameter, FTPRQSVLD can determine what type of FTP operation is being requested, For 
operation containing name of library or file name, FTPRQSVLD allows the operation if the 
library requested is a "Test" type library. For "Production" type library, the FTP request is 
rejected. FTP request requiring execution of CL commands are all rejected.

      /TITLE FTPRQSVLD  Firewall Program for FTP Request Validation
      *--------------------------------------------------------------*
      *  Programmers Group & Management Resources   Copyright  1999  *
      *                                                              *
      *                           \\\\\\\                            *
      *                          ( o   o )                           *
      *---------------------oOOO----(_)----OOOo----------------------*
      *                                                              *
      *  System name. . :  Security                                  *
      *  System name. . :  Technical Support                         *
      *  Module/Program :  FTPRQSVLD                                 *
      *  Text . . . . . :  Firewall for FTP Request Validation       *
      *                                                              *
      *  Author . . . . :  Alex Nubla                                *
      *  Description. . :  This program must be added to the exit    *
      *                    point QIBM_QTMF_CLIENT_REQ and            *
      *                    QIBM_QTMF_SERVER_REQ.                     *
      *                                                              *
      *                   OOOOO              OOOOO                   *
      *                   (    )             (    )                  *
      *--------------------(   )-------------(   )-------------------*
      *                     (_)               (_)                    *
      *                                                              *
      * Modification Log :                                           *
      *                                                              *
      *           Task  Programmer/                                  *
      *   Date     No.  Description                                  *
      * -------- ------ -------------------------------------------- *
      * 10/19/98        Alex Nubla                                   *
      *                 Creation Date                                *
      *                                                              *
      *--------------------------------------------------------------*
      *                                                              *
      * Modules:                                                     *
      *                                                              *
      * 1. FTPRQSVLD  RPGLE    FTP Request Validation Exit Program   *
      *                                                              *
      * Service Programs:                                            *
      *                                                              *
      * 1. *NONE                                                     *
      *                                                              *
      * Programs:                                                    *
      *                                                              *
      * 1. *NONE                                                     *
      *                                                              *
      *--------------------------------------------------------------*
      *                                                              *
      *  APIs Used:                                                  *
      *                                                              *
      *  QSYRUSRA      Retrieve user authority to object             *
      *                                                              *
      *--------------------------------------------------------------*
     H COPYRIGHT('(C) Alex Nubla of PGMR, Inc.  1998')
     D/EJECT
      ****************************************************************
      *       D E F I N I T I O N     S P E C I F I C A T I O N      *
      ****************************************************************

      *--------------------------------------------------------------*
      *
      *  Retrieve user authority to Object (QSYRUSRA) API
      *
     D@RtnObjAut       DS            93
     D  @UA2byte                      9B 0 Inz
     D  @UA2avail                     9B 0 Inz
     D  @UA2ObjAut                   10    Inz
      *
     D @UA2Len         S              9B 0 Inz(93)
     D @UA2Format      S              8    Inz('USRA0100')
     D @UA2User        S             10    Inz
     D @UA2Object      S             20    Inz('FTPLOGON  QSYS      ')
     D @UA2OType       S             10    Inz('*AUTL')

      *--------------------------------------------------------------*
      *
      *  Retrieve library description (QLIRLIBD) API
      *
     D@RtnLibDsc       DS            33
     D  @LDByte                       9B 0 Inz
     D  @LDAvail                      9B 0 Inz
     D  @LDLenRtn                     9B 0 Inz
     D  @LDLenAvail                   9B 0 Inz
     D  @LDRecord                    17    Inz
     D   @LDRLen                      9B 0 overlay(@LDRecord:  1)
     D   @LDRKey                      9B 0 overlay(@LDRecord:  5)
     D   @LDRSize                     9B 0 overlay(@LDRecord:  9)
     D   @LDRType                     1    overlay(@LDRecord: 13)
      *
     D@RtvAttr         DS
     D  @AttrElm                      9B 0 Inz(1)
     D  @ReqKey                       9B 0 Inz(1)
      *
     D @LDLen          S              9B 0 Inz(33)
     D FtpLib          S             10    Inz
     D FtpPath         S            256    Inz
     D Str             S              5S 0 Inz
     D Pos             S              5S 0 Inz
     D Len             S              5S 0 Inz
      *
     D Production      C                   '0'
     D Test            C                   '1'

      *--------------------------------------------------------------*
      *
      *  Record structure for error code parameter
      *
     D@ErrData         DS
     D  @BytesProv                    9B 0 Inz(200)
     D  @BytesAval                    9B 0
     D  @ExcpId                       7
     D  @Reserved1                    1
     D  @ExcpData                   184

      *--------------------------------------------------------------*
      *
      *  TCP/IP Application Request Validation Exit Point Interface
      *
      * *------------------------------------------------------------*
      * |  1 | Application identifier      | Input  | Binary(4)      |
      * |    |                             |        |                |
      * |    |  0 = FTP client program     |        |                |
      * |    |  1 = FTP server program     |        |                |
      * |    |                             |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  2 | Operations identified       | Input  | Binary(4)      |
      * |    |                             |        |                |
      * |    |  0 = Session initialization |        |                |
      * |    |  1 = Directory/library      |        |                |
      * |    |      creation               |        |                |
      * |    |  2 = Directory/library      |        |                |
      * |    |      deletion               |        |                |
      * |    |  3 = Set current directory  |        |                |
      * |    |  4 = List files             |        |                |
      * |    |  5 = File deletion          |        |                |
      * |    |  6 = Sending file           |        |                |
      * |    |  7 = Receiving file         |        |                |
      * |    |  8 = Renaming file          |        |                |
      * |    |  9 = Execute CL command     |        |                |
      * |    |                             |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  3 | User profile                | Input  | Char(10)       |
      * |----+------------+----------------+--------+----------------|
      * |  4 | Remote IP address           | Input  | Char(*)        |
      * |----+------------+----------------+--------+----------------|
      * |  5 | Length of remote IP address | Input  | Binary(4)      |
      * |----+------------+----------------+--------+----------------|
      * |  6 | Operation-specific          | Input  | Char(*)        |
      * |    | information                 |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  7 | Length of                   | Input  | Binary(4)      |
      * |    | operation-specific          |        |                |
      * |    | information                 |        |                |
      * |----+------------+----------------+--------+----------------|
      * |  8 | Allow operation             | Output | Binary(4)      |
      * |    |                             |        |                |
      * |    | -1 = Never allow the        |        |                |
      * |    |      operation identifier   |        |                |
      * |    |  0 = Reject the operation   |        |                |
      * |    |  1 = Allow the operation    |        |                |
      * |    |  2 = Always allow this      |        |                |
      * |    |      operation identifier   |        |                |
      * |    |                             |        |                |
      * *------------------------------------------------------------*
      *
      *     Exit Point:  QIBM_QTMF_CLIENT_REQ
      *                  QIBM_QTMF_SERVER_REQ
      *                  QIBM_QTMX_SERVER_REQ
      *                  QIBM_QTOD_SERVER_REQ
      *
     D AppId           S              9B 0
     D OperRqs         S              9B 0
     D User            S             10
     D IpAddr          S             15
     D IpAddrLen       S              9B 0
     D OperInf         S            999
     D OperInfLen      S              9B 0
     D AllowOper       S              9B 0
     D FullJob         S             26

     D SessionInz      C                   0
     D MakeDir         C                   1
     D DelDir          C                   2
     D ChgDir          C                   3
     D ListFile        C                   4
     D DelFile         C                   5
     D PutFile         C                   6
     D GetFile         C                   7
     D RnmFile         C                   8
     D SysCmd          C                   9
     D NeverAllow      C                   -1
     D Reject          C                   0
     D Allow           C                   1
     D AlwaysAllw      C                   2

      *--------------------------------------------------------------*
      *
      *  Standalone fields
      *
     D Message         S             52
     D Internet        S             15

      *--------------------------------------------------------------*
      *
      *  Constants
      *
     D @LO             C                   'abcdefghijklmnopqrstuvwxyz'
     D @UP             C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      *
     D Client          C                   0
     D Server          C                   1
      *
     D Warn1           C                   ' FTP REQUEST:                      '
     D Warn2           C                   ' =================================-
     D                                     =================='
     D Warn3           C                   ' The following info was logged fro-
     D                                     m the Server:'
      *
     D Anonymous       C                   'ANONYMOUS '
     D Special         C                   'ZFTP'
     D Qtcp            C                   'QTCP'
     D QsysLib         C                   '/QSYS.LIB/'
     D DotLib          C                   '.LIB'
     C/EJECT
      ****************************************************************
      *     C A L C U L A T I O N     S P E C I F I C A T I O N      *
      ****************************************************************
      *
     C     *Entry        Plist
      *
      * Input parameters
     C                   Parm                    AppId
     C                   Parm                    OperRqs
     C                   Parm                    User
     C                   Parm                    IpAddr
     C                   Parm                    IpAddrLen
     C                   Parm                    OperInf
     C                   Parm                    OperInfLen
      *
      * Return parameters
     C                   Parm                    AllowOper
      *
     C                   Eval      AllowOper   = Allow
     C                   If        User       <> Special   and
     C                             User       <> Qtcp
      *----------------------------------------------------*
      *  Determine client or server request                *
      *----------------------------------------------------*
B01  C                   Select
      *         *------------------------------------------*
      *         *  Client FTP request                      *
      *         *------------------------------------------*
     C                   When      AppId       = Client
     C                   Exsr      $ClientRq
      *         *------------------------------------------*
      *         *  Server FTP request                      *
      *         *------------------------------------------*
     C                   When      AppId       = Server
     C                   Exsr      $ServerRq
E01  C                   EndSl
      *
E01  C                   EndIf
      *
     C                   Eval      *InLR       = *On
     C                   Return
      /EJECT
      ****************************************************************
      *                    S U B R O U T I N E S                     *
      ****************************************************************
      /SPACE
      *==============================================================*
      *                                                              *
      *  Validate FTP Client Request                                 *
      *                                                              *
     C     $ClientRq     BegSr
      *==============================================================*
      *----------------------------------------------------*
      *  Validate client request (job on this server)      *
      *----------------------------------------------------*
     C                   Select
      *         *------------------------------------------*
      *         *  Rejected requests                       *
      *         *------------------------------------------*
     C                   When      OperRqs     = MakeDir   or
     C                             OperRqs     = DelDir    or
     C                             OperRqs     = DelFile   or
     C                             OperRqs     = RnmFile   or
     C                             OperRqs     = SysCmd
     C                   Eval      AllowOper   = NeverAllow
      *
      *         *------------------------------------------*
      *         *  Accepted requests - have the server     *
      *         *  system validate our request.            *
      *         *------------------------------------------*
     C                   When      OperRqs     = ChgDir    or
     C                             OperRqs     = ListFile  or
     C                             OperRqs     = PutFile   or
     C                             OperRqs     = GetFile
     C                   Eval      AllowOper   = Allow
E02  C                   EndSl
      *
     C     #ClientRq     EndSr
     C/EJECT
      *==============================================================*
      *                                                              *
      *  Validate FTP Server Request                                 *
      *                                                              *
     C     $ServerRq     BegSr
      *==============================================================*
      *----------------------------------------------------*
      *  User id accepted at this point                    *
      *----------------------------------------------------*
      *
B02  C                   Select
      *         *------------------------------------------*
      *         *  Rejected requests                       *
      *         *------------------------------------------*
     C                   When      OperRqs     = MakeDir   or
     C                             OperRqs     = DelDir    or
     C                             OperRqs     = DelFile   or
     C                             OperRqs     = RnmFile   or
     C                             OperRqs     = SysCmd
     C                   Eval      AllowOper   = NeverAllow
      *
      *         *------------------------------------------*
      *         *  Accepted requests - only for TEST type  *
      *         *  library.                                *
      *         *------------------------------------------*
     C                   When      OperRqs     = ChgDir    or
     C                             OperRqs     = ListFile  or
     C                             OperRqs     = PutFile   or
     C                             OperRqs     = GetFile
     C                   Eval      AllowOper   = Allow
      *
     C                   Reset                   FtpLib
     C                   Eval      FtpPath     = %Subst(OperInf: 1: OperInfLen)
     C     @Lo:@Up       Xlate     FtpPath       FtpPath
     C     QSysLib       Scan      FtpPath       Pos                      90
      *
     C                   If        *In90
     C                   Eval      Str         = Pos + 10
     C     DotLib        Scan      FtpPath:Str   Pos                      89
     C                   If        *In89
     C                   Eval      Len         = Pos - Str
     C                   Eval      FtpLib      = %Subst(FtpPath: Str: Len)
     C                   Else
     C                   Eval      FtpLib      = 'QSYS'
     C                   EndIf
      *
     C                   Call      'QLIRLIBD'
     C                   Parm                    @RtnLibDsc
     C                   Parm                    @LDLen
     C                   Parm                    FtpLib
     C                   Parm                    @RtvAttr
     C                   Parm                    @ErrData
      *
     C                   If        @LDRType    = Production
     C                   Eval      AllowOper   = Reject
     C                   Else
      *         *------------------------------------------*
      *         *  Log the request to QSYSOPR              *
      *         *------------------------------------------*
     C     Warn2         Dsply     'QSYSOPR'
     C                   Select
     C                   When      OperRqs     = ChgDir
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' CHANGE DIRECTORY'
     C                   When      OperRqs     = ListFile
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' LIST THE NAMES'
     C                   When      OperRqs     = PutFile
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' COPY OUR PATH TO REMOTE IP'
     C                   When      OperRqs     = GetFile
     C                   Eval      Message     = %Trimr(Warn1)     +
     C                                           ' COPY FROM IP INTO OUR PATH'
     C                   EndSl
     C     Message       Dsply     'QSYSOPR'
     C     Warn3         Dsply     'QSYSOPR'
     C                   Eval      Message     = '   User Id   : ' +  User
     C     Message       Dsply     'QSYSOPR'
     C                   Eval      Internet    = %Subst(IpAddr: 1: IpAddrLen)
     C                   Eval      Message     = '   IP Address: ' +  Internet
     C     Message       Dsply     'QSYSOPR'
     C                   Eval      Message     = '   Path Rqs  : '
     C     Message       Dsply     'QSYSOPR'
     C                   Eval      Message     = '   ' + FtpPath
     C     Message       Dsply     'QSYSOPR'
     C     Warn2         Dsply     'QSYSOPR'
     C                   EndIf
     C                   EndIf
      *
     C                   Other
      *         *------------------------------------------*
      *         *  If this is a secured system, use the    *
      *         *  Reject statement instead.               *
      *         *------------------------------------------*
     C                   Eval      AllowOper   = Allow
      *@@@@@@@@          Eval      AllowOper   = Reject
E02  C                   EndSl
      *
     C     #ServerRq     EndSr



沒有留言: