******************************************************************** *** *** This program is an example of how to access the Information *** Services of Entire Broker. *** *** Created: Mogens Lundqvist, Software AG April 1998 *** Modified: Theo Beack, Software AG August 2001 *** ******************************************************************** *** *** Modification: Added Broker Command Services logic. Program can *** no locat and terminate a Service using SHUTDOWN IMMED function. *** Server program will receive Broker ACI error 0010 0050 and will *** have to handle the error in the appropriate manner. *** ******************************************************************** DEFINE DATA LOCAL 1 #W 2 #RC (I02) 2 #BROKER (A32) INIT <'ETB172'> 2 #SEND_LEN (I04) INIT <250> 2 #RECV_LEN (I04) INIT <500> 2 #ERR_LEN (I04) INIT <40> 2 #EOC (L) INIT 2 #SAVED_CONV_ID (A16) 2 #OBJECT_TYPE (I02) 2 #NO (I02) 2 #H (N05) 2 #H_R (N04) 2 #M (N02) 2 #M_R (N04) 2 #S_R (N04) 2 #TIME_RUN (A11) * * ___ ENTIRE BROKER API Function Constants 1 #FCT_SEND (I01) INIT<1> 1 #FCT_RECEIVE (I01) INIT<2> 1 #FCT_UNDO (I01) INIT<4> 1 #FCT_EOC (I01) INIT<5> 1 #FCT_REGISTER (I01) INIT<6> 1 #FCT_DEREGISTER (I01) INIT<7> 1 #FCT_VERSION (I01) INIT<8> 1 #FCT_LOGON (I01) INIT<9> 1 #FCT_LOGOFF (I01) INIT<10> 1 #FCT_SET (I01) INIT<11> 1 #FCT_GET (I01) INIT<12> 1 #FCT_SYNCPOINT (I01) INIT<13> * * ___ ENTIRE BROKER API Option Constants 1 #OPT_HOLD (I01) INIT<2> 1 #OPT_IMMED (I01) INIT<3> 1 #OPT_QUIESCE (I01) INIT<4> 1 #OPT_EOC (I01) INIT<5> 1 #OPT_CANCEL (I01) INIT<6> /* new */ 1 #OPT_LAST (I01) INIT<7> 1 #OPT_NEXT (I01) INIT<8> 1 #OPT_PREVIEW (I01) INIT<9> 1 #OPT_COMMIT (I01) INIT<10> /* new */ 1 #OPT_BACKOUT (I01) INIT<11> /* new */ 1 #OPT_SYNC (I01) INIT<12> /* new */ 1 #OPT_ATTACH (I01) INIT<13> /* new */ * * ___ ENTIRE BROKER API Control Block 1 #ETBCB 2 #API_TYPE (I01) INIT<1> 2 REDEFINE #API_TYPE 3 #ETBAPI (A01) 2 #API_VERSION (I01) INIT<1> 2 #FUNCTION (I01) 2 #OPTION (I01) 2 #RESERVED (A16) 2 #SEND_LENGTH (I04) 2 #RECEIVE_LENGTH (I04) 2 #RETURN_LENGTH (I04) 2 #ERRTEXT_LENGTH (I04) 2 #BROKER_ID (A32) 2 #SERVER_CLASS (A32) 2 #SERVER_NAME (A32) 2 #SERVICE (A32) 2 #USER_ID (A32) 2 #PASSWORD (B32) 2 #TOKEN (A32) 2 #SECURITY_TOKEN (B32) 2 #CONV_ID (A16) 2 #WAIT (A08) 2 #ERROR_CODE (A08) 2 REDEFINE #ERROR_CODE 3 #ERROR_CLASS (N04) 3 #ERROR_NUMBER (N04) 2 #ENVIRONMENT (A32) 2 #USER_DATA (B16) 2 #CONV_STAT (I01) 2 #MSG_ID (B48) 2 #MSG_TYPE (A16) 2 #STORE (I01) 2 #PTIME (A08) 2 #STATUS (I01) 2 #ADCOUNT (I04) 2 #NEWPASSWORD (B32) 2 #ADAPTER_ERROR (A08) 2 #CLIENT_UID (A32) * * ___ Header Structure 32 Bytes 1 #HS (A32) 1 REDEFINE #HS 2 ERROR_CODE (I04) /* Result _ 0 = success 2 TOTAL_NUM_OBJECTS (I04) /* Total nr. of objects returned 2 CURRENT_NUM_OBJECTS (I04) /* Nr of objects in curr. recv block 2 MAX_SC_LEN (I04) /* Len of longest Server_Class 2 MAX_SN_LEN (I04) /* Len of longest Server_Name 2 MAX_SV_LEN (I04) /* Len of longest Service 2 MAX_UID_LEN (I04) /* Len of longest UID 2 MAX_TK_LEN (I04) /* Len of longest Token * * ___ Information Request Structure 216 Bytes 1 #IRS 2 #BLOCK_LENGTH (I04) /* R Blk len of data package 2 #VERSION (I02) /* R Interface Version 2 #INFO_LEVEL (I02) /* 2 #OBJECT_TYPE (I02) /* R Object Type * 1 = Server * 2 = Client * 4 = Conv * 6 = Service * 7 = Broker * 8 = Worker 2 #USER_ID (A32) /* O User Id 2 #P_USER_ID (B28) /* O Internal UID 2 #TOKEN (A32) /* O Token 2 #SERVER_CLASS (A32) /* O 2 #SERVER_NAME (A32) /* O 2 #SERVICE (A32) /* O 2 #CONV_ID (A16) /* O 2 #RESERVED (I02) /* O Reserved 1 REDEFINE #IRS 2 #IRS_GRP (A216) * * ___ Broker_Object Structure _ Type 7 92 Bytes 1 #BS (A92) 1 REDEFINE #BS 2 #PLATFORM (A08) /* 2 #RUN_TIME (I04) /* Time since start in sec's 2 #NUM_WORKER_ACT (I04) /* Nr of worker active 2 #NUM_LONG (I04) /* Nr of long buff 2 #LONG_ACT (I04) /* Nr long buff act 2 #LONG_HIGH (I04) /* HWM of long buff 2 #NUM_SHORT (I04) /* Num of short buff 2 #SHORT_ACT (I04) /* Nr of short buff act 2 #SHORT_HIGH (I04) /* HWM of short buff 2 #LONG_SIZE (I04) /* Size of long buff 2 #SHORT_SIZE (I04) /* Size of short buff 2 #NUM_SERVICE (I04) /* Nr of service 2 #SERVICE_ACT (I04) /* Nr of act services 2 #NUM_SERVER (I04) /* Nr of server 2 #SERVER_ACT (I04) /* Nr of act server 2 #SERVER_HIGH (I04) /* HWM of server 2 #NUM_CLIENT (I04) /* Nr clients defined 2 #CLIENT_ACT (I04) /* Nr of act client 2 #CLIENT_HIGH (I04) /* HWM of client 2 #NUM_CONV (I04) /* Nr conv 2 #CONV_HIGH (I04) /* HWM of conv 2 #TRACE_LEVEL (I02) /* Actual Trace_level 2 #RESERVE (I02) /* * * ___ Worker_Object Structure _ Type 8 12 Bytes 1 #WS (A12) 1 REDEFINE #WS 2 #WORKER_ID (I02) /* Table nr of Queue entry 2 #WORKER_STAT (I02) /* Status of Worker * 2 = Active * 4 = Started * 5 = Waiting 2 #CALL_SUM (I04) /* Sum of calls per Worker 2 #IDLE_SUM (I04) /* Sum of idle time * * ___ Command Request Structure _ 52 Bytes 1 #COMMAND_STRUCTURE (A52) 1 REDEFINE #COMMAND_STRUCTURE 2 #VERSION (I02) /* Interface Version. Current Version is 2 2 #OBJECT_TYPE (I02) /* Specifies the object type * 1 = Server * 7 = Broker * 9 = PSF 2 #COMMAND (I02) /* Command to be issued * 1 = Trace On * 2 = Trace Off * 8 = Shutdown * 12 = Purge 2 #OPTION (I02) /* Possible Values * 3 = IMMED * 4 = QUISCE * 11 = LEVEL 1 * 12 = LEVEL 2 * 13 = LEVEL 3 2 #P_USER_ID (A28) /* Internal Userid 2 #UOWID (A16) /* Optional Field. Specifies UOW. * * ___ Service_Object Structure _ Type 6 160 Bytes 1 #SS (A156) 1 REDEFINE #SS 2 #SERVER_CLASS (A32) /* 2 #SERVER_NAME (A32) /* 2 #SERVICE (A32) /* 2 #TRANS (A08) /* Translation Rtn Used 2 #CONV_NONACT (I04) /* Conversation Timeout 2 #SERVER_ACT (I04) /* Nr servers act 2 #CONV_ACT (I04) /* Nr conv act 2 #CONV_HIGH (I04) /* HWM conv act 2 #LONG_ACT (I04) /* Nr long buff 2 #LONG_HIGH (I04) /* HWM long buff 2 #SHORT_ACT (I04) /* Nr short buff 2 #SHORT_HIGH (I04) /* HWM short buff 2 #NUM_WAIT_SERVER (I04) /* Nr times client wait 2 #NUM_SERV_OCC (I04) /* Nr times client not served immed 2 #NUM_PEND (I04) /* Nr new conv in queue _ not assign 2 #PEND_HIGH (I04) /* HWM Pending conv 2 #REQ_SUM (I04) /* Accum nr of requests * * ___ Client/Server_Object Structure _ Type 1/2 276 bytes 1 #CS_G 2 #CS (A218) 2 #CS_2 (A58) 1 REDEFINE #CS_G 2 #USER_ID (A32) 2 #P_USER_ID (B28) 2 #P_USER_ID_CHAR (A28) 2 #TOKEN (A32) 2 #CHAR_SET (I2) 2 #ENDIAN (I2) 2 #CS_STATUS (I2) 2 #RESERVED (I2) 2 #WAIT_CONV_TYPE (A16) 2 #WAIT_SERVER_CLASS (A32) 2 #WAIT_SERVER_NAME (A32) 2 #WAIT_SERVICE (A32) 2 #CONV_ACT (I4) 2 #SERVICE_ACT (I4) 2 #LAST_ACTIVE (I4) 2 #NONACT (I4) 2 #WAIT_NEW (I4) 2 #NUM_WAIT_NEW (I4) 2 #WAIT_OLD (I4) 2 #NUM_WAIT_OLD (I4) 2 #SUM_CONV (I4) * 1 #SEND_AREA (A250) 1 #RECEIVE_AREA (A250/1:2) 1 REDEFINE #RECEIVE_AREA 2 #HEADER (A32) 2 #REST (A218) 2 #REST2 (A250) 1 #ERROR_TEXT (A40) * 1 #COMMAND_ERROR_CODE (I04) 1 #TERMINATE_FOUND (L) INIT 1 #SERVER_TO_TERMINATE (A32) INIT <'ASERVER'> 1 #SERVER_ID_TO_TERMINATE (B28) 1 #MESSAGE (A60) END-DEFINE #W.#OBJECT_TYPE := 1 /* Server PERFORM INFO_ABOUT_ACTIVE_SERVERS IF #TERMINATE_FOUND PERFORM SHUTDOWN_SERVICE END-IF DEFINE SUBROUTINE INFO_ABOUT_ACTIVE_SERVERS PERFORM SET_BROKER #ETBCB.#FUNCTION := #FCT_SEND #ETBCB.#WAIT := 'Yes' #ETBCB.#CONV_ID := 'New' * #IRS.#BLOCK_LENGTH := 276 #IRS.#VERSION := 1 #IRS.#OBJECT_TYPE := #W.#OBJECT_TYPE #SEND_AREA := #IRS_GRP * PERFORM CALL_BROKER #W.#SAVED_CONV_ID := #ETBCB.#CONV_ID #HS := #HEADER #CS := #REST #CS_2 := #REST2 #W.#NO := 1 RP01. REPEAT PERFORM SET_BROKER #ETBCB.#CONV_ID := #W.#SAVED_CONV_ID #IRS.#BLOCK_LENGTH := 276 #IRS.#VERSION := 1 #IRS.#OBJECT_TYPE := #W.#OBJECT_TYPE #SEND_AREA := #IRS_GRP #ETBCB.#FUNCTION := #FCT_RECEIVE #ETBCB.#WAIT := 'No' PERFORM CALL_BROKER IF #W.#EOC #W.#EOC := FALSE ESCAPE BOTTOM(RP01.) IMMEDIATE END-IF #HS := #HEADER #CS := #REST #CS_2 := #REST2 #W.#NO := #W.#NO + 1 * PERFORM DISP_CS IF #CS_G.#WAIT_SERVER_NAME = #SERVER_TO_TERMINATE #TERMINATE_FOUND := TRUE #SERVER_ID_TO_TERMINATE := #CS_G.#P_USER_ID END-IF END-REPEAT /* (RP01.) END-SUBROUTINE DEFINE SUBROUTINE CALL_BROKER CALL 'BROKER' #ETBAPI #SEND_AREA #RECEIVE_AREA(1) #ERROR_TEXT * #W.#RC := RET('BROKER') DECIDE FOR FIRST CONDITION WHEN #ETBCB.#ERROR_CLASS = 0 AND /* Success #W.#RC = 0 /* No Stub Error IGNORE WHEN #ETBCB.#ERROR_CLASS = 2 /* User does not exist WRITE / '*** User does not Exist ***' WHEN #ETBCB.#ERROR_CLASS = 3 /* Conversation Ended #W.#EOC := TRUE ESCAPE ROUTINE WHEN NONE WRITE 25T '*** Call Failed ***' /// / 7T 'Return_code from Stub:' #W.#RC / 7T 'Error' #ETBCB.#ERROR_CODE 5X ' ' #ERROR_TEXT STOP END-DECIDE END-SUBROUTINE DEFINE SUBROUTINE SET_BROKER RESET #ETBCB #SEND_AREA #RECEIVE_AREA(*) #ERROR_TEXT #IRS #W.#EOC := FALSE * #ETBCB.#API_TYPE := 1 #ETBCB.#API_VERSION := 1 #ETBCB.#BROKER_ID := #W.#BROKER #ETBCB.#SERVER_CLASS := 'SAG' #ETBCB.#SERVER_NAME := 'ETBCIS' #ETBCB.#SERVICE := 'INFO' #ETBCB.#USER_ID := *USER * #ETBCB.#SEND_LENGTH := #W.#SEND_LEN #ETBCB.#RECEIVE_LENGTH := #W.#RECV_LEN #ETBCB.#ERRTEXT_LENGTH := #W.#ERR_LEN END-SUBROUTINE DEFINE SUBROUTINE DISP_CS WRITE / 25T 'Server object information' (I) / WRITE / 5T '=' #CS_G.#USER_ID / 5T '=' #CS_G.#WAIT_SERVER_CLASS / 5T '=' #CS_G.#WAIT_SERVER_NAME / 5T '=' #CS_G.#WAIT_SERVICE END-SUBROUTINE DEFINE SUBROUTINE SHUTDOWN_SERVICE RESET #ETBCB #SEND_AREA #RECEIVE_AREA(*) #ERROR_TEXT #W.#EOC := FALSE #ETBCB.#API_TYPE := 1 #ETBCB.#API_VERSION := 1 #ETBCB.#FUNCTION := #FCT_SEND #ETBCB.#BROKER_ID := #W.#BROKER #ETBCB.#SERVER_CLASS := 'SAG' #ETBCB.#SERVER_NAME := 'ETBCIS' #ETBCB.#SERVICE := 'CMD' #ETBCB.#USER_ID := *USER #ETBCB.#CONV_ID := 'NONE' #ETBCB.#WAIT := '5S' #ETBCB.#SEND_LENGTH := 52 #ETBCB.#RECEIVE_LENGTH := 40 #ETBCB.#ERRTEXT_LENGTH := #W.#ERR_LEN #COMMAND_STRUCTURE.#VERSION := 2 #COMMAND_STRUCTURE.#OBJECT_TYPE := 1 #COMMAND_STRUCTURE.#COMMAND := 8 #COMMAND_STRUCTURE.#OPTION := 3 #COMMAND_STRUCTURE.#P_USER_ID := #SERVER_ID_TO_TERMINATE #SEND_AREA := #COMMAND_STRUCTURE CALL 'BROKER' #ETBAPI #SEND_AREA #ERROR_CODE #ERROR_TEXT * #W.#RC := RET('BROKER') DECIDE FOR FIRST CONDITION WHEN #ETBCB.#ERROR_CLASS = 0 AND /* Success #W.#RC = 0 /* No Stub Error COMPRESS '===> Server:' #SERVER_TO_TERMINATE 'successfully terminated' INTO #MESSAGE WRITE // #MESSAGE WHEN #ETBCB.#ERROR_CLASS = 3 /* Conversation Ended WRITE / '*** Conversation Ended ***' #W.#EOC := TRUE ESCAPE ROUTINE WHEN NONE WRITE 25T '*** Call Failed ***' /// / 7T 'Return_code from Stub:' #W.#RC / 7T 'Error' #ETBCB.#ERROR_CODE 5X ' ' #ERROR_TEXT STOP END-DECIDE END-SUBROUTINE END