顯示具有 Security 標籤的文章。 顯示所有文章
顯示具有 Security 標籤的文章。 顯示所有文章

星期一, 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



星期二, 11月 07, 2023

2006-01-01 如何快速更改整個 Library 的所有 Object 的擁有者?(Commad CHGLIBOWN)


如何快速更改整個 Library 的所有 Object 的擁有者?(Command CHGLIBOWN)

要更改 Object owner 可以使用 CHGOBJOWN 指令, 但此指令僅能針對一個 Object 有效, 
若需要針對多個物件更改時,處理時較麻煩.可以使用 CHGOWN 指令較容易快速, 他可以接受
萬用字元"*".


File  : QCLSRC
Member: CHGLIBOWNC
Type  : CLP
Usage : CRTCLPGM CHGLIBOWNC


Pgm (&Library &Owner)                                            
                                                                 
  Dcl &Library *Char 10                                          
  Dcl &Owner *Char 10                                            
  Dcl &Objects *Char 255                                         
                                                                 
  ChgVar &Objects Value('/QSYS.LIB/' *CAT &Library *TCAT +       
                    '.LIB/*.*')                                  
  ChgOwn  Obj(&Objects) NewOwn(&Owner)                           
  Return                                                         
  EndPgm                                                         

File  : QCMDSRC
Member: CHGLIBOWN
Type  : CMD
Usage : CRTCMD CMD(CHGLIBOWN) PGM(CHGLIBOWNC)

             CMD        PROMPT('Change Library Ownership')             
             PARM       KWD(LIB) TYPE(*CHAR) LEN(10) PROMPT('Library:')
             PARM       KWD(NEWOWN) TYPE(*CHAR) LEN(10) PROMPT('New +  
                          Owner:')                                     

                        



星期一, 11月 06, 2023

2003-04-11 如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?


如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?

如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步,簡化系
統管理工作?

當您管理電腦系統時(包含 AS/400 iSeries ),有三個動作視您需要記住的,
那就是備份、備份、備份。如果您想晚上睡個好覺,您最好有一個關於資料、程式
及作業系統的備份措施。

但仍然有其他的系統管理議題,例如,如果您有一個重要的應用軟體需要一年 365
天,全天 24 小時不中斷的運作,線上即時複製應用軟體及其資料庫系統將是一個
重要的議題。在今天的資訊服務的運算環境中,系統停機而導致無法對客戶提供服務
是不被接受的。如果您的客戶正在進行交易時,因為您的資訊系統無法及時提供應有
的服務,而被迫中斷正在進行的交易,可以想見,他明天有可能是別人的客戶。因此
,如果遇到災難及系統當機時,您的系統需要能自動切換到另一台伺服器,並繼續執
行,就好像沒事發生一樣。為了要完成讓客戶滿意的目標,您需要找適當的資訊技術
來複製應用軟體、資料及其他系統物件,如使用者設定檔(User profiles)。在
這篇文章中我將討論如何複製使用者設定檔(User profiles)至另一台 iSeries。

使用者設定檔(User profiles)

如何讓各個 AS/400(iSeries) 系統彼此之間有一組相同的使用者,是許多應用軟體
供應商或系統管理人員所面臨的挑戰之一。換句話說,當在提供服務的主要系統增加新
的使用者時,同時主要系統要有一個機制自動增加同一使用者於備份系統中。我們使用
AS/400(iSeries) 系統上二個不同且未經常被使用的功能來完成這個目標,這二個功
能是:程序檢核點(又稱跳出點 exit point)及遠端資料序列(remote data queue)。

在這篇文章中,我們將說明當系統管理人員完成某些動作時,系統能自動使用程序檢核點
(exit point)呼叫一支程式的方法;同時以系統管理人員於系統中新增使用者的動作當
成範例。我們也將說明您如何以遠端資料序列(remote data queue)將資訊自動地從一
個系統傳至另一系統。在範例中,我們也將使用遠端資料序列(remote data queue)將
使用者的資訊自動地從一個系統傳至另一備份系統。

現在開始說明如下:

我們將假設您有兩部 AS/400(iSeries)系統彼此間已也完成相關網路設定,並且已經互
相連接於網路上進行通訊,在這篇文章中我們並不說明相關網路設定的方法您能從網站
http://www.geocities.com/vengoal/ AS/400 初學者手冊中(含APPC與TCP/IP),取得相關
網路設定的方法。

當在 AS/400(iSeries)系統中複製使用者設定檔(User profiles)的第一個挑戰是
:判斷主要系統中何時新增使用者設定檔,一種方式是,我們可以新增一支程式列出兩個
系統的所有使用者,並比對其中的差異。但這種方式無法做到即時同步更新,所以我們需
要執行一支能即時同步更新更新使用者設定檔的程式,進而達到跨 AS/400(iSeries)系
統間使用者設定檔的同步,這才是這篇文章的主要目的。

我們想要執行這支同步更新使用者設定檔的程式能於新增使用者時,自動完成同步的動作
,很幸運的,系統提供一個程序檢核點(exit point)讓我們能完成這個動作,一個程序
檢核點(exit point)是系統執行某些系統處理程序時,系統會暫停並且呼叫程序檢核點
(exit point)所指定的程式,此程式需要系統管理人員依照自己的需求自行撰寫,而這
支程式稱為程序檢核程式(又稱跳出程式 exit program),表一列出程序檢核程式
(又稱跳出程式 exit program)的部份原始碼,這支程式於主要系統中每次新增使用
者時,會自動地被執行。

您可能會問:我們如何告訴系統執行程序檢核點(exit point)所指定的程式?回答是:
我們需要跟系統註冊相對應動作的程序檢核點(exit point),我們可以使用下述指令跟
系統註冊新增使用者的程序檢核點(exit point):

ADDEXITPGM +
   EXITPNT(QIBM_QSY_CRT_PROFILE) +
   FORMAT(CRTP0100) +
   PGMNBR(*LOW) +
   PGM(xxx/CRTPRFEXTR)

新增程序檢核程式(又稱跳出程式 exit program)的指令 Add Exit Program
(ADDEXITPGM) 會讓系統知道當新增使用者設定檔時執行範例程式 CRTUSREXTR。

不管您是否了解程序檢核點,系統提供許多的程序檢核點(exit point)供系統人
員使用,包括TCP/IP網路應用軟體的安全控管,使用者設定檔,備份等。如果您想
要知道系統提供哪些程序檢核點(exit point),僅需要執行 Work with 
Registration Information (WRKREGINF)指令,瀏覽所有的程序檢核點
(exit point),並可直接於畫面上新增或移除程序檢核點(exit point)中所指
定的程序檢核程式(又稱跳出程式 exit program);您也可以於程序檢核點中指定
多支程序檢核程式(又稱跳出程式 exit program),並使用參數 PGMNBR 指定程式
執行的順序。

在我們的範例中,我們於程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)中指
定一支程序檢核程式(跳出程式 exit program),這是一個新增使用者設定檔的程序
檢核點(exit point),我們選擇它是因為我們以新增使用者設定檔的程序當成範例
,當然還有 QSY_DLT_PROFILE 及 QSY_CHG_PROFILE 程序檢核點(exit point)
。您要如何利用這些程序檢核點(exit point)來控制您的系統,完全是您的環境而定
,您可能需要撰寫您自己的程序檢核程式(跳出程式 exit program)供刪除及更改使
用者設定檔使用。

