|
Hello Chuck,
To disallow *PUBLIC to see messages in a message queue but still be able to
send messages to it, set *PUBLIC authority to *CHANGE and remove read data
authority.
- And check that the user profile relating to the message queue has *ALL
authority to avoid problems on that account.
Here's a small CL program that will do it for a single user profile message
queue:
/*-- Compile instructions: ------------------------------------------*/
/*-- USRPRF(*OWNER) and transfer ownership to QSECOFR */
/*-- Parameters: ---------------------------------------------------*/
Pgm &UsrPrf
Dcl &UsrPrf *Char 10
/*-- Global variables: ---------------------------------------------*/
Dcl &MsgQ *Char 10
Dcl &MsgQlib *Char 10
Dcl &UsrPrf *Char 10
Dcl &MsgKey *Char 4 ' '
Dcl &ToCalStkE *Char 38
/*-- Global monitor: -----------------------------------------------*/
MonMsg CPF0000 *None GoTo Error
/*-- Message API parameter inz: ------------------------------------*/
ChgVar %Bin( &ToCalStkE 1 4 ) 1
ChgVar %Sst( &ToCalStkE 5 20 ) '*NONE *NONE '
ChgVar %Bin( &ToCalStkE 25 4 ) 10
ChgVar %Sst( &ToCalStkE 29 10 ) '*PGMBDY '
/*-- Set user message queue authority: -----------------------------*/
If ( &UsrPrf = ' ' ) Do
ChgVar &UsrPrf '*CURRENT'
EndDo
Else Do
ChkObj &UsrPrf *USRPRF
EndDo
RtvUsrPrf &UsrPrf MsgQ( &MsgQ ) MsgQlib( &MsgQlib ) +
RtnUsrPrf( &UsrPrf )
AlcObj (( &MsgQlib/&MsgQ *MSGQ *EXCL )) Wait( 0 )
RvkObjAut &MsgQlib/&MsgQ *MSGQ +
User( *ALL ) Aut( *ALL )
GrtObjAut &MsgQlib/&MsgQ *MSGQ +
User( *PUBLIC ) Aut( *OBJOPR *ADD *UPD *DLT *EXECUTE )
GrtObjAut &MsgQlib/&MsgQ *MSGQ +
User( &UsrPrf ) Aut( *ALL )
DlcObj (( &MsgQlib/&MsgQ *MSGQ *EXCL ))
/*-- Return: -------------------------------------------------------*/
Return:
Call QMHMOVPM ( &MsgKey +
'*COMP' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000000000008' +
)
Return
/*-- Error routines: -----------------------------------------------*/
Error:
Call QMHMOVPM ( &MsgKey +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000000000008' +
)
Call QMHRSNEM ( &MsgKey +
x'0000000000000008' +
&ToCalStkE +
x'00000026' +
'RSNM0100' +
'* ' +
x'00000000' +
)
EndPgm:
EndPgm
Best regards,
Carsten Flensburg
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.