|
midrange.com
On Tue, 12 Jun 2001, Graap, Ken wrote:
>
> Does anyone know of a command or technique, that could be used to check for
> the existence of an IFS file like CHKOBJ can check for the existence of a DB
> file?
As luck would have it, I wrote something like this a few months ago...
IT's written in RPG IV, but designed to be used from CL commands in the
same manner that CHKOBJ is.
Here it is.. hope you find it useful:
Member: CHKIFSOBJ
CMD PROMPT('Check IFS Object')
PARM KWD(OBJ) TYPE(*CHAR) LEN(120) MIN(1) +
CHOICE('Path Name') PROMPT('Name of IFS +
object')
PARM KWD(AUT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*NONE) VALUES(*NONE *EXCLUDE *RWX *RW +
*RX *R *WX *W *X) PROMPT('Authority')
Member: CHKIFSR4
** This is called by the CHKIFSOBJ command to check for
** an object in the IFS, and see if the user has authority
** to that object.
** SCK 04/02/01
**
** To compile:
** CRTBNDRPG PGM(xxx/CHKIFSR4) SRCFILE(xxx/xxx) DBGVIEW(*LIST)
** CRTCMD CMD(CHKIFSOBJ) PGM(xxx/CHKIFSR4) SRCFILE(xxx/xxxx)
**
**
H DFTACTGRP(*NO) ACTGRP(*NEW) BNDDIR('QC2LE')
D**********************************************************************
D* Access mode flags for access()
D*
D* F_OK = File Exists
D* R_OK = Read Access
D* W_OK = Write Access
D* X_OK = Execute or Search
D**********************************************************************
D F_OK C 0
D R_OK C 4
D W_OK C 2
D X_OK C 1
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 Options(*string)
D amode 10I 0 Value
D c_error PR
D peErrMsg 128A const
D error PR
D peMsg 256A const
D wkExists S 1N INZ(*OFF)
D wkReadOk S 1N INZ(*OFF)
D wkWriteOk S 1N INZ(*OFF)
D wkSearchOk S 1N INZ(*OFF)
D wkPos S 10I 0
D peObject S 120A
D peAuthority S 10A
c eval *inlr = *on
C *entry plist
c parm peObject
c parm peAuthority
C* We got parms, right?
c if %parms < 2
c callp error('You must pass the OBJ ' +
c ' and AUT parms to this command')
c return
c endif
C* Validate AUT parm
c if peAuthority <> '*NONE'
c and peAuthority<>'*EXCLUDE'
c and peAuthority<>'*ALL'
c '*RWX' check peAuthority wkPos
c if wkPos > 1
c and %subst(peAuthority:wkpos)<>*blanks
c callp error('''' + peAuthority + ''' not ' +
c 'valid for parameter AUT.')
c return
c endif
c endif
C* Figure out user's access to the file:
c if access(%trim(peObject): F_OK) = 0
c eval wkExists = *On
c if peAuthority <> '*NONE'
c if access(%trim(peObject): R_OK) = 0
c eval wkReadOk = *On
c endif
c if access(%trim(peObject): W_OK) = 0
c eval wkWriteOk = *On
c endif
c if access(%trim(peObject): X_OK) = 0
c eval wkSearchOk = *On
c endif
c endif
c else
c callp c_error('access:')
c endif
C* For none, just see if the file exists:
c if peAuthority = '*NONE'
c if wkExists
c return
c else
c callp error('No file found, or you' +
c ' lack authority to it.')
c endif
c endif
C* If any authority found, user isn't excluded:
c if peAuthority = '*EXCLUDE'
c if wkReadOk = *On
c or wkWriteOk = *On
c or wkSearchOk = *On
c return
c else
c callp error('No file found, or you' +
c ' lack authority to it.')
c endif
c endif
C* Check read access:
c if %scan('R': peAuthority: 2)>1
c and not wkReadOk
c callp error('No file found, or you' +
c ' lack authority to it.')
c endif
C* Check write access:
c if %scan('W': peAuthority: 2)>1
c and not wkWriteOk
c callp error('No file found, or you' +
c ' lack authority to it.')
c endif
C* Check execute/search access:
c if %scan('X': peAuthority: 2)>1
c and not wkSearchOk
c callp error('No file found, or you' +
c ' lack authority to it.')
c endif
c return
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Kill program and return an escape message that corresponds
* to the current ILE C error number.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P c_error B
D c_error PI
D peErrMsg 128A const
D geterrno PR * ExtProc('__errno')
D strerror PR * ExtProc('strerror')
D errno 10I 0 value
D p_errno S *
D errno S 10I 0 based(p_errno)
c eval p_errno = geterrno
c callp error(%trimr(peErrMsg)+' ' +
c %str(strerror(errno)))
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Kill program and return an escape message
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P error B
D error PI
D peMsg 256A const
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 1A
D dsEC DS
D dsECBytesP 1 4I 0 inz(256)
D dsECBytesA 5 8I 0 inz(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D wwMsgKey S 4A
D wwMsg S 52A
c callp SndPgmMsg('CPF9897': 'QCPFMSG *LIBL':
c peMsg: %len(peMsg): '*ESCAPE':
c '*PGMBDY': 1: wwMsgKey: dsEC)
c if dsECBytesA > 0
c eval wwMsg = dsECMsgID + ' occurred ' +
c 'calling QMHSNDPM API'
c dsply wwMsg
c endif
c return
P E
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