表一僅列出程式的一部份,我們來看看這支程式是如何運作的,

參數 InData 代表系統傳給程序檢核程式(跳出程式 exit program)的資訊,它是
一個 38 個位元的資料結構,這個資料結構的定義,依照不同的程序檢核點有不同的
格式,有關使用者設定檔程序檢核點的詳細格式請參照手冊 System API Reference
SC41-5801-03 Chapter 69. Security Exit Programs。

新增使用者設定檔的程序檢核點 QIBM_QSY_CRT_PROFILE (exit point)
格式 CRTP0100 的資料結構格式如下:

位置              欄位型態及長度   欄位說明
===============|
10進位   16進位|
======  =======|  ============   ====================================
  0       0    |  CHAR(20)       Exit point name QIBM_QSY_CRT_PROFILE
 20      14    |  CHAR(8)        Exit point format name CRTP0100
 28      1C    |  CHAR(10)       User profile name

在我們的範例中,我們所要擷取的是資料結構中最後 10 位的使用者設定檔名稱,這是
一個重要的資訊,我們呼叫 QSYRUSRI API 時,需要傳使用者設定檔名稱給這個 API
,並傳回該使用者相關的使用者設定檔的資訊,回傳的資訊放入變數 Receiver1 中,
並使用 QSNDDTAQ API 將資訊送至第二部 AS/400(iSeries)中,在本篇文章中會有
詳細說明。

在這個範例中,您會看到這支程式呼叫 QSYRUSRI API 兩次,第一次是要取得回傳資
料的可用長度,因為我們不知道真正回傳資訊的長度,但這個 API(其它的 API 也一
樣)將告訴您回傳資訊的可用長度,接著使用 ALLOC 運算元設定接收變數的長度,第
二次才是依照第一次所取得的長度取回資訊,並放入變數 QSYI0300 中。

QSYRUSRI API 所使用格式 USRI0300 的資料結構格式請參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。

您可能從手冊中注意到回傳值幾乎包含所有除了使用者密碼之外的使用者設定檔資訊,
所以下一件事,這支程序檢核程式(跳出程式 exit program)需要取得該使用者的密
碼。

您可能會有疑問,”我能獲得使用者的密碼嗎?如果能取得使用者密碼,哪我就能以任
一使用者的代碼及其密碼進入系統。”我不想搓破你的美夢,但這並不像您所想的,您
仍然無法取得使用者的原始密碼,但有一個 QSYRUPWD API 可以取得使用者經過系統
加密過後的密碼,而這個經過加密後的密碼是無法在進入系統(SignOn)畫面上使用的,
這個範例所取得的密碼即是經過系統加密過後的密碼,您無法看到使用者的真正密碼,
所以還是忘了那個美夢吧。唯一所能做的是將取得的加密密碼,傳給 QSYSUPWD API
,這個 API 用來設定同一個使用者的加密密碼,也就是說 QSYRUPWD API 的使用
者設定檔參數值及 QSYSUPWD API UPWD0100 格式中使用者設定檔欄位值要相同。

QSYRUPWD API 及 QSYSUPWD API 的相關詳細資訊參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。

這支程式呼叫 RtvEncPwd 程序擷取使用者的密碼,這個程序接收使用者設定檔名稱,
同樣呼叫 QSYRUPWD API 二次,然後傳資料結構(加密密碼及使用者設定檔名稱)給呼
叫程式;我們然後將此回傳的資料結構與 QSYRUSRI API 所擷取的使用者設定檔資訊
結合成一個字串,並使用 QSNDDTAQ API 將此合成字串寫入遠端資料序列(remote 
data queue)。

現在我們來說明資料序列(data queue),資料序列所存放的資料是先進先出,而所謂的
遠端資料序列(remote data queue)即是從系統 A 將資料寫入遠端資料序列(remote 
data queue),便可以從另一系統 B 擷取系統 A 所放入的資訊,而系統 A 及 系統 B
可以是不同的 AS/400(iSeries)系統。我們可藉由下述指令建立一個使用 TCP/IP 連線
的遠端資料序列(remote data queue):

CRTDTAQ +
   DTAQ(QGPL/PASSUSER) +
   TYPE(*DDM) +
   MAXLEN(1000) +
   SEQ(*KEYED) +
   KEYLEN(4) +
   RMTDTAQ(QGPL/PASSUSERRM) +
   RMTLOCNAME(RMTNAME)

我們於指令建立資料佇列(CRTDTAQ)參數 TYPE 指定值為 *DDM,DDM 代表分散式資
料管理(Distributed Data Management),它同時告訴 AS/400(iSeries) 系統
這個資料佇列將指向於參數 RMTLOCNAME(Remote Location Name)所指定的另一個
AS/400(iSeries)系統上,在我們的例子中,參數 RMTLOCNAME 值為 RMTNAME,你需要
參考 CFGTCP Menu(Go CFGTCP)選項 10 中,遠端 AS/400 的主機名稱(Host name)。

參數 RMTLOCNAME 告訴系統遠端資料佇列所擺放的遠端系統,遠端資料佇列(Remote
Data Queue) 參數 RMTDTAQ 告訴本端系統,此遠端資料佇列放置於遠端系統的哪個
程式館及其名稱。所以要讓遠端資料佇列能有效運作,需要作如下的動作:

系統 A                       系統 B
                            首先建立一個系統 B 本地端的資料佇列
                            CRTDTAQ DTAQ(QGPL/PASSUSERRM)
                                    MAXLEN(1000) 
                                    SEQ(*KEYED) 
                                    KEYLEN(4)
接著於系統 A 建立遠端資料佇列                   /\ 
(Remote Data Queue)                             ||
CRTDTAQ                                         ||
   DTAQ(QGPL/PASSUSER)                          ||
   TYPE(*DDM)                                   ||
   MAXLEN(1000)                                 ||
   SEQ(*KEYED)                                  ||
   KEYLEN(4)                                    ||
   RMTDTAQ(QGPL/PASSUSERRM) <===================|| 指向系統 B 的資料佇列
   RMTLOCNAME(RMTNAME)

要注意的是系統 A 建立遠端資料佇列參數 RMTDTAQ 要指定系統 B 本地端的資料佇
列名稱。


