This program uses the Gateway-Library system programmer calls to do tracing and accounting at the host.
SYSAMP1: PROC OPTIONS(MAIN REENTRANT);
/****** SYCPSAS1 - RPC REQUEST APPLICATION - PL/1 - CICS ********/
/* */
/* TRANID: SYS1 */
/* PROGRAM: SYCPSAS1 */
/* PLAN NAME: n/a */
/* FILES: n/a */
/* TABLES: n/a */
/* */
/* This program is executed via a client RPC request from sample */
/* dblib program 'SYS1'. The purpose of the program is primarily */
/* to demonstrate system programmer Server Library calls. */
/* */
/* Server Library calls: */
/* TDACCEPT accept request from client */
/* TDESCRIB describe a column */
/* TDFREE free TDPROC structure */
/* TDINFACT get accounting info */
/* TDINFLOG get logging info */
/* TDINFSPT get specific tracing info */
/* TDINIT establish environment */
/* TDLSTSPT get list of active specific trace tran ids */
/* TDRCVPRM retrieve rpc parameter from client */
/* TDRESULT describe next communication */
/* TDSETACT set accounting */
/* TDSETLOG set logging */
/* TDSETSPT set specific tracing */
/* TDSNDDON send results-completion to client */
/* TDSNDMSG send message to client */
/* TDSNDROW send row to client */
/* TDSTATUS get status information */
/* TDWRTLOG write user log record */
/* */
/**************************************************************/
/**************************************************************/
/* GATEWAY-LIBRARY PL/1 COPY BOOK */
/**************************************************************/
%INCLUDE SYGWPLI;
/*------------------------------------------------------------*/
/* SERVER LIB ROUTINES DECLARATIONS */
/*------------------------------------------------------------*/
DCL
TDACCEPT ENTRY OPTIONS(INTER ASSEMBLER),
TDESCRIB ENTRY OPTIONS(INTER ASSEMBLER),
TDFREE ENTRY OPTIONS(INTER ASSEMBLER),
TDINFACT ENTRY OPTIONS(INTER ASSEMBLER),
TDINFLOG ENTRY OPTIONS(INTER ASSEMBLER),
TDINFSPT ENTRY OPTIONS(INTER ASSEMBLER),
TDINIT ENTRY OPTIONS(INTER ASSEMBLER),
TDLSTSPT ENTRY OPTIONS(INTER ASSEMBLER),
TDRCVPRM ENTRY OPTIONS(INTER ASSEMBLER),
TDRESULT ENTRY OPTIONS(INTER ASSEMBLER),
TDSETACT ENTRY OPTIONS(INTER ASSEMBLER),
TDSETLOG ENTRY OPTIONS(INTER ASSEMBLER),
TDSETSPT ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDDON ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDMSG ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDROW ENTRY OPTIONS(INTER ASSEMBLER),
TDSTATUS ENTRY OPTIONS(INTER ASSEMBLER),
TDWRTLOG ENTRY OPTIONS(INTER ASSEMBLER);
/*------------------------------------------------------------*/
/* BUILT IN FUNCTIONS DECLARATIONS */
/*------------------------------------------------------------*/
DCL
ADDR BUILTIN,
STG BUILTIN,
STRING BUILTIN;
/*------------------------------------------------------------*/
/* WORK AREAS */
/*------------------------------------------------------------*/
DCL
01 GW_LIB_MISC_FIELDS,
05 GWL_PROC PTR,
05 GWL_INIT_HANDLE PTR,
05 GWL_INFACT_STATUS FIXED BIN(31),
05 GWL_INFACT_FILENAME CHAR(08),
05 GWL_INFACT_RECORDS FIXED BIN(31),
05 GWL_INFLOG_GLOBAL FIXED BIN(31),
05 GWL_INFLOG_API FIXED BIN(31),
05 GWL_INFLOG_HEADER FIXED BIN(31),
05 GWL_INFLOG_DATA FIXED BIN(31),
05 GWL_INFLOG_TRACEID FIXED BIN(31),
05 GWL_INFLOG_FILENAME CHAR(08),
05 GWL_INFLOG_RECORDS FIXED BIN(31),
05 GWL_INFSPT_ENTRY FIXED BIN(31),
05 GWL_INFSPT_STATUS FIXED BIN(31),
05 GWL_INFSPT_OPTIONS FIXED BIN(31),
05 GWL_INFSPT_TRANID CHAR(04),
05 GWL_INFSPT_TRANID_L FIXED BIN(31),
05 GWL_LSTSPT_LIST(8) CHAR(08),
05 GWL_RC FIXED BIN(31),
05 GWL_RCVPRM_ID FIXED BIN(31) INIT(1),
05 GWL_RCVPRM_MAX_DATA_L FIXED BIN(31) INIT(2),
05 GWL_RCVPRM_DATA_L FIXED BIN(31) INIT(2),
05 GWL_SETSPT_ENTRY FIXED BIN(31),
05 GWL_SETSPT_OPTIONS FIXED BIN(31),
05 GWL_STATUS_NR FIXED BIN(31),
05 GWL_STATUS_DONE FIXED BIN(31),
05 GWL_STATUS_COUNT FIXED BIN(31),
05 GWL_STATUS_COMM FIXED BIN(31),
05 GWL_STATUS_RETURN_CODE FIXED BIN(31),
05 GWL_STATUS_SUBCODE FIXED BIN(31),
05 GWL_WRTLOG_MSG_L FIXED BIN(31) INIT(34),
05 GWL_WRTLOG_MSG CHAR(34)
INIT('TEST MESSAGE FROM SYS1 TRANSACTION');
DCL
01 PARM_FIELDS,
05 PARM_REQUEST CHAR(02);
DCL
01 PARM_FIELDS_VALUES STATIC,
05 PARM_REQUEST_INFACT CHAR(02) INIT('IA'),
05 PARM_REQUEST_INFLOG CHAR(02) INIT('IL'),
05 PARM_REQUEST_LSTSPT CHAR(02) INIT('IS'),
05 PARM_REQUEST_SETACT_ON CHAR(02) INIT('YA'),
05 PARM_REQUEST_SETACT_OFF CHAR(02) INIT('NA'),
05 PARM_REQUEST_SETLOG_ON CHAR(02) INIT('YL'),
05 PARM_REQUEST_SETLOG_OFF CHAR(02) INIT('NL'),
05 PARM_REQUEST_SETSPT_ON CHAR(02) INIT('YS'),
05 PARM_REQUEST_SETSPT_OFF CHAR(02) INIT('NS'),
05 PARM_REQUEST_WRTLOG CHAR(02) INIT('WL');
DCL
01 SNA_FIELDS,
05 SNA_SUBC FIXED BIN(31),
05 SNA_CONNECTION_NAME CHAR(08) INIT(' ');
DCL
01 COLUMN_NAME_FIELDS STATIC,
05 CN_INFACT_STATUS CHAR(13)
INIT('ACT_STATUS'),
05 CN_INFACT_FILENAME CHAR(12)
INIT('ACT_FILENAME'),
05 CN_INFACT_RECORDS CHAR(11)
INIT('ACT_RECORDS'),
05 CN_INFLOG_GLOBAL CHAR(10)
INIT('LOG_GLOBAL'),
05 CN_INFLOG_API CHAR(07)
INIT('LOG_API'),
05 CN_INFLOG_HEADER CHAR(10)
INIT('LOG_HEADER'),
05 CN_INFLOG_DATA CHAR(08)
INIT('LOG_DATA'),
05 CN_INFLOG_TRACEID CHAR(11)
INIT('LOG_TRACEID'),
05 CN_INFLOG_FILENAME CHAR(12)
INIT('LOG_FILENAME'),
05 CN_INFLOG_RECORDS CHAR(11)
INIT('LOG_RECORDS'),
05 CN_LSTSPT_TRANID CHAR(06)
INIT('TRANID');
DCL
01 COUNTER_FIELDS,
05 CTR_COLUMN FIXED BIN(31) INIT(0),
05 CTR_ROWS FIXED BIN(31) INIT(0);
DCL
01 WORK_FIELDS,
05 WRKLEN1 FIXED BIN(31),
05 WRKLEN2 FIXED BIN(31),
05 WRK_DONE_STATUS FIXED BIN(31),
05 WRK_RPC CHAR(04) INIT('SYS1'),
05 WRK_LSTSPT_SS FIXED BIN(15),
05 WRK_TRANID CHAR(08);
DCL
01 MESSAGE_FIELDS,
05 MSG_TYPE FIXED BIN(31),
05 MSG_SEVERITY_ERROR FIXED BIN(31) INIT(11),
05 MSG_NR_ERROR FIXED BIN(31) INIT(2),
05 MSG_RPC CHAR(04),
05 MSG_RPC_L FIXED BIN(31) INIT(4),
05 MSG_TEXT CHAR(20),
05 MSG_TEXT_L FIXED BIN(31),
05 MSG_SRVLIB,
10 MSG_SRVLIB_FUNC CHAR(08) INIT(' '),
10 FILLER CHAR(06) INIT(' RC = '),
10 MSG_SRVLIB_RC PIC '----9';
DCL
01 SWITCHES,
05 SEND_DONE BIT(01) INIT('1'B),
05 SEND_DONE_ERROR BIT(01) INIT('0'B),
05 SEND_DONE_OK BIT(01) INIT('1'B),
05 TRACING BIT(01) INIT('0'B),
05 TRACING_ON BIT(01) INIT('1'B);
/*------------------------------------------------------------*/
INITIALIZE_PROGRAM:
/*------------------------------------------------------------*/
/* ------------------------------------------------------*/
/* establish gateway environment */
/* ------------------------------------------------------*/
CALL TDINIT (DFHEIBLK, GWL_RC, GWL_INIT_HANDLE);
/* ------------------------------------------------------*/
/* accept client request */
/* ------------------------------------------------------*/
CALL TDACCEPT (GWL_PROC, GWL_RC, GWL_INIT_HANDLE,
SNA_CONNECTION_NAME,
SNA_SUBC);
/* ------------------------------------------------------*/
/* TDRESULT to validate kicked off via rpc request */
/* ------------------------------------------------------*/
CALL TDRESULT (GWL_PROC, GWL_RC);
IF GWL_RC NE TDS_PARM_PRESENT THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDRESULT';
GO TO END_PROGRAM;
END;
/*------------------------------------------------------------*/
GET_PARM:
/*------------------------------------------------------------*/
CALL TDRCVPRM (GWL_PROC, GWL_RC,
GWL_RCVPRM_ID,
PARM_REQUEST,
TDSCHAR,
GWL_RCVPRM_MAX_DATA_L,
GWL_RCVPRM_DATA_L);
IF PARM_REQUEST = PARM_REQUEST_INFACT THEN
CALL TDINFACT_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_INFLOG THEN
CALL TDINFLOG_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_LSTSPT THEN
CALL TDLSTSPT_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETACT_ON THEN
CALL TDSETACT_ON_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETACT_OFF THEN
CALL TDSETACT_OFF_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETLOG_ON THEN
CALL TDSETLOG_ON_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETLOG_OFF THEN
CALL TDSETLOG_OFF_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETSPT_ON THEN
CALL TDSETSPT_ON_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_SETSPT_OFF THEN
CALL TDSETSPT_OFF_PROC;
ELSE IF PARM_REQUEST = PARM_REQUEST_WRTLOG THEN
CALL TDWRTLOG_PROC;
/*------------------------------------------------------------*/
END_PROGRAM:
/*------------------------------------------------------------*/
IF SEND_DONE = SEND_DONE_OK THEN
WRK_DONE_STATUS = TDS_DONE_COUNT;
ELSE
DO;
CALL SRVLIB_ERROR;
WRK_DONE_STATUS = TDS_DONE_ERROR;
CTR_ROWS = 0;
END;
CALL TDSNDDON (GWL_PROC, GWL_RC,
WRK_DONE_STATUS,
CTR_ROWS,
TDS_ZERO,
TDS_ENDRPC);
CALL * (GWL_PROC, GWL_RC);
EXEC CICS RETURN;
/*------------------------------------------------------------*/
TDINFACT_PROC: PROC;
/*------------------------------------------------------------*/
WRKLEN1 = STG(GWL_INFACT_STATUS);
WRKLEN2 = STG(CN_INFACT_STATUS);
CTR_COLUMN = CTR_COLUMN +1;
MSG_SRVLIB_FUNC = 'TDESCRIB';
CALL TDESCRIB (GWL_PROC, GWL_RC, CTR_COLUMN,
TDSINT4, WRKLEN1, GWL_INFACT_STATUS,
TDS_ZERO, TDS_FALSE, TDSINT4,
WRKLEN1, CN_INFACT_STATUS, WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFACT_EXIT;
END;
WRKLEN1 = STG(GWL_INFACT_FILENAME);
WRKLEN2 = STG(CN_INFACT_FILENAME);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSCHAR,
WRKLEN1,
GWL_INFACT_FILENAME,
TDS_ZERO,
TDS_FALSE,
TDSCHAR,
WRKLEN1,
CN_INFACT_FILENAME,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFACT_EXIT;
END;
WRKLEN1 = STG(GWL_INFACT_RECORDS);
WRKLEN2 = STG(CN_INFACT_RECORDS);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSINT4,
WRKLEN1,
GWL_INFACT_RECORDS,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFACT_RECORDS,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFACT_EXIT;
END;
CALL TDINFACT (GWL_INIT_HANDLE, GWL_RC,
GWL_INFACT_STATUS,
GWL_INFACT_FILENAME,
GWL_INFACT_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFACT';
GO TO TDINFACT_EXIT;
END;
CALL TDSNDROW (GWL_PROC, GWL_RC);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSNDROW';
GO TO TDINFACT_EXIT;
END;
CTR_ROWS = CTR_ROWS +1;
/*------------------------------------------------------------*/
TDINFACT_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDINFACT_PROC;
/*------------------------------------------------------------*/
TDINFLOG_PROC: PROC;
/*------------------------------------------------------------*/
WRKLEN1 = STG(GWL_INFLOG_GLOBAL);
WRKLEN2 = STG(CN_INFLOG_GLOBAL);
CTR_COLUMN = CTR_COLUMN +1;
MSG_SRVLIB_FUNC = 'TDESCRIB';
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSINT4,
WRKLEN1,
GWL_INFLOG_GLOBAL,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_GLOBAL,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_API);
WRKLEN2 = STG(CN_INFLOG_API);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSINT4,
WRKLEN1,
GWL_INFLOG_API,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_API,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_HEADER);
WRKLEN2 = STG(CN_INFLOG_HEADER);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSINT4,
WRKLEN1,
GWL_INFLOG_HEADER,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_HEADER,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_DATA);
WRKLEN2 = STG(CN_INFLOG_DATA);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC, CTR_COLUMN,
TDSINT4, WRKLEN1,
GWL_INFLOG_DATA,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_DATA,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_TRACEID);
WRKLEN2 = STG(CN_INFLOG_TRACEID);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC, CTR_COLUMN,
TDSINT4, WRKLEN1,
GWL_INFLOG_TRACEID,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_TRACEID,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_FILENAME);
WRKLEN2 = STG(CN_INFLOG_FILENAME);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC, CTR_COLUMN,
TDSCHAR, WRKLEN1,
GWL_INFLOG_FILENAME,
TDS_ZERO,
TDS_FALSE,
TDSCHAR,
WRKLEN1,
CN_INFLOG_FILENAME,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
WRKLEN1 = STG(GWL_INFLOG_RECORDS);
WRKLEN2 = STG(CN_INFLOG_RECORDS);
CTR_COLUMN = CTR_COLUMN +1;
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSINT4,
WRKLEN1,
GWL_INFLOG_RECORDS,
TDS_ZERO,
TDS_FALSE,
TDSINT4,
WRKLEN1,
CN_INFLOG_RECORDS,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDINFLOG_EXIT;
END;
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDINFLOG_EXIT;
END;
CALL TDSNDROW (GWL_PROC, GWL_RC);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSNDROW';
GO TO TDINFLOG_EXIT;
END;
CTR_ROWS = CTR_ROWS +1;
/*------------------------------------------------------------*/
TDINFLOG_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDINFLOG_PROC;
/*------------------------------------------------------------*/
TDLSTSPT_PROC: PROC;
/*------------------------------------------------------------*/
WRKLEN1 = STG(WRK_TRANID);
WRKLEN2 = STG(CN_LSTSPT_TRANID);
CTR_COLUMN = CTR_COLUMN +1;
MSG_SRVLIB_FUNC = 'TDESCRIB';
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSCHAR,
WRKLEN1,
WRK_TRANID,
TDS_ZERO,
TDS_FALSE,
TDSCHAR,
WRKLEN1,
CN_LSTSPT_TRANID,
WRKLEN2);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
GO TO TDLSTSPT_EXIT;
END;
/* ------------------------------------------------------*/
/* find global status */
/* ------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
/* ------------------------------------------------------*/
/* if any error, then assume tracing disabled */
/* ------------------------------------------------------*/
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDLSTSPT_EXIT;
END;
/* ------------------------------------------------------*/
/* if not specific tracing, then return nothing */
/* ------------------------------------------------------*/
IF GWL_INFLOG_GLOBAL NE TDS_TRACE_SPECIFIC_RPCS THEN
GO TO TDLSTSPT_EXIT;
/* ------------------------------------------------------*/
/* return rows */
/* ------------------------------------------------------*/
CALL TDLSTSPT (GWL_INIT_HANDLE, GWL_RC,
GWL_LSTSPT_LIST(1));
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDLSTSPT';
END;
DOROW: DO WRK_LSTSPT_SS = 1 TO 8;
WRK_TRANID = GWL_LSTSPT_LIST(WRK_LSTSPT_SS);
CALL TDSNDROW (GWL_PROC, GWL_RC);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSNDROW';
LEAVE DOROW;
END;
CTR_ROWS = CTR_ROWS +1;
END;
/*------------------------------------------------------------*/
TDLSTSPT_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDLSTSPT_PROC;
/*------------------------------------------------------------*/
TDSETACT_ON_PROC: PROC;
/*------------------------------------------------------------*/
CALL TDINFACT (GWL_INIT_HANDLE, GWL_RC,
GWL_INFACT_STATUS,
GWL_INFACT_FILENAME,
GWL_INFACT_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFACT';
GO TO TDSETACT_ON_EXIT;
END;
/* ------------------------------------------------------*/
/* turn on host accounting */
/* ------------------------------------------------------*/
CALL TDSETACT (GWL_INIT_HANDLE, GWL_RC,
TDS_TRUE,
GWL_INFACT_FILENAME,
GWL_INFACT_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETACT';
GO TO TDSETACT_ON_EXIT;
END;
/*------------------------------------------------------------*/
TDSETACT_ON_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETACT_ON_PROC;
/*------------------------------------------------------------*/
TDSETACT_OFF_PROC: PROC;
/*------------------------------------------------------------*/
CALL TDINFACT (GWL_INIT_HANDLE, GWL_RC,
GWL_INFACT_STATUS,
GWL_INFACT_FILENAME,
GWL_INFACT_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFACT';
GO TO TDSETACT_OFF_EXIT;
END;
/* ------------------------------------------------------*/
/* turn off host accounting if on */
/* ------------------------------------------------------*/
IF GWL_INFACT_STATUS = TDS_TRUE THEN
DO;
CALL TDSETACT (GWL_INIT_HANDLE, GWL_RC,
TDS_FALSE,
GWL_INFACT_FILENAME,
GWL_INFACT_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETACT';
GO TO TDSETACT_OFF_EXIT;
END;
END;
/*------------------------------------------------------------*/
TDSETACT_OFF_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETACT_OFF_PROC;
/*------------------------------------------------------------*/
TDSETLOG_ON_PROC: PROC;
/*------------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC, GWL_INFLOG_GLOBAL,
GWL_INFLOG_API, GWL_INFLOG_HEADER,
GWL_INFLOG_DATA, GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME, GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDSETLOG_ON_EXIT;
END;
/* ------------------------------------------------------*/
/* turn on API (CICS Aux Trace) and Header tracing */
/* ------------------------------------------------------*/
CALL TDSETLOG (GWL_INIT_HANDLE, GWL_RC,
TDS_TRACE_ALL_RPCS, TDS_TRUE,
TDS_TRUE, GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETLOG';
GO TO TDSETLOG_ON_EXIT;
END;
/*------------------------------------------------------------*/
TDSETLOG_ON_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETLOG_ON_PROC;
/*------------------------------------------------------------*/
TDSETLOG_OFF_PROC: PROC;
/*------------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDSETLOG_OFF_EXIT;
END;
/* ------------------------------------------------------*/
/* turn off API (CICS Aux Trace) and Header tracing */
/* ------------------------------------------------------*/
CALL TDSETLOG (GWL_INIT_HANDLE, GWL_RC,
TDS_NO_TRACING,
TDS_FALSE,
TDS_FALSE,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETLOG';
GO TO TDSETLOG_OFF_EXIT;
END;
/*------------------------------------------------------------*/
TDSETLOG_OFF_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETLOG_OFF_PROC;
/*------------------------------------------------------------*/
TDSETSPT_ON_PROC: PROC;
/*------------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDSETSPT_ON_EXIT;
END;
/* ------------------------------------------------------*/
/* turn on tracing for specific transactions */
/* ------------------------------------------------------*/
CALL TDSETLOG (GWL_INIT_HANDLE, GWL_RC,
TDS_TRACE_SPECIFIC_RPCS,
TDS_TRUE,
TDS_TRUE,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETLOG';
GO TO TDSETSPT_ON_EXIT;
END;
/* ------------------------------------------------------*/
/* enable error log recording for this tranid */
/* ------------------------------------------------------*/
GWL_SETSPT_OPTIONS = 2;
WRKLEN1 = STG(WRK_RPC);
CALL TDSETSPT (GWL_INIT_HANDLE, GWL_RC,
TDS_TRUE,
GWL_SETSPT_OPTIONS,
WRK_RPC,
WRKLEN1);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETSPT';
GO TO TDSETSPT_ON_EXIT;
END;
/*------------------------------------------------------------*/
TDSETSPT_ON_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETSPT_ON_PROC;
/*------------------------------------------------------------*/
TDSETSPT_OFF_PROC: PROC;
/*------------------------------------------------------------*/
/* ------------------------------------------------------*/
/* Assume specific tracing is on for this transaction, */
/* and turn it off. */
/* ------------------------------------------------------*/
WRKLEN1 = STG(WRK_RPC);
CALL TDSETSPT (GWL_INIT_HANDLE, GWL_RC,
TDS_FALSE,
GWL_SETSPT_OPTIONS,
WRK_RPC,
WRKLEN1);
IF GWL_RC NE TDS_OK
AND GWL_RC NE TDS_ENTRY_NOT_FOUND THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDSETSPT';
GO TO TDSETSPT_OFF_EXIT;
END;
/*------------------------------------------------------------*/
TDSETSPT_OFF_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDSETSPT_OFF_PROC;
/*------------------------------------------------------------*/
TDWRTLOG_PROC: PROC;
/*------------------------------------------------------------*/
/* ------------------------------------------------------*/
/* write a log entry only if logging is enabled */
/* ------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO TDWRTLOG_EXIT;
END;
/* ------------------------------------------------------*/
/* write a log entry only if logging is enabled */
/* ------------------------------------------------------*/
CALL GET_TRACE_STATUS;
IF (TRACING) THEN
DO;
CALL TDWRTLOG (GWL_PROC, GWL_RC,
TDS_TRUE,
GWL_WRTLOG_MSG,
GWL_WRTLOG_MSG_L);
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDWRTLOG';
GO TO TDWRTLOG_EXIT;
END;
END;
ELSE
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'LOGNOTON';
GO TO TDWRTLOG_EXIT;
END;
/*------------------------------------------------------------*/
TDWRTLOG_EXIT:
/*------------------------------------------------------------*/
RETURN;
END TDWRTLOG_PROC;
/*------------------------------------------------------------*/
GET_TRACE_STATUS: PROC;
/*------------------------------------------------------------*/
/* ------------------------------------------------------*/
/* find global status */
/* ------------------------------------------------------*/
CALL TDINFLOG (GWL_INIT_HANDLE, GWL_RC,
GWL_INFLOG_GLOBAL,
GWL_INFLOG_API,
GWL_INFLOG_HEADER,
GWL_INFLOG_DATA,
GWL_INFLOG_TRACEID,
GWL_INFLOG_FILENAME,
GWL_INFLOG_RECORDS);
/* ------------------------------------------------------*/
/* if any error, then assume tracing disabled */
/* ------------------------------------------------------*/
IF GWL_RC NE TDS_OK THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINFLOG';
GO TO GET_TRACE_STATUS_EXIT;
END;
/* ------------------------------------------------------*/
/* if global tracing on, then tracing enabled */
/* ------------------------------------------------------*/
IF GWL_INFLOG_GLOBAL = TDS_TRACE_ALL_RPCS THEN
DO;
TRACING = TRACING_ON;
GO TO GET_TRACE_STATUS_EXIT;
END;
/* ------------------------------------------------------*/
/* if error logging on, then tracing enabled */
/* ------------------------------------------------------*/
IF GWL_INFLOG_GLOBAL = TDS_TRACE_ERRORS_ONLY THEN
DO;
TRACING = TRACING_ON;
GO TO GET_TRACE_STATUS_EXIT;
END;
/* ------------------------------------------------------*/
/* if specific tracing not on, then no tracing on */
/* ------------------------------------------------------*/
IF GWL_INFLOG_GLOBAL NE TDS_TRACE_SPECIFIC_RPCS THEN
DO;
GO TO GET_TRACE_STATUS_EXIT;
END;
/* ------------------------------------------------------*/
/* specific tracing is on, see if on for this transaction*/
/* ------------------------------------------------------*/
WRKLEN1 = STG(WRK_RPC);
CALL TDINFSPT (GWL_INIT_HANDLE, GWL_RC,
GWL_INFSPT_STATUS,
GWL_INFSPT_OPTIONS,
WRK_RPC,
WRKLEN1);
IF (GWL_RC NE TDS_OK AND GWL_RC NE TDS_ENTRY_NOT_FOUND) THEN
DO;
SEND_DONE = SEND_DONE_ERROR;
MSG_SRVLIB_FUNC = 'TDINSPT';
GO TO GET_TRACE_STATUS_EXIT;
END;
IF GWL_INFSPT_STATUS = TDS_TRUE THEN
DO;
TRACING = TRACING_ON;
END;
/*------------------------------------------------------------*/
GET_TRACE_STATUS_EXIT:
/*------------------------------------------------------------*/
RETURN;
END GET_TRACE_STATUS;
/*------------------------------------------------------------*/
SRVLIB_ERROR: PROC;
/*------------------------------------------------------------*/
MSG_SRVLIB_RC = GWL_RC;
MSG_TEXT = STRING(MSG_SRVLIB);
MSG_TEXT_L = STG(MSG_SRVLIB);
MSG_TYPE = TDS_ERROR_MSG;
MSG_RPC = WRK_RPC;
/*------------------------------------------------------------------*/
SEND_ERROR_MESSAGE: PROC;
/*------------------------------------------------------------------*/
SEND_DONE = SEND_DONE_ERROR;
MSG_SEVERITY = MSG_SEVERITY_ERROR;
MSG_NR = MSG_NR_ERROR;
MSG_TYPE = TDS_ERROR_MSG;
CALL SEND_MESSAGE;
RETURN;
END SEND_ERROR_MESSAGE;
/*------------------------------------------------------------------*/
SEND_MESSAGE: PROC;
/*------------------------------------------------------------------*/
/* ------------------------------------------------------------*/
/* ensure we're in right state to send a message */
/* ------------------------------------------------------------*/
CALL TDSTATUS (GWL_PROC, GWL_RC,
GWL_STATUS_NR,
GWL_STATUS_DONE,
GWL_STATUS_COUNT,
GWL_STATUS_COMM,
GWL_STATUS_RETURN_CODE,
GWL_STATUS_SUBCODE);
IF GWL_RC = TDS_OK THEN
DO;
IF GWL_STATUS_COMM = TDS_RECEIVE THEN
CALL TDSNDMSG (GWL_PROC, GWL_RC,
MSG_TYPE, MSG_NR,
MSG_SEVERITY,
TDS_ZERO,
TDS_ZERO,
MSG_RPC, MSG_RPC_L,
MSG_TEXT, MSG_TEXT_L);
END;
RETURN;
END SEND_MESSAGE;
RETURN;
END SRVLIB_ERROR;
END SYSAMP1;
