$on warning then exit $set def sys$login $! $create icc_def.mar .title icc_def .library "sys$library:lib.mlb" $iccdef GLOBAL .end $! $macro/lis icc_def $! $create icc_server.cob identification division. program-id. icc_server. author. Richard Maher. data division. working-storage section. 01 ast_receive pic 9(9) comp value external ast_receive. 01 ast_handshake pic 9(9) comp value external ast_handshake. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 assoc_handle pic 9(9) comp. 01 buffer_count pic 9(9) comp value 5. 01 prot_sysprv pic 9(9) comp value 2. * procedure division. kick_off section. 00. perform server_init. display "Hibernating. . .zzzzzz". call "sys$hiber" giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. call "sys$icc_close_assoc" using by value assoc_handle giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. stop run. * server_init section. 00. call "sys$icc_open_assoc" using by reference assoc_handle by descriptor "ICC_TEST_SERVER" by value 0, 0, ast_handshake, ast_handshake, ast_receive, buffer_count, prot_sysprv giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. * end program icc_server. identification division. program-id. ast_handshake. data division. working-storage section. 01 ast_discon pic 9(9) comp value external ast_discon. 01 ss$_reject pic 9(9) comp value external ss$_reject. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 rem_pid pointer. 01 buff_init_size pic 9(9) comp value 1024. 01 event_type pointer. 88 icc$c_ev_connect value external icc$c_ev_connect. 88 icc$c_ev_disconnect value external icc$c_ev_disconnect. 01 cxn_handle pointer. 01 cxn_data_len pointer. 01 cxn_p5. 03 cxn_p5_lw pointer. 66 cxn_reply_buff_len renames cxn_p5_lw. 66 cxn_discon_status renames cxn_p5_lw. 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * linkage section. 01 by_val_event_type pic 9(9) comp. 01 by_val_cxn_handle pic 9(9) comp. 01 by_val_cxn_data_len pic 9(9) comp. 01 cxn_data_buff pic x(1000). 01 by_val_cxn_p5 pic 9(9) comp. 01 discon_user_context pic x(32). 01 rem_username pic x(12). * procedure division using by_val_event_type, by_val_cxn_handle, by_val_cxn_data_len, cxn_data_buff, by_val_cxn_p5, discon_user_context, rem_username. kick_off section. 00. set cxn_handle to reference by_val_cxn_handle. set cxn_data_len to reference by_val_cxn_data_len. set cxn_p5_lw to reference by_val_cxn_p5. set event_type to reference by_val_event_type. evaluate true when icc$c_ev_connect perform accept_reject_cxn when icc$c_ev_disconnect perform remove_cxn when other call "lib$stop" using by value ss$_abort end-evaluate. * fini. exit program. * accept_reject_cxn section. 00. set rem_pid to reference discon_user_context. display "pid = ", rem_pid with conversion. display "username = ", rem_username. display "connect data = ", cxn_data_buff(1:cxn_data_len). display "cxn_data_len is ", cxn_data_len with conversion. display "reply_buff_len = ", cxn_reply_buff_len with conversion. if cxn_data_buff(1:cxn_data_len) = "*Hello!*" call "sys$icc_accept" using by value cxn_handle by reference "*accepted*" by value 10 by reference user_context by value 0 giving sys_status else call "sys$icc_reject" using by value cxn_handle by reference "*rejected*" by value 10, ss$_reject giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "lib$get_vm" using buff_init_size, input_buff giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. move buff_init_size to input_buff_size. * fini. * remove_cxn section. 00. move discon_user_context to user_context. display "Exit Status was ", cxn_discon_status with conversion. call "sys$icc_disconnect" using by value cxn_handle by reference iosb by value ast_discon by reference user_context by value 0,0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. * end program ast_handshake. identification division. program-id. ast_receive. data division. working-storage section. 01 ast_read_comp pic 9(9) comp value external ast_read_comp. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 cxn_handle pointer. 01 message_size pointer. * linkage section. 01 by_val_msg_size pic 9(9) comp. 01 by_val_cxn_handle pic 9(9) comp. 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * procedure division using by_val_msg_size, by_val_cxn_handle, user_context. 00. set message_size to reference by_val_msg_size. set cxn_handle to reference by_val_cxn_handle. display "MSG Size = ", message_size with conversion. if message_size > input_buff_size call "lib$free_vm" using input_buff_size, input_buff giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if call "lib$get_vm" using message_size, input_buff giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if move message_size to input_buff_size. call "sys$icc_receive" using by value cxn_handle by reference ios_icc by value ast_read_comp by reference user_context by value input_buff, input_buff_size giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. exit program. * end program ast_receive. identification division. program-id. ast_read_comp. data division. working-storage section. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * procedure division using user_context. 00. display "in read ast". if icc_status not = ss$_normal call "lib$stop" using by value icc_status. if req_handle not = zeros display "Can't handle transceives" call "lib$stop" using by value ss$_abort. call "output_msg" using by value input_buff by reference recv_len. * fini. exit program. * end program ast_read_comp. identification division. program-id. ast_discon. data division. working-storage section. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_linkdiscon pic 9(9) comp value external ss$_linkdiscon. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * procedure division using user_context. 00. display "in discon ast". if cond_val not = ss$_normal and ss$_linkdiscon call "lib$stop" using by value cond_val. * fini. exit program. * end program ast_discon. identification division. program-id. output_msg. data division. working-storage section. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_linkdiscon pic 9(9) comp value external ss$_linkdiscon. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 out_buff pic x(65535). 01 out_len pic 9(9) comp. * procedure division using out_buff, out_len. 00. display "message = ", out_buff(1:out_len). * fini. exit program. * end program output_msg. $! $create icc_server.inp $deck $run icc_server $eod $! $cobol/lis icc_server $link icc_server,icc_def $run/detach sys$system:loginout.exe/out=icc_server.out/inp=icc_server.inp/process_name=icc_server $! $create icc_client.cob identification division. program-id. icc_client. author. Richard Maher. data division. working-storage section. 01 ast_receive pic 9(9) comp value external ast_receive. 01 ast_disconnect pic 9(9) comp value external ast_disconnect. 01 ast_cxn_comp pic 9(9) comp value external ast_cxn_comp. 01 ss$_wasclr pic 9(9) comp value external ss$_wasclr. 01 ss$_wasset pic 9(9) comp value external ss$_wasset. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 syi_item_list. 03 item_node_name. 05 pic 9(4) comp value 6. 05 pic 9(4) comp value external syi$_nodename. 05 pointer value reference node_name. 05 pointer value reference node_name_length. 03 pic 9(9) comp. * 01 syi_iosb. 03 syi_status pic 9(9) comp. 03 pic x(4). 01 node_name pic x(6). 01 node_name_length pic 9(4) comp. * 01 assoc_handle pic 9(9) comp. 01 buffer_count pic 9(9) comp value 5. 01 prot_sysprv pic 9(9) comp value 2. 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. * procedure division. kick_off section. 00. perform client_init. call "sys$setast" using by value 0 giving sys_status. if sys_status not = ss$_wasset call "lib$stop" using by value sys_status. call "sys$icc_connect" using by reference iosb by value ast_cxn_comp by reference user_context by value assoc_handle by reference cxn_handle by descriptor "ICC_TEST_SERVER", node_name(1:node_name_length) by reference user_context, "*Hello!*" by value 8 by reference return_buff by value 512 by reference return_buff_len by value 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Hibernating. . .zzzzzzz". call "sys$setast" using by value 1 giving sys_status. if sys_status not = ss$_wasclr call "lib$stop" using by value sys_status. call "sys$hiber". call "sys$setast" using by value 0 giving sys_status. if sys_status not = ss$_wasset call "lib$stop" using by value sys_status. display "Trying again.". call "sys$icc_connect" using by reference iosb by value ast_cxn_comp by reference user_context by value assoc_handle by reference cxn_handle by descriptor "ICC_TEST_SERVER", node_name(1:node_name_length) by reference user_context, "1234567" by value 7 by reference return_buff by value 512 by reference return_buff_len by value 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. display "Hibernating. . .zzzzzzz". call "sys$setast" using by value 1 giving sys_status. if sys_status not = ss$_wasclr call "lib$stop" using by value sys_status. call "sys$hiber". display "Exiting.". * fini. call "sys$icc_close_assoc" using by value assoc_handle giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. stop run. * client_init section. 00. call "sys$getsyiw" using by value 0, 0, 0, by reference syi_item_list, syi_iosb by value 0, 0 giving sys_status. if sys_status = ss$_normal move syi_status to sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. call "sys$icc_open_assoc" using by reference assoc_handle by descriptor "ICC_TEST_CLIENT" by value 0, 0, 0, ast_disconnect, ast_receive, buffer_count, prot_sysprv giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. * end program icc_client. identification division. program-id. ast_disconnect. data division. working-storage section. 01 ast_discon pic 9(9) comp value external ast_discon. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 rem_pid pointer. 01 buff_init_size pic 9(9) comp value 1024. * linkage section. 01 event_type pic 9(9) comp. 88 icc$c_ev_connect value external icc$c_ev_connect. 88 icc$c_ev_disconnect value external icc$c_ev_disconnect. 01 cxn_handle pic 9(9) comp. 01 cxn_data_len pic 9(9) comp. 01 cxn_data_buff pic x(1000). 01 cxn_p5. 03 cxn_p5_lw pic 9(9) comp. 66 cxn_reply_buff_len renames cxn_p5_lw. 66 cxn_discon_status renames cxn_p5_lw. 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 a_cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. 01 rem_username pic x(12). * procedure division using event_type, cxn_handle, cxn_data_len, cxn_data_buff, cxn_p5, user_context, rem_username. kick_off section. 00. if icc$c_ev_disconnect perform remove_cxn else call "lib$stop" using by value ss$_abort. * fini. exit program. * remove_cxn section. 00. display "exit Status was ", cxn_discon_status with conversion. call "sys$icc_disconnect" using by value cxn_handle by reference iosb by value ast_discon by reference user_context by value 0,0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. * end program ast_disconnect. identification division. program-id. ast_receive. data division. working-storage section. 01 ast_read_comp pic 9(9) comp value external ast_read_comp. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * 01 ast_param. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * linkage section. 01 message_size pic 9(9) comp. 01 cxn_handle pic 9(9) comp. 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 a_cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. * procedure division using message_size, cxn_handle, user_context. 00. display "MSG Size = ", message_size with conversion. if message_size > input_buff_size call "lib$free_vm" using input_buff_size, input_buff giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if call "lib$get_vm" using message_size, input_buff giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if move message_size to input_buff_size. call "sys$icc_receive" using by value cxn_handle by reference ios_icc by value ast_read_comp by reference ast_param by value input_buff, input_buff_size giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. exit program. * end program ast_receive. identification division. program-id. ast_read_comp. data division. working-storage section. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 ast_param. 03 ios_icc. 05 icc_status pic 9(4) comp. 05 pic xx. 05 recv_len pic 9(9) comp. 05 req_handle pic 9(9) comp. 05 reply_len pic 9(9) comp. * procedure division using ast_param. 00. display "in read ast". if icc_status not = ss$_normal call "lib$stop" using by value sys_status. if req_handle not = zeros display "Can't handle transceives" call "lib$stop" using by value ss$_abort. * fini. exit program. * end program ast_read_comp. identification division. program-id. ast_discon. data division. working-storage section. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 a_cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. * procedure division using user_context. 00. display "in discon ast", cond_val with conversion. if cond_val not = ss$_normal call "lib$stop" using by value cond_val. call "sys$wake" using by value 0, 0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. exit program. * end program ast_discon. identification division. program-id. ast_cxn_comp. data division. working-storage section. 01 ast_xmit pic 9(9) comp value external ast_xmit. 01 ss$_reject pic 9(9) comp value external ss$_reject. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 a_cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. * procedure division using user_context. 00. display "in cxn_comp ast". if cond_val = ss$_reject display "CXN rejected!" call "sys$wake" using by value 0, 0 giving sys_status if sys_status not = ss$_normal call "lib$stop" using by value sys_status end-if go to fini. if cond_val not = ss$_normal call "lib$stop" using by value cond_val. if return_buff_len not = zeros display "Return buff = ", return_buff (1:return_buff_len). call "sys$icc_transmit" using by value a_cxn_handle by reference iosb by value ast_xmit by reference user_context, "This is the message. . ." by value 24 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. exit program. * end program ast_cxn_comp. identification division. program-id. ast_xmit. data division. working-storage section. 01 ast_discon pic 9(9) comp value external ast_discon. 01 ss$_linkdiscon pic 9(9) comp value external ss$_linkdiscon. 01 ss$_abort pic 9(9) comp value external ss$_abort. 01 ss$_normal pic 9(9) comp value external ss$_normal. 01 sys_status pic 9(9) comp. * linkage section. * 01 user_context. 03 iosb. 05 cond_val pic 9(4) comp. 05 pic x(6). 03 input_buff pic 9(9) comp. 03 input_buff_size pic 9(9) comp. 03 a_cxn_handle pic 9(9) comp. 03 return_buff pic x(512). 03 return_buff_len pic 9(4) comp. * procedure division using user_context. 00. display "in xmit ast", cond_val with conversion. if cond_val = ss$_linkdiscon go to fini. if cond_val not = ss$_normal call "lib$stop" using by value cond_val. call "sys$icc_disconnect" using by value a_cxn_handle by reference iosb by value ast_discon by reference user_context by value 0,0 giving sys_status. if sys_status not = ss$_normal call "lib$stop" using by value sys_status. * fini. exit program. * end program ast_xmit. $! $cobol/lis icc_client $link icc_client,icc_def $run icc_client $stop icc_server $exit