上述說明是主要系統所要做的動作,我們設定程序檢核點 QIBM_QSY_CRT_PROFILE
(exit point)連結到一支程序檢核程式(跳出程式 exit program)需當新增使用者
設定檔時,自動呼叫程序檢核程式傳送新增使用者設定檔資訊至第二台 AS/400 
系統,所有其他的動作就是第二台 AS/400 系統取得使用者設定檔資訊,並新增
一個同樣的使用者設定檔於第二台 AS/400 系統中。表二列出完成這些動作的部
分原始碼。

在遠端系統上的這支程式利用 QRCVDTAQ API 從資料佇列(data queue)讀取資訊,
然後將資訊組成指令 CRTUSRPRF(新增使用者設定檔)所需要的參數,並利用 "system"
程序執行指令 CRTUSRPRF(新增使用者設定檔)。


相信上述的說明能幫助您自動化的管理使用者設定檔。


表一主要系統程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)的程序檢核程式
CRTPRFEXTR (跳出程式 exit program):

      **********************************************************************
      *  Program name : CRTPRFEXTR                                         *
      *  Date         : 2002/09/16                                         *
      **********************************************************************
      * Before you use the program to syncronize User profile between
      * AS/400(iSeries) systems, you need
      *
      * CRTBNDRPG CRTPRFEXTR
      *
      * Create a data queue on target system by following command :
      *    CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
      *
      * Create a remote data queue on source system by following command :
      *   使用 TCP/IP 方式:
      *   CRTDTAQ +
      *      DTAQ(QGPL/PASSUSER) +
      *      TYPE(*DDM) +
      *      MAXLEN(1000) +
      *      SEQ(*KEYED) +
      *      KEYLEN(4) +
      *      RMTDTAQ(QGPL/PASSUSERRM) +
      *      RMTLOCNAME(RMTNAME)      
      *
      *   或使用 APPC 方式:
      *
      *   CRTDTAQ +
      *      DTAQ(QGPL/PASSUSER) +
      *      TYPE(*DDM) +
      *      MAXLEN(1000) +
      *      SEQ(*KEYED) +
      *      KEYLEN(4) +
      *      RMTDTAQ(QGPL/PASSUSERRM) +
      *      RMTLOCNAME(RMTNAME)
      *   PS: RMTNAME specified in APPC device under communication line
      *
      * Add Exit program to Create User Profile exit point on source system:
      *
      *  ADDEXITPGM +
      *     EXITPNT(QIBM_QSY_CRT_PROFILE) +
      *     FORMAT(CRTP0100) +
      *     PGMNBR(*LOW) +
      *     PGM(xxx/CRTUSREXTR)
      *
     H DEBUG  OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO)

      */COPY QSYSINC/QRPGLESRC,QSYRUSRI
     DQSYI0300         DS                  Based(ReceivePtr)
     D*                                             Qsy USRI0300
     D QSYBRTN02               1      4B 0
     D*                                             Bytes Returned
     D QSYBAVL02               5      8B 0
     D*                                             Bytes Available
     D QSYUP03                 9     18
     D*                                             User Profile
     D QSYPS00                19     31
     D*                                             Previous Signon
     D QSYRSV103              32     32
     D*                                             Reserved 1
     D QSYSN00                33     36B 0
     D*                                             Signon Notval
     D QSYUS02                37     46
     D*                                             User Status
     D QSYPD02                47     54
     D*                                             Pwdchg Date
     D QSYNP00                55     55
     D*                                             No Password
     D QSYRSV203              56     56
     D*                                             Reserved 2
     D QSYPI01                57     60B 0
     D*                                             Pwdexp Interval
     D QSYPD03                61     68
     D*                                             Pwdexp Date
     D QSYPD04                69     72B 0
     D*                                             Pwdexp Days
     D QSYPE00                73     73
     D*                                             Password Expired
     D QSYUC00                74     83
     D*                                             User Class
     D  QSYAOBJ01             84     84
     D*                                             All Object
     D  QSYSA05               85     85
     D*                                             Security Admin
     D  QSYJC01               86     86
     D*                                             Job Control
     D  QSYSC01               87     87
     D*                                             Spool Control
     D  QSYSS02               88     88
     D*                                             Save System
     D  QSYRVICE01            89     89
     D*                                             Service
     D  QSYAUDIT01            90     90
     D*                                             Audit
     D  QSYISC01              91     91
     D*                                             Io Sys Cfg
     D  QSYERVED10            92     98
     D*                                             Reserved
     D QSYGP02                99    108
     D*                                             Group Profile
     D QSYOWNER01            109    118
     D*                                             Owner
     D QSYGA00               119    128
     D*                                             Group Auth
     D QSYAL04               129    138
     D*                                             Assistance Level
     D QSYCLIB               139    148
     D*                                             Current Library
     D  QSYNAME14            149    158
     D*                                             Name
     D  QSYBRARY14           159    168
     D*                                             Library
     D  QSYNAME15            169    178
     D*                                             Name
     D  QSYBRARY15           179    188
     D*                                             Library
     D QSYLC00               189    198
     D*                                             Limit Capabilities
     D QSYTD                 199    248
     D*                                             Text Description
     D QSYDS00               249    258
     D*                                             Display Signon
     D QSYLDS                259    268
     D*                                             Limit DeviceSsn
     D QSYKB                 269    278
     D*                                             Keyboard Buffering
     D QSYRSV300             279    280
     D*                                             Reserved 3
     D QSYMS                 281    284B 0
     D*                                             Max Storage
     D QSYSU                 285    288B 0
     D*                                             Storage Used
     D QSYSP                 289    289
     D*                                             Scheduling Priority
     D  QSYNAME16            290    299
     D*                                             Name
     D  QSYBRARY16           300    309
     D*                                             Library
     D QSYAC                 310    324
     D*                                             Accounting Code
     D  QSYNAME17            325    334
     D*                                             Name
     D  QSYBRARY17           335    344
     D*                                             Library
     D QSYMD                 345    354
     D*                                             Msgq Delivery
     D QSYRSV4               355    356
     D*                                             Reserved 4
     D QSYMS00               357    360B 0
     D*                                             Msgq Severity
     D  QSYNAME18            361    370
     D*                                             Name
     D  QSYBRARY18           371    380
     D*                                             Library
     D QSYPD05               381    390
     D*                                             Print Device
     D QSYSE                 391    400
     D*                                             Special Environment
     D  QSYNAME19            401    410
     D*                                             Name
     D  QSYBRARY19           411    420
     D*                                             Library
     D QSYLI                 421    430
     D*                                             Language Id
     D QSYCI                 431    440
     D*                                             Country Id
     D QSYCCSID00            441    444B 0
     D*                                             CCSID
     D  QSYSK00              445    445
     D*                                             Show Keywords
     D  QSYSD00              446    446
     D*                                             Show Details
     D  QSYFH00              447    447
     D*                                             Fullscreen Help
     D  QSYSS03              448    448
     D*                                             Show Status
     D  QSYNS00              449    449
     D*                                             Noshow Status
     D  QSYRK00              450    450
     D*                                             Roll Key
     D  QSYPM00              451    451
     D*                                             Print Message
     D  QSYERVED11           452    480
     D*                                             Reserved
     D  QSYNAME20            481    490
     D*                                             Name
     D  QSYBRARY20           491    500
     D*                                             Library
     D QSYOBJA18             501    510
     D*                                             Object Audit
     D  QSYCMDS00            511    511
     D*                                             Command Strings
     D  QSYREATE00           512    512
     D*                                             Create
     D  QSYELETE00           513    513
     D*                                             Delete
     D  QSYJD01              514    514
     D*                                             Job Data
     D  QSYOBJM07            515    515
     D*                                             Object Mgt
     D  QSYOS00              516    516
     D*                                             Office Services
     D  QSYPGMA00            517    517
     D*                                             Program Adopt
     D  QSYSR00              518    518
     D*                                             Save Restore
     D  QSYURITY00           519    519
     D*                                             Security
     D  QSYST00              520    520
     D*                                             Service Tools
     D  QSYSFILD00           521    521
     D*                                             Spool File Data
     D  QSYSM00              522    522
     D*                                             System Management
     D  QSYTICAL00           523    523
     D*                                             Optical
     D  QSYERVED12           524    574
     D*                                             Reserved
     D QSYGAT00              575    584
     D*                                             Group Auth Type
     D QSYSGO00              585    588B 0
     D*                                             Supp Group Offset
     D QSYSGNBR02            589    592B 0
     D*                                             Supp Group Number
     D QSYUID                593    596U 0
     D*                                             UID
     D QSYGID                597    600U 0
     D*                                             GID
     D QSYHDO                601    604B 0
     D*                                             HomeDir Offset
     D QSYHDL                605    608B 0
     D*                                             HomeDir Len
     D QSYLJA                609    624
     D*                                             Locale Job Attributes
     D QSYLO                 625    628B 0
     D*                                             Locale Offset
     D QSYLL                 629    632B 0
     D*                                             Locale Len
     D QSYGMI03              633    633
     D*                                             Group Members Indicator
     D QSYDCI                634    634
     D*                                             Digital Certificate Indicato
     D QSYCC                 635    644
     D*                                             Chrid Control
     D QSYSPSDO              645    648B 0
     D*                                             IASP Storage Dsc Offset
     D QSYSPSDC              649    652B 0
     D*                                             IASP Storage Dsc Count
     D QSYPSDCR              653    656B 0
     D*                                             IASP Storage Dsc Count Rtn
     D QSYSPSDL              657    660B 0
     D*                                             IASP Storage Dsc Length
     D*QSYSGN02              661    670    DIM(00001)
     D*
     D*                                  Varying length
     D*QSYPI02               671    671
     D*
     D*                             Varying length
     D*QSYLI00               672    672
     D*
     D*                               Varying length
     D*QSYASPSD00                    20    DIM(00001)
     D* QSYIASPN00                   10    OVERLAY(QSYASPSD00:00001)
     D* QSYERVED36                    2    OVERLAY(QSYASPSD00:00011)
     D* QSYMS02                       9B 0 OVERLAY(QSYASPSD00:00013)
     D* QSYSU01                       9B 0 OVERLAY(QSYASPSD00:00017)
     D*
     D*                                              Varying length
      /COPY QSYSINC/QRPGLESRC,QUSEC

     d RtvEncPwd       PR            38
     d PmProfile                     10    const

     d Data            S           1000
     d DataQue         S             10     inz('PASSUSERRM')
     d DataQueLib      S             10     inz('QGPL ')
     d DataLength      S              5  0  inz(1000)
     D FormatName      S              8     inz('USRI0300')
     D InData          S             38
     d UsrProFile      S             10
     d Key             S              4     inz('0000')
     d KeyLength       S              3  0  inz(4)
     D OI              S              4  0
     D ReceiveLen      S             10i 0

     D Receiver1       DS
     D BytesRtn1                     10i 0
     D BytesAvl1                     10i 0

     D PassWordDs      Ds            38

     C     *Entry        PList
     C                   Parm                    InData

     C                   Eval      UsrProFile = %Subst(InData : 29 : 10)
      * Retrieve the user profile information
     C                   Call      'QSYRUSRI'
     C                   Parm                    Receiver1
     C                   Parm      8             ReceiveLen
     C                   Parm                    FormatName
     C                   Parm                    UsrProfile
     C                   Parm                    QusEc
     c                   Alloc     BytesAvl1     ReceivePtr

     C                   Call      'QSYRUSRI'
     C                   Parm                    QSYI0300
     C                   Parm      BytesAvl1     ReceiveLen
     C                   Parm                    FormatName
     C                   Parm                    UsrProfile
     C                   Parm                    QusEc

      * Retrieve the encrypted password data
     c                   Eval      PassWordDs = RtvEncPwd(UsrProfile)
     c                   Eval      DataLength = BytesAvl1 + 38
     c                   Eval      Data = PassWordDs + Qsyi0300

      * Write the information to the DDM data queue
     c                   CALL      'QSNDDTAQ'
     C                   PARM                    DataQue
     C                   PARM                    DataQueLib
     C                   PARM                    DataLength
     C                   PARM                    Data
     C                   PARM                    KeyLength
     C                   PARM                    Key

     c                   Eval      *inlr = *on

      * procedure RtvEncPwd: Retrieve encrypted password for given user
     P RtvEncPwd       B                   export
     d RtvEncPwd       PI            38
     d PmProfile                     10    const

     DQSYD0100         DS                  Based(ReceivePtr)
     D* Qsy RUPWD UPWD0100
     D QSYBRTN04               1      4B 0
     D* Bytes Returned
     D QSYBAVL04               5      8B 0
     D* Bytes Available
     D QSYPN06                 9     18
     D* Profile Name
     D PassWord               19     38

     D Receiver1       DS
     D BytesRtn1                     10i 0
     D BytesAvl1                     10i 0

     DQUSEC            DS           116    inz
     D QUSBPRV                 1      4B 0 inz(116)
     D QUSBAVL                 5      8B 0 inz(0)
     D QUSEI                   9     15
     D QUSERVED               16     16
     D QUSED01                17    116

     D FormatName      S              8    Inz('UPWD0100')
     D InProfile       S             10
     D ReceiveLen      S             10i 0

     c                   Eval      InProfile = PmProfile
     C                   Call      'QSYRUPWD'
     C                   Parm                    Receiver1
     C                   Parm      8             ReceiveLen
     C                   Parm                    FormatName
     C                   Parm                    InProfile
     C                   Parm                    QusEc
     c                   Alloc     BytesAvl1     ReceivePtr
     C                   Call      'QSYRUPWD'
     C                   Parm                    QsyD0100
     C                   Parm      BytesAvl1     ReceiveLen
     C                   Parm                    FormatName
     C                   Parm                    InProfile
     C                   Parm                    QusEc

     c                   Return                  QsyD0100
     P RtvEncPwd       E






