************************************************************************************ * * * COPYRIGHT (c) 1994 BY TIER3 SOFTWARE LTD. ALL RIGHTS RESERVED. * * * * THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ONLY * * IN ACCORDANCE WITH THE TERMS AND CONDITIONS OF SUCH LICENSE AND WITH THE * * THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * * COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * * OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * * TRANSFERRED. * * * * THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE AND * * SHOULD NOT BE CONSTRUED AS A COMMITMENT BY TIER3 SOFTWARE LTD. * * * ************************************************************************************ *+ * Routine Name: USER_INIT * * This routine is called by Tier3 as part of the execution server's initialization * procedures. * * In this routine you would normally open files or connect to any database(s) * required by your application. In the DEMO application no files or databases are * accessed directly, but an exit handler is declared to listen for an abnormal * termination. * * As a CLI has been loaded you are also free to spawn a sub-process via LIB$SPAWN * if that is a requirement of your application, and it should be noted that there * is no restriction on this execution server becoming a client of different Tier3 * application(s) on other node(s). *- identification division. program-id. user_init. data division. working-storage section. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 sys_status pic s9(9) comp value external ss$_normal. 01 exit_desblk. 03 pic s9(9) comp. 03 pic s9(9) comp value external exit_handler. 03 pic s9(9) comp value 1. 03 pointer value reference exit_status. 01 exit_status pic s9(9) comp. * 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. *+ * DEBUG area. TIER3 sets the "language" to COBOL by default, so the following * debugger commands are included just to show how. *- \d01 ss$_debug pic s9(9) comp value external ss$_debug. \d01 debug_commands. \d 03 cmd_len pic x(1) value x"25". \d 03 pic x(37) value "set language cobol; show process/full". * linkage section. 01 t3_system_name pic x(8). 01 t3_buffer_size pic 9(9) comp. procedure division using t3_system_name, t3_buffer_size giving sys_status. 00. *+ * In this example, for the VMS debugger to be invoked at run-time then * the /conditionals=d qualifier needs to be applied at compile-time. * * To assist a run-time decision as to whether or not to invoke debug * TIER3 has defined a local DCL symbol T3$DEBUG. This symbol is set * to the value specified by the system manager in the Tier3 Configuration * file ie: "Y" or "N". *- \d call "lib$signal" \d using by value ss$_debug, 1 \d by reference debug_commands. *+ * Record some startup information in the execution server's log file. *- display "Initializing application " t3_system_name. display "Buffer size is " t3_buffer_size with conversion. *+ * These example routines are designed specifically to handle requests for * the DEMO application only and require a buffer size of 510 bytes, but a * single shareable image, or set of user action routines, could be designed * to service the requests of multiple applications. Such routines could use * the t3_system_name argument to determine the appropriate code path to * execute at run-time. Similarly, by designing your user action routines to * be able to cope with a variable buffer size you afford the system manager * greater flexibility in tuning your application. * * We'll remember the Tier3 application parameters as they may come in handy. *- move t3_system_name to system_name. move t3_buffer_size to buffer_size. *+ * By passing the address of the data structure DEMO_CONTEXT as the context * argument to the routine T3$SETCTX, the data is made available to all * subsequent user routines by becoming the first argument in each call. *- call "t3$setctx" using demo_context giving sys_status. if sys_status not = ss$_normal go to fini. *+ * DEMO does not need any application specific cleanup but we'll check the exit * status anyway. *- call "sys$dclexh" using exit_desblk giving sys_status. * fini. exit program. * end program user_init. *+ * Routine Name: USER_LOGON * * This routine is called by Tier3 when a client request has been allocated to * the execution server for processing. From this point on an association is said * to exist between the client and execution server. The association is terminated * by specifying either the t3$m_close or the t3$m_disconnect modifier in a call to * the T3$SEND routine. The communication server may also cancel an association at * any time if the link to the client task is lost. * * Note: The output channel to the client will not be opened until the USER_LOGON * routine has returned control to Tier3. Therefore any attempt to call * T3$SEND from this routine would result in the error T3$_CHANCLOSE being * returned. *- identification division. program-id. user_logon. data division. working-storage section. 01 t3$k_decnet pic s9(9) comp value external t3$k_decnet. 01 t3$k_tcp_ip pic s9(9) comp value external t3$k_tcp_ip. 01 lib$_strtru pic s9(9) comp value external lib$_strtru. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 sys_status pic s9(9) comp value external ss$_normal. * 01 persona_create_flags pic s9(9) comp value external persona_create_flags. 01 persona_assume_flags pic s9(9) comp value external persona_assume_flags. * 01 remote_node_name pic x(31). 01 remote_user_name pic x(12). 01 remote_user_socket redefines remote_user_name. 03 remote_host_addr. 05 rha_1 pic x. 05 rha_2 pic x. 05 rha_3 pic x. 05 rha_4 pic x. 03 remote_port_num pic 9(9) comp. * 01 tcpip_rem_user_len pic 9(4) comp. 01 tcpip_rem_user pic x(21). * linkage section. 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. * 01 transport_type pic 9(4) comp. * 01 remote_node_desc pic x(8). * 01 remote_user_desc pic x(8). * 01 local_user_desc. 03 lud_class_len. 05 lud_len pic 9(4) comp. 05 lud_class pic 9(4) comp. 03 lud_addr pic 9(9) comp. * procedure division using demo_context, transport_type, remote_node_desc, remote_user_desc, local_user_desc giving sys_status. 00. *+ * Initialize the timers and counts for session statistics. *- call "lib$init_timer" using timer_context giving sys_status. if sys_status not = ss$_normal go to fini. add 1 to session_count. *+ * COBOL cannot receive arguments by descriptor transparenty so * the Run-Time Library routine LIB$SCOPY_DXDX is used to copy * the remote_node, remote_user and local_user arguments to fixed * length strings in local working-storage. *- call "lib$scopy_dxdx" using by reference remote_node_desc by descriptor remote_node_name giving sys_status. if sys_status not = ss$_normal and lib$_strtru go to fini. call "lib$scopy_dxdx" using by reference remote_user_desc by descriptor remote_user_name giving sys_status. if sys_status not = ss$_normal and lib$_strtru go to fini. *+ * The return status lib$_strtru is treated as a serious error for * the local username. ie 12 bytes is the maximum length for a VMS * username. *- call "lib$scopy_dxdx" using by reference local_user_desc by descriptor session_user giving sys_status. if sys_status not = ss$_normal go to fini. *+ * Report the client association in the execution server's log file. *- display "Association with ", session_user(1:lud_len), " established". display "Transport = " transport_type with conversion. display "Rem node = " remote_node_name. display "Rem user = " no advancing. evaluate transport_type when t3$k_decnet display remote_user_name when t3$k_tcp_ip call "sys$fao" using by descriptor "!@UB.!@UB.!@UB.!@UB:!ZL" by reference tcpip_rem_user_len by descriptor tcpip_rem_user by reference rha_1, rha_2, rha_3, rha_4 by value remote_port_num giving sys_status if sys_status not = ss$_normal go to fini end-if display tcpip_rem_user(1:tcpip_rem_user_len) end-evaluate. *+ * By assuming the persona of the VMS username that the remote client has * been authorized to use on local node we have removed the need to perform * additional security checking such as $check_access. IE: This server will * be running with only those privileges and access rights that the client * is entitled to assume. (Let VMS do all the work :-) * * NB: Again, this is only a suggestion and not a requirement of Tier3. If * you choose to use this extremely usefull VMS feature then the username * that the demo application will run under will need DETACH privilege * and read access to SYSUAF (Usually SYSPRV). *- call "sys$persona_create" using by reference persona_context by descriptor session_user(1:lud_len) by value persona_create_flags giving sys_status. if sys_status not = ss$_normal go to fini. call "sys$persona_assume" using by reference persona_context by value persona_assume_flags giving sys_status. * fini. exit program. * end program user_logon. *+ * Routine: USER_RECV * * The USER_RECV routine is called by Tier3 for each message, or * fragment of a message, that is received from a client with which * the execution server is associated. * * In the DEMO example we are receiving one message per association * with no fragmentation. * * If the status value T3$_CHANCLOSE is returned from the T3$SEND * routine it is assumed that the link to the client has been lost * so we simply return control to Tier3 after resetting our exist * status to SS$_NORMAL to avoid server crash. * * NB: If you application incorporates User Written System Services * do NOT use any executive mode dispatching codes in the range * -3000 to -2900 as these codes are reserved to Tier3. *- identification division. program-id. user_recv. data division. working-storage section. 01 t3$_chanclose pic s9(9) comp value external t3$_chanclose. 01 jbc$_nosuchent pic s9(9) comp value external jbc$_nosuchent. 01 jbc$_nomoreent pic s9(9) comp value external jbc$_nomoreent. 01 jbc$_normal pic s9(9) comp value external jbc$_normal. 01 ss$_abort pic s9(9) comp value external ss$_abort. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 sys_status pic s9(9) comp. * 01 t3$m_close pic 9(9) comp value external t3$m_close. 01 t3$m_now pic 9(9) comp value external t3$m_now. 01 t3$m_more pic 9(9) comp value external t3$m_more. 01 t3$m_oob pic 9(9) comp value external t3$m_oob. 01 qui$_display_entry pic s9(9) comp value external qui$_display_entry. 01 qui$_cancel_operation pic s9(9) comp value external qui$_cancel_operation. 01 qui$m_search_wildcard pic s9(9) comp value external qui$m_search_wildcard. * 01 sts_index pic s9(9) comp. 01 on_or_off pic s9(9) comp. 01 entry_count pic 9(9) comp. 01 qui_iosb. 03 qui_cond pic s9(9) comp. 03 pic s9(9) comp. 01 que_status_table. 03 pic s9(9) comp value external qui$m_queue_available. 03 pic x(10) value "AVAILABLE". 03 pic s9(9) comp value external qui$m_queue_busy. 03 pic x(10) value "BUSY". 03 pic s9(9) comp value external qui$m_queue_disabled. 03 pic x(10) value "DISABLED". 03 pic s9(9) comp value external qui$m_queue_idle. 03 pic x(10) value "IDLE". 03 pic s9(9) comp value external qui$m_queue_paused. 03 pic x(10) value "PAUSED". 03 pic s9(9) comp value external qui$m_queue_pausing. 03 pic x(10) value "PAUSING". 03 pic s9(9) comp value external qui$m_queue_resuming. 03 pic x(10) value "RESUMING". 03 pic s9(9) comp value external qui$m_queue_stalled. 03 pic x(10) value "STALLED". 03 pic s9(9) comp value external qui$m_queue_starting. 03 pic x(10) value "STARTING". 03 pic s9(9) comp value external qui$m_queue_stopped. 03 pic x(10) value "STOPPED". 03 pic s9(9) comp value external qui$m_queue_stopping. 03 pic x(10) value "STOPPING". 01 que_status_array redefines que_status_table. 03 que_status_item occurs 11. 05 que_value pic s9(9) comp. 05 que_text pic x(10). 01 que_flags_table. 03 pic s9(9) comp value external qui$m_queue_printer. 03 pic x(10) value "PRINTER". 03 pic s9(9) comp value external qui$m_queue_batch. 03 pic x(10) value "BATCH". 03 pic s9(9) comp value external qui$m_queue_generic. 03 pic x(10) value "GENERIC". 03 pic s9(9) comp value external qui$m_queue_terminal. 03 pic x(10) value "TERMINAL". 01 que_flags_array redefines que_flags_table. 03 que_flags_item occurs 4. 05 flags_value pic s9(9) comp. 05 flags_text pic x(10). 01 job_status_table. 03 pic s9(9) comp value external qui$m_job_aborting. 03 pic x(15) value "ABORTING". 03 pic s9(9) comp value external qui$m_job_executing. 03 pic x(15) value "EXECUTING". 03 pic s9(9) comp value external qui$m_job_holding. 03 pic x(15) value "HOLDING". 03 pic s9(9) comp value external qui$m_job_inaccessible. 03 pic x(15) value "INACCESSIBLE". 03 pic s9(9) comp value external qui$m_job_pending. 03 pic x(15) value "PENDING". 03 pic s9(9) comp value external qui$m_job_refused. 03 pic x(15) value "REFUSED". 03 pic s9(9) comp value external qui$m_job_retained. 03 pic x(15) value "RETAINED". 03 pic s9(9) comp value external qui$m_job_stalled. 03 pic x(15) value "STALLED". 03 pic s9(9) comp value external qui$m_job_starting. 03 pic x(15) value "STARTING". 03 pic s9(9) comp value external qui$m_job_suspended. 03 pic x(15) value "SUSPENDED". 03 pic s9(9) comp value external qui$m_job_timed_release. 03 pic x(15) value "TIMED RELEASE". 01 job_status_array redefines job_status_table. 03 job_status_item occurs 11. 05 job_value pic s9(9) comp. 05 job_text pic x(15). * 01 item_list_addr pointer. * 01 entry_item_list. 03 item_search_entry. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_search_number. 05 pointer value reference search_number. 05 pic s9(9) comp. 03 item_queue_flags. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_queue_flags. 05 pointer value reference que_flags. 05 pic s9(9) comp. 03 item_que_status. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_queue_status. 05 pointer value reference que_status. 05 pic s9(9) comp. 03 item_job_status. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_job_status. 05 pointer value reference job_status. 05 pic s9(9) comp. 03 item_que_name. 05 pic s9(4) comp value 31. 05 pic s9(4) comp value external qui$_queue_name. 05 pointer value reference que_name. 05 pointer value reference que_name_len. 03 item_job_name. 05 pic s9(4) comp value 39. 05 pic s9(4) comp value external qui$_job_name. 05 pointer value reference job_name. 05 pointer value reference job_name_len. 03 pic s9(9) comp. * 01 wild_item_list. 03 item_search_flags. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_search_flags. 05 pointer value reference qui$m_search_wildcard. 05 pic s9(9) comp. 03 item_queue_flags. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_queue_flags. 05 pointer value reference que_flags. 05 pic s9(9) comp. 03 item_job_entry. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_entry_number. 05 pointer value reference job_entry. 05 pic s9(9) comp. 03 item_que_status. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_queue_status. 05 pointer value reference que_status. 05 pic s9(9) comp. 03 item_job_status. 05 pic s9(4) comp value 4. 05 pic s9(4) comp value external qui$_job_status. 05 pointer value reference job_status. 05 pic s9(9) comp. 03 item_que_name. 05 pic s9(4) comp value 31. 05 pic s9(4) comp value external qui$_queue_name. 05 pointer value reference que_name. 05 pointer value reference que_name_len. 03 item_job_name. 05 pic s9(4) comp value 39. 05 pic s9(4) comp value external qui$_job_name. 05 pointer value reference job_name. 05 pointer value reference job_name_len. 03 pic s9(9) comp. * 01 search_number pic s9(9) comp. 01 que_name pic x(31). 01 que_name_len pic 9(4) comp. 01 que_status pic s9(9) comp. 01 que_flags pic s9(9) comp. 01 job_name pic x(39). 01 job_name_len pic 9(4) comp. 01 job_status pic s9(9) comp. 01 job_entry pic s9(9) comp. * 01 local_flags pic 9(9) comp. 01 show_entry_reply. 03 pic xx value "11". 03 se_entry_number pic 9(4). 03 se_job_name pic x(39). 03 se_job_status pic x(15). 03 se_que_name pic x(31). 03 se_que_type pic x(10). 03 se_que_status pic x(10). 01 show_entry_len pic 9(9) comp value 111. 01 error_msg. 03 pic xx value "00". 03 error_len pic 999. 03 error_text pic x(505). * linkage section. 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. * 01 msg_buff. 03 msg_type pic xx. 88 show_entry value "10". 03 pic x(508). 01 show_entry_msg redefines msg_buff. 03 pic xx. 03 show_entry_number pic 9(4). 03 show_entry_max pic 9(4). * 01 msg_size pic s9(9) comp. * 01 msg_flags pic s9(9) comp. * procedure division using demo_context, msg_buff, msg_size, msg_flags giving sys_status. kick_off section. 00. add 1 to message_count. *+ * If the client has sent a message that is greater than the buffer size * for this application, then Tier3 will set the bit T3$V_MORE in the * msg_flags argument. The remaining fragments of the message are not lost, * and will be delivered to user_recv routine in subsequent invocations. * This example does not contain all of the code necessary to properly * handle fragmented messages. The following "IF" statement is included * merely to illustrate how your routine would be notified of fragmentation. *- call "mth$jiand" using msg_flags, t3$m_more giving local_flags. if local_flags not = zeros display "Fragmented message - More to come". *+ * NOTE: All Tier3 parameters passed to your routines are maintained in * user mode read-only storage. Any attempt to modify their contents will * result in an access violation. Take a copy of any input parameter that * needs to be modified to local working-storage. *- move low-values to error_text. evaluate true when show_entry if show_entry_number = zeros perform get_entry_wild else perform get_entry_info end-if when other move ss$_abort to sys_status end-evaluate. exit program. * get_entry_wild section. 00. set item_list_addr to reference wild_item_list. perform get_que_info. if sys_status = jbc$_nosuchent perform send_error else if sys_status = jbc$_normal move zeros to entry_count perform until sys_status not = jbc$_normal or entry_count = show_entry_max add 1 to entry_count perform send_entry if sys_status = ss$_normal perform get_que_info end-if end-perform if sys_status = jbc$_normal or jbc$_nomoreent call "t3$send" using by reference "99EOF" by value 5, t3$m_close giving sys_status. *+ * The maximum number of entries may have been reached before all $GETQUI information * had been retrieved for the wildcard search, or the association with the client may * have been terminated prematurely by the communication server, therefore we must * be sure to tell the job controller that we wish to terminate the wildcard search. *- if sys_status = ss$_normal or t3$_chanclose call "sys$getquiw" using by value 0, qui$_cancel_operation, 0, 0 by reference qui_iosb by value 0, 0 giving sys_status if sys_status = ss$_normal and qui_cond not = jbc$_normal move qui_cond to sys_status. * get_entry_info section. 00. move show_entry_number to search_number, job_entry. set item_list_addr to reference entry_item_list. perform get_que_info. if sys_status = jbc$_nosuchent perform send_error else if sys_status = jbc$_normal perform send_entry if sys_status = ss$_normal call "t3$send" using by reference "99EOF" by value 5, t3$m_close giving sys_status. * fini. if sys_status = t3$_chanclose move ss$_normal to sys_status. * send_error section. 00. move 13 to error_len. move "No such entry" to error_text (1:error_len). call "t3$send" using by reference error_msg by value buffer_size, t3$m_close giving sys_status. * send_entry section. 00. move job_entry to se_entry_number. move job_name(1:job_name_len) to se_job_name. move que_name(1:que_name_len) to se_que_name. move zeros to sts_index, on_or_off. perform until sts_index = 11 or on_or_off not = zeros add 1 to sts_index call "mth$jiand" using job_status, job_value (sts_index) giving on_or_off end-perform. if on_or_off = zeros move "UNKNOWN" to se_job_status else move job_text (sts_index) to se_job_status move zeros to on_or_off. move zeros to sts_index. perform until sts_index = 11 or on_or_off not = zeros add 1 to sts_index call "mth$jiand" using que_status, que_value (sts_index) giving on_or_off end-perform. if on_or_off = zeros move "UNKNOWN" to se_que_status else move que_text (sts_index) to se_que_status move zeros to on_or_off. move zeros to sts_index. perform until sts_index = 4 or on_or_off not = zeros add 1 to sts_index call "mth$jiand" using que_flags, flags_value (sts_index) giving on_or_off end-perform. if on_or_off = zeros move "UNKNOWN" to se_que_type else move flags_text (sts_index) to se_que_type. call "t3$send" using by reference show_entry_reply by value show_entry_len, t3$m_now giving sys_status. * get_que_info section. 00. call "sys$getquiw" using by value 0, qui$_display_entry, 0 item_list_addr by reference qui_iosb by value 0, 0 giving sys_status. if sys_status = ss$_normal move qui_cond to sys_status. * end program user_recv. *+ * Routine: USER_LOGOFF * * This routine is called when the association with the client has been * terminated, either by the USER_RECV routine or the communication server, * and the USER_RECV routine has returned control to Tier3. * * For the DEMO example we are logging resource usage by the client. *- identification division. program-id. user_logoff. data division. working-storage section. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 sys_status pic s9(9) comp. * 01 persona_assume_flags pic s9(9) comp value external persona_assume_flags. 01 restore_persona pic 9(9) comp value 1. * linkage section. 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. * procedure division using demo_context giving sys_status. 00. display "Session completed with user ", session_user. move spaces to session_user. call "sys$persona_assume" using by reference restore_persona by value persona_assume_flags giving sys_status. if sys_status not = ss$_normal go to fini. call "sys$persona_delete" using persona_context giving sys_status. if sys_status not = ss$_normal go to fini. *+ * Display the user's session statistics. * * The Run-Time Library performance reporting routines have been used * as a very simple example of obtaining information on server resource * usage by a client. If this is a requirement of your application then * you should consider obtaining more detailed information via the VMS * system services $GETTIM and $GETJPI and accumulating totals for each * user in a disk file. This disk file could be processed at a later * date as part of charge-back accounting procedures. *- call "lib$show_timer" using timer_context giving sys_status. * fini. exit program. * end program user_logoff. *+ * Routine: USER_FINI * * This routine is called by Tier3 when the server has been culled from * the execution server pool due to inactivity timeout. * * In the DEMO aplication there are no files to close or databases to * disconnect from so the only image rundown activity performed here * is the logging of server statistics. *- identification division. program-id. user_fini. data division. working-storage section. 01 ss$_normal pic s9(9) comp value external ss$_normal. * linkage section. 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. * procedure division using demo_context giving ss$_normal. 00. display "Execution server shutting down". display "Number of associations formed: " session_count with conversion. display "Number of messages received : " message_count with conversion. display "Number of client links broken: " lostlnk_count with conversion. exit program. * end program user_fini. *+ * Routine: USER_INT * * The user interrupt routine differs from the five other user action * routines invoked by Tier3, in that it is called from AST level. * * In this example we merely increment a count of the number associations * that were terminated abnormally. This count will be reported at image * exit. *- identification division. program-id. user_int. data division. working-storage section. 01 ss$_normal pic s9(9) comp value external ss$_normal. 01 link_lost pic x(1) value x"01". * linkage section. 01 demo_context. 03 system_name pic x(8). 03 buffer_size pic 9(9) comp. 03 session_user pic x(12). 03 timer_context pic 9(9) comp. 03 session_count pic 9(9) comp. 03 message_count pic 9(9) comp. 03 lostlnk_count pic 9(9) comp. 03 persona_context pic 9(9) comp. * 01 interrupt_msg pic x(16). * 01 interrupt_type pic 9(9) comp. 88 system_msg value external t3$k_system. 88 user_msg value external t3$k_user. * procedure division using demo_context, interrupt_msg, interrupt_type giving ss$_normal. 00. *+ * The client program in the DEMO example does not send interrupts, * therefore the only interrupt that this routine needs to cater for * is that of link disconnection notification sent by the communication * server. * * The Interrupt_Type field with contain T3$K_SYSTEM indicating that * the message is from the communication server and the first byte of * the interrupt message will contain the value 1 indicating that it is * a link disconnection message. Currently bytes 2 thru 16 are unused * for Tier3 interrupts, and link disconnection notification is the only * interrupt that is sent by Tier3. * * Note: The maximum message size for TCP/IP interrupt messages is 1 byte. * This is a network transport restriction and not a TIER3 restriction. *- if (system_msg and interrupt_msg(1:1) = link_lost) add 1 to lostlnk_count display "Link to client has been lost". exit program. * end program user_int. *+ * Routine: exit_handler. * * This routine is application specific and not required by Tier3. * * For the DEMO example there are no special cleanup procedures * required but we'll interogate the exit status for error logging * purposes. * * VMS won't let a new persona to survive after image exit so no * special cleanup check is required. *- identification division. program-id. exit_handler. data division. working-storage section. 01 t3$_nocomsrv pic s9(9) comp value external t3$_nocomsrv. 01 ss$_normal pic s9(9) comp value external ss$_normal. linkage section. 01 exit_status pic s9(9) comp. procedure division using exit_status. 00. display "In exit handler - " no advancing. evaluate exit_status when ss$_normal display "Normal rundown. Everything is OK" when t3$_nocomsrv display "Can't find Tier3 communication server" when other if exit_status is failure display "This will bring down the communication server" else display "Problem, but another server will take my place" end-if end-evaluate. exit program. * end program exit_handler.