/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

    Source: geocities.com/~alex_nubla