表二:在遠端系統上的 RTVUSRINFR 程式列表


      **********************************************************************
      *  Program name : RTVUSRINFR                                         *
      *  Date         : 2002/09/16                                         *
      **********************************************************************
      *
      * CRTBNDRPG RTVUSRINFR
      *
      * CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
      *
      * SBMJOB CMD(CALL PGM(RTVUSRINFR)) JOB(AUTOCRTPRF)
      *
     H DEBUG  OPTION(*SRCSTMT:*NODEBUGIO) BNDDIR('QC2LE') DFTACTGRP(*NO)

     d System          PR            10i 0 extproc('system')
     d Cmd                             *   value options(*string)

     d CpfMsgId        S              7    import('_EXCP_MSGID')

     d FormatCmd       PR          1000
     d UsrProfile                    10    const

     d SetEncPwd       PR
     d PwdStruct                     38

     DPassWordDs       DS            38
     DReceiveDs        DS          1000
     d ProfData               39   1000
     d pwdexpitvb             95     98B 0
     d maxstgb               319    322B 0
     d msgsevb               395    398B 0
     d ccsidb                479    482B 0

     DQSYI0300         DS
     D QSYUP03                 9     18
     D* User Profile
     D QSYURITY00            519    519
     D* Security

     d DataQue         S             10    inz('PASSUSERRM')
     d DataQueLib      S             10    inz('QGPL ')
     d DataLength      S              5  0 inz(1000)
     d Key             S              4    inz('0000')
     d KeyLength       S              3  0 inz(4)
     d KeyOrder        S              2    inz('EQ')
     d SenderInf       S             50
     d SenderLen       S              3  0 inz(50)
     d WaitLength      S              5  0 inz(-1)

      * Read the data queue as entries arrive
     c                   CALL      'QRCVDTAQ'
     C                   PARM                    DataQue
     C                   PARM                    DataQueLib
     C                   PARM                    DataLength
     C                   PARM                    ReceiveDs
     C                   PARM                    WaitLength
     C                   PARM                    KeyOrder
     C                   PARM                    KeyLength
     C                   PARM                    Key
     C                   PARM                    SenderLen
     C                   PARM                    SenderInf
     c                   Movel     ReceiveDs     PassWordDs
     c                   Movel     ProfData      Qsyi0300

      * execute the command to create the user profile
     c                   If        System(FormatCmd(QsyUp03)) > 0
      * If procedure returned not zero, display the error msgid
     c     CpfMsgId      dsply
     C*                  Dump
     c                   Else

      * Set the password the same as in the original profile
     c                   Callp     SetEncPwd(PassWordDs)

     c
     c                   Endif
     c
     c                   eval      *inlr = *on

     P FormatCmd       B                   export
     d FormatCmd       PI          1000
     d UsrProfile                    10    const

     D cmdStr          S           1000    inz
     D password        S             10    inz('*USRPRF')
     D pwdexp          S              4
     D status          S              9
     D usrcls          S             10
     D astlvl          S              9
     D curlib          S             10
     D inlpgm          S             10
     D inlpgml         S             10
     D fullinlpgm      S             21
     D inlmnu          S             10
     D inlmnul         S             10
     D lmtcpb          S              8
     D text            S             50
     D spcaut          S             80
     D spcautind       S              1
     D spcenv          S              9
     D dspsgninf       S              9
     D pwdexpitv       S              9
     D lmtdevssn       S              9
     D kbdbuf          S              9
     D maxstg          S              9
     D ptylmt          S              1
     D fulljobd        S             21
     D jobdname        S             10
     D jobdlib         S             10
     D grpprf          S             10
     D owner           S              7
     D grpaut          S              8
     D grpauttyp       S              8
     D acgcde          S             15
     D msgq            S             21
     D dlvry           S              7
     D msgsev          S              6
     D prtdev          S             10
     D outq            S             21
     D atn             S             21
     D srt             S             21
     D langid          S              7
     D cntryid         S              7
     D ccsid           S             11
     D chridctl        S              9
     D tempn           S             10

      * PWDEXP
     C                   If        %SubSt(ProfData : 73 : 1) = 'Y'
     C                   Eval      pwdexp = '*YES'
     C                   Else
     C                   Eval      pwdexp = '*NO '
     C                   EndIf

     C                   Eval      status = %SubSt(ProfData :  37 : 10)
     C                   Eval      usrcls = %SubSt(ProfData :  74 : 10)
     C                   Eval      astlvl = %SubSt(ProfData : 129 : 10)
     C                   Eval      curlib = %SubSt(ProfData : 139 : 10)
     C                   Eval      inlpgm = %SubSt(ProfData : 169 : 10)
     C                   Eval      inlpgml= %SubSt(ProfData : 179 : 10)
     C                   If        inlpgm = '*NONE     '
     C                   Eval      fullinlpgm = '*NONE'
     C                   Else
     C                   Eval      fullinlpgm = %trim(inlpgml) + '/' +
     C                                          %trim(inlpgm)
     C                   EndIf
     C                   Eval      inlmnu = %SubSt(ProfData : 149 : 10)
     C                   Eval      inlmnul= %SubSt(ProfData : 159 : 10)
     C                   Eval      lmtcpb = %SubSt(ProfData : 189 : 10)
     C                   Eval      text   = %SubSt(ProfData : 199 : 10)
      *SPCAUT
     C                   Eval      spcautind = '0'
     C                   If        %SubSt(ProfData :  84 : 1) = 'Y'
     C                   Eval      spcaut = '*ALLOBJ'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  85 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *SECADM'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  86 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *JOBCTL'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  87 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *SPLCTL'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  88 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *SAVSYS'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  89 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *SERVICE'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  90 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *AUDIT'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        %SubSt(ProfData :  91 : 1) = 'Y'
     C                   Eval      spcaut = %trim(spcaut) + ' *IOSYSCFG'
     C                   Eval      spcautind = '1'
     C                   EndIf
     C                   If        spcautind = '0'
     C                   Eval      spcaut = '*NONE'
     C                   EndIf

     C                   Eval      spcenv = %SubSt(ProfData : 391 : 10)
     C                   Eval      dspsgninf = %SubSt(ProfData : 249 : 10)
      *PWDEXPITV
     C                   If        pwdexpitvb =  0
     C                   Eval      pwdexpitv ='*SYSVAL'
     C                   Else
     C                   If        pwdexpitvb =  -1
     C                   Eval      pwdexpitv ='*NOMAX'
     C                   Else
     C                   MoveL     pwdexpitvb    pwdexpitv
     C                   EndIf
     C                   EndIf

     C                   Eval      lmtdevssn = %SubSt(ProfData : 259 : 10)
     C                   Eval      kbdbuf    = %SubSt(ProfData : 269 : 10)
     C
      *MAXSTG
     C                   If        maxstgb    =  -1
     C                   Eval      maxstg     = '*NOMAX'
     C                   Else
     C                   MoveL     maxstgb       maxstg
     C                   EndIf
      *PTYLMT
     C                   Eval      ptylmt    = %SubSt(ProfData : 289 :  1)
      *JOBD
     C                   Eval      jobdlib   = %SubSt(ProfData : 300 : 10)
     C                   Eval      jobdname  = %SubSt(ProfData : 290 : 10)
     C                   Eval      fulljobd  = %trim(jobdlib) + '/' +
     C                                         %trim(jobdname)
      *GRPPRF
     C                   Eval      grpprf    = %SubSt(ProfData :  99 : 10)
      *OWNER
     C                   Eval      owner     = %SubSt(ProfData : 109 : 10)
      *GRPAUT
     C                   Eval      grpaut    = %SubSt(ProfData : 119 : 10)
      *GRPAUTTYP
     C                   Eval      grpauttyp = %SubSt(ProfData : 575 : 10)
      *ACGCDE
     C                   Eval      acgcde    = %SubSt(ProfData : 310 : 15)
      *MSGQ
     C                   Eval      msgq = %trim(%SubSt(ProfData : 335 : 10)) +
     C                                    '/' +
     C                                    %trim(%SubSt(ProfData : 325 : 10))
      *DLVRY
     C                   Eval      dlvry = (%SubSt(ProfData : 345 : 10))
      *MSG SEV
     C                   Movel     msgsevb       msgsev
      *PRTDEV
     C                   Eval      prtdev = (%SubSt(ProfData : 381 : 10))
      *OUTQ
     C                   Eval      tempn= %trim(%SubSt(ProfData : 361 : 10))
     C                   If        tempn = '*WRKSTN   ' or
     C                             tempn = '*DEV      '
     C                   Eval      outq = tempn
     C                   Else
     C                   Eval      outq = %trim(%SubSt(ProfData : 371 : 10)) +
     C                                    '/' +
     C                                    %trim(%SubSt(ProfData : 361 : 10))
     C                   EndIf
      *ATNPGM
     C                   Eval      tempn= %trim(%SubSt(ProfData : 401 : 10))
     C                   If        tempn<> '*SYSVAL   ' or
     C                             tempn<> '*NONE     ' or
     C                             tempn<> '*ASSIST   '
     C                   Eval      atn = tempn
     C                   Else
     C                   Eval      atn  = %trim(%SubSt(ProfData : 411 : 10)) +
     C                                    '/' +
     C                                    %trim(%SubSt(ProfData : 401 : 10))
     C                   EndIf
      *SRTSEQ
     C                   Eval      tempn = %SubSt(ProfData : 481 : 10)
     C                   If        (tempn = '*HEX      ')  OR
     C                             (tempn = '*LANGIDUNQ')  OR
     C                             (tempn = '*LANGIDSHR')  OR
     C                             (tempn = '*SYSVAL   ')
     C                   Eval      srt = tempn
     C                   Else
     C                   Eval      srt  = %trim(%SubSt(ProfData : 491 : 10)) +
     C                                    '/' +
     C                                    %trim(%SubSt(ProfData : 481 : 10))
     C                   EndIf
      *LANGID
     C                   Eval      langid= %SubSt(ProfData : 421 : 10)
      *CNTRYID
     C                   Eval      cntryid= %SubSt(ProfData : 431 : 10)
      *CCSID
     C                   If        ccsidb = -2
     C                   Eval      ccsid  = '*SYSVAL'
     C                   Else
     C                   Movel     ccsidb        ccsid
     C                   EndIf
      *CHRIDCTL
     C                   Eval      cntryid= %SubSt(ProfData : 635 : 10)

     C                   Eval      cmdStr =  'CRTUSRPRF ' +
     C                             'USRPRF(' + %trim(UsrProfile) + ') ' +
     C                             'PASSWORD(*USRPRF) ' +
     C                             'PWDEXP(' + %trim(pwdexp) + ') '  +
     C                             'STATUS(' + %trim(status) + ') '  +
     C                             'USRCLS(' + %trim(usrcls) + ') '  +
     C                             'ASTLVL(' + %trim(astlvl) + ') '  +
     C                             'CURLIB(' + %trim(curlib) + ') ' +
     C                             'INLPGM(' + %trim(fullinlpgm) + ') ' +
     C                             'INLMNU(' + %trim(inlmnul) +
     C                                        '/' + %trim(inlmnu) +
     C                                                      ') ' +
     C                             'LMTCPB(' + %trim(lmtcpb) + ') ' +
     C                             'TEXT('   + %trim(text)   + ') ' +
     C                             'SPCAUT(' +  %trim(spcaut)+ ') ' +
     C                             'SPCENV(' + %trim(spcenv)  + ') '   +
     C                             'DSPSGNINF('+ %trim(dspsgninf) + ') ' +
     C                             'PWDEXPITV('+ %trim(pwdexpitv) + ') ' +
     C                             'KBDBUF('   + %trim(kbdbuf)    + ') ' +
     C                             'MAXSTG('   + %trim(maxstg)    + ') ' +
     C                             'PTYLMT('   + %trim(ptylmt)    + ') ' +
     C                             'JOBD('     + %trim(fulljobd)  + ') ' +
     C                             'GRPPRF('   + %trim(grpprf)    + ') ' +
     C                             'OWNER('    + %trim(owner)     + ') ' +
     C                             'GRPAUT('   + %trim(grpaut)    + ') ' +
     C                             'GRPAUTTYP('+ %trim(grpauttyp) + ') ' +
     C                             'ACGCDE('   + %trim(acgcde)    + ') ' +
     C                             'MSGQ('     + %trim(msgq)      + ') ' +
     C                             'DLVRY('    + %trim(dlvry)     + ') ' +
     C                             'SEV('      + %trim(msgsev)    + ') ' +
     C                             'PRTDEV('   + %trim(prtdev)    + ') ' +
     C                             'OUTQ('     + %trim(outq)      + ') ' +
     C                             'ATNPGM('   + %trim(atn)       + ') ' +
     C                             'SRTSEQ('   + %trim(srt)       + ') ' +
     C                             'LANGID('   + %trim(langid)    + ') ' +
     C                             'CNTRYID('  + %trim(cntryid)   + ') ' +
     C                             'CCSID('    + %trim(ccsid)     + ') ' +
     C                             'CHRIDCTL(' + %trim(chridctl)  + ') '

     C                   Dump
     C                   Return                  CmdStr
     P FormatCmd       E

     P SetEncPwd       B                   export
     d SetEncPwd       PI
     d QSYSD0100                     38

     DQUSEC            DS           116    inz
     D QUSBPRV                 1      4B 0 inz(116)
     D QUSBAVL                 5      8B 0 inz(0)
     D QUSEI                   9     15
     D QUSERVED               16     16
     D QUSED01                17    116

     D FormatName      S              8    Inz('UPWD0100')

     C                   Call      'QSYSUPWD'
     C                   Parm                    QsysD0100
     C                   Parm                    FormatName
     C                   Parm                    QusEc

     c                   Return
     P SetEncPwd       E








