Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Submitting jobs from CICS regions

72 views
Skip to first unread message

James R. Harper

unread,
Feb 6, 1998, 3:00:00 AM2/6/98
to

Can anyone advise me on what controls can be implemented to control the
submission of batch jobs from a CICS region; through an internal reader or
the spool interface. What I would like to prevent are jobs being submitted
and run with the userid of the CICS region - as these would have access to
all the resources that the CICS region has.

I know that you can use the RACF SURROGAT resource class to allow the CICS
region userid to submit a job that will run under another userid. But this
relies on the USER= parameter being specified on the jobcard. Therefore to
implement this the controls have to be implemented at development time. Or
you have to rely upon the user specifying the parameter themselves.

What I would like is a control that works the other way around - something
to prevent the CICS region from submitting jobs to run under it's userid.
So, in order for their job to work the user would have to specify the USER
parameter on the jobcard.

I suppose that if the CICS region ran as a started task you could set up a
SURROGAT profile that didn't permit the regions userid from submitting jobs
with its userid. But our CICS regions run as jobs which are started via a
RDR started task so the associated userid has to be able to submit jobs of
it's own. And we don't particularly want to change to using started tasks.

So, has anybody got any suggestions?

Thanks in anticipation.....

James Harper Upton-by-Chester, Chester, CH2 1EB, UK
ja...@harpers.demon.co.uk
http://www.harpers.demon.co.uk

Michael Harder

unread,
Feb 6, 1998, 3:00:00 AM2/6/98
to

We are a RACF shop, run our CICS regions as started
task using a full 8 digit RACF USERID. Unless things
have changed recently you can only have a 7 digit
USER= on a job card. Also, I assume since you mentioned
SURROGAT you are RACF as well.

Hope this helps!


Michael Harder
VNET 622-3198
(719) 535-3198
FAX: (719) 535-1387
EMail: Michael...@mci.com

Volker Bandke

unread,
Feb 7, 1998, 3:00:00 AM2/7/98
to

** Reply to note from CICS List <CIC...@UGA.CC.UGA.EDU> Fri, 6 Feb 1998 21:46:19 +0000

The way I did it some times ago was to code an exit to TD processing. This exit would scan the
record to be wriiten if it was a JCL JOB card, and then search for the USER= parameter. If this was not
present, then its an easy thing to mangle the JCL, and the job disappears into "data-Nirwhana"

Regards

Volker Bandke

What does CICS mean? - Control Is CICS's Specialty

Michael Erichsen

unread,
Feb 10, 1998, 3:00:00 AM2/10/98
to

From: Michael Erichsen on 10-02-98 15.42

Other people have already talked about RACF surrogate users.

This is an exit and a program to run as TD triggered program that does the
trick on 4.1.
It checks and corrects the JCL to make sure that the job user is the
submitting user.

