iSeries & System i

#5 API - Table of Contents #7

API Name # Description
QsyGetProfileHandle   Validates the user profile and password
QsySetToProfileHandle   Validates the profile handle
QsyReleaseProfileHandle   Validates a given profile handle and then releases it
QsyGenPrfTknE   Verifies the authority to generate a profile token
QsySetToPrfTkn   Validates the profile token and changes the current job
QsyChkPrfTknUser   Verifies that the user profile associated with the token
QsyGenPrfTknFromPrfTkn   Generates a token based on an existing profile token
QsyGetPrfTknTimeOut   Gets the num. of sec's until a token is no longer valid
QsyRemovePrfTkn   Removes the specified profile token
QsyInvalidatePrfTkn   Invalidates a profile token
QDMLOPNF   List Open Files
QWCRJBLK 2 Retrieve Job Lock
QUSROBJD   Retrieve Object Description
QCLRPGMI   Retrieve Program Information
QP0ZGETENV   Get Value of Environment Variabel (Extended)
Other QSY..... Prototypes   Prototypes for QSYSET & -GET
IFS API's   Constants, Structures & Prototypes
QSRLSAVF   List save file
QUIOPNDA   Open Display Application
QUIPUTV   Put Display Variable
QUIADDLE   Add List Entry
QUIDSPP   Display Panel
QUICLOA   Close Application
Other QSY..... Prototypes   More Prototypes for QSY... a.o.
QJOSJRNE   Send journal entry
QleActBndPgm   Activate Bound Program
QleGetExp   Get Export