星期四, 11月 02, 2023

Best practices for securing an IBM i system

 https://www.ibm.com/docs/en/powersc-standard/2.1?topic=concepts-i-best-practices

The IBM i best practices automate the recommended system configuration for securing your IBM i system.

Table 1 describes the best practices for securing an IBM i system.
Table 1. Settings related to the IBM i Best Practices
Group
Description
Location of the script that modifies the setting
System-wide access control

Sets the default public authority used when objects are created into a library. When the *LIBCRTAUT value of the AUT keyword of a create object command is used to set public authority for an object, the CRTAUT value of the library where the object is being created determines what public authority will be used for the object. If the CRTAUT value of the library is set to *SYSVAL, the value specified in the QCRTAUT system value is used to set the public authority for the object being created.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QCRTAUT *USE

Password policies

Sets the password expiration warning. It controls the number of days prior to a password expiring to begin displaying password expiration warning messages on the sign-on information display.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QPWDEXPWRN 7

Password policies

Block password change. Specifies the time period in hours during which a password is blocked from being changed following the prior successful password change operation. This system value does not restrict password changes made by the Change User Profile (CHGUSRPRF) command.

The default value is *NONE.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QPWDCHGBLK 24

Password policies

Password rules. Specifies the password composition rules used to check whether a password is formed correctly. See the IBM i help text of system value QPWDRULES for all possible values. Note that you get the full mixed case support and special character support with QPWDLVL 2 or 3.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QPWDRULES "*MINLEN8 *MAXLEN10 *DGTMIN1 *LMTPRFNAME *ALLCRTCHG *CHRLMTAJC *LTRMIN2"