TITLE 'GEXTDERQ USER EXIT: BEFORE INVOKING A TD REQUEST'
***********************************************************************
* *
* GEXTDEREQ - U S E R E X I T A T X T D E R E Q *
* *
* THIS EXIT GETS A USER ID TO GE0100XA (Batch submit) *
* *
***********************************************************************
* *
* EXEC CICS ENABLE PROGRAM('GEXTDERQ') EXIT('XTDEREQ') *
* GALENGTH(8) START *
* *
***********************************************************************
DFHREGS
UEPXREG EQU R1
UEPREG EQU R2
CODEREG EQU R3
WORKREG EQU R4
SUBRREG EQU R5
ADDRREG EQU R6
GWAREG EQU R7
*---------------------------------------------------------------------*
* *
* Copybook and DSECTS required by the exit program *
* *
*---------------------------------------------------------------------*
DFHUEXIT TYPE=EP,ID=XTDEREQ
COPY DFHTDUED Command Level Plist definitions
*---------------------------------------------------------------------*
* The following definitions are for program working storage. *
*---------------------------------------------------------------------*
DFHEISTG DSECT
USERID DS CL8 RACF Userid
*---------------------------------------------------------------------*
* Main exit program *
*---------------------------------------------------------------------*
GEXTDERQ DFHEIENT
GEXTDERQ AMODE 31
GEXTDERQ RMODE ANY
*
LR UEPREG,R1 DFHUEPAR Plist
USING DFHUEPAR,UEPREG Address UEPAR PLIST
* Addressability to EIB
EXEC CICS ADDRESS EIB(DFHEIBR)
USING DFHEIBLK,DFHEIBR
* Check for possible recursion
L WORKREG,UEPRECUR Address of recursive count
LH WORKREG,0(WORKREG) Fetch count
LTR WORKREG,WORKREG Invoked recursively?
BNZ FINISH Then exit
* Test for existence of Global Work Area
L GWAREG,UEPGAA Addr of Global Work Area
LTR GWAREG,GWAREG Any address?
BZ FINISH Otherwise exit
* Address Command Parameter List
L ADDRREG,UEPCLPS Fetch address of command plist
USING TD_ADDR_LIST,ADDRREG Establish addressability
* Address EXEC Interface Descriptor
L WORKREG,TD_ADDR0 Address the EID
USING TD_EID,WORKREG Establish addressability
TM TD_FUNCT,X'02' Is it a WRITEQ operation?
BNO FINISH Otherwise exit
DROP WORKREG
* Address TD Queue Name
L WORKREG,TD_ADDR1 Address the Queue Name
USING TD_DATA1,WORKREG
* These two lines must be repeated for each queue redirected to GEIR
CLC TD_QUEUE(4),=CL4'GEXX' Is it a redirected queue?
BE GET_USER Then fill it in
* End of repeat lines
B FINISH Otherwise exit
DROP WORKREG
* Get Userid and insert into Global Work Area
GET_USER DS 0H
EXEC CICS ASSIGN USERID(USERID)
MVC 0(8,GWAREG),USERID Move to Global Work Area
* Set up return code and return to caller
FINISH DS 0H Return point
LA R15,UERCNORM Set OK Response
DFHEIRET RCREG=15 Return to CICS
END GEXTDERQ

----------------------------------------------------------