Security-related APIs
Security-related APIs

     **  Program . . : CBX117
     **  Description : Profile Token APIs
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : April 29, 2004
     **
     **
     **  Program summary
     **  ---------------
     **
     **  Security-related APIs:
     **    QsyGetProfileHandle        Validates the user profile and password
     **                               passed to the API and generates a profile
     **                               handle.
     **
     **                               The profile handle can be used to set the
     **                               current user profile of the job running.
     **
     **                               Invalid passwords will increase the
     **                               incorrect password count and possibly
     **                               disable the specified user profile.
     **
     **                               A maximum of approximately 20,000 handles
     **                               can be created in one job.
     **
     **    QsySetToProfileHandle      Validates the profile handle, locks the
     **                               user profile, and changes the current
     **                               job (or thread) to run under the user and
     **                               group profiles represented by the profile
     **                               handle.
     **
     **                               The qualified job name does not change to
     **                               reflect the new user profile. Any objects
     **                               created while running under the new user
     **                               profile will be owned by this user profile.
     **
     **                               Spooled files created during the profile
     **                               swap will be put under a QPRTJOB job.
     **
     **    QsyReleaseProfileHandle    Validates a given profile handle and then
     **                               releases it.  To use the user profile
     **                               represented by the deleted profile handle
     **                               again, you must generate a new profile
     **                               handle for the user profile.
     **
     **    QsyGenPrfTknE              Verifies that the caller has authority to
     **                               generate a profile token for the requested
     **                               profile and then generates a profile token.
     **
     **                               This profile token can be passed to one or
     **                               more additional processes which can then
     **                               use it to perform tasks on behalf of the
     **                               authenticated user.
     **
     **                               A maximum of approximately 2,000,000
     **                               profile tokens can be generated on a
     **                               system. At that point further profile
     **                               tokens can only be generated after one
     **                               or more tokens have been removed.
     **
     **                               APIs are available to remove all profile
     **                               tokens generated for a specific user or
     **                               systemwide: QsyRemoveAllPrfTknsForUser
     **                               respectively QsyRemoveAllPrfTkns.
     **
     **                               Introduced on V5R1, the QsyGenPrfTkn API
     **                               is available on V4R5.
     **
     **    QsySetToPrfTkn             Validates the profile token and changes
     **                               the current job (or thread) to run under
     **                               the user and group profiles represented
     **                               by the profile token.
     **
     **                               The qualified job name does not change to
     **                               reflect the new user profile. Any objects
     **                               created while running under the new user
     **                               profile will be owned by this user profile.
     **
     **                               Spooled files created during the profile
     **                               swap will be put under a QPRTJOB job.
     **
     **    QsyChkPrfTknUser           Verifies that the user profile associated
     **                               with the token is the same as the current
     **                               user profile. Introduced on V5R1.
     **
     **    QsyGenPrfTknFromPrfTkn     Generates a profile token based on an
     **                               existing profile token.
     **
     **                               The existing profile token must be a valid,
     **                               multiple-use, regenerable profile token.
     **                               The new profile token will represent the
     **                               same user and group information as the
     **                               original profile token.
     **
     **                               The existing profile token will be
     **                               invalidated by this process.
     **
     **    QsyGetPrfTknTimeOut        Gets the number of seconds until a profile
     **                               token is no longer valid.
     **
     **    QsyRemovePrfTkn            Removes the specified profile token. The
     **                               profile token will no longer be valid for
     **                               use with other profile token APIs.
     **
     **    QsyInvalidatePrfTkn        Invalidates a profile token. The profile
     **                               token is no longer usable for other
     **                               profile token APIs except the Remove
     **                               Profile Token API.
     **
     **  User interface manager APIs:
     **    QUILNGTX       Display long text    Displays the text string passed
     **                                        to the API in a pop-up window.
     **                                        Optionally a panel title can be
     **                                        retrieved from a message file.
     **
     **                                        Maximum string length is 15360k.
     **
     **  C library function:
     **    system        Run system command    Executes a system command. In the
     **                                        event of an resulting error the
     **                                        error message ID is exported in
     **                                        the _EXCP_MSGID variable.
     **
     **  Programmer's notes:
     **    The majority of the Profile Token APIs were introduced on V4R5.
     **
     **    A profile token can be passed between processes and jobs, so a
     **    profile token created in one job can be passed to and activated
     **    in another job. The time-out value, multiple-use and regenerable
     **    token attributes enables the creating process to stay in control
     **    of the further use of a profile token.
     **
     **    A profile handle can only be used in the job that created it.
     **
     **    According to Memo to Users V5R2 a number of changes is going to be
     **    introduced in a future release to the following of the APIs in this
     **    example:
     **
     **      QsyGetProfileHandle - Special values will not be allowed for the
     **                            password value. The QSYGETPH API should be
     **                            used instead.
     **
     **      QsyGenPrfTknE       - Special values will not be allowed for the
     **                            password value. The QsyGenPrfTkn API should
     **                            be used instead.
     **
     **    The following changes are pending for the replacement APIs mentioned
     **    above:
     **
     **      QSYGETPH            - When specifying a password for the password
     **                            parameter, the password length and CCSID
     **                            parameters will be required. When specifying
     **                            a special value for the password parameter,
     **                            the password length and CCSID parameters will
     **                            not be allowed.
     **
     **      QsyGenPrfTkn        - Password values will not be allowed for the
     **                            password parameter, only password special
     **                            values. The QsyGenPrfTknE API should be used
     **                            if password values are to be specified.
     **
     **    To run this API Example program issue the following command from
     **    a command line:
     **
     **    Call Pgm( CBX117 )  Parm( 'user profile' )
     **
     **    The user profile specified as the parameter is the one being swapped
     **    to during the Profile Token API demonstration performed by this
     **    program.
     **
     **    The process of user profile swapping and restore is demonstrated and
     **    commented in a message display window and also documented using the
     **    DSPJOB (Display job) and DSPMSGD (Display message description)
     **    commands. To this process, extra steps have been added to show the
     **    use of the APIs that regenerates profile tokens, validates the user
     **    profile and profile token correlation as well as checks the profile
     **    token time-out value.
     **
     **    Please note that only allowing this program to complete normally and
     **    execute all program statements will ensure that the initial current
     **    job user profile is restored correctly.
     **
     **
     **  Authority and security restrictions:
     **    To get a profile handle or token using special values *NOPWD or
     **    *NOPWDCHK, *USE authority is required to the user profile for which
     **    the handle is requested.
     **
     **    If appropriate, the required authority can be obtained by means of
     **    adopted authority - se Compile options and Runtime requirement
     **    below.
     **
     **    Profile handles or tokens will not be generated for user profiles
     **    that are disabled or whose passwords have expired. This restriction
     **    can, however, be circumvented if the special value *NOPWDCHK is
     **    specified for the password - and the requesting user profile has
     **    *ALLOBJ and *SECADM special authority. There are also a number of
     **    system supplied user profiles that cannot have profile handles or
     **    tokens generated.
     **
     **
     **  Compile options:
     **    CrtBndRpg  Pgm( CBX117 )
     **
     **  Runtime requirement:
     **    ChgObjOwn  Obj( CBX117 )
     **               ObjType( *PGM )
     **               NewOwn( QSECOFR )
     **
     **
     **-- Control spec:  -----------------------------------------------------**
     H Option( *SrcStmt )  UsrPrf( *Owner )
     H DftActGrp( *No )    ActGrp( 'QILE' )  BndDir( 'QC2LE' )
     **-- System information:  -----------------------------------------------**
     D PgmSts         SDs
     D  PsPgmNam         *Proc
     D  PsSts                         5a   Overlay( PgmSts:  11 )
     D  PsCurJob                     10a   Overlay( PgmSts: 244 )
     D  PsUsrPrf                     10a   Overlay( PgmSts: 254 )
     D  PsJobNbr                      6a   Overlay( PgmSts: 264 )
     D  PsCurUsr                     10a   Overlay( PgmSts: 358 )
     **-- API error data structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPrv                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0
     D  AeExcpId                      7a
     D                                1a
     D  AeExcpDta                   128a
     **-- system function error id:  -----------------------------------------**
     D SysError        s              7a   Import( '_EXCP_MSGID' )
     **-- Global variables:  -------------------------------------------------**
     D PrfHdlCur       s             12a
     D PrfTkn          s             32a
     D PrfTknNew       s             32a
     D PrfChk          s             10i 0
     D TknTmo          s             10i 0
     **-- Get profile handle:  -----------------------------------------------**
     D GetPrfHdl       Pr                  ExtProc( 'QsyGetProfileHandle' )
     D  GpPrfHdl                     12a
     D  GpUsrPrf                     10a   Const
     D  GpPwd                       512a   Const  Options( *VarSize )
     D  GpPwdLen                     10i 0 Value
     D  GpPwdCcsId                   10u 0 Value
     D  GpError                   32767a          Options( *VarSize )
     **-- Set profile handle:  -----------------------------------------------**
     D SetPrfHdl       Pr                  ExtProc( 'QsySetToProfileHandle' )
     D  SpPrfHdl                     12a   Const
     D  SpError                   32767a          Options( *VarSize: *NoPass )
     **-- Release profile handle:  -------------------------------------------**
     D RlsPrfHdl       Pr                  ExtProc( 'QsyReleaseProfileHandle' )
     D  RpPrfHdl                     12a   Const
     D  RpError                   32767a          Options( *VarSize: *NoPass )
     **-- Generate profile token extended:  ----------------------------------**
     D GenPrfTknE      Pr                  ExtProc( 'QsyGenPrfTknE' )
     D  GtPrfTkn                     32a
     D  GtUsrPrf                     10a   Const
     D  GtPwd                       512a   Const  Options( *VarSize )
     D  GtPwdLen                     10i 0 Value
     D  GtPwdCcsId                   10u 0 Value
     D  GtTimOutInt                  10i 0 Value
     D  GtPrtTknTyp                   1a   Value
     D  GtError                   32767a          Options( *VarSize )
     **-- Set to profile token:  ---------------------------------------------**
     D SetPrfTkn       Pr                  ExtProc( 'QsySetToPrfTkn' )
     D  StPrfTkn                     32a   Const
     D  StError                   32767a          Options( *VarSize )
     **-- Check profile token user:  -----------------------------------------**
     D ChkPrfTkn       Pr                  ExtProc( 'QsyChkPrfTknUser' )
     D  CtChkRes                     10i 0
     D  CtPrfTkn                     32a   Const
     D  CtError                   32767a          Options( *VarSize )
     **-- Generate profile token from profile token;  ------------------------**
     D GenPrfTknFt     Pr                  ExtProc( 'QsyGenPrfTknFromPrfTkn' )
     D  GtNewTkn                     32a
     D  GtFrmTkn                     32a   Const
     D  GtTimOutInt                  10i 0 Const
     D  GtPrtTknTyp                   1a   Const
     D  GtError                   32767a          Options( *VarSize )
     **-- Get profile token time out:  ---------------------------------------**
     D GetTknTmo       Pr                  ExtProc( 'QsyGetPrfTknTimeOut' )
     D  GtTknTmo                     10i 0
     D  GtPrfTkn                     32a   Const
     D  GtError                   32767a          Options( *VarSize )
     **-- Remove profile token:  ---------------------------------------------**
     D RmvPrfTkn       Pr                  ExtProc( 'QsyRemovePrfTkn' )
     D  RtPrfTkn                     32a   Const
     D  RtError                   32767a          Options( *VarSize )
     **-- Invalidate profile token:  -----------------------------------------**
     D InvPrfTkn       Pr                  ExtProc( 'QsyInvalidatePrfTkn' )
     D  ItPrfTkn                     32a   Const
     D  ItError                   32767a          Options( *VarSize )
     **-- Display long text:  ------------------------------------------------**
     D DspLngTxt       Pr                  ExtPgm( 'QUILNGTX' )
     D  DtLngTxt                   1024a   Const  Options( *VarSize )
     D  DtLngTxtLen                  10i 0 Const
     D  DtMsgId                       7a   Const
     D  DtMsgF                       20a   Const
     D  DtError                      10i 0 Const
     **-- Run system command:  -----------------------------------------------**
     D system          Pr            10i 0 ExtProc( 'system' )
     D  command                        *   Value  Options( *String )
     **-- Display message window:  -------------------------------------------**
     D DspMsgWdw       Pr
     D  PxMsgStr                    512a   Const  Varying
     **-- Parameter:  --------------------------------------------------------**
     D PxUsrPrf        s             10a
     **
     C     *Entry        Plist
     C                   Parm                    PxUsrPrf
     **
     **-- Mainline:  ---------------------------------------------------------**
     **
     C                   CallP     DspMsgWdw ( 'Step 1: Save profile handle ' +
     C                                         'to original user profile '    +
     C                                          %TrimR( PsUsrPrf )            +
     C                                         ' to enable a subsequent '     +
     C                                         'restore - press Enter to '    +
     C                                         'continue.'
     C                                       )
     **
     C                   CallP     GetPrfHdl( PrfHdlCur
     C                                      : '*CURRENT'
     C                                      : '*NOPWD'
     C                                      : 6
     C                                      : *Zero
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    > *Zero
     **
     C                   CallP     DspMsgWdw ( 'Save of profile handle ended' +
     C                                         ' in error - test terminated.' +
     C                                         ' Press Enter.'
     C                                       )
     **
     C                   Else
     C                   CallP     DspMsgWdw ( 'Step 2: Generate a profile '  +
     C                                         'token for requested user '    +
     C                                         'profile: '                    +
     C                                          %TrimR( PxUsrPrf )            +
     C                                         '. The token will be a '       +
     C                                         'multiple-use, regenerable '   +
     C                                         'profile token with a default' +
     C                                         ' time-out value of 3600 '     +
     C                                         'seconds. Press Enter to '     +
     C                                         'continue.'
     C                                       )
     **
     C                   CallP     GenPrfTknE( PrfTkn
     C                                       : PxUsrPrf
     C                                       : '*NOPWD'
     C                                       : 6
     C                                       : *Zero
     C                                       : -1
     C                                       : '3'
     C                                       : ApiError
     C                                       )
     **
     C                   CallP     DspMsgWdw ( 'Step 3: Generate a profile '  +
     C                                         'token from the previously '   +
     C                                         'obtained profile token for '  +
     C                                          %TrimR( PxUsrPrf )            +
     C                                         '. The new token will be a '   +
     C                                         'single-use, non-regenerable ' +
     C                                         'profile token with a time-'   +
     C                                         'out value of 100 seconds. '   +
     C                                         'Press Enter to continue.'
     C                                       )
     **
     C                   CallP     GenPrfTknFt( PrfTknNew
     C                                        : PrfTkn
     C                                        : 100
     C                                        : '1'
     C                                        : ApiError
     C                                        )
     **
     C                   CallP     DspMsgWdw ( 'Step 4: Set current profile ' +
     C                                         'of this job using the profile'+
     C                                         ' token from step 3. Please '  +
     C                                         'note "Current user profile" ' +
     C                                         'in the Display Job Status '   +
     C                                         'panel to follow. '            +
     C                                         'Press Enter to continue.'
     C                                       )
     **
     C                   CallP     SetPrfTkn( PrfTknNew
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    > *Zero
     **
     C                   CallP     DspMsgWdw ( 'Setting of current profile '  +
     C                                         'ended in error. Press Enter ' +
     C                                         'to terminate test.'
     C                                       )
     **
     C                   Else
     C                   CallP     system( 'DSPJOB JOB(*) OPTION(*STSA)' )
     **
     C                   CallP     ChkPrfTkn( PrfChk
     C                                      : PrfTknNew
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 5: Check of token and '  +
     C                                         'user profile correlation '    +
     C                                         'returned result code: '       +
     C                                          %Char( PrfChk )               +
     C                                         ' (0=Different, 1=Same) '      +
     C                                         '- press Enter to continue.'
     C                                       )
     **
     C                   Reset                   ApiError
     **
     C                   CallP     GetTknTmo( TknTmo
     C                                      : PrfTkn
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 6: Check of token time'  +
     C                                         '-out for initial profile '    +
     C                                         'token from step 2 returned '  +
     C                                         'error message ID: '           +
     C                                          %Trim( AeExcpId )             +
     C                                         '. Press Enter to continue.'
     C                                       )
     **
     C                   CallP     system( 'DSPMSGD ' + AeExcpId )
     **
     C                   CallP     GetTknTmo( TknTmo
     C                                      : PrfTknNew
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 7: Check of token time'  +
     C                                         '-out for new profile token '  +
     C                                         'from step 3 returned: '       +
     C                                          %Char( TknTmo )               +
     C                                         ' seconds. Press Enter to '    +
     C                                         'continue.'
     C                                       )
     **
     C                   CallP     InvPrfTkn( PrfTknNew
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 8: New profile token '   +
     C                                         'has been invalidated. '       +
     C                                         'Press Enter to continue.'
     C                                       )
     **
     C                   CallP     RmvPrfTkn( PrfTkn
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     RmvPrfTkn( PrfTknNew
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 9: Both profile tokens ' +
     C                                         'have been removed. '          +
     C                                         'Press Enter to continue.'
     C                                       )
     **
     C                   CallP     DspMsgWdw ( 'Step 10: Set current profile '+
     C                                         'of this job using the profile'+
     C                                         ' handle from step 1. Please ' +
     C                                         'note "Current User profile" ' +
     C                                         'in the Display Job Status '   +
     C                                         'panel to follow. '            +
     C                                         'Press Enter to continue.'
     C                                       )
     **
     C                   CallP     SetPrfHdl( PrfHdlCur
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     system( 'DSPJOB JOB(*) OPTION(*STSA)' )
     **
     C                   EndIf
     **
     C                   CallP     RlsPrfHdl( PrfHdlCur
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     DspMsgWdw ( 'Step 11: The profile handle ' +
     C                                         'from step 1 has been released'+
     C                                         '. Press Enter to end test '   +
     C                                         'normally.'
     C                                       )
     **
     C                   EndIf
     **
     C                   Return
     **
     **-- Display message window:  -------------------------------------------**
     P DspMsgWdw       B                   Export
     D                 Pi
     D  PxMsgStr                    512a   Const  Varying
     **
     C                   CallP(e)  DspLngTxt( PxMsgStr
     C                                      : %Len( PxMsgStr )
     C                                      : *Blanks
     C                                      : *Blanks
     C                                      : *Zero
     C                                      )
     **
     P DspMsgWdw       E

Thanks to Carsten Flensburg and
Club Tech iSeries Programming Tips Newsletter
Back

QDMLOPNF
List Open Files

     **  Program . . : CBX502
     **  Description : List job's open files
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : March 11, 2004
     **
     **
     **  Program description:
     **
     **    This program was intended to ease the process of retrieving the
     **    current job's list of open files. The information returned is the
     **    file names and file library names that are displayed by the DSPJOB
     **    or WRKJOB command's open files panel.  Running the command DSPJOB
     **    OPTION( *OPNF ) will show the information referred to above.
     **
     **    QDMLOPNF was introduced at V5R1.
     **
     **    Program CBX502T is provided to examplify the use of this program.
     **
     **
     **  Parameters:
     **
     **    PxEntNbr    BOTH       The maximum number of open file entries
     **                           to return in the output array.  A maximum
     **                           of 128 open file entries can be returned.
     **
     **                           On return this parameter specifies the
     **                           actual number of open file entries loaded
     **                           in the second parameter.
     **
     **    PxFilEnt    OUTPUT     The retrieved open file entries are returned
     **                           in this parameter. Both the file name and the
     **                           file library name is returned for each open
     **                           file entry as illustrated below:
     **
     **                           1            21           41
     **                           |  entry 1   |  entry 2   |  entry 3   | --
     **
     **                           1      11    21     31    41     51
     **                           | file | lib | file | lib | file | lib | --
     **
     **
     **-- Compilation specification:
     **
     **   CrtBndRpg   Pgm( 'library'/CBX502 )
     **               SrcFile( 'library'/QRPGLESRC )
     **               DbgView( *LIST )
     **
     **-- Control spec:  -----------------------------------------------------**
     H Option( *SrcStmt )
     **-- API error data structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPrv                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0
     D  AeMsgId                       7a
     D                                1a
     D  AeMsgDta                    256a
     **-- Global variables:  -------------------------------------------------**
     D Eix             s             10i 0
     **-- Job identification format JIDF0100:  -------------------------------**
     D JiJobInf        Ds                   Inz
     D  JiJobNam                     10a    Inz( '*' )
     D  JiUsrNam                     10a
     D  JiJobNbr                      6a
     D  JiIntJobId                   16a
     D                                2a    Inz( *Allx'00' )
     D  JiThrInd                     10i 0  Inz( 1 )
     D  JiThrId                       8a    Inz( *Allx'00' )
     **-- List open files header:  -------------------------------------------**
     D OfRcvVar        Ds
     D  OhOpnFilHdr
     D   OhBytRtn                    10i 0 Overlay( OhOpnFilHdr: 1 )
     D   OhBytAvl                    10i 0 Overlay( OhOpnFilHdr: *Next )
     D   OhNbrFilAvl                 10i 0 Overlay( OhOpnFilHdr: *Next )
     D   OhOfsFilLst                 10i 0 Overlay( OhOpnFilHdr: *Next )
     D   OhNbrFilRtn                 10i 0 Overlay( OhOpnFilHdr: *Next )
     D   OhFilEntLen                 10i 0 Overlay( OhOpnFilHdr: *Next )
     D   OhJobNamUsd                 10a   Overlay( OhOpnFilHdr: *Next )
     D   OhUsrNamUsd                 10a   Overlay( OhOpnFilHdr: *Next )
     D   OhJobNbrUsd                  6a   Overlay( OhOpnFilHdr: *Next )
     D   OhThrIdUsd                   8a   Overlay( OhOpnFilHdr: *Next )
     D  OhFilLst                  32000a
     **-- File information
     D  OfFilInf       Ds                  Based( pFilInf )
     D   OeFilNam                    10a
     D   OeFilLib                    10a
     D   OeMbrNam                    10a
     D   OeFilTyp                    10a
     D   OeRcdFmt                    10a
     D   OeActGrpNam                 10a
     D   OeThrId                      8a
     D   OeOpnOpt                     1a
     D                                3a
     D   OeActGrpNbr                 20i 0
     D   OeWrtCnt                    20i 0
     D   OeReadCnt                   20i 0
     D   OeWrtReadCnt                20i 0
     D   OeOthIoCnt                  20i 0
     D   OeRelRcdNbr                 20i 0
     D   OeNbrShrOpn                 20i 0
     **-- List open files:  --------------------------------------------------**
     D LstOpnF         Pr                  ExtPgm( 'QDMLOPNF' )
     D  LfRcvVar                  32767a          Options( *VarSize )
     D  LfRcvVarLen                  10i 0 Const
     D  LfRcvInfFmt                   8a   Const
     D  LfJobId                   32767a   Const  Options( *VarSize )
     D  LfJobIdFmt                    8a   Const
     D  LfError                   32767a          Options( *VarSize )
     **-- Parameters:  -------------------------------------------------------**
     D PxEntNbr        s              5p 0
     D PxFilEnt        s             20a   Dim( 128 )
     **
     C     *Entry        Plist
     C                   Parm                    PxEntNbr
     C                   Parm                    PxFilEnt
     **
     **-- Mainline:  ---------------------------------------------------------**
     **
     C                   CallP     LstOpnF( OfRcvVar
     C                                    : %Size( OfRcvVar )
     C                                    : 'OPNF0100'
     C                                    : JiJobInf
     C                                    : 'JIDF0100'
     C                                    : ApiError
     C                                    )
     **
     C                   If        AeBytAvl   =  *Zero
     C                   Eval      pFilInf    =  %Addr( OfRcvVar ) +
     C                                           OhOfsFilLst
     **
     C                   For       Eix = 1  to OhNbrFilRtn
     **
     C                   Eval      PxFilEnt(Eix) = OeFilNam + OeFilLib
     **
     C                   If        Eix         = PxEntNbr      Or
     C                             Eix         = OhNbrFilRtn   Or
     C                             Eix         = %Elem( PxFilEnt )
     **
     C                   Leave
     C                   EndIf
     **
     C                   Eval      pFilInf     = pFilInf + OhFilEntLen
     C                   EndFor
     C                   EndIf
     **
     C                   Eval      PxEntNbr    = Eix
     **
     C                   Eval      *InLr      =  *On
     C                   Return

And the calling program:
     **-- Compilation specification:  ----------------------------------------**
     **
     **   CrtBndRpg   Pgm( 'library'/CBX502T )
     **               SrcFile( 'library'/QRPGLESRC )
     **               DbgView( *LIST )
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt )
     **-- Global variables:  -------------------------------------------------**
     D Eix             s             10i 0
     **-- File information----------------------------------------------------**
     D FilInf          Ds
     D  FiFilNam                     10a
     D  FiFilLib                     10a
     **-- Parameters:  -------------------------------------------------------**
     D PxEntNbr        s              5p 0 Inz( %Elem( PxFilEnt ))
     D PxFilEnt        s             20a   Dim( 64 )
     **
     C                   Call      'CBX502'
     C                   Parm                    PxEntNbr
     C                   Parm                    PxFilEnt
     **
     C                   For       Eix = 1  to PxEntNbr
     **
     C                   Eval      FilInf      = PxFilEnt(Eix)
     C                   EndFor
     **
     C                   Return

Thanks to Carsten Flensburg and
Club Tech iSeries Programming Tips Newsletter
Back

QWCRJBLK
Retrieve Job Lock

     **  Program . . : CBX504
     **  Description : List job's object locks
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : July 15, 2004
     **
     **
     **  Program description:
     **
     **    This program is intended to ease the process of retrieving the
     **    current job's list of object locks.  The information returned is
     **    object name, library and type as well as object lock state, similar
     **    to some of the information that is displayed by the DSPJOB or
     **    WRKJOB commands' Job Locks panel.  Running the command DSPJOB
     **    OPTION( *JOBLCK ) will show the information referred to above.
     **
     **    Program CBX504T is provided to give an example of how to call
     **    this program.
     **
     **  Parameters:
     **
     **    PxEntNbr    BOTH       The maximum number of job object lock entries
     **                           to return in the output array.  A maximum
     **                           of 128 job object lock entries can be returned.
     **
     **                           On return this parameter specifies the
     **                           actual number of job object locks loaded
     **                           in the second parameter.
     **
     **    PxLckEnt    OUTPUT     The list of job object lock entries are returned
     **                           in this parameter. The object name, library and
     **                           type as well as object lock state is returned
     **                           for each job object lock entry as illustrated
     **                           below:
     **
     **                1                           41                          81
     **                | -------- entry 1 -------- | -------- entry 2 -------- |
     **
     **                1      11     21     31     41     51     61     71     81
     **                | obj  | lib  | type | lock | obj  | lib  | type | lock |
     **
     **
     **-- Compilation specification:
     **
     **   CrtBndRpg   Pgm( 'library'/CBX504 )
     **               SrcFile( 'library'/QRPGLESRC )
     **               DbgView( *LIST )
     **
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt )
     **-- Api error data structure:  -----------------------------------------**
     D ERRC0100        Ds                  Qualified
     D  BytPro                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0 Inz
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      256a
     **-- Global variables:  -------------------------------------------------**
     D Eix             s             10i 0
     D ApiRcvSiz       s             10u 0
     **-- Job lock information:  ---------------------------------------------**
     D JBLK0100        Ds                  Qualified  Based( pLstHdr )
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0
     D  NbrObjLck                    10i 0
     D  OfsObjLck                    10i 0
     D  NbrLckObjRtn                 10i 0
     D  LckObjEntLen                 10i 0
     **
     D JBLK0100E       Ds                  Qualified  Based( pLstEnt )
     D  ObjNam                       10a
     D  ObjLib                       10a
     D  ObjTyp                       10a
     D  ObjExtAtr                    10a
     D  LckStt                       10a
     D                                2a
     D  LckSts                       10i 0
     D  MbrLcks                      10i 0
     D  LckCnt                       10i 0
     D  LckScp                        1a
     D                                3a
     D  ThrId                         8a
     D  ThrHdl                       10u 0
     ** V5R2:
     D  LckSpcId                     20a
     D  ObjAspNam                    10a
     D  ObjLibAspNam                 10a
     D  ObjAspNbr                    10i 0
     D  ObjLibAspNbr                 10i 0
     **-- Job id:  -----------------------------------------------------------**
     D JlJobId         Ds
     D  JiJobNam                     10a   Inz( '*' )
     D  JiUsrNam                     10a
     D  JiJobNbr                      6a
     D  JiIntJobId                   16a   Inz( *Blanks )
     D                                2a   Inz( *Allx'00' )
     D  JlThrInd                     10i 0 Inz( 3 )
     D  JlThrId                       8a
     **-- Retrieve job locks:  -----------------------------------------------**
     D RtvJobLck       Pr                  ExtPgm( 'QWCRJBLK' )
     D  JlRcvVar                  65535a         Options( *VarSize )
     D  JlRcvVarLen                  10i 0 Const
     D  JlFmtNam                      8a   Const
     D  JlJobId                      56a   Const
     D  JlFmtJobId                    8a   Const
     D  JlError                   32767a          Options( *VarSize )
     **
     D  JlLckFlr                     53a   Const  Options( *NoPass )
     D  JlFlrFmt                      8a   Const  Options( *NoPass )
     **-- Parameters:  -------------------------------------------------------**
     D PxEntNbr        s              5p 0
     D PxLckEnt        s             40a   Dim( 128 )
     **
     C     *Entry        Plist
     C                   Parm                    PxEntNbr
     C                   Parm                    PxLckEnt
     **
     **
     **-- Mainline:  ---------------------------------------------------------**
     **
     C                   Eval      ApiRcvSiz   = 10240
     C                   Eval      pLstHdr     = %Alloc( ApiRcvSiz )
     **
     C                   DoU       JBLK0100.BytAvl <= ApiRcvSiz  Or
     C                             ERRC0100.BytAvl  > *Zero
     **
     C                   If        ApiRcvSiz   < JBLK0100.BytAvl
     **
     C                   Eval      ApiRcvSiz   = JBLK0100.BytAvl
     C                   Eval      pLstHdr     = %ReAlloc( pLstHdr: ApiRcvSiz )
     C                   EndIf
     **
     C                   CallP     RtvJobLck( JBLK0100
     C                                      : ApiRcvSiz
     C                                      : 'JBLK0100'
     C                                      : JlJobId
     C                                      : 'JIDF0100'
     C                                      : ERRC0100
     C                                      )
     **
     C                   EndDo
     **
     C                   If        JBLK0100.NbrLckObjRtn > *Zero   And
     C                             ERRC0100.BytAvl       = *Zero
     **
     C                   ExSr      PrcJobLcks
     C                   Else
     **
     C                   Eval      PxEntNbr    = *Zero
     C                   EndIf
     **
     C                   DeAlloc                 pLstHdr
     **
     C                   Eval      *InLr       = *On
     C                   Return
     **
     **-- Process job locks:  ------------------------------------------------**
     C     PrcJobLcks    BegSr
     **
     C                   Eval      pLstEnt    = pLstHdr + JBLK0100.OfsObjLck
     **
     C                   For       Eix = 1  to JBLK0100.NbrLckObjRtn
     **
     C                   Eval      PxLckEnt(Eix) = JBLK0100E.ObjNam +
     C                                             JBLK0100E.ObjLib +
     C                                             JBLK0100E.ObjTyp +
     C                                             JBLK0100E.LckStt
     **
     **-- Specific exit point for this example:
     C                   If        Eix        = PxEntNbr              Or
     C                             Eix        = %Elem( PxLckEnt )     Or
     C                             Eix        = JBLK0100.NbrLckObjRtn
     **
     C                   Leave
     C                   EndIf
     **
     **-- General logic to keep entry pointer within list size:
     C                   If        Eix        < JBLK0100.NbrLckObjRtn
     C                   Eval      pLstEnt    = pLstEnt + JBLK0100.LckObjEntLen
     C                   EndIf
     C                   EndFor
     **
     C                   Eval      PxEntNbr    = Eix
     **
     C                   EndSr

And the calling program:
     **-- Compilation specification:  ----------------------------------------**
     **
     **   CrtBndRpg   Pgm( 'library'/CBX504T )
     **               SrcFile( 'library'/QRPGLESRC )
     **               DbgView( *LIST )
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt )
     **-- Global variables:  -------------------------------------------------**
     D Eix             s             10i 0
     **-- File information----------------------------------------------------**
     D LckInf          Ds
     D  LiObjNam                     10a
     D  LiObjLib                     10a
     D  LiObjTyp                     10a
     D  LiLckStt                     10a
     **-- Parameters:  -------------------------------------------------------**
     D PxEntNbr        s              5p 0 Inz( %Elem( PxLckEnt ))
     D PxLckEnt        s             40a   Dim( 64 )
     **
     C                   Call      'CBX504'
     C                   Parm                    PxEntNbr
     C                   Parm                    PxLckEnt
     **
     C                   For       Eix = 1  to PxEntNbr
     **
     C                   Eval      LckInf      = PxLckEnt(Eix)
     C     LckInf        Dsply
     **
     C                   EndFor
     **
     C                   Return

Thanks to Carsten Flensburg and
Club Tech iSeries Programming Tips Newsletter
Back

QUSROBJD
Retrieve Object Description

     **-- Global variables:-------------------------------------------------**
     D ObjNam          s             10a
     D ObjLib          s             10a
     D ObjTyp          s             10a
     **-- Api error data structure:-----------------------------------------**
     D ApiError        Ds
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0 Inz
     D  AeMsgId                       7a
     D                                1a
     D  AeMsgDta                    128a
     **-- Object description structure OBJD0100:----------------------------**
     D RoData          Ds
     D  RoBytRtn                     10i 0
     D  RoBytAvl                     10i 0
     D  RoObjNam                     10a
     D  RoObjLib                     10a
     D  RoObjTypRt                   10a
     D  RoObjLibRt                   10a
     D  RoObjASP                     10i 0
     D  RoObjOwn                     10a
     D  RoObjDmn                      2a
     D  RoObjCrtDts                  13a
     D  RoObjChgDts                  13a
     D  RoExtAtr                     10a
     D  RoTxtDsc                     50a
     D  RoSrcF                       10a
     D  RoSrcLib                     10a
     D  RoSrcMbr                     10a
     **-- Retrieve object description:--------------------------------------**
     D RtvObjD         Pr                  ExtPgm( 'QUSROBJD' )
     D  RoRcvVar                  32767a         Options( *VarSize )
     D  RoRcvVarLen                  10i 0 Const
     D  RoFmtNam                      8a   Const
     D  RoObjNamQ                    20a   Const
     D  RoObjTyp                     10a   Const
     D  RoError                   32767a         Options( *VarSize )
     **
     **-- Get Web value:----------------------------------------------------**
     **
     C                   Eval      ObjNam     =  '???'
     C                   Eval      ObjLib     =  '*LIBL'
     C                   Eval      ObjTyp     =  '*PGM'
     **
     C                   CallP     RtvObjD( RoData
     C                                    : %Size( RoData )
     C                                    : 'OBJD0100'
     C                                    : ObjNam + ObjLib
     C                                    : ObjTyp
     C                                    : ApiError
     C                                    )
     **
     C                   If        AeBytAvl   >  *Zero
     C                   If        %Subst(AeMsgId:1:5) = 'CPF98'
     **-- Object doesn't exist...
     **   CPF9801 E - Object &2 in library &3 not found.
     **   CPF9802 E - Not authorized to object &2 in &3.
     **   CPF9803 E - Cannot allocate object &2 in library &3.
     **   CPF9811 E - Program &2 in library &3 not found.
     C                   EndIf
     C                   EndIf
     C                   Return
     **

Thanks to Carsten Flensburg and Bob Cozzi
Back

QCLRPGMI
Retrieve Program Information

d ritorno         s           1000
d len             s             10i 0
d formato         s              8    inz('PGMI0100')
d pgmx            s             20
d errori          s             20
d pgmi            s             10
d gruppo          s             30
c     *entry        plist
c                   parm                    pgmi
c                   parm                    gruppo
c*
c                   movel     pgmi          pgmx
c                   move      '*LIBL     '  pgmx
c                   eval      len=%len(ritorno)
c                   clear                   errori
c                   call      'QCLRPGMI'
c                   parm                    ritorno
c                   parm                    len
c                   parm                    formato
c                   parm                    pgmx

c                   parm                    errori
c*
c                   eval     gruppo=%subst(ritorno:369:%len(gruppo))
c                   eval      *inlr=*on
c                   return
Thanks to Marco Facchinetti

And here an US/UK version ;-)
      *
      * Program Info
      *
     d                SDS
     d  @PGM                 001    010
     d  @PARMS               037    039  0
     d  @JOB                 244    253
     d  @USER                254    263
     d  @JOB#                264    269  0
      *==============================================
      *   QCLRPGMI  API to Retrieve program info
      *==============================================
      *
      * Standard API error data structure
      *
     d APIERR          DS                  INZ
     d  AEBYPR                 1      4B 0
     d  AEBYAV                 5      8B 0
     d  AEEXID                 9     15
     d  AEEXDT                16    116
      *
      * Standard parameters for QCLRPGMI                                API
      * (Retrieve Program Information)                                  API
      *
     d RP_PARM         DS                  INZ
     d  RP_RCV                 1    416                   RECEIVER VARIABLE
     d   RP_PGMNAME            9     18                   PROGRAM NAME
     d   RP_PGMLIB            19     28                   PROGRAM LIBRARY
     d   RP_PGMATTR           39     48                   PROGRAM ATTRIBUTE
     d   RP_TEXT             111    160                   TEXT DESCRIPTION
     d   RP_MODULES          413    416B 0                NUMBER OF MODULES
     d  RP_RCV_LEN           417    420B 0                LENGTH OF RCV VAR
     d  RP_FORMAT            421    428                   FORMAT NAME
     d  RP_PGM_LIB           429    448                   PGM NAME & LIBRARY
     d   RP_PGM              429    438                   PROGRAM NAME
     d   RP_LIB              439    448                   PROGRAM LIBRARY
      *
      * Define Variables
      *
     d InLibrary       S             10
     d InProgram       S             10
      *
     c                   clear                   RP_parm
     c                   eval      RP_RCV_LEN = 416
     c                   eval      RP_FORMAT  = 'PGMI0100'
     c                   eval      RP_PGM     = InProgram
     c                   eval      RP_LIB     = InLibrary
     c                   clear                   APIERR
     c                   eval      AEBYPR     = 116
      *
     c                   call      'QCLRPGMI'
     c                   parm                    RP_RCV
     c                   parm                    RP_RCV_LEN
     c                   parm                    RP_FORMAT
     c                   parm                    RP_PGM_LIB
     c                   parm                    APIERR
      *
     c                   eval      *INLR = *On
      *
      *==============================================
      *   *Inzsr - Initial onetime subroutine
      *==============================================
     csr   *Inzsr        begsr
      *
     c     *Entry        Plist
     c                   parm                    InLibrary
     c                   parm                    InProgram
      *
     c                   endsr
      *==============================================

Thanks an unknown writer
Back

QP0ZGETENV
Get Value of Environment Variable (Extended)

Here's the prototype that is used in the CGILIB (similar to CGIDEV2) D Qp0zGetEnv PR * ExtProc('Qp0zGetEnv') D envvar * VALUE OPTIONS(*STRING) D nCCSID 10I 0 The 2nd parm, CCSID, can be set to 0 for the current CCSID. Here's the wrapper I built for CGILIB so that you don't have to deal with the C string return values: P GetEnvVar B Export D GetEnvVar PI 65535A VARYING D pInEnv * VALUE OPTIONS(*STRING) D pEnv S * Inz D nCCSID S 10I 0 Inz(0) C eval pEnv = Qp0zGetEnv(pInEnv : nCCSID) C C if pEnv = *NULL C return '' C endif C return %str(pEnv) P GetEnvVar E CGILIB is available in the RPG xTools at www.rpgxtools.com Thanks to Bob Cozzi

Back

Prototypes for QSYSET... & -GET...

Q: Anyone have an RPG IV prototype example using either of these two APIs?
    Syntax
     #include <qsysetid.h>
     int qsysetuid(uid_t uid);

A: At one time, I wrote an RPG version of qsysetid.h (I called it QSYSETID_H) I don't remember which prototypes have been tested in this source file and which have not, but to the best of my knowledge, they are all correct. My RPG member called QSYSETID_H follows:
/if defined(QSYSETID_H) /eof /endif /define QSYSETID_H D uid_t s 10U 0 based(template) D gid_t s 10U 0 based(template) D QSYSETID_NOCHANGE... D c const(4294967295) D qsysetuid PR 10I 0 extproc('qsysetuid') D uid like(uid_t) value D qsyseteuid PR 10I 0 extproc('qsyseteuid') D uid like(uid_t) value D qsysetreuid PR 10I 0 extproc('qsysetreuid') D ruid like(uid_t) value D euid like(uid_t) value D qsysetgid PR 10I 0 extproc('qsysetgid') D gid like(gid_t) value D qsysetegid PR 10I 0 extproc('qsysetegid') D gid like(gid_t) value D qsysetregid PR 10I 0 extproc('qsysetregid') D rgid like(gid_t) value D egid like(gid_t) value D qsygetgroups PR 10I 0 extproc('qsygetgroups') D gidsize 10I 0 value D grouplist like(gid_t) D dim(32767) D options(*varsize) D qsysetgroups PR 10I 0 extproc('qsysetgroups') D gidsize 10I 0 value D grouplist like(gid_t) D dim(32767) D const D options(*varsize) Reply: Thanks. I will give it a shot. I'm trying to use these APIs to extend adopted authority functionality to IFS files.
New reply: Those APIs (qsysetuid(), et al) are designed to make it easier to convert Unix programs to run on the iSeries. Since you're coding in RPG, that's probably not where you're coming from. You might find the Profile Handle or Profile Token APIs more intuitive for your purposes, since you give them an actual user profile name rather than a Unix uid/gid as input. Just a thought.
Reply: Thanks again. I am actually trying to follow Carol Woodbury's recommendations in 'Experts Guide to OS/400 & i5/OS Security' in which she reviews the Profile Swap and Profile Token APIs as well as the UID and GID API methods and recommends GID as her current favorite because it provides temporary authority to the application objects for the current thread only.
Thanks to Scott Klement & Lorne
Back

IFS API: Constants, Structures & Prototypes

      *---------------------------------------------------------------------
      * This code courtesy Scott Klement via MIDRANGE-L
      *---------------------------------------------------------------------

      * This header file contains the constants, structures and prototypes
      * for using the Integrated File System API
      *
      * These APIs were designed originally for use in C programming.
      * Therefore bear in mind:
      * 1) All strings must be null-terminated, and variable-length.
      * 2) Errors are returned in the errno variable, and strings for
      *    them are available by calling strerror()
      * 3) To use strerror(), errno, you must bind to the ILE C binding
      *    directory QC2LE
      *
      * SCK 03/24/1999
      *
      * To use these in your source code, you need a D-spec like this:
      * D/COPY LIBSOR/QRPGLESRC,IFSIO_H
      * For detailed info seee the UNIX-type APIs manual

      * This header file includes (in order)
      * 1) Constants
      * 2) Structures
      * 3) Prototypes


     D* ascii code-page
     D CP_ASCII C 819
     D*********************************************************************
     D* Flags for use in open()
     D*
     D* More than one can be used -- add them together.
     D*********************************************************************
     D* Reading Only
     D O_RDONLY C 1
     D* Writing Only
     D O_WRONLY C 2
     D* Reading & Writing
     D O_RDWR C 4
     D* Create File if not exist
     D O_CREAT C 8
     D* Exclusively create
     D O_EXCL C 16
     D* Truncate File to 0 bytes
     D O_TRUNC C 64
     D* Append to File
     D O_APPEND C 256
     D* Convert text by code-pag
     D O_CODEPAGE C 8388608
     D* Open in text-mode
     D O_TEXTDATA C 16777216
     D*********************************************************************
     D* Access mode flags for access()
     D*********************************************************************
     D F_OK C 0
     D R_OK C 4
     D W_OK C 2
     D X_OK C 1
     D*********************************************************************
     D* Mode Flags.
     D* basically, the mode parm of open(), creat(), chmod(),etc
     D* uses 9 least significant bits to determine the
     D* file's mode. (peoples access rights to the file)
     D*
     D* user: owner group other
     D* access: R W X R W X R W X
     D* bit: 8 7 6 5 4 3 2 1 0
     D*
     D* (This is accomplished by adding the flags below to get the mode)
     D*********************************************************************
     D* owner authority
     D S_IRUSR C 256
     D S_IWUSR C 128
     D S_IXUSR C 64
     D S_IRWXU C 448
     D* group authority
     D S_IRGRP C 32
     D S_IWGRP C 16
     D S_IXGRP C 8
     D S_IRWXG C 56
     D* other people
     D S_IROTH C 4
     D S_IWOTH C 2
     D S_IXOTH C 1
     D S_IRWXO C 7

     D*********************************************************************
     D* File Information Structure (stat)
     D*
     D* struct stat {
     D* mode_t st_mode; /* File mode *
     D* ino_t st_ino; /* File serial number *
     D* nlink_t st_nlink; /* Number of links *
     D* uid_t st_uid; /* User ID of the owner of file *
     D* gid_t st_gid; /* Group ID of the group of file *
     D* off_t st_size; /* For regular files, the file
     D* * size in bytes *
     D* time_t st_atime; /* Time of last access *
     D* time_t st_mtime; /* Time of last data modification *
     D* time_t st_ctime; /* Time of last file status change *
     D* dev_t st_dev; /* ID of device containing file *
     D* size_t st_blksize; /* Size of a block of the file *
     D* unsigned long st_allocsize; /* Allocation size of the file *
     D* qp0l_objtype_t st_objtype; /* AS/400 object type *
     D* unsigned short st_codepage; /* Object data codepage *
     D* char st_reserved1[66]; /* Reserved *
     D* };
     D*
     D p_statds S *
     D statds DS BASED(p_statds)
     D st_mode 10U 0
     D st_ino 10U 0
     D st_nlink 5U 0
     D st_uid 10U 0
     D st_gid 10U 0
     D st_size 10I 0
     D st_atime 10I 0
     D st_mtime 10I 0
     D st_ctime 10I 0
     D st_dev 10U 0
     D st_blksize 10U 0
     D st_alcsize 10U 0
     D st_objtype 11A
     D st_codepag 5U 0
     D st_resv11 66A

     D*********************************************************************
     D* Group Information Structure (group)
     D*
     D* struct group {
     D* char *gr_name; /* Group name.
     D* gid_t gr_gid; /* Group id.
     D* char **gr_mem; /* A null-terminated list of pointe
     D* to the individual member names.
     D* };
     D*
     D p_group S *
     D group DS Based(p_group)
     D gr_name *
     D gr_gid 10U 0
     D gr_mem * DIM(256)

     D*********************************************************************
     D*
     D* User Information Structure (passwd)
     D*
     D* (Don't let the name fool you, this structure does not contain
     D* any password information. Its named after the UNIX file that
     D* contains all of the user info. That file is "passwd")
     D*
     D* struct passwd {
     D* char *pw_name; /* User name.
     D* uid_t pw_uid; /* User ID number.
     D* gid_t pw_gid; /* Group ID number.
     D* char *pw_dir; /* Initial working directory.
     D* char *pw_shell; /* Initial user program.
     D* };
     D*
     D p_passwd S *
     D passwd DS BASED(p_passwd)
     D pw_name *
     D pw_uid 10U 0
     D pw_gid 10U 0
     D pw_dir *
     D pw_shell *

     D*********************************************************************
     D* File Time Structure (utimbuf)
     D*
     D* struct utimbuf {
     D* time_t actime; /* access time */
     D* time_t modtime; /* modification time */
     D* };
     D*
     D p_utimbuf S *
     D utimbuf DS based(p_utimbuf)
     D actime 10I 0
     D modtime 10I 0

     D*********************************************************************
     D*
     D* Directory Entry Structure (dirent)
     D*
     D* struct dirent {
     D* char d_reserved1[16]; /* Reserved
     D* unsigned int d_reserved2; /* Reserved
     D* ino_t d_fileno; /* The file number of the file
     D* unsigned int d_reclen; /* Length of this directory entr
     D* * in bytes
     D* int d_reserved3; /* Reserved
     D* char d_reserved4[8]; /* Reserved
     D* qlg_nls_t d_nlsinfo; /* National Language Information
     D* * about d_name
     D* unsigned int d_namelen; /* Length of the name, in bytes
     D* * excluding NULL terminator
     D* char d_name[_QP0L_DIR_NAME]; /* Name...null terminated
     D*
     D* };
     D*
     D p_dirent s *
     D dirent ds based(p_dirent)
     D d_reserv1 16A
     D d_reserv2 10U 0
     D d_fileno 10U 0
     D d_reclen 10U 0
     D d_reserv3 10I 0
     D d_reserv4 8A
     D d_nlsinfo 12A
     D nls_ccsid 10I 0 OVERLAY(d_nlsinfo:1)
     D nls_cntry 2A OVERLAY(d_nlsinfo:5)
     D nls_lang 3A OVERLAY(d_nlsinfo:7)
     D nls_reserv 3A OVERLAY(d_nlsinfo:10)
     D d_namelen 10U 0
     D d_name 640A


     D*--------------------------------------------------------------------
     D* Determine file accessibility
     D*
     D* int access(const char *path, int amode)
     D*
     D*--------------------------------------------------------------------
     D access PR 10I 0 ExtProc('access')
     D Path * Value
     D amode 10I 0 Value
     D*--------------------------------------------------------------------
     D* Change Directory
     D*
     D* int chdir(const char *path)
     D*--------------------------------------------------------------------
     D chdir PR 10I 0 ExtProc('chdir')
     D path * Value
     D*--------------------------------------------------------------------
     D* Change file authorizations
     D*
     D* int chmod(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D chmod PR 10I 0 ExtProc('chmod')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Change Owner/Group of File
     D*
     D* int chown(const char *path, uid_t owner, gid_t group)
     D*--------------------------------------------------------------------
     D chown PR 10I 0 ExtProc('chown')
     D path * Value
     D owner 10U 0 Value
     D group 10U 0 Value
     D*--------------------------------------------------------------------
     D* Close a file
     D*
     D* int close(int fildes)
     D*--------------------------------------------------------------------
     D close PR 10I 0 ExtProc('close')
     D handle 10I 0 value
     D*--------------------------------------------------------------------
     D* Close a directory
     D*
     D* int closedir(DIR *dirp)
     D*--------------------------------------------------------------------
     D closedir PR 10I 0 EXTPROC('closedir')
     D dirhandle * VALUE
     D*--------------------------------------------------------------------
     D* Create or Rewrite File
     D*
     D* int creat(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D creat PR 10I 0 ExtProc('creat')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Duplicate open file descriptor
     D*
     D* int dup(int fildes)
     D*--------------------------------------------------------------------
     D dup PR 10I 0 ExtProc('dup')
     D fildes 10I 0 Value
     D*--------------------------------------------------------------------
     D* Duplicate open file descriptor to another descriptor
     D*
     D* int dup2(int fildes, int fildes2)
     D*--------------------------------------------------------------------
     D dup2 PR 10I 0 ExtProc('dup2')
     D fildes 10I 0 Value
     D fildes2 10I 0 Value
     D*--------------------------------------------------------------------
     D* Change file authorizations by descriptor
     D*
     D* int fchmod(int fildes, mode_t mode)
     D*--------------------------------------------------------------------
     D fchmod PR 10I 0 ExtProc('fchmod')
     D fildes 10I 0 Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Change Owner and Group of File by Descriptor
     D*
     D* int fchown(int fildes, uid_t owner, gid_t group)
     D*--------------------------------------------------------------------
     D fchown PR 10I 0 ExtProc('fchown')
     D fildes 10I 0 Value
     D owner 10U 0 Value
     D group 10U 0 Value
     D*--------------------------------------------------------------------
     D* Perform File Control
     D*
     D* int fcntl(int fildes, int cmd, . . .)
     D*--------------------------------------------------------------------
     D fcntl PR 10I 0 ExtProc('fcntl')
     D fildes 10I 0 Value
     D cmd 10I 0 Value
     D arg 10I 0 Value options(*nopass)
     D*--------------------------------------------------------------------
     D* Get configurable path name variables by descriptor
     D*
     D* long fpathconf(int fildes, int name)
     D*--------------------------------------------------------------------
     D fpathconf PR 10I 0 ExtProc('fpathconf')
     D fildes 10I 0 Value
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get File Information by Descriptor
     D*
     D* int fstat(int fildes, struct stat *buf)
     D*--------------------------------------------------------------------
     D fstat PR 10I 0 ExtProc('fstat')
     D fildes 10I 0 Value
     D buf * Value
     D*--------------------------------------------------------------------
     D* Synchronize Changes to fIle
     D*
     D* int fsync(int fildes)
     D*--------------------------------------------------------------------
     D fsync PR 10I 0 ExtProc('fsync')
     D fildes 10I 0 Value
     D*--------------------------------------------------------------------
     D* Truncate file
     D*
     D* int ftruncate(int fildes, off_t length)
     D*--------------------------------------------------------------------
     D ftruncate PR 10I 0 ExtProc('ftruncate')
     D fildes 10I 0 Value
     D length 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get current working directory
     D*
     D* char *getcwd(char *buf, size_t size)
     D*--------------------------------------------------------------------
     D getcwd PR * ExtProc('getcwd')
     D buf * Value
     D size 10U 0 Value
     D*--------------------------------------------------------------------
     D* Get effective group ID
     D*
     D* gid_t getegid(void)
     D*--------------------------------------------------------------------
     D getegid PR 10U 0 ExtProc('getegid')
     D*--------------------------------------------------------------------
     D* Get effective user ID
     D*
     D* uid_t geteuid(void)
     D*--------------------------------------------------------------------
     D geteuid PR 10U 0 ExtProc('geteuid')
     D*--------------------------------------------------------------------
     D* Get Real Group ID
     D*
     D* gid_t getgid(void)
     D*--------------------------------------------------------------------
     D getgid PR 10U 0 ExtProc('getgid')
     D*--------------------------------------------------------------------
     D* Get group information from group ID
     D*
     D* struct group *getgrgid(gid_t gid)
     D*--------------------------------------------------------------------
     D getgrid PR * ExtProc('getgrgid')
     D gid 10U 0 VALUE
     D*--------------------------------------------------------------------
     D* Get group info using group name
     D*
     D* struct group *getgrnam(const char *name)
     D*--------------------------------------------------------------------
     D getgrnam PR * ExtProc('getgrnam')
     D name * VALUE
     D*--------------------------------------------------------------------
     D* Get group IDs
     D*
     D* int getgroups(int gidsetsize, gid_t grouplist[])
     D*--------------------------------------------------------------------
     D getgroups PR * ExtProc('getgroups')
     D gidsetsize 10I 0 VALUE
     D grouplist *
     D*--------------------------------------------------------------------
     D* Get user information by user-name
     D*
     D* (Don't let the name mislead you, this does not return the password,
     D* the user info database on unix systems is called "passwd",
     D* therefore, getting the user info is called "getpw")
     D*
     D* struct passwd *getpwnam(const char *name)
     D*--------------------------------------------------------------------
     D getpwnam PR * ExtProc('getpwnam')
     D name * Value
     D*--------------------------------------------------------------------
     D* Get user information by user-id
     D*
     D* (Don't let the name mislead you, this does not return the password,
     D* the user info database on unix systems is called "passwd",
     D* therefore, getting the user info is called "getpw")
     D*
     D* struct passwd *getpwuid(uid_t uid)
     D*--------------------------------------------------------------------
     D getpwuid PR * extproc('getpwuid')
     D uid 10U 0 Value
     D*--------------------------------------------------------------------
     D* Get Real User-ID
     D*
     D* uid_t getuid(void)
     D*--------------------------------------------------------------------
     D getuid PR 10U 0 ExtProc('getuid')
     D*--------------------------------------------------------------------
     D* Perform I/O Control Request
     D*
     D* int ioctl(int fildes, unsigned long req, ...)
     D*--------------------------------------------------------------------
     D ioctl PR 10I 0 ExtProc('ioctl')
     D fildes 10I 0 Value
     D req 10U 0 Value
     D arg * Value
     D*--------------------------------------------------------------------
     D* Create Link to File
     D*
     D* int link(const char *existing, const char *new)
     D*--------------------------------------------------------------------
     D link PR 10I 0 ExtProc('link')
     D existing * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Set File Read/Write Offset
     D*
     D* off_t lseek(int fildes, off_t offset, int whence)
     D*--------------------------------------------------------------------
     D lseek PR 10I 0 ExtProc('lseek')
     D offset 10I 0
     D whence 10I 0
     D*--------------------------------------------------------------------
     D* Get File or Link Information
     D*
     D* int lstat(const char *path, struct stat *buf)
     D*--------------------------------------------------------------------
     D lstat PR 10I 0 ExtProc('lstat')
     D path * Value
     D buf * Value
     D*--------------------------------------------------------------------
     D* Make Directory
     D*
     D* int mkdir(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D mkdir PR 10I 0 ExtProc('mkdir')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Open a File
     D*
     D* int open(const char *path, int oflag, . . .);
     D*--------------------------------------------------------------------
     D open PR 10I 0 ExtProc('open')
     D filename * value
     D openflags 10I 0 value
     D mode 10U 0 value options(*nopass)
     D codepage 10U 0 value options(*nopass)
     D*--------------------------------------------------------------------
     D* Open a Directory
     D*
     D* DIR *opendir(const char *dirname)
     D*--------------------------------------------------------------------
     D opendir PR * EXTPROC('opendir')
     D dirname * VALUE
     D*--------------------------------------------------------------------
     D* Get configurable path name variables
     D*
     D* long pathconf(const char *path, int name)
     D*--------------------------------------------------------------------
     D pathconf PR 10I 0 ExtProc('pathconf')
     D path * Value
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get path name of object from its file id
     D*
     D* char *Qp0lGetPathFromFileID(char *buf, size_t size,Qp0lFID_t fileid
     D*--------------------------------------------------------------------
     D GetPathFID PR * ExtProc('Qp0lGetPathFromFileID')
     D buf * Value
     D size 10U 0 Value
     D fileid 16A
     D*--------------------------------------------------------------------
     D* Rename File or Directory, return error if a file/dir under the
     D* "new" name already exists.
     D*
     D* int Qp0lRenameKeep(const char *old, const char *new)
     D*--------------------------------------------------------------------
     D Rename PR 10I 0 ExtProc('Qp0lRenameKeep')
     D old * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Rename File or Directory. If another file/dir exists under the
     D* "new" name, delete it first.
     D*
     D* int Qp0lRenameUnlink(const char *old, const char *new)
     D*--------------------------------------------------------------------
     D Replace PR 10I 0 ExtProc('Qp0lRenameUnlink')
     D old * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Read From a File
     D*
     D* ssize_t read(int handle, void *buffer, size_t bytes);
     D*--------------------------------------------------------------------
     D read PR 10I 0 ExtProc('read')
     D handle 10i 0 value
     D buffer * value
     D bytes 10U 0 value
     D*--------------------------------------------------------------------
     D* Read Directory Entry
     D*
     D* struct dirent *readdir(DIR *dirp)
     D*--------------------------------------------------------------------
     D readdir PR * EXTPROC('readdir')
     D dirp * VALUE
     D*--------------------------------------------------------------------
     D* Read Value of Symbolic Link
     D*
     D* int readlink(const char *path, char *buf, size_t bufsiz)
     D*--------------------------------------------------------------------
     D readlink PR 10I 0 ExtProc('readlink')
     D path * value
     D buf * value
     D bufsiz 10U 0 value
     D*--------------------------------------------------------------------
     D* Reset Directory Stream to Beginning
     D*
     D* void rewinddir(DIR *dirp)
     D*--------------------------------------------------------------------
     D rewinddir PR ExtProc('rewinddir')
     D dirp * value

     D*--------------------------------------------------------------------
     D* Remove Directory
     D*
     D* int rmdir(const char *path)
     D*--------------------------------------------------------------------
     D rmdir PR 10I 0 ExtProc('rmdir')
     D path * value
     D*--------------------------------------------------------------------
     D* Get File Information
     D*
     D* int stat(const char *path, struct stat *buf)
     D*--------------------------------------------------------------------
     D stat PR 10I 0 ExtProc('stat')
     D path * value
     D buf * value
     D*--------------------------------------------------------------------
     D* Make Symbolic Link
     D*
     D* int symlink(const char *pname, const char *slink)
     D*--------------------------------------------------------------------
     D symlink PR 10I 0 ExtProc('symlink')
     D pname * value
     D slink * value
     D*--------------------------------------------------------------------
     D* Get system configuration variables
     D*
     D* long sysconf(int name)
     D*--------------------------------------------------------------------
     D sysconf PR 10I 0 ExtProc('sysconf')
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Set Authorization Mask for Job
     D*
     D* mode_t umask(mode_t cmask)
     D*--------------------------------------------------------------------
     D umask PR 10U 0 ExtProc('umask')
     D cmask 10U 0 Value
     D*--------------------------------------------------------------------
     D* Remove Link to File. (Deletes Directory Entry for File, and if
     D* this was the last link to the file data, the file itself is
     D* also deleted)
     D*
     D* int unlink(const char *path)
     D*--------------------------------------------------------------------
     D unlink PR 10I 0 ExtProc('unlink')
     D pa|h * Value
     D*--------------------------------------------------------------------
     D* Set File Access & Modification Times
     D*
     D* int utime(const char *path, const struct utimbuf *times)
     D*--------------------------------------------------------------------
     D utime PR 10I 0 ExtProc('utime')
     D path * value
     D times * value
     D*--------------------------------------------------------------------
     D* Write to a file
     D*
     D* ssize_t write(int fildes, const void *buf, size_t bytes)
     D*--------------------------------------------------------------------
     D write PR 10I 0 ExtProc('write')
     D handle 10I 0 value
     D buffer * value
     D bytes 10U 0 value
     ----------------------------------------------------------------------
     * This header file contains the constants, structures and prototypes
     * for using the Integrated File System API
     *
     * These APIs were designed originally for use in C programming.
     * Therefore bear in mind:
     * 1) All strings must be null-terminated, and variable-length.
     * 2) Errors are returned in the errno variable, and strings for
     * them are available by calling strerror()
     * 3) To use strerror(), errno, you must bind to the ILE C binding
     * directory QC2LE
     *
     * SCK 03/24/1999
     *
     * To use these in your source code, you need a D-spec like this:
     * D/COPY LIBSOR/QRPGLESRC,IFSIO_H
     * For detailed info seee the UNIX-type APIs manual

     * This header file includes (in order)
     * 1) Constants
     * 2) Structures
     * 3) Prototypes

     D* ascii code-page
     D CP_ASCII C 819
     D*********************************************************************
     D* Flags for use in open()
     D*
     D* More than one can be used -- add them together.
     D*********************************************************************
     D* Reading Only
     D O_RDONLY C 1
     D* Writing Only
     D O_WRONLY C 2
     D* Reading & Writing
     D O_RDWR C 4
     D* Create File if not exist
     D O_CREAT C 8
     D* Exclusively create
     D O_EXCL C 16
     D* Truncate File to 0 bytes
     D O_TRUNC C 64
     D* Append to File
     D O_APPEND C 256
     D* Convert text by code-pag
     D O_CODEPAGE C 8388608
     D* Open in text-mode
     D O_TEXTDATA C 16777216
     D*********************************************************************
     D* Access mode flags for access()
     D*********************************************************************
     D F_OK C 0
     D R_OK C 4
     D W_OK C 2
     D X_OK C 1
     D*********************************************************************
     D* Mode Flags.
     D* basically, the mode parm of open(), creat(), chmod(),etc
     D* uses 9 least significant bits to determine the
     D* file's mode. (peoples access rights to the file)
     D*
     D* user: owner group other
     D* access: R W X R W X R W X
     D* bit: 8 7 6 5 4 3 2 1 0
     D*
     D* (This is accomplished by adding the flags below to get the mode)
     D*********************************************************************
     D* owner authority
     D S_IRUSR C 256
     D S_IWUSR C 128
     D S_IXUSR C 64
     D S_IRWXU C 448
     D* group authority
     D S_IRGRP C 32
     D S_IWGRP C 16
     D S_IXGRP C 8
     D S_IRWXG C 56
     D* other people
     D S_IROTH C 4
     D S_IWOTH C 2
     D S_IXOTH C 1
     D S_IRWXO C 7

     D*********************************************************************
     D* File Information Structure (stat)
     D*
     D* struct stat {
     D* mode_t st_mode; /* File mode *
     D* ino_t st_ino; /* File serial number *
     D* nlink_t st_nlink; /* Number of links *
     D* uid_t st_uid; /* User ID of the owner of file *
     D* gid_t st_gid; /* Group ID of the group of file *
     D* off_t st_size; /* For regular files, the file
     D* * size in bytes *
     D* time_t st_atime; /* Time of last access *
     D* time_t st_mtime; /* Time of last data modification *
     D* time_t st_ctime; /* Time of last file status change *
     D* dev_t st_dev; /* ID of device containing file *
     D* size_t st_blksize; /* Size of a block of the file *
     D* unsigned long st_allocsize; /* Allocation size of the file *
     D* qp0l_objtype_t st_objtype; /* AS/400 object type *
     D* unsigned short st_codepage; /* Object data codepage *
     D* char st_reserved1[66]; /* Reserved *
     D* };
     D*
     D p_statds S *
     D statds DS BASED(p_statds)
     D st_mode 10U 0
     D st_ino 10U 0
     D st_nlink 5U 0
     D st_uid 10U 0
     D st_gid 10U 0
     D st_size 10I 0
     D st_atime 10I 0
     D st_mtime 10I 0
     D st_ctime 10I 0
     D st_dev 10U 0
     D st_blksize 10U 0
     D st_alcsize 10U 0
     D st_objtype 11A
     D st_codepag 5U 0
     D st_resv11 66A

     D*********************************************************************
     D* Group Information Structure (group)
     D*
     D* struct group {
     D* char *gr_name; /* Group name.
     D* gid_t gr_gid; /* Group id.
     D* char **gr_mem; /* A null-terminated list of pointe
     D* to the individual member names.
     D* };
     D*
     D p_group S *
     D group DS Based(p_group)
     D gr_name *
     D gr_gid 10U 0
     D gr_mem * DIM(256)

     D*********************************************************************
     D*
     D* User Information Structure (passwd)
     D*
     D* (Don't let the name fool you, this structure does not contain
     D* any password information. Its named after the UNIX file that
     D* contains all of the user info. That file is "passwd")
     D*
     D* struct passwd {
     D* char *pw_name; /* User name.
     D* uid_t pw_uid; /* User ID number.
     D* gid_t pw_gid; /* Group ID number.
     D* char *pw_dir; /* Initial working directory.
     D* char *pw_shell; /* Initial user program.
     D* };
     D*
     D p_passwd S *
     D passwd DS BASED(p_passwd)
     D pw_name *
     D pw_uid 10U 0
     D pw_gid 10U 0
     D pw_dir *
     D pw_shell *

     D*********************************************************************
     D* File Time Structure (utimbuf)
     D*
     D* struct utimbuf {
     D* time_t actime; /* access time */
     D* time_t modtime; /* modification time */
     D* };
     D*
     D p_utimbuf S *
     D utimbuf DS based(p_utimbuf)
     D actime 10I 0
     D modtime 10I 0

     D*********************************************************************
     D*
     D* Directory Entry Structure (dirent)
     D*
     D* struct dirent {
     D* char d_reserved1[16]; /* Reserved
     D* unsigned int d_reserved2; /* Reserved
     D* ino_t d_fileno; /* The file number of the file
     D* unsigned int d_reclen; /* Length of this directory entr
     D* * in bytes
     D* int d_reserved3; /* Reserved
     D* char d_reserved4[8]; /* Reserved
     D* qlg_nls_t d_nlsinfo; /* National Language Information
     D* * about d_name
     D* unsigned int d_namelen; /* Length of the name, in bytes
     D* * excluding NULL terminator
     D* char d_name[_QP0L_DIR_NAME]; /* Name...null terminated
     D*
     D* };
     D*
     D p_dirent s *
     D dirent ds based(p_dirent)
     D d_reserv1 16A
     D d_reserv2 10U 0
     D d_fileno 10U 0
     D d_reclen 10U 0
     D d_reserv3 10I 0
     D d_reserv4 8A
     D d_nlsinfo 12A
     D nls_ccsid 10I 0 OVERLAY(d_nlsinfo:1)
     D nls_cntry 2A OVERLAY(d_nlsinfo:5)
     D nls_lang 3A OVERLAY(d_nlsinfo:7)
     D nls_reserv 3A OVERLAY(d_nlsinfo:10)
     D d_namelen 10U 0
     D d_name 640A

     D*--------------------------------------------------------------------
     D* Determine file accessibility
     D*
     D* int access(const char *path, int amode)
     D*
     D*--------------------------------------------------------------------
     D access PR 10I 0 ExtProc('access')
     D Path * Value
     D amode 10I 0 Value
     D*--------------------------------------------------------------------
     D* Change Directory
     D*
     D* int chdir(const char *path)
     D*--------------------------------------------------------------------
     D chdir PR 10I 0 ExtProc('chdir')
     D path * Value
     D*--------------------------------------------------------------------
     D* Change file authorizations
     D*
     D* int chmod(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D chmod PR 10I 0 ExtProc('chmod')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Change Owner/Group of File
     D*
     D* int chown(const char *path, uid_t owner, gid_t group)
     D*--------------------------------------------------------------------
     D chown PR 10I 0 ExtProc('chown')
     D path * Value
     D owner 10U 0 Value
     D group 10U 0 Value
     D*--------------------------------------------------------------------
     D* Close a file
     D*
     D* int close(int fildes)
     D*--------------------------------------------------------------------
     D close PR 10I 0 ExtProc('close')
     D handle 10I 0 value
     D*--------------------------------------------------------------------
     D* Close a directory
     D*
     D* int closedir(DIR *dirp)
     D*--------------------------------------------------------------------
     D closedir PR 10I 0 EXTPROC('closedir')
     D dirhandle * VALUE
     D*--------------------------------------------------------------------
     D* Create or Rewrite File
     D*
     D* int creat(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D creat PR 10I 0 ExtProc('creat')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Duplicate open file descriptor
     D*
     D* int dup(int fildes)
     D*--------------------------------------------------------------------
     D dup PR 10I 0 ExtProc('dup')
     D fildes 10I 0 Value
     D*--------------------------------------------------------------------
     D* Duplicate open file descriptor to another descriptor
     D*
     D* int dup2(int fildes, int fildes2)
     D*--------------------------------------------------------------------
     D dup2 PR 10I 0 ExtProc('dup2')
     D fildes 10I 0 Value
     D fildes2 10I 0 Value
     D*--------------------------------------------------------------------
     D* Change file authorizations by descriptor
     D*
     D* int fchmod(int fildes, mode_t mode)
     D*--------------------------------------------------------------------
     D fchmod PR 10I 0 ExtProc('fchmod')
     D fildes 10I 0 Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Change Owner and Group of File by Descriptor
     D*
     D* int fchown(int fildes, uid_t owner, gid_t group)
     D*--------------------------------------------------------------------
     D fchown PR 10I 0 ExtProc('fchown')
     D fildes 10I 0 Value
     D owner 10U 0 Value
     D group 10U 0 Value
     D*--------------------------------------------------------------------
     D* Perform File Control
     D*
     D* int fcntl(int fildes, int cmd, . . .)
     D*--------------------------------------------------------------------
     D fcntl PR 10I 0 ExtProc('fcntl')
     D fildes 10I 0 Value
     D cmd 10I 0 Value
     D arg 10I 0 Value options(*nopass)
     D*--------------------------------------------------------------------
     D* Get configurable path name variables by descriptor
     D*
     D* long fpathconf(int fildes, int name)
     D*--------------------------------------------------------------------
     D fpathconf PR 10I 0 ExtProc('fpathconf')
     D fildes 10I 0 Value
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get File Information by Descriptor
     D*
     D* int fstat(int fildes, struct stat *buf)
     D*--------------------------------------------------------------------
     D fstat PR 10I 0 ExtProc('fstat')
     D fildes 10I 0 Value
     D buf * Value
     D*--------------------------------------------------------------------
     D* Synchronize Changes to fIle
     D*
     D* int fsync(int fildes)
     D*--------------------------------------------------------------------
     D fsync PR 10I 0 ExtProc('fsync')
     D fildes 10I 0 Value
     D*--------------------------------------------------------------------
     D* Truncate file
     D*
     D* int ftruncate(int fildes, off_t length)
     D*--------------------------------------------------------------------
     D ftruncate PR 10I 0 ExtProc('ftruncate')
     D fildes 10I 0 Value
     D length 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get current working directory
     D*
     D* char *getcwd(char *buf, size_t size)
     D*--------------------------------------------------------------------
     D getcwd PR * ExtProc('getcwd')
     D buf * Value
     D size 10U 0 Value
     D*--------------------------------------------------------------------
     D* Get effective group ID
     D*
     D* gid_t getegid(void)
     D*--------------------------------------------------------------------
     D getegid PR 10U 0 ExtProc('getegid')
     D*--------------------------------------------------------------------
     D* Get effective user ID
     D*
     D* uid_t geteuid(void)
     D*--------------------------------------------------------------------
     D geteuid PR 10U 0 ExtProc('geteuid')
     D*--------------------------------------------------------------------
     D* Get Real Group ID
     D*
     D* gid_t getgid(void)
     D*--------------------------------------------------------------------
     D getgid PR 10U 0 ExtProc('getgid')
     D*--------------------------------------------------------------------
     D* Get group information from group ID
     D*
     D* struct group *getgrgid(gid_t gid)
     D*--------------------------------------------------------------------
     D getgrid PR * ExtProc('getgrgid')
     D gid 10U 0 VALUE
     D*--------------------------------------------------------------------
     D* Get group info using group name
     D*
     D* struct group *getgrnam(const char *name)
     D*--------------------------------------------------------------------
     D getgrnam PR * ExtProc('getgrnam')
     D name * VALUE
     D*--------------------------------------------------------------------
     D* Get group IDs
     D*
     D* int getgroups(int gidsetsize, gid_t grouplist[])
     D*--------------------------------------------------------------------
     D getgroups PR * ExtProc('getgroups')
     D gidsetsize 10I 0 VALUE
     D grouplist *
     D*--------------------------------------------------------------------
     D* Get user information by user-name
     D*
     D* (Don't let the name mislead you, this does not return the password,
     D* the user info database on unix systems is called "passwd",
     D* therefore, getting the user info is called "getpw")
     D*
     D* struct passwd *getpwnam(const char *name)
     D*--------------------------------------------------------------------
     D getpwnam PR * ExtProc('getpwnam')
     D name * Value
     D*--------------------------------------------------------------------
     D* Get user information by user-id
     D*
     D* (Don't let the name mislead you, this does not return the password,
     D* the user info database on unix systems is called "passwd",
     D* therefore, getting the user info is called "getpw")
     D*
     D* struct passwd *getpwuid(uid_t uid)
     D*--------------------------------------------------------------------
     D getpwuid PR * extproc('getpwuid')
     D uid 10U 0 Value
     D*--------------------------------------------------------------------
     D* Get Real User-ID
     D*
     D* uid_t getuid(void)
     D*--------------------------------------------------------------------
     D getuid PR 10U 0 ExtProc('getuid')
     D*--------------------------------------------------------------------
     D* Perform I/O Control Request
     D*
     D* int ioctl(int fildes, unsigned long req, ...)
     D*--------------------------------------------------------------------
     D ioctl PR 10I 0 ExtProc('ioctl')
     D fildes 10I 0 Value
     D req 10U 0 Value
     D arg * Value
     D*--------------------------------------------------------------------
     D* Create Link to File
     D*
     D* int link(const char *existing, const char *new)
     D*--------------------------------------------------------------------
     D link PR 10I 0 ExtProc('link')
     D existing * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Set File Read/Write Offset
     D*
     D* off_t lseek(int fildes, off_t offset, int whence)
     D*--------------------------------------------------------------------
     D lseek PR 10I 0 ExtProc('lseek')
     D offset 10I 0
     D whence 10I 0
     D*--------------------------------------------------------------------
     D* Get File or Link Information
     D*
     D* int lstat(const char *path, struct stat *buf)
     D*--------------------------------------------------------------------
     D lstat PR 10I 0 ExtProc('lstat')
     D path * Value
     D buf * Value
     D*--------------------------------------------------------------------
     D* Make Directory
     D*
     D* int mkdir(const char *path, mode_t mode)
     D*--------------------------------------------------------------------
     D mkdir PR 10I 0 ExtProc('mkdir')
     D path * Value
     D mode 10U 0 Value
     D*--------------------------------------------------------------------
     D* Open a File
     D*
     D* int open(const char *path, int oflag, . . .);
     D*--------------------------------------------------------------------
     D open PR 10I 0 ExtProc('open')
     D filename * value
     D openflags 10I 0 value
     D mode 10U 0 value options(*nopass)
     D codepage 10U 0 value options(*nopass)
     D*--------------------------------------------------------------------
     D* Open a Directory
     D*
     D* DIR *opendir(const char *dirname)
     D*--------------------------------------------------------------------
     D opendir PR * EXTPROC('opendir')
     D dirname * VALUE
     D*--------------------------------------------------------------------
     D* Get configurable path name variables
     D*
     D* long pathconf(const char *path, int name)
     D*--------------------------------------------------------------------
     D pathconf PR 10I 0 ExtProc('pathconf')
     D path * Value
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Get path name of object from its file id
     D*
     D* char *Qp0lGetPathFromFileID(char *buf, size_t size,Qp0lFID_t fileid
     D*--------------------------------------------------------------------
     D GetPathFID PR * ExtProc('Qp0lGetPathFromFileID')
     D buf * Value
     D size 10U 0 Value
     D fileid 16A
     D*--------------------------------------------------------------------
     D* Rename File or Directory, return error if a file/dir under the
     D* "new" name already exists.
     D*
     D* int Qp0lRenameKeep(const char *old, const char *new)
     D*--------------------------------------------------------------------
     D Rename PR 10I 0 ExtProc('Qp0lRenameKeep')
     D old * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Rename File or Directory. If another file/dir exists under the
     D* "new" name, delete it first.
     D*
     D* int Qp0lRenameUnlink(const char *old, const char *new)
     D*--------------------------------------------------------------------
     D Replace PR 10I 0 ExtProc('Qp0lRenameUnlink')
     D old * Value
     D new * Value
     D*--------------------------------------------------------------------
     D* Read From a File
     D*
     D* ssize_t read(int handle, void *buffer, size_t bytes);
     D*--------------------------------------------------------------------
     D read PR 10I 0 ExtProc('read')
     D handle 10i 0 value
     D buffer * value
     D bytes 10U 0 value
     D*--------------------------------------------------------------------
     D* Read Directory Entry
     D*
     D* struct dirent *readdir(DIR *dirp)
     D*--------------------------------------------------------------------
     D readdir PR * EXTPROC('readdir')
     D dirp * VALUE
     D*--------------------------------------------------------------------
     D* Read Value of Symbolic Link
     D*
     D* int readlink(const char *path, char *buf, size_t bufsiz)
     D*--------------------------------------------------------------------
     D readlink PR 10I 0 ExtProc('readlink')
     D path * value
     D buf * value
     D bufsiz 10U 0 value
     D*--------------------------------------------------------------------
     D* Reset Directory Stream to Beginning
     D*
     D* void rewinddir(DIR *dirp)
     D*--------------------------------------------------------------------
     D rewinddir PR ExtProc('rewinddir')
     D dirp * value

     D*--------------------------------------------------------------------
     D* Remove Directory
     D*
     D* int rmdir(const char *path)
     D*--------------------------------------------------------------------
     D rmdir PR 10I 0 ExtProc('rmdir')
     D path * value
     D*--------------------------------------------------------------------
     D* Get File Information
     D*
     D* int stat(const char *path, struct stat *buf)
     D*--------------------------------------------------------------------
     D stat PR 10I 0 ExtProc('stat')
     D path * value
     D buf * value
     D*--------------------------------------------------------------------
     D* Make Symbolic Link
     D*
     D* int symlink(const char *pname, const char *slink)
     D*--------------------------------------------------------------------
     D symlink PR 10I 0 ExtProc('symlink')
     D pname * value
     D slink * value
     D*--------------------------------------------------------------------
     D* Get system configuration variables
     D*
     D* long sysconf(int name)
     D*--------------------------------------------------------------------
     D sysconf PR 10I 0 ExtProc('sysconf')
     D name 10I 0 Value
     D*--------------------------------------------------------------------
     D* Set Authorization Mask for Job
     D*
     D* mode_t umask(mode_t cmask)
     D*--------------------------------------------------------------------
     D umask PR 10U 0 ExtProc('umask')
     D cmask 10U 0 Value
     D*--------------------------------------------------------------------
     D* Remove Link to File. (Deletes Directory Entry for File, and if
     D* this was the last link to the file data, the file itself is
     D* also deleted)
     D*
     D* int unlink(const char *path)
     D*--------------------------------------------------------------------
     D unlink PR 10I 0 ExtProc('unlink')
     D pa|h * Value
     D*--------------------------------------------------------------------
     D* Set File Access & Modification Times
     D*
     D* int utime(const char *path, const struct utimbuf *times)
     D*--------------------------------------------------------------------
     D utime PR 10I 0 ExtProc('utime')
     D path * value
     D times * value
     D*--------------------------------------------------------------------
     D* Write to a file
     D*
     D* ssize_t write(int fildes, const void *buf, size_t bytes)
     D*--------------------------------------------------------------------
     D write PR 10I 0 ExtProc('write')
     D handle 10I 0 value
     D buffer * value
     D bytes 10U 0 value

Thanks to Scott Klement
Back

QSRLSAVF & QUI......

The Work with Save File Objects (WRKSAVFOBJ) Utility
 Robin Klima - 12:01am Nov 1, 1995 PST
 MC Press Online

Save files are a versatile type of AS/400 object. You can use save
files to compress and store AS/400 objects and libraries to disk.
The contents of save files can be saved to offline storage as part
of a backup strategy. Save files can also be used as containers for
sending objects over a SNADS network.

OS/400 provides a number of commands that allow you to interact with
save files. Surprisingly enough, however, there are no commands in
the operating system that allow you to "work with" the contents of
a save file. The closest command is Display Save File (DSPSAVF),
which only lets you view the contents of a save file. In this article,
I'll introduce you to a command that overcomes this limitation. The
Work with Save File Objects (WRKSAVFOBJ) command presents a list of
objects in a save file and allows you to select objects that you want
to restore.

This command is useful because it can save you time when you need to
restore individual objects from a save file. It accomplishes this by
combining several steps into one. For example, suppose you want to
restore some objects from a save file, but you don't know the exact
names of the objects. Using native OS/400 commands, you need to first
run the DSPSAVF command, then either write down the names of the
objects you want to restore or, if you requested a listing, send the
output to a printer. Finally, you need to return to a command line,
prompt the Restore Object (RSTOBJ) command, and begin keying object
names. This can be a time-consuming and possibly error-prone task.

Given the same scenario, the WRKSAVFOBJ command makes this task much
easier. You just need to enter the command followed by the name of the
save file. You are presented with a display showing a list of all of
the objects in the save file. As you find objects you want to restore,
you simply select them from the list and press Enter to restore them to
the system. I'll discuss a number of other features to this command
shortly, but this gives you the basic idea for the purpose for this
command.

As I describe this utility, you'll notice that it has functionality
similar to many other commands in OS/400. This is because I designed
this application to use a UIM list panel (see "UIM List Panels," MC,
July 1994). UIM provides a very consistent user interface that IBM uses
extensively throughout OS/400. UIM list panels provide functionality
similar to subfiles, but require much less code. This utility also takes
advantage of several system application program interfaces (APIs) to
accomplish its task.

APIs

In addition to calling APIs to interact with the list panel, the SAV001RG
program also calls APIs to retrieve information about the contents of the
save file. I'll briefly describe all of the APIs used in this program in
the order in which they are called. Refer to Figure 6 to see the syntax
of the API calls.

The List Save File (QSRLSAVF) API loads the user space with information
about the library that the objects in the save file were saved from.

The Retrieve User Space (QUSRTVUS) API is called to retrieve the library
information from the user space.

The Open Display Application (QUIOPNDA) API opens the SAV001PG panel group.

The Put Dialog Variable (QUIPUTV) API updates the value of the dialog
variables in the "header" variable record by passing a buffer containing
the new values.

The QSRLSAVF API loads the user space with information about the objects
in the save file.

The QUSRTVUS API is called a second time to retrieve the object information
from the user space.

The Add List Entry API (QUIADDLE) API adds an entry to the list panel
(similar to adding a record to a subfile).

The Display Panel (QUIDSPP) API displays the panel and waits for the user
to press F3 or F12.

The Close Application (QUICLOA) API closes the UIM panel group.


 /*===============================================================*/
 /* To compile:                                                   */
 /*                                                               */
 /*           CRTCMD     CMD(XXX/WRKSAVFOBJ) PGM(XXX/SAV001CL) +  */
 /*                        SRCFILE(XXX/QCMDSRC)                   */
 /*                                                               */
 /*===============================================================*/
              CMD        PROMPT('Work with Save File Objects')

              PARM       KWD(SAVF) TYPE(QUAL) MIN(1) PROMPT('Save file')

              PARM       KWD(OBJ) TYPE(*GENERIC) DFT(*ALL) +
                           SPCVAL((*ALL)) PROMPT('Object')

              PARM       KWD(OBJTYP) TYPE(*CHAR) LEN(10) RSTD(*YES) +
                           DFT(*ALL) VALUES(*ALRTBL *BNDDIR *CFGL +
                           *CHTFMT *CLD *CLS *CMD *CRQD *CSI *CSPMAP +
                           *CSPTBL *DTAARA *DTAQ *EDTD *EXITRG *FCT +
                           *FILE *FNTRSC *FORMDF *FTR *GSS *JOBD +
                           *JOBQ *JOBSCD *JRN *JRNRCV *MENU *MODULE +
                           *MSGF *MSGQ *NODL *OUTQ *OVL *PAGDFN +
                           *PAGSEG *PDG *PGM *PNLGRP *PRDAVL *PRDDFN +
                           *PRDLOD *QMFORM *QMQRY *QRYDFN *RCT *SBSD +
                           *SCHIDX *SPADCT *SQLPKG *SRVPGM *SSND +
                           *SVRSTG *S36 *TBL *USRIDX *USRQ *USRSPC +
                           *WSCST) SPCVAL((*ALL)) PROMPT('Object type')

  QUAL:       QUAL       TYPE(*NAME) LEN(10)
              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
                           SPCVAL((*LIBL)) PROMPT('Library')


 /*===============================================================*/
 /* To compile:                                                   */
 /*                                                               */
 /*           CRTCLPGM   PGM(XXX/SAV001CL) SRCFILE(XXX/QCLSRC)    */
 /*                                                               */
 /*===============================================================*/
              PGM        PARM(&SAVF &OBJ &OBJTYP)

              DCL        VAR(&SAVF) TYPE(*CHAR) LEN(20)
              DCL        VAR(&OBJ) TYPE(*CHAR) LEN(10)
              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)
              DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)
              DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
              DCL        VAR(&ERRDTA) TYPE(*CHAR) LEN(10)
              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(80)

              /* Send all errors to error handling routine */
              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

              /* Don't allow this command to be called recursively */
              SNDPGMMSG  MSG(' ') TOPGMQ(*SAME (SAV001RG))
              MONMSG     MSGID(CPF2469) EXEC(GOTO CMDLBL(CONTINUE))
              RMVMSG     PGMQ(*SAME (SAV001RG)) CLEAR(*ALL)
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Command +
                           WRKSAVFOBJ already in use within this +
                           job') MSGTYPE(*ESCAPE)

              /* Check to be sure file exists */
  CONTINUE:   CHKOBJ     OBJ(%SST(&SAVF 11 10)/%SST(&SAVF 1 10)) +
                           OBJTYPE(*FILE)

              /* Check to be sure file is a save file */
              RTVOBJD    OBJ(%SST(&SAVF 11 10)/%SST(&SAVF 1 10)) +
                           OBJTYPE(*FILE) RTNLIB(&RTNLIB) +
                           OBJATR(&OBJATR)
              IF         COND(&OBJATR *NE 'SAVF') THEN(SNDPGMMSG +
                           MSGID(CPF3782) MSGF(QCPFMSG) +
                           MSGDTA(&SAVF) MSGTYPE(*ESCAPE))
              CHGVAR     VAR(%SST(&SAVF 11 10)) VALUE(&RTNLIB)

              /* Re-create the user space */
              DLTUSRSPC  USRSPC(QTEMP/SAV001US)
              MONMSG     MSGID(CPF0000)
              CALL       PGM(QUSCRTUS) PARM('SAV001US  QTEMP' '' +
                           100000 '' '*ALL' '')

              /* Call program to display save file information */
              CALL       PGM(SAV001RG) PARM(&SAVF &OBJ &OBJTYP &ERRDTA)
              IF         COND(&ERRDTA *EQ '*EMPTY') THEN(SNDPGMMSG +
                           MSGID(CPF3707) MSGF(QCPFMSG) +
                           MSGDTA(&SAVF) MSGTYPE(*ESCAPE))
              ELSE       CMD(IF COND(&ERRDTA *NE ' ') THEN(SNDPGMMSG +
                           MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Save +
                           file data generated with' *BCAT &ERRDTA +
                           *BCAT 'command not supported') +
                           MSGTYPE(*ESCAPE)))

              /* Branch around error handling routine */
              GOTO       CMDLBL(ENDPGM)

              /* Error handling routine */
  ERROR:      RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID)
              SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
                           MSGTYPE(*ESCAPE)
  ENDPGM:     ENDPGM


 .*===================================================================*
 .* To compile:                                                       *
 .*                                                                   *
 .*           CRTPNLGRP  PNLGRP(XXX/SAV001PG) SRCFILE(XXX/QPNLSRC)    *
 .*                                                                   *
 .*===================================================================*
 :PNLGRP.
 .*====================================================================
 .* Class Definitions
 .*====================================================================
 :CLASS    NAME=optcls   BASETYPE=action.
 :ECLASS.
 :CLASS    NAME=objcls   BASETYPE='OBJNAME 10'.
 :ECLASS.
 :CLASS    NAME=typcls   BASETYPE='CHAR 7'.
 :ECLASS.
 :CLASS    NAME=txtcls   BASETYPE='CHAR 40'.
 :ECLASS.
 :CLASS    NAME=prmcls   BASETYPE='CHAR 255'.
 :ECLASS.
 .*====================================================================
 .* Variable Definitions
 .*====================================================================
 :VAR      NAME=sfn      CLASS=objcls.
 :VAR      NAME=sfl      CLASS=objcls.
 :VAR      NAME=cmd      CLASS=objcls.
 :VAR      NAME=ofl      CLASS=objcls.
 :VAR      NAME=lib      CLASS=objcls.
 :VAR      NAME=tfl      CLASS=objcls.
 :VAR      NAME=opt      CLASS=optcls.
 :VAR      NAME=obj      CLASS=objcls.
 :VAR      NAME=typ      CLASS=typcls.
 :VAR      NAME=atr      CLASS=objcls.
 :VAR      NAME=txt      CLASS=txtcls.
 :VAR      NAME=prm      CLASS=prmcls.
 .*====================================================================
 .* Variable Record and List Definitions
 .*====================================================================
 :VARRCD  NAME=header    VARS='sfn sfl cmd ofl lib tfl'
          NOGET='sfn sfl cmd ofl lib tfl'.
 :VARRCD  NAME=detail    VARS='opt obj typ atr txt'
          NOGET='obj typ atr txt'.
 :LISTDEF NAME=detlst    VARS='opt obj typ atr txt'
          MSGID=EDT0417  MSGF='QPDA/QEDTMSG'.
 .*====================================================================
 .* Key Definitions
 .*====================================================================
 :KEYL  NAME=fkeys.
 :KEYI  KEY=enter    HELP=hlp  ACTION=enter.
 :KEYI  KEY=help     HELP=hlp  ACTION=help.
 :KEYI  KEY=f1       HELP=hlp  ACTION=help.
 :KEYI  KEY=f3       HELP=hlp  ACTION=exit     VARUPD=no  .F3=Exit
 :KEYI  KEY=f4       HELP=hlp  ACTION=prompt              .F4=Prompt
 :KEYI  KEY=f9       HELP=hlp  ACTION=retrieve            .F9=Retrieve
 :KEYI  KEY=f12      HELP=hlp  ACTION=cancel   VARUPD=no  .F12=Cancel
 :KEYI  KEY=pagedown HELP=hlp  ACTION=pagedown.
 :KEYI  KEY=pageup   HELP=hlp  ACTION=pageup.
 :KEYI  KEY=print    HELP=hlp  ACTION=print.
 :EKEYL.
 .*====================================================================
 .* Panel Definition
 .*====================================================================
 :PANEL NAME=SAV001PG KEYL=fkeys HELP=hlp
        TOPSEP=space .Work with Save File Objects
 :DATA     DEPTH=4         LAYOUT=2    compact.
 :DATACOL  WIDTH=19.
 :DATACOL  WIDTH='*'.
 :DATAGRP  GRPSEP=qindent  compact.
 :DATAI    VAR=sfn         HELP=hlp    USAGE=out  .Save file
 :DATAI    VAR=sfl         HELP=hlp    USAGE=out  .Library
 :EDATAGRP.
 :DATAI    VAR=cmd         HELP=hlp    USAGE=out  .Save command
 :DATAGRP  GRPSEP=qindent  compact.
 :DATAI    VAR=ofl         HELP=hlp    USAGE=out  .Object
 :DATAI    VAR=lib         HELP=hlp    USAGE=out  .Library
 :EDATAGRP.
 :DATAI    VAR=tfl         HELP=hlp    USAGE=out  .Object type
 :EDATA.
 :LIST     DEPTH=14  LISTDEF=detlst  MAXHEAD=1  ACTOR=uim  PARMS=prm.
 :TOPINST .Type options, press Enter.
 :LISTACT  ENTER='CMD RSTOBJ OBJ(&obj.) SAVLIB(&lib.) DEV(*SAVF)'
           ENTER='OBJTYPE(&typ.) SAVF(&sfl./&sfn.) &prm.'
           PROMPT='CMD ?RSTOBJ ?*OBJ(&obj.) ?*SAVLIB(&lib.)'
           PROMPT='?*DEV(*SAVF) ?*OBJTYPE(&typ.) ?*SAVF(&sfl./&sfn.)'
           PROMPT='&prm.' HELP=hlp OPTION=1  .1=Restore object
 :LISTCOL  VAR=opt   USAGE=inout   MAXWIDTH=3   HELP=hlp  .Opt
 :LISTCOL  VAR=obj   USAGE=out     MAXWIDTH=10  HELP=hlp  .Object
 :LISTCOL  VAR=typ   USAGE=out     MAXWIDTH=7   HELP=hlp  .Type
 :LISTCOL  VAR=atr   USAGE=out     MAXWIDTH=10  HELP=hlp  .Attribute
 :LISTCOL  VAR=txt   USAGE=out     MAXWIDTH=40  HELP=hlp  .Text
 :LISTVIEW COLS='opt obj typ atr txt'.
 :ELIST.
 :CMDLINE  SIZE=short  .Parameters or command
 :EPANEL.
 .*====================================================================
 .* Help Module
 .*====================================================================
 :HELP     NAME=hlp.
 :EHELP.
 :EPNLGRP.


  *===============================================================
  * To compile:
  *
  *      CRTRPGPGM  PGM(XXX/SAV001RG) SRCFILE(XXX/QRPGSRC)
  *
  *===============================================================
  *. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
 IGENDS       DS
 I                                    B 125 1280OFFLST
 I                                    B 133 1360NUMLST
 I                                    B 137 1400SIZENT
 ILIBINF      DS                             72
 I                                        1  10 SAVLIB
 I                                       11  20 SAVCMD
 I                                       11  16 SAVCM6
 IOBJINF      DS                            204
 I                                        1  10 OBJNAM
 I                                       21  30 OBJTYP
 I                                       31  40 OBJATR
 I                                      155 194 OBJTXT
 ILIBBUF      DS
 I                                        1  10 SFN
 I                                       11  20 SFL
 I                                       21  30 CMD
 I                                       31  40 OFL
 I                                       41  50 LIB
 I                                       51  60 TFL
 IOBJBUF      DS
 I                                    B   1   20OPT
 I                                        3  12 OBJ
 I                                       13  19 TYP
 I                                       20  29 ATR
 I                                       30  69 TXT
 I           IDS
 I I            'SAV001US  QTEMP     '    1  20 USRSPC
 I I            'SAV001PG  *LIBL     '   21  40 PNLGRP
 I                                    B  41  440STRPOS
 I                                    B  45  480STRLEN
 I                                    B  49  520LENSPC
 I                                    B  53  560STKCNT
 I                                    B  57  600APPSCP
 I                                    B  61  640EXTPRM
 I                                    B  65  680ERRCOD
 I                                    B  69  720FKEY
 I                                    B  73  760VARLEN
  *===============================================================
 C           *ENTRY    PLIST
 C                     PARM           SAVF   20
 C                     PARM           OBJFLT 10
 C                     PARM           TYPFLT 10
 C                     PARM           ERRDTA 10
  *
  * Load user space with library level information
 C                     MOVEL'SAVF0100'FMTNAM  8
 C                     EXSR LODSPC
  *
  * Get library level information from user space
 C                     CALL 'QUSRTVUS'
 C                     PARM           USRSPC
 C                     PARM           STRPOS
 C                     PARM           STRLEN
 C                     PARM           LIBINF
  *
  * Perform error checking selection
 C                     SELEC
  *
  * If no data issue message
 C           SAVLIB    WHEQ *BLANKS
 C                     MOVEL'*EMPTY'  ERRDTA
  *
  * If unsupported save command issue message
 C           SAVCM6    WHNE 'SAVLIB'
 C           SAVCM6    ANDNE'SAVOBJ'
 C           SAVCM6    ANDNE'SAVCHG'
 C                     MOVELSAVCMD    ERRDTA
  *
  * Otherwise process data
 C                     OTHER
 C                     EXSR PROCES
 C                     ENDSL
  *
 C                     MOVE *ON       *INLR
  *===============================================================
 C           LODSPC    BEGSR
  *
  * Call the list save file API
 C                     CALL 'QSRLSAVF'
 C                     PARM           USRSPC
 C                     PARM           FMTNAM
 C                     PARM           SAVF
 C                     PARM           OBJFLT
 C                     PARM           TYPFLT
 C                     PARM *BLANKS   CNTHND 36
 C                     PARM 0         ERRCOD
  *
  * Retrieve the generic header
 C                     Z-ADD1         STRPOS
 C                     Z-ADD140       STRLEN
  *
 C                     CALL 'QUSRTVUS'
 C                     PARM           USRSPC
 C                     PARM           STRPOS
 C                     PARM           STRLEN
 C                     PARM           GENDS
  *
  * Calculate starting position and length
 C           OFFLST    ADD  1         STRPOS
 C                     Z-ADDSIZENT    STRLEN
  *
 C                     ENDSR
  *===============================================================
 C           PROCES    BEGSR
  *
  * Open display application
 C                     CALL 'QUIOPNDA'
 C                     PARM           HANDLE  8
 C                     PARM           PNLGRP
 C                     PARM -1        APPSCP
 C                     PARM           EXTPRM
 C                     PARM 'N'       FULHLP  1
 C                     PARM 0         ERRCOD
  *
  * Put the library level information on the screen
 C                     MOVELSAVF      SFN
 C                     MOVE SAVF      SFL
 C                     MOVELSAVCMD    CMD
 C                     MOVELOBJFLT    OFL
 C                     MOVELSAVLIB    LIB
 C                     MOVELTYPFLT    TFL
  *
 C                     CALL 'QUIPUTV'
 C                     PARM           HANDLE
 C                     PARM           LIBBUF
 C                     PARM 60        VARLEN
 C                     PARM 'HEADER'  RCDNAM 10
 C                     PARM 0         ERRCOD
  *
  * Load user space with object level information
 C                     MOVEL'SAVF0200'FMTNAM
 C                     EXSR LODSPC
 C                     MOVEL'FRST'    OPTION  4
  *
  * Get object level information from user space
 C                     DO   NUMLST
 C                     CALL 'QUSRTVUS'
 C                     PARM           USRSPC
 C                     PARM           STRPOS
 C                     PARM           STRLEN
 C                     PARM           OBJINF
  *
  * Exclude library objects from list
 C           OBJTYP    IFNE '*LIB'
 C                     Z-ADD0         OPT
 C                     MOVELOBJNAM    OBJ
 C                     MOVELOBJTYP    TYP
 C                     MOVELOBJATR    ATR
 C                     MOVELOBJTXT    TXT
  *
  * Add a list entry to the screen
 C                     CALL 'QUIADDLE'
 C                     PARM           HANDLE
 C                     PARM           OBJBUF
 C                     PARM 69        VARLEN
 C                     PARM 'DETAIL'  RCDNAM 10
 C                     PARM 'DETLST'  LSTNAM 10
 C                     PARM           OPTION
 C                     PARM           LEHNDL  4
 C                     PARM 0         ERRCOD
  *
 C                     MOVEL'NEXT'    OPTION
 C                     ENDIF
  *
  * Calculate position of next entry
 C                     ADD  SIZENT    STRPOS
 C                     ENDDO
  *
  * Display the panel
 C                     CALL 'QUIDSPP'
 C                     PARM           HANDLE
 C                     PARM           FKEY
 C                     PARM 'SAV001PG'PNLNAM 10
 C                     PARM 'N'       REDSPO  1
 C                     PARM 0         ERRCOD
  *
  * Close the application
 C                     CALL 'QUICLOA'
 C                     PARM           HANDLE  8
 C                     PARM 'M'       CLSOPT  1
 C                     PARM 0         ERRCOD
  *
 C                     ENDSR