Password policies

Password expiration interval. Specifies the number of days for which passwords are valid. This provides password security by requiring users to change their passwords after a specified number of days. If the password is not changed within the specified number of days, the user cannot sign on until the password is changed.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QPWDEXPITV 90

Password policies
Duplicate password control (password history). Controls when a previously used password can be used again. The setting specifies how many times a password must be different than the previously used passwords. Valid values are as follows:
  • 0 - A password can be the same as one previously used.
  • 1 - A password must be different than the previous 32 passwords.
  • 2 - A password must be different than the previous 24 passwords.
  • 3 - A password must be different than the previous 18 passwords.
  • 4 - A password must be different than the previous 12 passwords.
  • 5 - A password must be different than the previous 10 passwords.
  • 6 - A password must be different than the previous 8 passwords.
  • 7 - A password must be different than the previous 6 passwords.
  • 8 - A password must be different than the previous 4 passwords.
The recommendation is that a password cannot be reused for 2 years. The chosen value is calculated by the password expiration and the duplicate password control.
/etc/security/pscxpert/bin/worksystemvalue

Arguments: QPWDRQDDIF 6

System securitySets the system-wide security level. The default value is 40./etc/security/pscxpert/bin/worksystemvalue

Arguments: QSECURITY 40

System security

Retain server security data. Determines whether the security data needed by a server to authenticate a user on a target system through client-server interfaces can be retained on the host system. Because many network services require the storage of security data, it is recommended to set the value to 1.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QRETSVRSEC 1