*ASM XOPTS(SP)
***********************************************************************
*
* GE0100XA
*
* THIS PROGRAM IS STARTED FROM AN INTERNAL TRANSIENT DATA
* QUEUE, TO WHICH JCL IS WRITTEN.
* IT CHECKS THE JOBCARDS FOR CORRECTNESS OF USERID
* AND COPIES ALL THE JCL TO AN EXTERNAL TRANSIENT DATA
* QUEUE, WHICH POINTS TO THE INTTERNAL READER
*
* MICHAEL ERICHSEN, APRIL 1992
*
* 16.01.98 MER
* EXIT PROGRAM NAME CHANGED TO GEXTDERQ AT CICS V4.1
*
***********************************************************************
*
* PROGRAM STRUCTURE:
*
* PROCESS FIRST JOBCARD
* (
* READ CARD
* BYPASS SLASHES, JOBNAME, SPACES, 'JOB' AND SPACES
* REPEAT HANDLING A PARAMETER
* UNTIL THERE ARE NO MORE IN THIS CARD
* WRITE CARD
* )
* WHILE CONTINUE
* PROCESS REST OF JOBCARDS
* (
* READ CARD
* BYPASS SLASHES AND SPACES
* REPEAT HANDLING A PARAMETER
* UNTIL THERE ARE NO MORE IN THIS CARD
* WRITE CARD
* )
* INSERT USER= JOBCARD
* COPY REST OF JCL DIRECTLY
* PROVIDE /*EOF CARD IF NEEDED
* RETURN TO CICS
*
***********************************************************************
*
* READ CARD:
*
* READ CARD FROM TD INTRA QUEUE
* IF IT STARTS WITH ' //'
* THEN MOVE WHOLE CARD ONE POSITION TO THE LEFT
* IF IT IS JCL
* THEN BLANK OUT NUMBER FIELD
*
***********************************************************************
*
* HANDLING A PARAMETER:
*
* IF IT STARTS WITH LEFT PARENTHESIS
* PASS ON UNTIL RIGHT PARENTHESIS
* IF IT STARTS WITH AN APOSTROPHE
* PASS ON UNTIL NEXT APOSTROPHE
* IF IT STARTS WITH USER= OR PASSWORD=
* MOVE REST OF LINE BACK TO BLANK THE PARAMETER AWAY
* OTHERWISE PASS ON
* UNTIL COMMA OR SPACE
* IF IT ENDS WITH A COMMA
* CONTINUE
* OTHERWISE
* INSERT A COMMA AND A SPACE AT END
*
***********************************************************************
*
* REGISTERS AND EQUATES
*
USERPTR EQU 2
POINTER EQU 4
EOCARD EQU 5
WORKREG EQU 6
SUBREG1 EQU 7
SUBREG2 EQU 8
CONTINUE EQU C','
BREAK EQU C' '
APOSTROF EQU X'7D'
*
* WORKING STORAGE
*
DFHEISTG DSECT
CONTFLAG DS X FLAG FOR CONTINUE OR BREAK
MOVEFLAG DS X FLAG FOR MOVING TO THE LEFT
QNAME DS CL8 TD INTRA QUEUE NAME
QRECORD DS CL80 TD RECORD
QRECLEN DS H
RACFUSER DS CL8 USERID FROM RACF
INTRDR DS CL4 TD EXTRA QUEUE NAME
INTRLEN DS H
GALEN DS H
*
* EXECUTABLE CODE
*
GE0100XA CSECT
GE0100XA AMODE 31
GE0100XA RMODE ANY
B MAIN
DC CL9'GE0100XA'
DC CL9'&SYSDATE'
DC CL9'&SYSTIME'
DS 0D
*
* INITIALISATION
*
MAIN EQU *
MVC QNAME,=CL8' '
MVC INTRDR(4),=CL4'GEIR' NAME OF TD EXTRA Q TO INTRDR
MVC INTRLEN,=H'4'
MVI CONTFLAG,CONTINUE THIS IS FIRST JOB IN JCL
MVI MOVEFLAG,C'9'
*
* MAIN ROUTINE
*
EXEC CICS ENQ RESOURCE(INTRDR) LENGTH(INTRLEN)
EXEC CICS ASSIGN QNAME(QNAME) NOHANDLE
****** WHILE TESTING **************
MVC QNAME,=CL8'GEXX'
****** WHILE TESTING **************
MAIN05 EQU *
BAL SUBREG1,CARDONE PROCESS FIRST JOBCARD
MAIN10 EQU *
CLI CONTFLAG,BREAK
BE MAIN20 WHILE CONTFLAG == CONTINUE
BAL SUBREG1,CARDNEXT PROCESS FURTHER JOBCARDS
B MAIN10
*
MAIN20 EQU *
BAL SUBREG1,CARDLAST INSERT USER= JOBCARD
BAL SUBREG1,BODY PROCESS BODY OF JCL
CLI CONTFLAG,BREAK START ALL OVER AGAIN?
BE MAIN05
EXEC CICS DEQ RESOURCE(INTRDR) LENGTH(INTRLEN) NOHANDLE
EXEC CICS RETURN
*
* PROCESSING OF FIRST JOBCARD
*
CARDONE EQU *
CLI CONTFLAG,BREAK NOT THE FIRST JOB IN JCL?
BE CARDON10 THEN SKIP READING
BAL SUBREG2,READCARD
CLC EIBRESP,DFHRESP(QZERO) TEST FOR EMPTY QUEUE
BE ERROR1
CARDON10 EQU *
LA EOCARD,QRECORD+71 POINT TO END OF CARD
LA POINTER,QRECORD+2 POINT BEHIND SLASHES
BAL SUBREG2,STRING BYPASS JOBNAME
BAL SUBREG2,SPACES BYPASS SPACES
BAL SUBREG2,STRING BYPASS 'JOB'
BAL SUBREG2,SPACES BYPASS SPACES
*
CARDON20 EQU *
CLI 0(POINTER),C' ' NO MORE PARAMETERS?
BE CARDON30 THEN GO WRITE CARD
BAL SUBREG2,PARAMS ELSE PROCESS PARAMETER
B CARDON20
*
CARDON30 EQU *
CLI CONTFLAG,BREAK
BNE CARDON40
BCTR POINTER,0 MOVE BACK ONE POSITION
MVI 0(POINTER),C',' INSERT COMMA
*
CARDON40 EQU *
MVC QRECLEN,=H'80'
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
BR SUBREG1
*
* PROCESSING OF NEXT JOBCARDS
*
CARDNEXT EQU *
BAL SUBREG2,READCARD
CLC EIBRESP,DFHRESP(QZERO) TEST FOR EMPTY QUEUE
BE ERROR2
CLC QRECLEN,=H'80' IS IT FULL SIZE?
BE CARDNE10
LH WORKREG,QRECLEN OTHERWISE COMPENSATE
LA WORKREG,1(WORKREG) BY ADDING ONE
SH WORKREG,QRECLEN
*
CARDNE10 EQU *
LA POINTER,QRECORD+2 POINT BEHIND SLASHES
LR EOCARD,POINTER
AH EOCARD,=H'71' POINT TO END OF CARD
BAL SUBREG2,SPACES BYPASS SPACES
*
CARDNE20 EQU *
CLI 0(POINTER),C' ' END OF PARAMETERS?
BE CARDNE30
BAL SUBREG2,PARAMS ELSE PROCESS PARAMETER
B CARDNE20
*
CARDNE30 EQU *
CLC =CL17'//',QRECORD EMPTY CARD?
BE CARDNE99 THEN IGNORE
CLI CONTFLAG,BREAK
BNE CARDNE40
BCTR POINTER,0 MOVE BACK ONE POSITION
MVI 0(POINTER),C',' INSERT COMMA
*
CARDNE40 EQU *
MVC QRECLEN,=H'80'
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
CARDNE99 EQU *
BR SUBREG1
*
* INSERT A USER= AS LAST JOBCARD
*
CARDLAST EQU *
MVI QRECORD,C' ' CLEAR RECORD
MVC QRECORD+1(79),QRECORD
MVC QRECORD(2),=CL2'//'
MVC QRECORD+3(5),=CL5'USER='
MVC QRECORD+8(8),RACFUSER
MVC QRECLEN,=H'80' LENGTH OF CARD
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
BR SUBREG1 RETURN
*
* PROCESS BODY OF JCL CARDS
*
BODY EQU *
BAL SUBREG2,READCARD READ NEXT CARD
CLC EIBRESP,DFHRESP(QZERO) END OF QUEUE?
BE BODY10 THEN BREAK
BAL SUBREG2,TESTJOB TEST FOR ' JOB '
CLI CONTFLAG,BREAK
BE BODY99 GO START ALL OVER AGAIN
MVC QRECLEN,=H'80' LENGTH OF CARD
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
B BODY
*
BODY10 EQU *
CLC QRECORD(5),=CL5'/*EOF' IS END-CARD PROVIDED?
BE BODY99 THEN FINISH
MVI QRECORD,C' ' CLEAR RECORD
MVC QRECORD+1(79),QRECORD
MVC QRECORD(5),=CL5'/*EOF' PROVIDE END-CARD
MVC QRECLEN,=H'80' LENGTH OF CARD
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
*
BODY99 EQU *
BR SUBREG1
*
* SERVICE SUBROUTINES
*
* READ A CARD FROM TD INTRA QUEUE AND MOVE RIGHT IF NEEDED
*
READCARD EQU *
MVC QRECLEN,=H'80' MAXIMUM LENGTH OF CARD
MVI QRECORD,C' ' CLEAR RECORD
MVC QRECORD+1(79),QRECORD
EXEC CICS READQ TD QUEUE(QNAME) INTO(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
CLC EIBRESP,DFHRESP(QZERO) END OF QUEUE?
BE READCA99 THEN BREAK
MVC QRECLEN,=H'80' MAXIMUM LENGTH OF CARD
CLC RACFUSER,=XL8'00' IS IT NULLS?
BE READCA10
CLC RACFUSER,=CL8' ' OR BLANKS?
BNE READCA20 OTHERWISE IGNORE
READCA10 EQU *
EXEC CICS EXTRACT EXIT PROGRAM('GEXTDERQ') GASET(WORKREG) *
GALENGTH(GALEN) NOHANDLE
MVC RACFUSER,0(WORKREG) GET USERID FROM GLOBAL EXIT PGM
READCA20 EQU *
CLI MOVEFLAG,C'9' IS IT SET?
BNE READCA30 THEN BRANCH ON
CLC QRECORD+1(3),=CL3' //' IS IT MOVED TWO TO THE RIGHT?
BE READCA21 THEN MOVE TWO
CLC QRECORD+1(2),=CL2'//' IS IT MOVED ONE TO THE RIGHT?
BE READCA22 THEN MOVE ONE
MVI MOVEFLAG,C'0' SET SWITCH
B READCA30
*
READCA21 EQU *
MVI MOVEFLAG,C'2' SET SWITCH
B READCA30
*
READCA22 EQU *
MVI MOVEFLAG,C'1' SET SWITCH
B READCA30
*
READCA30 EQU *
CLI MOVEFLAG,C'1' MOVE ONE?
BE READCA40
CLI MOVEFLAG,C'2' MOVE TWO
BE READCA45
B READCA50 OTHERWISE NO MOVE
*
READCA40 EQU *
MVC QRECORD(79),QRECORD+1 MOVE ONE TO THE LEFT
B READCA50
*
READCA45 EQU *
MVC QRECORD(78),QRECORD+2 MOVE TWO TO THE LEFT
B READCA50
*
READCA50 EQU *
CLC QRECORD(2),=CL2'//' IS IT JCL?
BNE READCA99 ELSE IGNORE
MVC QRECORD+71(8),=CL8' ' OTHERWISE BLANK LAST POS. OUT
*
READCA99 EQU *
BR SUBREG2 RETURN
*
* BYPASS STRING IN JOBCARD
*
STRING EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR4
CLI 0(POINTER),C' ' MORE NON BLANK CHARACTERS?
BE STRING10 ELSE BREAK
LA POINTER,1(POINTER)
B STRING
*
STRING10 EQU *
BR SUBREG2 RETURN
*
* BYPASS SPACES IN JOBCARD
*
SPACES EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR5
CLI 0(POINTER),C' ' MORE SPACES?
BNE SPACES10 ELSE BREAK
LA POINTER,1(POINTER)
B SPACES
*
SPACES10 EQU *
BR SUBREG2 RETURN
*
* PROCESS A SINGLE PARAMETER IN JOBCARD
*
PARAMS EQU *
CLI 0(POINTER),C'(' START OF ACCOUNT FIELD?
BE PARAMS20
CLI 0(POINTER),APOSTROF START OF PROGRAMMER FIELD?
BE PARAMS30
CLC 0(5,POINTER),=CL5'USER=' USER= FIELD?
BE PARAMS50
CLC 0(9,POINTER),=CL9'PASSWORD=' PASSWORD= FIELD?
BE PARAMS50
*
PARAMS10 EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR6
CLI 0(POINTER),C',' END WITH A COMMA?
BE PARAMS80
CLI 0(POINTER),C' ' END WITH A SPACE?
BE PARAMS90
LA POINTER,1(POINTER)
B PARAMS10
*
PARAMS20 EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR10
LA POINTER,1(POINTER)
CLI 0(POINTER),C')' MATCHING PARENTHESIS?
BNE PARAMS20 ELSE CONTINUE
LA POINTER,1(POINTER)
CLI 0(POINTER),C',' END WITH A COMMA?
BE PARAMS80
CLI 0(POINTER),C' ' END WITH A SPACE?
BE PARAMS90
B ERROR11
*
PARAMS30 EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR7
LA POINTER,1(POINTER)
CLI 0(POINTER),APOSTROF MATCHING APOSTROPHE?
BNE PARAMS30
LA POINTER,1(POINTER)
CLI 0(POINTER),C',' END WITH A COMMA?
BE PARAMS80
CLI 0(POINTER),C' ' END WITH A SPACE?
BE PARAMS90
B ERROR8
*
PARAMS50 EQU *
LR USERPTR,POINTER SAVE START ADDRESS
PARAMS60 EQU *
CR POINTER,EOCARD AT END OF CARD?
BNL ERROR9
CLI 0(POINTER),C',' END WITH A COMMA?
BE PARAMS70
CLI 0(POINTER),C' ' END WITH A SPACE?
BE PARAMS70
LA POINTER,1(POINTER)
B PARAMS60
*
PARAMS70 EQU *
MVC CONTFLAG,0(POINTER) GET CONTFLAG
LA POINTER,1(POINTER) FIRST POS IN NEXT PARAMETER
LR WORKREG,EOCARD CALCULATE LENGTH OF
SR WORKREG,POINTER ...REST OF CARD
BCTR WORKREG,0 SUBTRACT ONE FOR EX STATEMENT
EX WORKREG,PARAMMOV OVERWRITE THIS PARAMETER
LR POINTER,USERPTR RESTORE POINTER TO NEXT PARM
BR SUBREG2 RETURN
*
PARAMMOV MVC 0(*-*,USERPTR),0(POINTER)
*
PARAMS80 EQU *
MVI CONTFLAG,CONTINUE
LA POINTER,1(POINTER)
BR SUBREG2 RETURN
*
PARAMS90 EQU *
MVI CONTFLAG,BREAK
LA POINTER,1(POINTER)
BR SUBREG2 RETURN
*
* TEST A BODY CARD FOR START OG NEW JOB IN SAME JCL
*
TESTJOB EQU *
MVI CONTFLAG,CONTINUE FLAG NO JOB STATEMENT
CLC QRECORD(2),=CL2'//' IS THIS A JCL CARD?
BNE TESTJO99 ELSE BREAK
CLI QRECORD+2,C'A' IS THIS '*' OR ' '?
BL TESTJO99 THEN BREAK
LA POINTER,QRECORD POINT TO START OF RECORD
LA WORKREG,66 COUNTER
TESTJO10 EQU *
CLC 0(5,POINTER),=CL5' JOB ' IS THERE A JOB STATEMENT?
BE TESTJO50 THEN FLAG IT
LA POINTER,1(POINTER)
BCT WORKREG,TESTJO10
B TESTJO99
*
TESTJO50 EQU *
MVI CONTFLAG,BREAK FLAG START OF NEW JOB
*
TESTJO99 EQU *
BR SUBREG2
*
* ERROR HANDLING
*
ERROR1 EQU *
MVC QRECORD,=CL80'GE0100XA: EMPTY INPUT QUEUE'
B ERROR99
*
ERROR2 EQU *
MVC QRECORD,=CL80'GE0100XA: UNEXPECTED QZERO'
B ERROR99
*
ERROR4 EQU *
MVC QRECORD,=CL80'GE0100XA: STRING TOO LONG'
B ERROR99
*
ERROR5 EQU *
MVC QRECORD,=CL80'GE0100XA: TOO MANY SPACES'
B ERROR99
*
ERROR6 EQU *
MVC QRECORD,=CL80'GE0100XA: PARAMETER TOO LONG'
B ERROR99
*
ERROR7 EQU *
MVC QRECORD,=CL80'GE0100XA: NO MATCHING APOSTROPHE'
B ERROR99
*
ERROR8 EQU *
MVC QRECORD,=CL80'GE0100XA: ERROR AFTER APOSTROPHE'
B ERROR99
*
ERROR9 EQU *
MVC QRECORD,=CL80'GE0100XA: PARAMETER TOO LONG'
B ERROR99
*
ERROR10 EQU *
MVC QRECORD,=CL80'GE0100XA: NO MATCHING PARENTHESIS'
B ERROR99
*
ERROR11 EQU *
MVC QRECORD,=CL80'GE0100XA: ERROR AFTER PARENTHESIS'
B ERROR99
*
ERROR99 EQU *
MVC QRECLEN,=H'80'
EXEC CICS WRITEQ TD QUEUE('CSMT') FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
EXEC CICS DELETEQ TD QUEUE(QNAME) NOHANDLE
MVI QRECORD,C' ' CLEAR RECORD
MVC QRECORD+1(79),QRECORD
MVC QRECORD(5),=CL5'/*EOF' PROVIDE END-CARD
EXEC CICS WRITEQ TD QUEUE(INTRDR) FROM(QRECORD) *
LENGTH(QRECLEN) NOHANDLE
EXEC CICS RETURN
*
END GE0100XA

Best rgds,
Michael

Baker, Steve

unread,
Feb 10, 1998, 3:00:00 AM2/10/98
to

Watch out for those programs that issue an EXEC CICS SIGNOFF prior to
writing to the
TD queue. Depending on your CICS release and security package you can
get interesting results.

Steve Baker
Fidelity Investments

0 new messages