The full article can be found here: MC Press Online

Thanks to Robin Klima
Back

More Prototypes for QSY... a.o.

Override group profile - CPP


     **
     **  Program . . : CBX128
     **  Description : Override group profile - CPP
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : December 16, 2004
     **
     **
     **  Program summary
     **  ---------------
     **
     **  Unix type APIs:
     **    getgrnam      Get group information Returns a pointer to a structure
     **                  using group name      containing group profile name,
     **                                        group ID and a list of the user
     **                                        profiles that are members of
     **                                        the group - based on the group
     **                                        profile input parameter.
     **
     **    getegid       Get effective         Returns the effective group ID -
     **                  group ID              the group profile under which the
     **                                        calling job is currently running.
     **                                        The effective gid of a thread may
     **                                        change while the thread is running.
     **
     **    qsysetegid    Set effective         Sets the effective group
     **                  group ID              ID of the current job to
     **                                        the gid specified.
     **
     **  MI builtins:
     **    _MODINVAU     Modify invocation     Sets the authority propagation
     **                  authority attribute   attribute for the current
     **                                        invocation of a program without
     **                                        affecting the program object
     **                                        permanently.  The propagation
     **                                        attribute controls if adopted
     **                                        authority should be passed to
     **                                        programs higher in the call
     **                                        stack.
     **
     **  Message handling API:
     **    QMHSNDPM      Send program message  Sends a message to a program stack
     **                                        entry (current, previous, etc.) or
     **                                        an external message queue.
     **
     **                                        Both messages defined in a message
     **                                        file and immediate messages can be
     **                                        used. For specific message types
     **                                        only one or the other is allowed.
     **
     **  Work management API:
     **    QUSRJOBI       Retrieve job         Retrieves specific information
     **                   information          about a specific job, covering
     **                                        all attributes and other state
     **                                        and runtime related information.
     **
     **  Journal & commit API:
     **    QJOSJRNE       Send journal entry   Writes a single journal entry to a
     **                                        specific journal.  The entry can
     **                                        contain any information.  You can
     **                                        assign an entry type to the
     **                                        journal entry.
     **
     **  Security-related APIs:
     **    QsyGenPrfTknE              Verifies that the caller has authority to
     **                               generate a profile token for the requested
     **                               profile and then generates a profile token.
     **
     **                               This profile token can be passed to one or
     **                               more additional processes which can then
     **                               use it to perform tasks on behalf of the
     **                               authenticated user.
     **
     **                               A maximum of approximately 2,000,000
     **                               profile tokens can be generated on a
     **                               system. At that point further profile
     **                               tokens can only be generated after one
     **                               or more tokens have been removed.
     **
     **                               APIs are available to remove all profile
     **                               tokens generated for a specific user or
     **                               systemwide: QsyRemoveAllPrfTknsForUser
     **                               respectively QsyRemoveAllPrfTkns.
     **
     **                               Introduced on V5R1, the QsyGenPrfTkn API
     **                               is available on V4R5.
     **
     **    QsyChkPrfTknUser           Verifies that the user profile associated
     **                               with the token is the same as the current
     **                               user profile. Introduced on V5R1.
     **
     **    QsyGetPrfTknTimeOut        Gets the number of seconds until a profile
     **                               token is no longer valid.
     **
     **    QsyRemovePrfTkn            Removes the specified profile token. The
     **                               profile token will no longer be valid for
     **                               use with other profile token APIs.
     **
     **
     **  Authority and security restrictions:
     **    To successfully run this program *ALLOBJ special authority is
     **    necessary.  The required authority can be obtained by means of
     **    adopted authority:
     **
     **    -  Change the program object's USRPRF attribute to *OWNER using
     **       the CHGPGM command.
     **
     **    -  Change the program object owner to QSECOFR using the CHGOBJOWN
     **       command.
     **
     **    If you successfully follow the compile and setup instructions below,
     **    the program will be capable of performing the necessary operations.
     **
     **    The adopted authority will not be propagated to higher invocation
     **    levels in the job running this program due to the propagation block
     **    enforced by the _MODINVAU MI builtin.
     **
     **
     **  Compile and setup instructions:
     **    CrtRpgMod   Module( CBX128 )
     **                DbgView( *NONE )
     **                Aut( *USE )
     **
     **    CrtPgm      Pgm( CBX128 )
     **                Module( CBX128 )
     **                ActGrp( *NEW )
     **                UsrPrf( *OWNER )
     **                Aut( *USE )
     **
     **    ChgObjOwn   Obj( CBX128 )
     **                ObjType( *PGM )
     **                NewOwn( QSECOFR )
     **
     **    ChgPgm      Pgm( CBX128 )
     **                RmvObs( *ALL )
     **
     **
     **-- Control specifications:  -------------------------------------------**
     H Option( *SrcStmt )  BndDir( 'QC2LE' )
     **-- API error information:
     D ERRC0100        Ds                  Qualified
     D  BytPro                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      256a
     **-- System information:
     D PgmSts         SDs                  Qualified
     D  PgmNam           *Proc
     D  MsgId                         7a   Overlay( PgmSts:  40 )
     D  Msg                          80a   Overlay( PgmSts:  91 )
     D  CurJob                       10a   Overlay( PgmSts: 244 )
     D  UsrPrf                       10a   Overlay( PgmSts: 254 )
     D  JobNbr                        6a   Overlay( PgmSts: 264 )
     D  CurUsr                       10a   Overlay( PgmSts: 358 )
     **-- group structure:
     D Group           Ds                  Based( pGroup )  Align
     D  gr_name                        *
     D  gr_gid                       10u 0
     D  gr_mbr                         *
     **-- Global variables:
     D rc              s             10i 0
     D egid_t          s             10i 0
     D gid_t           s             10i 0
     D PrfChk          s             10i 0
     D TknTmo          s             10i 0
     **
     D MsgKey          s              4a
     D RtnCod          s              1a
     **-- _MODINVAU constants:
     D ADP_AUT_PPG     c                   x'00'
     D ADP_AUT_BLK     c                   x'01'
     **-- Get group information using group name:
     D getgrnam        Pr              *   ExtProc( 'getgrnam' )
     D                                 *   Value  Options( *String )
     **-- Get effective group ID:
     D getegid         Pr            10i 0 ExtProc( 'getegid' )
     **-- Set effective group ID:
     D setegid         Pr            10i 0 ExtProc( 'qsysetegid' )
     D                               10u 0 Value
     **-- Check profile token user:
     D ChkPrfTkn       Pr                  ExtProc( 'QsyChkPrfTknUser' )
     D  CtChkRes                     10i 0
     D  CtPrfTkn                     32a   Const
     D  CtError                   32767a          Options( *VarSize )
     **-- Get profile token time out:
     D GetTknTmo       Pr                  ExtProc( 'QsyGetPrfTknTimeOut' )
     D  GtTknTmo                     10i 0
     D  GtPrfTkn                     32a   Const
     D  GtError                   32767a          Options( *VarSize )
     **-- Remove profile token:
     D RmvPrfTkn       Pr                  ExtProc( 'QsyRemovePrfTkn' )
     D  RtPrfTkn                     32a   Const
     D  RtError                   32767a          Options( *VarSize )
     **-- Error number:
     D sys_errno       Pr              *    ExtProc( '__errno' )
     **-- Error string:
     D sys_strerror    Pr              *    ExtProc( 'strerror' )
     D  errno                        10i 0  Value
     **-- Modify invocation authority attribute:
     D ModInvAutA      Pr                  ExtProc( '_MODINVAU' )
     D  MiAutAtr                      1a   Const
     **-- Command entry:
     D CmdEntry        Pr                  ExtPgm( 'QCMD' )
     **-- Retrieve job information:
     D RtvJobInf       Pr                  ExtPgm( 'QUSRJOBI' )
     D  JiRcvVar                  32767a          Options( *VarSize )
     D  JiRcvVarLen                  10i 0 Const
     D  JiFmtNam                      8a   Const
     D  JiJobNamQ                    26a   Const
     D  JiJobIntId                   16a   Const
     D  JiError                   32767a          Options( *NoPass: *VarSize )
     D  JiRstStc                      1a          Options( *NoPass )
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  SpMsgId                       7a   Const
     D  SpMsgFq                      20a   Const
     D  SpMsgDta                    128a   Const
     D  SpMsgDtaLen                  10i 0 Const
     D  SpMsgTyp                     10a   Const
     D  SpCalStkE                    10a   Const  Options( *VarSize )
     D  SpCalStkCtr                  10i 0 Const
     D  SpMsgKey                      4a
     D  SpError                   32767a          Options( *VarSize )
     **-- Send journal entry:
     D SndJrnE         Pr                  ExtPgm( 'QJOSJRNE' )
     D  SjJrnNamQ                    20a   Const
     D  SjJrnEntInf                4096a   Const  Options( *VarSize )
     D  SjEntDta                  32766a   Const  Options( *VarSize )
     D  SjEntDtaLen                  10i 0 Const
     D  SjError                   32767a          Options( *VarSize )
     **
     D JrnEntInf       Ds                  Qualified
     D  InfEntRcds                   10i 0 Inz( 1 )
     D  InfKey                       10i 0 Inz( 1 )
     D  InfLen                       10i 0 Inz( %Size( JrnEntInf.InfDta ))
     D  InfDta                        2a
     **
     D JrnEntA2        Ds                  Qualified
     D  GrpPrf                       10a
     D  AutCod                       10a
     D  Reason                      256a
     **
     D JrnEntA3        Ds                  Qualified
     D  GrpPrf                       10a
     D  AutCod                       10a
     D  RtnCod                        1a

     **-- Send diagnostic message:
     D SndDiagMsg      Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send completion message:
     D SndCmpMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send completion message:
     D SndRqsMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Error identification:
     D errno           Pr            10i 0
     D strerror        Pr           128a   Varying

     **-- Entry parameters:
     D CBX128          Pr
     D  PxGrpPrf                     10a   Varying
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxPrfTkn                     32a
     **
     D CBX128          Pi
     D  PxGrpPrf                     10a   Varying
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxPrfTkn                     32a

      /Free

        RtnCod = '0';

        JrnEntInf.InfDta = 'A2';
        JrnEntA2.GrpPrf  = PxGrpPrf;
        JrnEntA2.AutCod  = PxAutCod;
        JrnEntA2.Reason  = PxReason;

        SndJrnE( 'QAUDJRN   *LIBL '
               : JrnEntInf
               : JrnEntA2
               : %Size( JrnEntA2 )
               : ERRC0100
               );

        ChkPrfTkn( PrfChk: PxPrfTkn: ERRC0100 );

        If  ERRC0100.BytAvl > *Zero  Or  PrfChk = *Zero;
          RtnCod = '1';

        Else;
          GetTknTmo( TknTmo: PxPrfTkn: ERRC0100 );

          If  ERRC0100.BytAvl > *Zero  Or  TknTmo = *Zero;
            RtnCod = '2';

          EndIf;
        EndIf;

        RmvPrfTkn( PxPrfTkn: ERRC0100 );

        If  RtnCod > '0';
          SndDiagMsg( 'Unauthorized program interface.' );

        Else;
          egid_t = getegid();

          pGroup = getgrnam( PxGrpPrf );

          If  pGroup = *Null;

            RtnCod = '3';
            SndDiagMsg( 'Group profile ' + PxGrpPrf + ' does not exist.' );
          Else;

            If  setegid( gr_gid ) = -1;

              RtnCod = '4';
              SndDiagMsg( %Char( errno ) + ': ' + strerror );
            Else;

              SndRqsMsg( '/*-- Group profile override currently active --*/' );

              ModInvAutA( ADP_AUT_BLK );

              CallP(e)  CmdEntry();

              If  %Error;
                RtnCod = '5';
              EndIf;

              ModInvAutA( ADP_AUT_PPG );

              rc = setegid( egid_t );

              SndCmpMsg( 'OVRGRPPRF command ended normally.' );

            EndIf;
          EndIf;
        EndIf;

        JrnEntInf.InfDta = 'A3';
        JrnEntA3.GrpPrf  = PxGrpPrf;
        JrnEntA3.AutCod  = PxAutCod;
        JrnEntA3.RtnCod  = RtnCod;

        SndJrnE( 'QAUDJRN   *LIBL '
               : JrnEntInf
               : JrnEntA3
               : %Size( JrnEntA3 )
               : ERRC0100
               );

          If  RtnCod > '0';
            SndEscMsg( 'OVRGRPPRF command ended in error' );
          EndIf;

        Return;

      /End-Free

     **-- Get runtime error number:  -----------------------------------------**
     P errno           B
     D                 Pi            10i 0
     **
     D Error           s             10i 0  Based( pError )  NoOpt

      /Free

        pError = sys_errno;

        Return  Error;

      /End-Free

     P Errno           E
     **-- Get runtime error text:  -------------------------------------------**
     P strerror        B
     D                 Pi           128a    Varying

      /Free

        Return  %Str( sys_strerror( Errno ));

      /End-Free

     P strerror        E
     **-- Send diagnostic message:  ------------------------------------------**
     P SndDiagMsg      B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying

      /Free

        SndPgmMsg( 'CPF9897'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*DIAG'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return   0;
        EndIf;

      /End-Free

     P SndDiagMsg      E
     **-- Send escape message:  ----------------------------------------------**
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying

      /Free

        SndPgmMsg( 'CPF9898'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*ESCAPE'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return  0;

        EndIf;

      /End-Free

     P SndEscMsg       E
     **-- Send completion message:  ------------------------------------------**
     P SndCmpMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying

      /Free

        SndPgmMsg( 'CPF9897'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*COMP'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return  0;

        EndIf;

      /End-Free

     **
     P SndCmpMsg       E
     **-- Send request message:  ---------------------------------------------**
     P SndRqsMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying

      /Free

        SndPgmMsg( *Blanks
                 : *Blanks
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*RQS'
                 : '*EXT'
                 : *Zero
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return  0;

        EndIf;

      /End-Free

     **
     P SndRqsMsg       E


     **
     **  Program . . : CBX128V
     **  Description : Override group profile - VCP
     **  Author  . . : Carsten Flensburg
     **  Published . : Club Tech iSeries Programming Tips Newsletter
     **  Date  . . . : December 16, 2004
     **
     **
     **  Program description:
     **    This program checks the existence of the specified group profile,
     **    verifies the QSECOFR ownership of the utility validation list,   e
     **    the existence of the system audit journal QAUDJRN as well as the
     **    validity of the specified authorization code.
     **
     **
     **  Compile options:
     **    CrtRpgMod   Module( CBX128V )
     **                DbgView( *NONE )
     **                Aut( *USE )
     **
     **    CrtPgm      Pgm( CBX128V )
     **                Module( CBX128V )
     **                ActGrp( *NEW )
     **                UsrPrf( *OWNER )
     **                Aut( *USE )
     **
     **    ChgObjOwn   Obj( CBX128V )
     **                ObjType( *PGM )
     **                NewOwn( QSECOFR )
     **
     **    ChgPgm      Pgm( CBX128V )
     **                RmvObs( *ALL )
     **
     **
     **
     **-- Control specification:  --------------------------------------------**
     H Option( *SrcStmt )

     **-- System information:
     D PgmSts         SDs                  Qualified
     D  PgmNam           *Proc
     D  CurJob                       10a   Overlay( PgmSts: 244 )
     D  UsrPrf                       10a   Overlay( PgmSts: 254 )
     D  JobNbr                        6a   Overlay( PgmSts: 264 )
     D  CurUsr                       10a   Overlay( PgmSts: 358 )
     **-- API error data structure:
     D ERRC0100        Ds                  Qualified
     D  BytPrv                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      512a
     **-- Global constants:
     D VLD_LST         c                   'CBX128L'
     D QSY_IN_VLDL     c                   0
     D QSY_SYSTEM_ATTR...
     D                 c                   0
     **-- Global variables:
     D AtrDta          Ds                  Qualified
     D  CrtDat                        8a
     D  LstVfyDat                     8a
     D  PwdChgDat                     8a
     D  InvPwdCnt                    10i 0
     **
     D UsrDta          s            128a
     **-- Validation list attribute data:
     D Qsy_Attr_Info_T...
     D                 Ds                  Qualified
     D  Number_Attrs                 10i 0 Inz( 1 )
     D  Res_align                    12a
     D  Attr_Descr                         LikeDs( Qsy_Attr_Descr_T )
     D                                     Inz( *LikeDs )
     **
     D Qsy_Attr_Descr_T...
     D                 Ds                  Qualified
     D  Attr_Location                10i 0 Inz( QSY_IN_VLDL )
     D  Attr_Type                    10i 0 Inz( QSY_SYSTEM_ATTR )
     D  Attr_Res                      8a   Inz( *Allx'00' )
     D  Attr_ID_p                      *
     D  Attr_Other_Descr...
     D                               32a   Inz( *Allx'00' )
     D  Attr_Data_Info...
     D                               96a
     D   Attr_VLDL                         LikeDs( Qsy_In_VLDL_T )
     D                                     Overlay( Attr_Data_Info: 1 )
     D                                     Inz( *LikeDs )
     D   Attr_In_Other...
     D                               96a   Overlay( Attr_Data_Info: 1 )
     D                               64a   Overlay( Attr_In_Other: 33 )
     D                                     Inz( *Allx'00' )
     D  Attr_Other_Data...
     D                               32a   Inz( *Allx'00' )
     **
     D Qsy_In_VLDL_T   Ds                  Qualified
     D  Attr_CCSID                   10i 0 Inz( -1 )
     D  Attr_Len                     10i 0 Inz( 1 )
     D  Attr_Res_1                    8a   Inz( *Allx'00' )
     D  Attr_Value_p                   *
     **
     D Qsy_Rtn_VLDL_Attr_T...
     D                 Ds                  Qualified
     D  Bytes_Returned...
     D                               10i 0
     D  Bytes_Available...
     D                               10i 0
     D  Attr_Len                     10i 0
     D  Attr_CCSID                   10u 0
     D  Attr_Data                          LikeDs( Qsy_Rtn_Entry_Usage_Attr_T )
     **
     D Qsy_Rtn_Entry_Usage_Attr_T...
     D                 Ds
     D  Create_Date                   8a
     D  Last_Used_Date...
     D                                8a
     D  Encr_Data_Chg_Date...
     D                                8a
     D  Not_Valid_Verify_Count...
     D                               10i 0
     **-- Validation list return data:
     D Qsy_Rtn_Vld_Lst_Ent_T...
     D                 Ds                  Qualified
     D  Entry_ID_Info                      LikeDs( Qsy_Entry_ID_Info_T )
     D  Encr_Data_Info...
     D                                     LikeDs( Qsy_Entry_Encr_Data_Info_T )
     D  Entry_Data_Info...
     D                                     LikeDs( Qsy_Entry_Data_Info_T )
     D                                4a
     D  AtrPtr                         *
     **
     D Qsy_Entry_ID_Info_T...
     D                 Ds
     D  Entry_ID_Len                 10i 0
     D  Entry_ID_CCSID...
     D                               10i 0 Inz( 65535 )
     D  Entry_ID                    100a
     **
     D Qsy_Entry_Encr_Data_Info_T...
     D                 Ds
     D  Encr_Data_Len                10i 0
     D  Encr_Data_CCSID...
     D                               10i 0 Inz( 65535 )
     D  Encr_Data                   600a
     **
     D Qsy_Entry_Data_Info_T...
     D                 Ds
     D  Entry_Data_Len...
     D                               10i 0
     D  Entry_Data_CCSID...
     D                               10i 0
     D  Entry_Data                 1000a

     **-- Retrieve object description:
     D RtvObjD         Pr                  ExtPgm( 'QUSROBJD' )
     D  RoRcvVar                  32767a          Options( *VarSize )
     D  RoRcvVarLen                  10i 0 Const
     D  RoFmtNam                      8a   Const
     D  RoObjNamQ                    20a   Const
     D  RoObjTyp                     10a   Const
     D  RoError                   32767a          Options( *VarSize )
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  SpMsgId                       7a   Const
     D  SpMsgFq                      20a   Const
     D  SpMsgDta                    128a   Const
     D  SpMsgDtaLen                  10i 0 Const
     D  SpMsgTyp                     10a   Const
     D  SpCalStkE                    10a   Const  Options( *VarSize )
     D  SpCalStkCtr                  10i 0 Const
     D  SpMsgKey                      4a
     D  SpError                    1024a          Options( *VarSize )
     **-- Find validation list entry:
     D FndVldLst       Pr            10i 0 ExtProc( 'QsyFindValidation+
     D                                     LstEntry' )
     D  FvLstNam                     20a   Const
     D  FvEntId                        *   Value
     D  FvRtnDta                       *   Value
     **-- Find validation list entry attributes:
     D FndVldLstAtr    Pr            10i 0 ExtProc( 'QsyFindValidation+
     D                                     LstEntryAttrs' )
     D  FvLstNam                     20a   Const
     D  FvEntId                        *   Value
     D  FvRtnDta                       *   Value
     D  FvAtrInf                       *   Value
     **-- Verify validation list entry:
     D VfyVldLst       Pr            10i 0 ExtProc( 'QsyVerifyValidation+
     D                                     LstEntry' )
     D  VvLstNam                     20a   Const
     D  VvEntId                        *   Value
     D  VvEncDta                       *   Value
     **-- Generate profile token:
     D GenPrfTkn       Pr                  ExtProc( 'QsyGenPrfTkn' )
     D  GtPrfTkn                     32a
     D  GtUsrPrf                     10a   Const
     D  GtPwd                       512a   Const  Options( *VarSize )
     D  GtTimOutInt                  10i 0 Const
     D  GtPrtTknTyp                   1a   Const
     D  GtError                   32767a          Options( *VarSize )
     **-- Check object existence:
     D ChkObj          Pr            10a
     D  RaObjNam                     10a   Const
     D  RaObjLib                     10a   Const
     D  RaObjTyp                     10a   Const
     **-- Get object owner:
     D GetObjOwn       Pr            10a
     D  PxObjNam                     10a   Const
     D  RaObjLib                     10a   Const
     D  PxObjTyp                     10a   Const
     **-- Verify user password:
     D VfyUsrPwd       Pr            10i 0
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
     D  PxUsrPwd                     10a   Const
     **-- Get usage information:
     D GetUsgInf       Pr            28a
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
     **-- Get user data:
     D GetUsrDta       Pr          1000a   Varying
     D  PxVldLst                     10a   Const
     D  PxVldLstLib                  10a   Const
     D  PxUsrId                      20a   Const
     **-- Send diagnostic message:
     D SndDiagMsg      Pr            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgDta                    512a   Const  Varying
     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgDta                    512a   Const  Varying

     **-- Entry parameters:
     D CBX128V         Pr
     D  PxGrpPrf                     10a   Varying
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxPrfTkn                     32a
     **
     D CBX128V         Pi
     D  PxGrpPrf                     10a   Varying
     D  PxAutCod                     10a
     D  PxReason                    256a   Varying
     D  PxPrfTkn                     32a

      /Free

        Select;
        When  ChkObj( PxGrpPrf: '*LIBL': '*USRPRF' ) = *Off;

          SndDiagMsg( 'CPD0006': '0000Group profile does not exist.' );
          SndEscMsg( 'CPF0002': '' );

        When  ChkObj( 'QAUDJRN': '*LIBL': '*JRN' ) = *Off;

          SndDiagMsg( 'CPD0006': '0000Invalid configuration.  Error code 01.' );
          SndEscMsg( 'CPF0002': '' );

        When  GetObjOwn( VLD_LST: '*LIBL': '*VLDL' ) <> 'QSECOFR';

          SndDiagMsg( 'CPD0006': '0000Invalid configuration.  Error code 02.' );
          SndEscMsg( 'CPF0002': '' );

        Other;

          // Remove the following condition if appropriate:

          If  PxAutCod <> '*NONE';
            ExSr  ChkVldLst;
          EndIf;

          GenPrfTkn( PxPrfTkn
                   : PgmSts.UsrPrf
                   : '*NOPWDCHK'
                   : 10
                   : '1'
                   : ERRC0100
                   );
        EndSl;

        *InLr = *On;
        Return;


        BegSr  ChkVldLst;

          AtrDta = GetUsgInf( VLD_LST
                            : '*LIBL'
                            : PgmSts.UsrPrf + PxGrpPrf
                            );

          If  AtrDta = *Blanks  Or AtrDta.InvPwdCnt > 3;

            SndDiagMsg( 'CPD0006': '0000Invalid authorization code.' );
            SndEscMsg( 'CPF0002': '' );
          EndIf;

          UsrDta = GetUsrDta( VLD_LST
                            : '*LIBL'
                            : PgmSts.UsrPrf + PxGrpPrf
                            );

          Test(ze)  UsrDta;

          If  %Error  Or %Timestamp() > %Timestamp( UsrDta );

            SndDiagMsg( 'CPD0006': '0000Authorization code expired.' );
            SndEscMsg( 'CPF0002': '' );
          EndIf;

          If  VfyUsrPwd( VLD_LST
                       : '*LIBL'
                       : PgmSts.UsrPrf + PxGrpPrf
                       : PxAutCod
                       ) < *Zero;

            SndDiagMsg( 'CPD0006': '0000Invalid authorization code.' );
            SndEscMsg( 'CPF0002': '' );
          EndIf;

        EndSr;

      /End-Free

     **-- Check object existence:  -------------------------------------------**
     P ChkObj          B                   Export
     D                 Pi            10a
     D  RaObjNam                     10a   Const
     D  RaObjLib                     10a   Const
     D  RaObjTyp                     10a   Const
     **
     D OBJD0100        Ds                  Qualified
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0
     D  ObjNam                       10a
     D  ObjLib                       10a
     D  ObjTyp                       10a

      /Free

         RtvObjD( OBJD0100
                : %Size( OBJD0100 )
                : 'OBJD0100'
                : RaObjNam + RaObjLib
                : RaObjTyp
                : ERRC0100
                );

         If  ERRC0100.BytAvl > *Zero;
           Return  *Off;

         Else;
           Return  *On;
         EndIf;

      /End-Free

     P ChkObj          E
     **-- Get object owner:  -------------------------------------------------**
     P GetObjOwn       B                   Export
     D                 Pi            10a
     D  RaObjNam                     10a   Const
     D  RaObjLib                     10a   Const
     D  PxObjTyp                     10a   Const
     **
     D OBJD0100        Ds                  Qualified
     D  BytRtn                       10i 0
     D  BytAvl                       10i 0
     D  ObjNam                       10a
     D  ObjLib                       10a
     D  ObjTyp                       10a
     D  ObjLibRt                     10a
     D  ObjASP                       10i 0
     D  ObjOwn                       10a
     D  ObjDmn                        2a

      /Free

         RtvObjD( OBJD0100
                : %Size( OBJD0100 )
                : 'OBJD0100'
                : RaObjNam + RaObjLib
                : PxObjTyp
                : ERRC0100
                );

         If  ERRC0100.BytAvl > *Zero;
           Return  *Blanks;

         Else;
           Return  OBJD0100.ObjOwn;
         EndIf;

      /End-Free

     P GetObjOwn       E
     **-- Send diagnostic message:  ------------------------------------------**
     P SndDiagMsg      B
     D                 Pi            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a

      /Free

        SndPgmMsg( PxMsgId
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*DIAG'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return   0;
        EndIf;

      /End-Free

     P SndDiagMsg      E
     **-- Send escape message:  ----------------------------------------------**
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a

      /Free

        SndPgmMsg( PxMsgId
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*ESCAPE'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return   0;
        EndIf;

      /End-Free

     P SndEscMsg       E
     **-- Verify user password:  ---------------------------------------------**
     P VfyUsrPwd       B                   Export
     D                 Pi            10i 0
     D  PxVldL                       10a   Const
     D  PxVldLlib                    10a   Const
     D  PxUsrId                      20a   Const
     D  PxUsrPwd                     10a   Const

      /Free

        Reset  Qsy_Entry_ID_Info_T;
        Reset  Qsy_Entry_Encr_Data_Info_T;

        Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
        Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );

        Qsy_Entry_Encr_Data_Info_T.Encr_Data = PxUsrPwd;
        Qsy_Entry_Encr_Data_Info_T.Encr_Data_Len = %Len( %TrimR( PxUsrPwd ));

        Return  VfyVldLst( PxVldL + PxVldLlib
                         : %Addr( Qsy_Entry_ID_Info_T )
                         : %Addr( Qsy_Entry_Encr_Data_Info_T )
                         );

      /End-Free

     P VfyUsrPwd       E
     **-- Get usage information:  --------------------------------------------**
     P GetUsgInf       B                   Export
     D                 Pi            28a
     D  PxVldL                       10a   Const
     D  PxVldLlib                    10a   Const
     D  PxUsrId                      20a   Const

      /Free

        Reset  Qsy_Entry_ID_Info_T;
        Reset  Qsy_Entry_Encr_Data_Info_T;

        Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
        Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );

        Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p = %Alloc( 14 );
        %Str( Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p: 14 ) = 'QsyEntryUsage';

        Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Len =
                                             %Size( Qsy_Rtn_VLDL_Attr_T );

        Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Value_p =
                                             %Addr( Qsy_Rtn_VLDL_Attr_T );

        If  FndVldLstAtr( PxVldL + PxVldLlib
                        : %Addr( Qsy_Entry_ID_Info_T )
                        : %Addr( Qsy_Rtn_Vld_Lst_Ent_T )
                        : %Addr( Qsy_Attr_Info_T )
                        ) = -1;

          Return  *Blanks;
        Else;

          Return  %SubSt( Qsy_Rtn_VLDL_Attr_T.Attr_Data
                        : 1
                        : Qsy_Rtn_VLDL_Attr_T.Attr_Len
                        );
        EndIf;

      /End-Free

     P GetUsgInf       E
     **-- Get user data:  ----------------------------------------------------**
     P GetUsrDta       B                   Export
     D                 Pi          1000a   Varying
     D  PxVldL                       10a   Const
     D  PxVldLlib                    10a   Const
     D  PxUsrId                      20a   Const

      /Free

        Reset  Qsy_Entry_ID_Info_T;

        Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
        Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );

        If  FndVldLst( PxVldL + PxVldLlib
                     : %Addr( Qsy_Entry_ID_Info_T )
                     : %Addr( Qsy_Rtn_Vld_Lst_Ent_T )
                     ) = -1;

          Return  '';
        Else;

          Return  %SubSt( Qsy_Rtn_Vld_Lst_Ent_T.Entry_Data_Info.Entry_Data
                        : 1
                        : Qsy_Rtn_Vld_Lst_Ent_T.Entry_Data_Info.Entry_Data_Len
                        );
        EndIf;

      /End-Free

     P GetUsrDta       E


/*-------------------------------------------------------------------*/
/*                                                                   */
/*  Program . . : CBX128M                                            */
/*  Description : Override group profile - setup                     */
/*  Author  . . : Carsten Flensburg                                  */
/*  Published . : Club Tech iSeries Programming Tips Newsletter      */
/*  Date  . . . : December 16, 2004                                  */
/*                                                                   */
/*                                                                   */
/*  Program function:  Compiles, creates and configures all the      */
/*                     OVRGRPPRF command objects.                    */
/*                                                                   */
/*                     This program expects a single parameter       */
/*                     specifying the library to contain the         */
/*                     command objects.                              */
/*                                                                   */
/*                     Object sources must exist in the respective   */
/*                     source type default source files in the       */
/*                     command object library.                       */
/*                                                                   */
/*  Requirements:      This program must be run by a user profile    */
/*                     having *ALLOBJ special authority.             */
/*                                                                   */
/*                     The system audit journal QAUDJRN must exist   */
/*                     for this utility to run successfully.         */
/*                                                                   */
/*                                                                   */
/*  Compile options:                                                 */
/*    CrtClPgm    Pgm( CBX128M )                                     */
/*                SrcFile( QCLSRC )                                  */
/*                SrcMbr( *PGM )                                     */
/*                                                                   */
/*-------------------------------------------------------------------*/
     Pgm    &UtlLib

     Dcl    &UtlLib         *Char     10

     MonMsg      CPF0000    *N        GoTo Error


     ChkObj      QAUDJRN    *JRN

     CrtRpgMod   &UtlLib/CBX128                  +
                 SrcFile( &UtlLib/QRPGLESRC )    +
                 SrcMbr( *Module )               +
                 DbgView( *NONE )                +
                 Aut( *USE )

     CrtPgm      &UtlLib/CBX128                  +
                 Module( CBX128 )                +
                 ActGrp( *NEW )                  +
                 UsrPrf( *OWNER )                +
                 Aut( *USE )

     ChgObjOwn   Obj( &UtlLib/CBX128 )           +
                 ObjType( *PGM )                 +
                 NewOwn( QSECOFR )

     ChgPgm      Pgm( &UtlLib/CBX128 )           +
                 RmvObs( *ALL )

     CrtRpgMod   &UtlLib/CBX128V                 +
                 SrcFile( &UtlLib/QRPGLESRC )    +
                 SrcMbr( *Module )               +
                 DbgView( *NONE )                +
                 Aut( *USE )

     CrtPgm      &UtlLib/CBX128V                 +
                 Module( CBX128V )               +
                 ActGrp( *NEW )                  +
                 UsrPrf( *OWNER )                +
                 Aut( *USE )

     ChgObjOwn   Obj( &UtlLib/CBX128V )          +
                 ObjType( *PGM )                 +
                 NewOwn( QSECOFR )

     ChgPgm      Pgm( &UtlLib/CBX128V )          +
                 RmvObs( *ALL )

     CrtPnlGrp   &UtlLib/CBX128H                 +
                 SrcFile( &UtlLib/QPNLSRC )      +
                 SrcMbr( *PNLGRP )

     CrtCmd      Cmd( &UtlLib/OVRGRPPRF )        +
                 Pgm( CBX128 )                   +
                 SrcFile( &UtlLib/QCMDSRC )      +
                 SrcMbr( CBX128X )               +
                 VldCkr( CBX128V )               +
                 Allow( *INTERACT )              +
                 HlpPnlGrp( CBX128H )            +
                 HlpId( *CMD )                   +
                 Aut( *EXCLUDE )

     CrtVldL     VldL( &UtlLib/CBX128L )

     ChgObjOwn   Obj( &UtlLib/CBX128L )          +
                 ObjType( *VLDL )                +
                 NewOwn( QSECOFR )

     SndPgmMsg   Msg( 'Command OVRGRPPRF has been'       *Bcat  +
                      'successfully created in library'  *Bcat  +
                      &UtlLib                            *Tcat  +
                      '.' )                                     +
                 MsgType( *COMP )

     Return

/*-- Error handling:  -----------------------------------------------*/
 Error:
     Call        QMHMOVPM    ( '    '                 +
                               '*DIAG'                +
                               x'00000001'            +
                               '*PGMBDY'              +
                               x'00000001'            +
                               x'0000000800000000'    +
                             )

     Call        QMHRSNEM    ( '    '                 +
                               x'0000000800000000'    +
                             )

 EndPgm:
     EndPgm


/*-------------------------------------------------------------------*/
/*                                                                   */
/*  Compile options:                                                 */
/*                                                                   */
/*    CrtCmd     Cmd( OVRGRPPRF )                                    */
/*               Pgm( CBX128 )                                       */
/*               SrcMbr( CBX128X )                                   */
/*               VldCkr( CBX128V )                                   */
/*               Allow( *INTERACT )                                  */
/*               HlpPnlGrp( CBX128H )                                */
/*               HlpId( *CMD )                                       */
/*               Aut( *EXCLUDE )                                     */
/*                                                                   */
/*                                                                   */
/*  Authorize user profiles to command:                              */
/*                                                                   */
/*    GrtObjAut Obj( OVRGRPPRF )                                     */
/*              ObjType( *CMD )                                      */
/*              User(  )                               */
/*              Aut( *USE )                                          */
/*                                                                   */
/*  - Or use the EDTOBJAUT command:                                  */
/*                                                                   */
/*    EdtObjAut Obj( OVRGRPPRF )                                     */
/*              ObjType( *CMD )                                      */
/*                                                                   */
/*                                                                   */
/*-------------------------------------------------------------------*/
      Cmd        Prompt( 'Override Group Profile' )

      PARM       GRPPRF     *Sname      10            +
                 Min( 1 )                             +
                 Vary( *YES *INT2 )                   +
                 Expr( *YES )                         +
                 Prompt( 'Group profile' )

      PARM       AUTCOD     *Char       10            +
                 Min( 1 )                             +
                 Expr( *YES )                         +
                 Prompt( 'Authorization code' )

      PARM       REASON     *Char      256            +
                 Min( 1 )                             +
                 Vary( *YES *INT2 )                   +
                 Expr( *YES )                         +
                 Case( *MIXED )                      +
                 Prompt( 'Reason' )

      PARM       PRFTKN     *Char       32            +
                 Constant( '*PRFTKN' )


.*-----------------------------------------------------------------------**
.*
.*  Compile options:
.*
.*    CrtPnlGrp PnlGrp( CBX128H )
.*              SrcFile( QPNLSRC )
.*              SrcMbr( *PNLGRP )
.*
.*-----------------------------------------------------------------------**
:PNLGRP.
:HELP NAME='OVRGRPPRF'.Override Group Profile - Help
:P.
The Override Group Profile (OVRGRPPRF) command temporarily replaces the
current job's primary group profile with the specified group profile.
During this replacement, any special or object authority coming from
the replaced group profile is suspended, and likewise any object or
special authority provided by the new group profile is activated while
the override is in effect.
:P.
Due to the system authorization algorithm, private authority is always
resolved before group authority when the system performs an authority
lookup.  This has the effect that a user's private authority to an
object always will take precedence over the group's authority,
regardless of the privileges held by the group profile.
:P.
:NT.
All *EXCLUDE private object authorities held by the user running this
command will remain in effect during the override, and the user will
not be able to access these objects, even if the group profile is being
overriden to a group profile having *ALLOBJ special authority.
:ENT.
:NT.
System audit journal QAUDJRN must exist for the OVRGRPPRF command to
run successfully.
:ENT.
:P.
:HP2.Restriction&COLON.:EHP2. This command can only be run in an
interactive environment.
:P.
:EHELP.
:HELP NAME='OVRGRPPRF/GRPPRF'.Group profile (GRPPRF) - Help
:XH3.Group profile (GRPPRF)
:P.
The name of the group profile that the current job should temporarily
have its primary group profile replaced by.
:P.
This is a required parameter.
:P.
:EHELP.
:HELP NAME='OVRGRPPRF/AUTCOD'.Authorization code (AUTCOD) - Help
:XH3.Authorization code (AUTCOD)
:P.
Specify the authorization code that was issued by the security officer
to approve the change of current group profile.
:P.
This is a required parameter.
:P.
:EHELP.
:HELP NAME='OVRGRPPRF/REASON'.Reason (REASON) - Help
:XH3.Reason (REASON)
:P.
Specify the reason for the requested change of current group profile.
:P.
This is a required parameter.
:P.
:EHELP.
:EPNLGRP.

Thanks to Carsten Flensburg writing for
Club Tech iSeries Programming Tips Newsletter
Back

QleActBndPgm & QleGetExp

QleActBndPgm - Activate Bound Program
QleGetExp       - Get Export


     H nomain BndDir('QC2LE')

      ***********************************************************
      * PROTOTYPES
      ***********************************************************
      /COPY QCPYSRC,Activator

      *------------------------------------------*
      *    DYNAMIC
      *------------------------------------------*
      * Retrieve operational descriptor
     D  CEEDOD         PR
     D   ParmNum                     10I 0  const
     D   DescType                    10I 0
     D   DataType                    10I 0
     D   DescInfo1                   10I 0
     D   DescInfo2                   10I 0
     D   Length                      10I 0
     D   UnknownParm                 12A    options(*OMIT)

      * Resolve System Pointer
     DRslvSP           PR              *   extproc('rslvsp') procptr
     D HexType                        2A   value
     D Object                          *   value options(*STRING)
     D Lib                             *   value options(*STRING)
     D Auth                           2A   value

      * Get Object Type Hex Value
     DQLICVTTP         PR                  extpgm('QLICVTTP')
     D CvtType                       10A   const
     D ObjType                       10A   const
     D HexType                        2A
     D ErrorDS                    32767A   options(*VARSIZE:*OMIT) noopt

      * Activate Bound Program
     DQleActBndPgm     PR            10I 0 extproc('QleActBndPgm')
     D SrvPgmPtr                       *   procptr const
     D ActMark                       10I 0 const options(*OMIT)
     D ActInfo                       64A   const options(*OMIT)
     D ActInfoLen                    10I 0 const options(*OMIT)
     D ErrorDS                    32767A   options(*VARSIZE:*OMIT) noopt

      * Get export pointer
     DQleGetExp        PR              *   extproc('QleGetExp') procptr
     D ActMark                       10I 0 const options(*OMIT)
     D ExpNo                         10I 0 const options(*OMIT)
     D ExpNameLen                    10I 0 const options(*OMIT)
     D ExpName                    32767A   const options(*VARSIZE:*OMIT)
     D Exp@                            *   options(*OMIT) procptr
     D ExpType                       10I 0 options(*OMIT)
     D ErrorDS                    32767A   options(*VARSIZE:*OMIT) noopt

      *------------------------------------------*
      *    PRIVATE
      *------------------------------------------*

      * Retrieve System Pointer
     DRtvSysPtr        PR              *   procptr
     D SrvPgm                        10A   value
     D Lib                           10A   value
      ***********************************************************
      *     GLOBALS
      ***********************************************************
     D G_HexType       S              2A   inz(*LOVAL)

     D ErrorDS         DS
     D  Err_BytProv                  10I 0
     D  Err_BytAvail                 10I 0
     D  Err_MsgID                     7A
     D  Err_Rsvd                      1A
     D  Err_Parms                   128A
      ***********************************************************
      *     PUBLIC PROCEDURES
      ***********************************************************
     PActSrvPgm        B                   export
      * Activate Service Program, return Activation Mark
     DActSrvPgm        PI            10I 0
     D SrvPgm                        10A   value
     D Lib                           10A   value

      * Locals:
     D  ActMark        S             10I 0 inz(0)
     D  ActInfo        S             64A

     C                   return    QleActBndPgm(RtvSysPtr(SrvPgm:Lib)
     C                                         :ActMark
     C                                         :ActInfo
     C                                         :%size(ActInfo)
     C                                         :ErrorDS)

     P                 E
      ***********************************************************
     PRtvSrvPgmProc@   B                   export
      * Return procptr to ProcName
     DRtvSrvPgmProc@   PI              *   procptr opdesc
     D ActMark                       10I 0 value
     D ProcName                   32767A   const options(*VARSIZE)

      * Locals:
     D ExpNo           S             10I 0 inz(0)
     D Length          S             10I 0
     D Exp@            S               *   procptr inz(*NULL)
     D ExpType         S             10I 0 inz(0)
     D DescType        S             10I 0
     D DataType        S             10I 0
     D DescInfo1       S             10I 0
     D DescInfo2       S             10I 0

     C                   callp     CEEDOD(2 : DescType : DataType
     C                                   : DescInfo1 : DescInfo2 : Length
     C                                   : *OMIT)

     C                   return    QleGetExp(ActMark
     C                                      :ExpNo
     C                                      :Length
     C                                      :%subst(ProcName:1:Length)
     C                                      :Exp@
     C                                      :ExpType
     C                                      :ErrorDS)

     P                 E
      ***********************************************************
      *     PRIVATE PROCEDURES
      ***********************************************************
     PRtvSysPtr        B
      * Retrieve System Pointer
     DRtvSysPtr        PI              *   procptr
     D SrvPgm                        10A   value
     D Lib                           10A   value

      * Locals:
     D  Auth           S              2A   inz(*LOVAL)

      * get hex value of type '*SRVPGM':
     C                   if        G_HexType=*LOVAL
     C                   callp     QLICVTTP('*SYMTOHEX'
     C                                     :'*SRVPGM'
     C                                     :G_HexType
     C                                     :ErrorDS)
     C                   endif

     C                   if        Err_MsgID<>*BLANKS
     C                   return    *NULL
     C                   endif

      * get service program system pointer:
     C                   return    rslvSP(G_HexType
     C                                   :%trim(SrvPgm)
     C                                   :%trim(Lib)
     C                                   :Auth)

     P                 E
      ***********************************************************

/COPY QCPYSRC,Activator
     *===========================================================*
      * Activate Service Program, return Activation Mark
     DActSrvPgm        PR            10I 0
     D SrvPgm                        10A   value
     D Lib                           10A   value
      *===========================================================*
      * Return procptr to ProcName
     DRtvSrvPgmProc@   PR              *   procptr opdesc
     D ActMark                       10I 0 value
     D ProcName                   32767A   const options(*VARSIZE)
      *===========================================================*

Example of a calling program
      *****************************************************************
     D Example1        pr

      *---------------------------------------------------------------*
      *    This program activates service program SRVPGM1, which has
      *    procedure Proc1.
      *    A pointer to Proc1 is then recovered, and Proc1 is executed.
      *
      *    Note that SRVPGM1 needn't be listed as a BNDSRVPGM when
      *    this program is created.
      *---------------------------------------------------------------*


      /COPY QCPYSRC,Activator
     D Example1        pi

     D ActMark         s             10i 0
     D Proc1           pr                  extproc(Proc1@)
     D Proc1@          s               *   procptr

     C                   eval      ActMark=ActSrvPgm('SRVPGM1'
     C                                              :'*LIBL')
     C                   eval      Proc1@=RtvSrvPgmProc@(ActMark
     C                                                  :'Proc1')
     C                   callp     Proc1


     C                   eval      *INLR=*ON
     C                   return
      *****************************************************************

Thanks to Johny Thompson
Back

Page #5 Page #7

Back