System security
Verify object on restore. This system value specifies the policy to be used for object signature verification during a restore operation. This value applies to objects of the following types:
  • *CMD
  • *PGM
  • *SRVPGM
  • *SQLPKG
  • *MODULE
  • *STMF objects that contain Java™ programs
The recommended value is 3.
/etc/security/pscxpert/bin/worksystemvalue

Arguments: QVFYOBJRST 3

Login controls

Limits security officer device access. This system value controls whether users with *ALLOBJ or *SERVICE special authorities need explicit authority to specific work stations.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QLMTSECOFR 1

Login controls
Maximum sign-on attempts action. Specifies how the system reacts when the maximum number of consecutive, incorrect, sign-on attempts (the system value QMAXSIGN) is reached. Valid values are as follows:
  • 1 - Vary off device if limit is reached.
  • 2 - Disable user profile if limit is reached.
  • 3 - Vary off device and disable user profile if limit is reached.
The default value is 3.
/etc/security/pscxpert/bin/worksystemvalue

Arguments: QMAXSGNACN 3

Login controls

Maximum number of invalid sign-on attempts action. If the number of invalid sign-on attempts is reached, the action as specified in the QMAXSGNACN system value is performed.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QMAXSIGN 3

Login controls

Sets the password expiration warning. It controls the number of days prior to a password expiring to begin displaying password expiration warning messages on the sign-on information display.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QDSPSGNINF 1

System auditing

Audit control. This system value contains the on and off switches for object and user action auditing. This system value activates auditing on the system that is selected by the Change Object Auditing (CHGOBJAUD) and Change User Auditing (CHGUSRAUD) commands and the QAUDLVL and QAUDLVL2 system values.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QAUDCTL "*AUDLVL *NOQTEMP *OBJAUD"

System auditing

Security auditing level. Controls the level of action auditing on the system. If the QAUDLVL system value contains the value *AUDLVL2, then the values in the QAUDLVL2 system value will also be used.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QAUDLVL *AUDLVL2

System auditing

Security auditing level extension specifying the audit event types to be logged. It is a best practice to add all system audit events to the QAUDLVL2 system value.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QAUDLVL2 "*SECURITY *AUTFAIL *SERVICE *PGMFAIL *ATNEVT"

System security

Secure Sockets Layer (SSL) cipher control. Specifies whether or not the QSSLCSL (SSL cipher specification list) system value is controlled by the system or by the user.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QSSLCSLCTL *USRDFN

Secure connections

Secure Sockets Layer (SSL) cipher specification list. Specifies the list of cipher suites that are supported by System SSL. The values are read-only unless the QSSLCSLCTL (SSL cipher control) system value is set to *USRDFN. The rule disallows the use of the cipher suites with SHA-1 or MD5 message authentication algorithms.

This rule applies to IBM i V7R4 or later systems.

/etc/security/pscxpert/bin/worksystemvalue
Arguments:

