ALERT: Some images may not load properly within the Knowledge Base Article. If you see a broken image, please right-click and select 'Open image in a new tab'. We apologize for this inconvenience.

Sample program to pass TSS commands via RACROUTE

book

Article ID: 74538

calendar_today

Updated On:

Products

Top Secret Top Secret - LDAP

Issue/Introduction

Sample program to pass TSS commands using the IBM RACROUTE macro.

Environment

Release:
Component: TSSMVS

Resolution

Sample code to pass TSS commands using IBM's RACROUTE macro:
 


S2222200 TITLE 'ISSUE TSS COMMAND VIA R_ADMIN'
S2222200 CSECT
*---------------------------------------------------------------------*
* *
* ++ OUTPUT FROM TEST PROGRAMS SHOULD BE WRITTEN TO A PDS DATASET IF *
* ++ POSSIBLE AS IT IS DIFFICULT TO MAINTAIN SAVED OUTPUT WHEN *
* ++ A WTO. *
* *
* MODULE - S2222200 *
* *
* FUNCTION - ISSUE R_ADMIN CALL *
* *
* INPUT - NONE *
* *
* OUTPUT - NONE *
* RC WILL BE SET TO 0 *
* *
* ** NOTE, COMMAND OUTPUT WILL SHOW IN SYSLOG AND IN THE JOB MESSAGES *
* ** IF THIS IS RUN AS A BATCH JOB. *
* *
* STANDARD REGISTER EQUATES *
* REGISTER *
* USAGE - R12 = BASE *
* R11 = SECOND BASE *
* R13 = STANDARD SAVEAREA *
* *
* *
* *
* CHANGE *
* LEVEL - 03/05/18 BIRTH *
*---------------------------------------------------------------------*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
* BEGIN STANDARD MODULE INITIALIZATION
START STM R14,R12,12(R13) SAVE REGISTERS
LR R2,R1 POINT AT PARMLIST
LR R12,R15 BASE REGISTER
LA R11,4095(R12) 2ND BASE
LA R11,1(,R11) 2ND BASE
USING S2222200,R12,R11 SET ADDRESSABILITY
L R0,AWORKLEN LENGTH FOR WORKAREA GETMAIN
GETMAIN RU,LV=(0) ISSUE GETMAIN
LR R10,R1 R10 POINTS TO GETMAINED AREA
USING WORKAREA,R10 ADDRESSABILITY FOR WORKAREA
ST R10,8(R13) FORWARD CHAIN SAVEAREA
ST R13,SAVEAREA+4 BACKWARD CHAIN SAVEAREA
LR R13,R10 POINT AT MY NEW SAVEAREA
L R2,0(,R2) POINT AT PARM
LH R3,0(,R2) POINT AT PARM
B INIT TO INITIALIZATION
*
* START THE REAL WORK
*
INIT DS 0H
*
* UNCOMMENT THE FOLLOWING TO ISSUE A WTO AT START
*
* WTO 'GO.. COLLECT $200',ROUTCDE=(1,11)
*
**********************************************************************
*
* THIS PROGRAM WILL CALL THE R_ADMIN CALLABLE SERVICE. IT TAKES THE
* COMMAND ENTERED IN FIELD TSSMOD AND SENDS IT TO THE R_ADMIN
* CALLABLE SERVICE.
*
**********************************************************************
*
*--------------------------------------------------------------
* BUILD A COMMAND BUFFER FROM THE INPUT DATA
*--------------------------------------------------------------
*
LA R7,CMDBUFF+4 POINT TO COMMAND BUFFER (PAST LEN)
MVC 0(L'TSSMOD,R7),TSSMOD COPY IN 'TSS MODIFY' CMD
LA R15,L'TSSMOD GET LENGTH OF COMMAND
STCM R15,15,CMDBUFF SET LENGTH IN BUFFER
*
*--------------------------------------------------------------
* CALL R_ADMIN TO ISSUE THE PASSED COMMAND
*--------------------------------------------------------------
*
USING COMP,R7
LA R7,RPARMS POINT TO R_ADMIN PARMS
LA R1,ALET POINT TO R_ADMIN PARMS
ST R1,[email protected]
ST R1,[email protected]
ST R1,[email protected]
LA R1,IRRWRK POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,SAFRC POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,RACRC POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,RACRS POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,ADMN_RUN_COMD GET FUNCTION CODE
STC R1,FUNC SAVE IT
LA R1,FUNC POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,CMDBUFF+2 POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,ALET POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,ALET POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R1,10 GET A SUBPOOL
STCM R1,1,SUBPOOL
LA R1,SUBPOOL POINT TO R_ADMIN PARMS
ST R1,[email protected]
LA R6,MSGBUFF
ST R6,[email protected]
OI [email protected],X'80' MARK LAST ONE
*
LOAD EP=IRRSEQ00
LR R15,R0
LA R0,IRRSEQ00#
LA R1,COMP
CALL (15) (IRRWRK, X
ALET,SAFRC, X
ALET,RACRC, X
ALET,RACRS, X
FUNC, FUNCTION CODE X
CMDBFLN, PARM_LIST X
ALET, USER_ID X
ALET, ACEE_PTR X
SUBPOOL, OUTPUT SUB-POOL X
MSGBUFF), MESSAGE BUFFER X
MF=(E,PCOMP)
*
LTR 15,15 CHECK RC FROM R_ADMIN
BNZ EXIT08 <>0 RC RETURNED TO CALLER
*
*------------------------------------------------------------------
* WE DISPLAY THE OUTPUT FROM THE COMMAND
*------------------------------------------------------------------
*
L R2,MSGBUFF GET RETURN BUFFER ADDRESS
USING MSGOUT,R2 ADDRESS IT
LR R3,R2 COPY OUTPUT ADDRESS
LR R6,R2 COPY OUTPUT ADDRESS
LA R6,MSGSTART-MSGOUT(,R6) BUMP TO FIRST MESSAGE
A R3,MSGEND GET ADDRESS OF END
MVC WTOD,WTOL MOVE LIST FORM OF MACRO TO WORK
*
MSGLOOP DS 0H
CR R6,R3 END OF MESSAGE?
BNL EXIT00 YES, ALL DONE
XR R4,R4 CLEAR FOR ICM
ICM R4,3,0(R6) GOT LENGTH OF THIS MESSAGE?
BZ EXIT00 NO, ALL DONE
STH R4,PREFIX SAVE LENGTH FOR WTO
BCTR R4,0 PREP FOR EX
LA R6,2(,R6) GET START OF MESSAGE
EX R4,MSG COPY MESSAGE
LA R4,PREFIX GET PREFIX
WTO TEXT=(R4),MF=(E,WTOD)
MSGZERO DS 0H
AH R6,PREFIX GET NEXT MESSAGE
B MSGLOOP PRINT IT
B EXIT00 <>0 WTO RC RETURNED TO CALLER
EXIT00 DS 0H
SR R15,R15 RC=00
B EXIT
EXIT08 DS 0H
LA R15,8 RC=08
B EXIT
* STANDARD EXIT LOGIC
EXIT L R13,4(R13) PREV SAVE AREA
L R14,12(R13) RESTORE REG 14
LM R0,R12,20(R13) RESTORE REGS 0-12
BR R14 RETURN
LTORG
ZEROES DC F'0'
REQSTOR DC CL8'REQ22222'
SUBSYS DC CL8'SUB22222'
TIME DC A(100*30*2) 60 SECS * 5 = 5 MINS
FDB1 DC C'TSSF',X'FF',X'00000000',X'00',6X'00',240X'FF'
RACWRK2 DC 512C'F'
AWORKLEN DC A(WORKLEN)
ALET DC F'0' PRIMARY AS
WORKLN DC F'4096'
QNAM DC CL8'ZAP'
RNAM DC CL44'COMMON.SUBPOOL.245'
RNAMLN DC XL1'18'
BLANKS DC CL128' '
TSSMOD DC C'TSS ADD(FJAU1) PHRASEONLY'
*SSMOD DC C'TSS WHOAMI'
MSG MVC BUFFER(*-*),0(6)
WTOL WTO TEXT=,ROUTCDE=11,DESC=12,MF=L LIST FORM
WTOLEN EQU *-WTOL
WORKAREA DSECT
SAVEAREA DS 18F
WTOD DS CL(WTOLEN)
PREFIX DS H
BUFFER DS CL126
*
SAVEINPX DS CL8 PARM LIST ADDRESS
SAVEINP DS A PARM LIST ADDRESS
SAVEREG DS A
SAFRC DS F
RACRC DS F
RACRS DS F
FUNC DS X
SUBPOOL DS X
FLAG DS X
F1MULT EQU X'80'
DS X
OPTIONS DS F
MSGBUFF DS A
USERID DS CL9
RPARMS DS 30F
MODE DS CL9
TYPE DS CL9
SYSID DS CL9
IRRWRK DS CL1024
CMDBUFF DS CL1024
WORKLEN EQU *-WORKAREA
IRRPCOMP ,
IRRPFC ,
* MACREGS
*
MSGOUT DSECT
MSGNXTBL DS F NEXT OUTPUT MESSAGE BLOCK
MSGEYE DS CL4 EYE CATCHER 'RMSG'
MSGSPOOL DS X STORAGE SUBPOOL
MSGBLKLN DS XL3 TOTAL BLOCK LENGTH
MSGEND DS F OFFSET TO FIRST BYTE AFTER LAST MESSAGE
MSGSTART DS X START OF THE FIRST MESSAGE
END


Please note that this is just an example and is not supported by Broadcom. Its use, maintenance, and customization are the sole responsibility of its user.

Attachments

1558535944215RADMIN.txt get_app