QSSLCSL "*AES_128_GCM_SHA256 
*AES_256_GCM_SHA384 
*CHACHA20_POLY1305_SHA256 
*ECDHE_ECDSA_AES_128_GCM_SHA256 
*ECDHE_ECDSA_AES_256_GCM_SHA384 
*ECDHE_RSA_AES_128_GCM_SHA256 
*ECDHE_RSA_AES_256_GCM_SHA384 
*ECDHE_ECDSA_CHACHA20_POLY1305_SHA256 
*ECDHE_RSA_CHACHA20_POLY1305_SHA256"
 
Secure connections

Secure Sockets Layer (SSL) cipher specification list. Specifies the list of cipher suites that are supported by System SSL. The values are read-only unless the QSSLCSLCTL (SSL cipher control) system value is set to *USRDFN. The rule disallows the use of the cipher suites with SHA-1 or MD5 message authentication algorithms.

/etc/security/pscxpert/bin/worksystemvalue
Arguments:

QSSLCSL "*ECDHE_ECDSA_AES_256_GCM_SHA384 
*ECDHE_ECDSA_AES_128_GCM_SHA256 
*ECDHE_RSA_AES_256_GCM_SHA384 
*ECDHE_RSA_AES_128_GCM_SHA256 
*RSA_AES_256_GCM_SHA384 
*RSA_AES_128_GCM_SHA256 
*ECDHE_ECDSA_AES_128_CBC_SHA256 
*ECDHE_ECDSA_AES_256_CBC_SHA384 
*ECDHE_RSA_AES_128_CBC_SHA256 
*ECDHE_RSA_AES_256_CBC_SHA384 
*RSA_AES_128_CBC_SHA256 
*RSA_AES_256_CBC_SHA256"
Secure connections

The Transport Layer Security protocols (QSSLPCL) system value specifies the Transport Layer Security (TLS) protocols supported by the System TLS.

This rule applies to IBM i V7R4 or later systems.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QSSLPCL "*TLSV1.3 *TLSV1.2"

Secure connections

The Transport Layer Security protocols (QSSLPCL) system value specifies the Transport Layer Security (TLS) protocols supported by the System TLS.

/etc/security/pscxpert/bin/worksystemvalue

Arguments: QSSLPCL *TLSV1.2

User profile security

Sets the public authorities for user profile objects. The default authority is *EXCLUDE. When checking all user profiles (parameter 1=*ALL), the apply will set the public authority for all user profiles to *EXCLUDE with the exception of the default IBM i profiles QDBSHR, QDBSHRDO, and QTMPLPD. You can also set and check the public authority for single profiles by specifying an individual user profile in parameter 1 and the desired public authority in parameter 2. Parameter 3 specifies one or more user profiles names to be exempt from the check.

/etc/security/pscxpert/bin/userpublicpermissions

Arguments: *ALL *EXCLUDE ""

Secure connectionsCheck if port 992 (secure Telnet) is in listen state. If not, report it as a violation and it is recommended to turn on TLS encryption for TELNET./etc/security/pscxpert/bin/checksecureport

Arguments: 992 Telnet

Secure connectionsCheck if port 990 (secure FTP) is in listen state. If not, report it as a violation and it is recommended to turn on TLS encryption for FTP./etc/security/pscxpert/bin/checksecureport

Arguments: 990 FTP

Secure connectionsCheck if port 9470 (Secure central server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure central server./etc/security/pscxpert/bin/checksecureport

Arguments: 9470 "Secure central server"

Secure connectionsCheck if port 9471 (Secure database server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure database server./etc/security/pscxpert/bin/checksecureport

Arguments: 9471 "Secure database server"

Secure connectionsCheck if port 9472 (Secure data queue server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure data queue server./etc/security/pscxpert/bin/checksecureport

Arguments: 9472 "Secure data queue server"

Secure connectionsCheck if port 9473 (Secure file server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure file server./etc/security/pscxpert/bin/checksecureport

Arguments: 9473 "Secure file server"

Secure connectionsCheck if port 9474 (Secure network print server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure network print server./etc/security/pscxpert/bin/checksecureport

Arguments: 9474 "Secure network print server"

Secure connectionsCheck if port 9475 (Secure remote command/Program call server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure remote command/Program call server./etc/security/pscxpert/bin/checksecureport

Arguments: 9475 "Secure remote command/Program call server"

Secure connectionsCheck if port 9476 (Secure signon server) is in listen state. If not, report it as a violation and it is recommended to turn on the secure signon server./etc/security/pscxpert/bin/checksecureport

Arguments: 9476 "Secure signon server"

Network servicesCheck if REXEC (port 512) is up and running. If yes, it is recommended to disable it./etc/security/pscxpert/bin/checkNetworkService
Network servicesCheck if LPD (port 515) is up and running. If yes, it is recommended to disable it./etc/security/pscxpert/bin/checkNetworkService
Group PTF currency statusChecks whether the installed group PTF levels are current or if a newer level exists./etc/security/pscxpert/bin/checkPTFgroupsstatus
Network servicesCheck if the DDM network server attributes (lowest authentication method) do not contain the following values: *NO, *VLDONLY, *USRID, *USRIDPWD./etc/security/pscxpert/bin/checkDDMAuthentication

Arguments: *USRENCPWD

System auditingCommand auditing for privileged users. It is assumed that all users that posses one or more special authorities are treated as a privileged user. Performs the following actions:
  1. Checks (using the USER_INFO table function) whether a user has directly assigned special authorities. Retrieves potential primary and supplemental group profile names. Checks whether the assigned groups provide a special authority.
  2. Checks if the users who have a direct (or indirect via group membership) assigned special authority have the *CMD event turned on for their user profile audit level parameter.
  3. Reports every privileged user who does not have the *CMD auditing value turned as a violation.
  • Parm 1: Individual user profile name or *ALL to check all users.
  • Parm 2: The audit event to be checked. The default is *CMD. You can copy and customize the rule to run against another audit event, such as *CREATE or *DELETE, and so forth
  • Parm 3: One or more user profile names to be exempt from the check.

Applying the rule performs the check and, if not set, sets the required audit event.

/etc/security/pscxpert/bin/checkAuditing

Arguments: *ALL *CMD ""

Patch status individual PTFsPatch status individual PTFs. If you need a specific patch (PTF) installed on a system, you can use this check to see if a specific patch has been applied on the system. The first argument is the PTF's name. The second argument is the expected status. Set the third argument to y to download, load, and apply the PTF./etc/security/pscxpert/bin/checkPTFStatus

Arguments: MF57964 SUPERCEDED n

Default passwordsAnalyze default passwords and report those with a default password as a violation. Passwords must be changed by the administrator. The first argument is the action to take against the identified users with default passwords:
  • *NONE - No action is taken against profiles with a default password.
  • *DISABLE - The user profile STATUS field is set to *DISABLED.
  • *PWDEXP - The user profile PWDEXP field is set to *YES.
/etc/security/pscxpert/bin/checkDefaultPasswords

Arguments: *NONE