convert_dial_message_.pl1 08/05/87 0818.5r 08/04/87 1538.8 99585 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* CONVERT_DIAL_MESSAGE_ - Procedure to convert the event message received on a dial control channel into a device name, default IOSIM/DIM name, and standard status code. Written 750310 by Paul Green Modified 03/18/76 by David Jordan to add return_io_module entry. Modified 07/05/76 by D. M. Wells to understand about FTP channels and to use as_data_ names for IOSIMs Modified 04/23/79 by C. Hornig to know that AS uses iox_. Modified 80-11-11 by E.N. Kittlitz for full error code, line type. Modified May 1982 by E. N. Kittlitz for silly error_table_ typo. */ /****^ HISTORY COMMENTS: 1) change(86-06-30,Coren), approve(86-06-30,MCR7415), audit(86-07-02,Margolin), install(86-07-11,MR12.0-1092): Use dial_event_message.incl.pl1 to interpret the format of the message. Call as_user_message_$read_message to get the information defining the connection if the ls_message flag is set in the event message. END HISTORY COMMENTS */ /* format: style4 */ convert_dial_message_: procedure (bv_dial_message_fb, bv_device, bv_io_module, bv_n_dialed, bv_status, bv_code); /* parameters */ dcl (bv_dial_message_fb fixed bin (71), /* Input */ bv_device char (*), /* Output */ bv_io_module char (*), /* Output */ bv_n_dialed fixed bin, /* Output */ bv_code fixed bin (35) /* Output */ ) parameter; dcl 1 bv_status aligned parameter, /* Output */ 2 dialed_up bit (1) unaligned, 2 hung_up bit (1) unaligned, 2 control bit (1) unaligned, 2 pad bit (33) unaligned; dcl bv_dial_message bit (72) aligned based (addr (bv_dial_message_fb)); /* automatic */ dcl make_iox_name bit (1) aligned; /* which flavor of io module, "1"b-> iox */ dcl chan_name char (32); dcl code fixed bin (35); dcl system_areap pointer; dcl 1 auto_user_message_info aligned like as_user_message_info; /* based */ dcl user_message (as_user_message_info.message_length) bit (36) aligned based (ls_connection_message_ptr); dcl 1 message_device unal based (dial_event_message_ptr), /* for messages that contain devxs */ 2 devx fixed bin (17) unal, 2 line_type bin (17) unal, 2 pad fixed bin (35) unal; dcl 1 message_error aligned based (dial_event_message_ptr),/* for messages that contain full error codes */ 2 error_code fixed bin (35) aligned, 2 pad fixed bin (35) aligned; dcl 1 devx_tab_entry aligned based, /* format of internal dexv tab entry */ 2 channel char (32), 2 devx fixed bin; dcl 1 devx_tab aligned based (devx_tabp), 2 devx_entries (n_devx_entries) like devx_tab_entry; /* builtins and conditions */ dcl (addr, fixed, hbound, length, null, rtrim, string) builtin; dcl cleanup condition; /* entries */ dcl hcs_$tty_get_name entry (fixed bin, char (*), fixed bin, fixed bin (35)); dcl get_temp_segment_ entry (char (*), pointer, fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl user_message_$read_message entry (pointer, pointer, fixed bin (35)); /* external static */ dcl (as_data_$g115_dim, as_data_$mrd_dim, as_data_$ntty_dim, as_data_$tty_dim) character (32) external static; dcl (error_table_$action_not_performed, error_table_$unimplemented_version, error_table_$smallarg, error_table_$badcall) fixed bin (35) external static; /* internal static variables */ dcl n_devx_entries fixed bin int static; /* size of current devx_tab */ dcl devx_tabp ptr int static init (null); dcl 1 static_devx_tab aligned int static, /* use this little table until it overflows */ 2 entries (8) like devx_tab_entry; /* program */ make_iox_name = ""b; /* return ios DIM name */ goto cv_go; return_io_module: entry (bv_dial_message_fb, bv_device, bv_io_module, bv_n_dialed, bv_status, bv_code); make_iox_name = "1"b; /* caller wants to use iox */ goto cv_go; cv_go: dial_event_message_ptr = addr (bv_dial_message); /* get set to overlay on message */ bv_n_dialed = -1; /* not all messages set this...initialize it */ string (bv_status) = ""b; /* .. */ /* check for message of all 1s (-1) which dial_manager_ may return */ if bv_dial_message = (72)"1"b then do; bv_code = error_table_$badcall; bv_status.control = "1"b; return; end; /* See if this is a control message or a terminal status message */ if dial_event_message.description = "contrl" /* it's a control message */ then do; bv_status.control = "1"b; /* mark as a control message */ if dial_event_message.control = DIALS_ALLOWED then bv_code = 0; else if dial_event_message.control = DIALS_DENIED then bv_code = error_table_$action_not_performed; else do; bv_n_dialed = fixed (dial_event_message.control, 18); bv_code = 0; end; return; end; /* See if this is an error message */ if dial_event_message.error_msg then do; /* it's an error return */ bv_status.control = "1"b; bv_code = message_error.error_code; return; end; /* It is a terminal status message ... return device name from message */ bv_status.control = "0"b; /* mark as a terminal info message */ if dial_event_message.devx_msg then do; call hcs_$tty_get_name ((message_device.devx), chan_name, (0), code); if code ^= 0 then do; if dial_event_message.control = JUST_HUNGUP then do; /* I may have name internally */ call lookup_chan_name ((message_device.devx), chan_name); if chan_name = "" then do; bv_code = code; return; end; end; else do; bv_code = code; return; end; end; else if dial_event_message.control = JUST_DIALED then call store_chan_name ((message_device.devx), chan_name); if length (bv_device) < length (rtrim (chan_name)) then do; bv_code = error_table_$smallarg; return; end; bv_device = chan_name; /* try to deduce I/O module name from line type */ bv_io_module = as_data_$tty_dim; /* default assumed */ if message_device.line_type = LINE_MC then bv_io_module = as_data_$mrd_dim; else if message_device.line_type = LINE_TELNET then bv_io_module = as_data_$ntty_dim; else if message_device.line_type = LINE_G115 then bv_io_module = as_data_$g115_dim; else if message_device.line_type = LINE_BSC then bv_io_module = "bisync_"; end; else if dial_event_message.ls_msg then do; /* message is from login server; the "device" name and I/O module are in a user_message sent by the login server */ as_user_message_info_ptr = addr (auto_user_message_info); as_user_message_info.version = AS_USER_MESSAGE_INFO_VERSION_1; string (as_user_message_info.flags) = ""b; as_user_message_info.message_handle = dial_event_message_handle || USER_MESSAGE_LS_CONNECTION_INFO_HANDLE_LOWER_18; system_areap = get_system_free_area_ (); ls_connection_message_ptr = null (); on cleanup begin; if ls_connection_message_ptr ^= null () then free user_message; end; call user_message_$read_message (system_areap, as_user_message_info_ptr, code); if code ^= 0 then do; bv_code = code; return; end; ls_connection_message_ptr = as_user_message_info.message_ptr; if ls_connection_message_common.version ^= LS_CONNECTION_MESSAGE_V1 then do; free user_message; bv_code = error_table_$unimplemented_version; return; end; bv_device = ls_connection_message_common.connection_name; bv_io_module = ls_connection_message_common.io_module_name; free user_message; end; else bv_device = dial_event_message.description; /* this should never happen, but it's all we've got */ if ^make_iox_name then /* user really wanted an iox io module name */ if bv_io_module = as_data_$tty_dim then bv_io_module = "tw_"; /* map the names */ else if bv_io_module = as_data_$ntty_dim then bv_io_module = "ntw_"; else if bv_io_module = as_data_$mrd_dim then bv_io_module = "mrd_"; else ; /* don't know how to map name, leave asis */ /* Convert control bits into standard status code. */ if dial_event_message.control = JUST_DIALED then bv_status.dialed_up = "1"b; else if dial_event_message.control = JUST_HUNGUP then bv_status.hung_up = "1"b; /* That's it. */ bv_code = 0; return; /* procedure to manage an internal data-base of channel names and devx's */ /* this is because if we are told by the answering service that one of our channels hung up, we are only told the devx. There is no sure way of finding the channel name unless we remember it ourselves from the time the channel hung up. */ store_chan_name: proc (devx, name); dcl devx fixed bin; dcl name char (*); dcl i fixed bin; dcl code fixed (35); dcl p ptr; if devx_tabp = null () then do; /* once per process */ devx_tabp = addr (static_devx_tab); n_devx_entries = hbound (static_devx_tab.entries, 1); do i = 1 to n_devx_entries; devx_tab.devx (i) = -1; devx_tab.channel (i) = ""; end; end; do i = 1 to n_devx_entries; /* look for entry for given devx */ if devx_tab.devx (i) = devx then do; devx_tab.channel (i) = name; /* remember name */ return; end; end; do i = 1 to n_devx_entries; /* look for free entry */ if devx_tab.devx (i) = -1 then do; devx_tab.devx (i) = devx; devx_tab.channel (i) = name; return; end; end; if devx_tabp = addr (static_devx_tab) then do; /* our internal static table is full */ call get_temp_segment_ ("convert_dial_message_", p, code); if code ^= 0 then return; /* punt */ do i = 1 to n_devx_entries; p -> devx_tab.devx (i) = devx_tab.devx (i); p -> devx_tab.channel (i) = devx_tab.channel (i); end; devx_tabp = p; /* abandon internal static table */ end; n_devx_entries = n_devx_entries + 1; /* can grow without bound now */ devx_tab.devx (n_devx_entries) = devx; devx_tab.channel (n_devx_entries) = name; return; lookup_chan_name: entry (devx, name); name = ""; if devx_tabp = null () then return; do i = 1 to n_devx_entries; if devx_tab.devx (i) = devx then do; name = devx_tab.channel (i); return; end; end; end store_chan_name; %include line_types; %page; %include as_user_message_info; %page; %include user_message_handles; %page; %include ls_connection_message; %page; %include dial_event_message; end convert_dial_message_;  dial_manager_.pl1 08/05/87 0818.5r 08/04/87 1538.8 113274 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ /* DIAL_MANAGER_ - This subroutine is the user interface to the answering service dial facility. Written 750324 by Paul Green Modified 03/18/76 by David Jordan for Auto Call. Modified 11/9/76 by S.T. Kent to allow selective release of dialed channels. and to accept request to become a registered dial server. Modified April 1979 by Larry Johnson for release_channel_no_hangup Modified November 1980 by E.N.Kittlitz for version_2 requests, release_dial_id. Modified March 1981 by Robert Coren to add tandd_attach and release_channel_no_listen entry points Modified May 1983 by E. N. Kittlitz for version_3: access_class. Modified 84-04-04 by BIM for version_4: privileged_server. Modified 84-11-06 by E. Swenson to recompile after include file changes. */ allow_dials: procedure (bv_request_ptr, bv_code); /* parameters */ dcl (bv_request_ptr ptr, bv_code fixed bin (35) ) parameter; /* automatic */ dcl dial_control_process bit (36) aligned, ldx fixed bin, i fixed bin, dial_control_channel fixed bin (71), request_mseg_dir char (168), request_mseg char (32), code fixed bin (35), hangup_channel bit (1), dont_listen bit (1), tandd bit (1), sub_string char (168), reservation_string char (168), release_dial_id_sw bit (1) aligned, request_uid bit (72) aligned; dcl 1 dial_rq aligned like dial_server_request; dcl 1 wait_list aligned, /* channels to block on */ 2 n_channels fixed bin, 2 pad bit (36), 2 channel_id (1) fixed bin (71); dcl 1 reply aligned, /* filled in by ipc_$block */ 2 channel_id fixed bin (71), 2 message fixed bin (71), 2 sending_process bit (36) aligned, 2 origin bit (36) aligned, 2 channel_index fixed bin; /* conditions */ dcl conversion condition; /* external static */ dcl (error_table_$action_not_performed, error_table_$bad_conversion, error_table_$invalid_line_type, error_table_$bad_arg, error_table_$unimplemented_version) fixed bin (35) external static; /* entries */ dcl system_info_$request_chn entry (bit (36) aligned, fixed bin (71), char (*), char (*)), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), bit (72) aligned, fixed bin (35)), message_segment_$add_file entry (char (*), char (*), ptr, fixed bin (18), bit (72) aligned, fixed bin (35)), ipc_$block entry (ptr, ptr, fixed bin (35)), convert_ipc_code_ entry (fixed bin (35)), convert_dial_message_ entry (fixed bin (71), char (*), char (*), fixed bin, bit (36) aligned, fixed bin (35)); /* builtins */ dcl (addr, after, before, convert, hbound, lbound, ltrim, size, string, substr) builtin; %page; /* include files */ %include dial_manager_arg; %include as_request_header; %include dial_server_request; %include line_types; %page; /* entry to request to become a non-registered dial server */ bv_code = 0; request_ptr = bv_request_ptr; call fill_request; /* fill out red tape */ dial_rq.header.type = ASR_DIAL_SERVER; dial_rq.flags.start = "1"b; /* this is a request to allow dials */ call send_request; /* communicate with boss */ return; /* Entry for a dial server process to release a selected channel dialed to him */ release_channel: entry (bv_request_ptr, bv_code); hangup_channel = "1"b; dont_listen = "0"b; go to release_channel_join; release_channel_no_hangup: entry (bv_request_ptr, bv_code); hangup_channel = "0"b; dont_listen = "0"b; go to release_channel_join; release_channel_no_listen: entry (bv_request_ptr, bv_code); dont_listen = "1"b; hangup_channel = "1"b; release_channel_join: bv_code = 0; request_ptr = bv_request_ptr; /* copy ptr */ call fill_request; dial_rq.header.type = ASR_DIAL_SERVER; dial_rq.flags.release_channel = "1"b; /* this is a channel release request */ dial_rq.channel_name = request_ptr -> dial_manager_arg.channel_name; /* this is the channel to hangup */ dial_rq.flags.no_hangup = ^hangup_channel; dial_rq.flags.no_listen = dont_listen; call send_request; return; /* Entry to request to allow dials on a registered dial qualifier */ registered_server: entry (bv_request_ptr, bv_code); bv_code = 0; request_ptr = bv_request_ptr; call fill_request; dial_rq.header.type = ASR_DIAL_SERVER; dial_rq.flags.registered_server = "1"b; dial_rq.flags.start = "1"b; /* this is in for test purposes only */ call send_request; return; /* Entries to stop being a dial server */ release_dial_id: /* stop as server, but keep current calls */ entry (bv_request_ptr, bv_code); release_dial_id_sw = "1"b; go to shutoff_dials_common; shutoff_dials: /* stop as server and hangup all calls */ entry (bv_request_ptr, bv_code); release_dial_id_sw = "0"b; shutoff_dials_common: bv_code = 0; request_ptr = bv_request_ptr; /* copy ptr for efficiency */ call fill_request; dial_rq.header.type = ASR_DIAL_SERVER; if release_dial_id_sw then dial_rq.flags.release_dial_id = "1"b; /* keep current lines */ else dial_rq.flags.stop = "1"b; /* hang 'em up */ call send_request; return; /* Entry for a privileged process (daemons) to call to attach any channel in the lines file as if it had dialed to the process itself. */ privileged_attach: entry (bv_request_ptr, bv_code); tandd = "0"b; go to priv_attach_join; tandd_attach: entry (bv_request_ptr, bv_code); tandd = "1"b; priv_attach_join: bv_code = 0; request_ptr = bv_request_ptr; /* copy ptr for efficiency */ call fill_request; dial_rq.header.type = ASR_DIAL_SERVER; dial_rq.channel_name = request_ptr -> dial_manager_arg.channel_name; dial_rq.flags.privileged_attach = "1"b; /* ask for the channel */ dial_rq.flags.tandd_attach = tandd; call send_request; return; /* Entry for a user to attach and dial an auto call line. */ dial_out: entry (bv_request_ptr, bv_code); bv_code = 0; request_ptr = bv_request_ptr; call fill_request; dial_rq.channel_name = request_ptr -> dial_manager_arg.channel_name; /* remember requested line */ dial_rq.header.type = ASR_DIAL_OUT; /* we're dialing out */ if request_ptr -> dial_manager_arg.version >= dial_manager_arg_version_2 then do; /* look at new fields */ dial_rq.dial_out_destination = request_ptr -> dial_manager_arg.dial_out_destination; if request_ptr -> dial_manager_arg.reservation_string ^= "" then do; /* RCP-like description */ reservation_string = request_ptr -> dial_manager_arg.reservation_string; /* efficiency, svp. */ sub_string = ltrim (before (reservation_string, ",")); /* get a device requirement */ do while (sub_string ^= ""); if index (sub_string, "baud_rate=") = 1 then do; on conversion begin; /* prevent the outrageous */ code = error_table_$bad_conversion; goto return_code; end; sub_string = after (sub_string, "="); if sub_string = "" then go to bad_arg_found; dial_rq.baud_rate = convert (dial_rq.baud_rate, sub_string); revert conversion; end; else if index (sub_string, "line_type=") = 1 then do; sub_string = ltrim (after (sub_string, "=")); /* just the LINE_TYPE */ ldx = lbound (line_types, 1) - 1; /* flag nothing found yet */ do i = lbound (line_types, 1) to hbound (line_types, 1) /* is there any such animal? */ while (ldx < lbound (line_types, 1)); if sub_string = line_types (i) then ldx = i; end; if ldx < lbound (line_types, 1) then do; code = error_table_$invalid_line_type; goto return_code; end; else dial_rq.line_type = ldx; /* make specification to dial_ctl_ */ end; else if index (sub_string, "server_type=") = 1 then do; dial_rq.server_type = substr (sub_string, 13); end; else do; bad_arg_found: code = error_table_$bad_arg; goto return_code; end; reservation_string = after (reservation_string, ","); /* eliminate portion just considered */ sub_string = ltrim (before (reservation_string, ",")); /* and set up for next portion */ end; end; end; else do; /* version 1 dial_manager_arg structure */ dial_rq.dial_out_destination = request_ptr -> dial_manager_arg.dial_qualifier; end; call send_request; return; /* Entry to release a dial out line. */ terminate_dial_out: entry (bv_request_ptr, bv_code); bv_code = 0; request_ptr = bv_request_ptr; call fill_request; dial_rq.channel_name = request_ptr -> dial_manager_arg.channel_name; dial_rq.header.type = ASR_DIAL_OUT; dial_rq.flags.release_channel = "1"b; /* Hang up the line */ call send_request; return; dial_failed: code = error_table_$action_not_performed; return_code: bv_code = code; return; %page; fill_request: procedure; if request_ptr -> dial_manager_arg.version < /* dial_manager_arg_version_1 */ 1 | request_ptr -> dial_manager_arg.version > dial_manager_arg_version_4 then do; code = error_table_$unimplemented_version; go to return_code; end; if request_ptr -> dial_manager_arg.version >= dial_manager_arg_version_2 then request_ptr -> dial_manager_arg.dial_message = -1; /* initialize OUTPUT field */ call system_info_$request_chn (dial_control_process, dial_control_channel, request_mseg_dir, request_mseg); dial_rq.header.version = as_request_version_1; dial_rq.header.reply_channel = request_ptr -> dial_manager_arg.dial_channel; dial_rq.version = dial_server_request_version_4; dial_rq.dial_control_channel = request_ptr -> dial_manager_arg.dial_channel; dial_rq.dial_qualifier = request_ptr -> dial_manager_arg.dial_qualifier; string (dial_rq.flags) = ""b; dial_rq.channel_name = ""; dial_rq.baud_rate = -1; dial_rq.line_type = lbound (line_types, 1) - 1; dial_rq.server_type = ""; dial_rq.dial_out_destination = ""; dial_rq.access_class = ""b; dial_rq.privileged_server = "0"b; if (request_ptr -> dial_manager_arg.version >= dial_manager_arg_version_3) then do; if request_ptr -> dial_manager_arg.access_class_required then do; dial_rq.access_class = request_ptr -> dial_manager_arg.access_class; dial_rq.flags.access_class_specified = "1"b; end; if request_ptr -> dial_manager_arg.version >= dial_manager_arg_version_4 then do; if request_ptr -> dial_manager_arg.privileged_operation /* only meaningful for accept dials */ then dial_rq.privileged_server = "1"b; end; else dial_rq.privileged_server = comm_privilege (); end; else dial_rq.privileged_server = comm_privilege (); return; end fill_request; %page; send_request: procedure; dcl cdm_device char (32); /* these variables are used to avoid */ dcl cdm_iom char (32); /* errors from convert_dial_message */ dcl cdm_ndialed fixed bin; /* which gets upset if string parameters are too short. */ dcl cdm_status bit (36) aligned; /* We just throw the results away */ call message_segment_$add_file (request_mseg_dir, request_mseg, addr (dial_rq), 36 * size (dial_rq), request_uid, code); if code ^= 0 then go to return_code; call hcs_$wakeup (dial_control_process, dial_control_channel, request_uid, code); if code ^= 0 then go to dial_failed; wait_list.n_channels = 1; wait_list.channel_id (1) = dial_rq.header.reply_channel; call ipc_$block (addr (wait_list), addr (reply), code); if code ^= 0 then do; call convert_ipc_code_ (code); go to return_code; end; if request_ptr -> dial_manager_arg.version >= dial_manager_arg_version_2 then request_ptr -> dial_manager_arg.dial_message = reply.message; /* OUTPUT field */ call convert_dial_message_ (reply.message, cdm_device, cdm_iom, cdm_ndialed, cdm_status, code); if code ^= 0 then go to return_code; end send_request; comm_privilege: procedure returns (bit (1) aligned); declare get_privileges_ entry() returns(bit (36) aligned); %include aim_privileges; return ((get_privileges_ () & COMM_PRIVILEGE) = COMM_PRIVILEGE); end comm_privilege; end allow_dials;  dial_manager_call.pl1 01/16/85 1237.8rew 01/16/85 1237.0 83574 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ /* DIAL_MANAGER_CALL - Command interface to dial_manager_ */ /* Written February 1979 by Larry Johnson */ /* Modified December 1980 by E. N. Kittlitz for V2 dial_manager_arg, new dial_manager functions */ /* Modified 84-04-12 BIM for access_class */ dial_manager_call: procedure options (variable); /* Automatic */ dcl code fixed bin (35); dcl save_code fixed bin (35); dcl arg_ptr ptr; dcl arg_len fixed bin; dcl entry entry (ptr, fixed bin (35)) variable; dcl next_arg fixed bin; dcl arg_count fixed bin; dcl io_module char (32); dcl n_dialed fixed bin; dcl channel_name char (32); dcl 1 status_flags aligned, 2 dialed_up bit (1) unal, 2 hung_up bit (1) unal, 2 control bit (1) unal, 2 pad bit (33) unal; dcl 1 auto_dial_manager_arg like dial_manager_arg aligned automatic; dcl dmap ptr; /* Based */ dcl arg char (arg_len) based (arg_ptr); /* Internal static */ dcl static_channel fixed (71) int static init (0); dcl static_channel_is_wait bit (1) int static; /* Current state of chanel - wait/call */ dcl reporting_enabled bit (1) init ("1"b) int static; /* Constants */ dcl name char (17) int static options (constant) init ("dial_manager_call"); /* External */ dcl iox_$user_output ptr ext static; dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl ioa_ entry options (variable); dcl com_err_ entry options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl convert_dial_message_$return_io_module entry (fixed bin (71), char (*), char (*), fixed bin, 1 aligned like status_flags, fixed bin (35)); dcl (dial_manager_$allow_dials, dial_manager_$registered_server, dial_manager_$dial_out, dial_manager_$release_channel, dial_manager_$release_channel_no_hangup, dial_manager_$release_channel_no_listen, dial_manager_$release_dial_id, dial_manager_$shutoff_dials, dial_manager_$privileged_attach, dial_manager_$tandd_attach, dial_manager_$terminate_dial_out) entry (ptr, fixed bin (35)); dcl (addr, null) builtin; /* Setup event channel for this program */ if static_channel = 0 then do; call ipc_$create_ev_chn (static_channel, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, name, "Unable to create event channel."); static_channel = 0; return; end; else static_channel_is_wait = "1"b; end; /* Initialize dial_manager_args */ dmap = addr (auto_dial_manager_arg); dmap -> dial_manager_arg.version = dial_manager_arg_version_4; dmap -> dial_manager_arg.dial_qualifier = ""; dmap -> dial_manager_arg.dial_channel = static_channel; dmap -> dial_manager_arg.channel_name = ""; dmap -> dial_manager_arg.reservation_string = ""; dmap -> dial_manager_arg.dial_out_destination = ""; dmap -> dial_manager_arg.access_class = ""b; dmap -> dial_manager_arg.flags = "0"b; /* Process arguments */ call cu_$arg_count (arg_count, code); if code ^= 0 then do; call com_err_ (code, "dial_manager_call"); return; end; next_arg = 1; call get_arg ("Usage: dial_manager_call request qualifier/channel"); if arg = "allow_dials" | arg = "ad" then do; call get_qualifier; entry = dial_manager_$allow_dials; end; else if arg = "registered_server" | arg = "rs" then do; call get_qualifier; entry = dial_manager_$registered_server; end; else if arg = "dial_out" | arg = "do" then do; call get_channel; call get_dial_out_destination; if next_arg <= arg_count then call get_reservation_string; if next_arg <= arg_count then call get_access_class; entry = dial_manager_$dial_out; end; else if arg = "release_channel" | arg = "rc" then do; call get_channel; entry = dial_manager_$release_channel; end; else if arg = "release_channel_no_hangup" | arg = "rcnh" then do; call get_channel; entry = dial_manager_$release_channel_no_hangup; end; else if arg = "release_channel_no_listen" | arg = "rcnl" then do; call get_channel; entry = dial_manager_$release_channel_no_listen; end; else if arg = "shutoff_dials" | arg = "sd" then do; call get_qualifier; entry = dial_manager_$shutoff_dials; end; else if arg = "privileged_attach" | arg = "pa" then do; call get_channel; entry = dial_manager_$privileged_attach; end; else if arg = "tandd_attach" | arg = "tda" then do; call get_channel; entry = dial_manager_$tandd_attach; end; else if arg = "terminate_dial_out" | arg = "tdo" then do; call get_channel; entry = dial_manager_$terminate_dial_out; end; else if arg = "release_dial_id" | arg = "rdi" then do; call get_qualifier; entry = dial_manager_$release_dial_id; end; else if arg = "start_report" | arg = "start" then do; reporting_enabled = "1"b; go to done; end; else if arg = "stop_report" | arg = "stop" then do; reporting_enabled = "0"b; go to done; end; else do; bad_arg: call com_err_ (0, name, "Unrecognized arg: ^a", arg); return; end; /* Make the dial manager call */ if ^static_channel_is_wait then do; call ipc_$decl_ev_wait_chn (static_channel, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, name, "Unable to setup event wait channel."); return; end; static_channel_is_wait = "1"b; end; call entry (dmap, save_code); /* make the call */ call ipc_$decl_ev_call_chn (static_channel, handler, null (), 10, code); if code ^= 0 then do; call convert_ipc_code_ (code); call com_err_ (code, name, "Unable to setup event call channel."); end; else static_channel_is_wait = "0"b; if save_code ^= 0 then call com_err_ (save_code, name, "dial_manager_ error."); /* Allow event calls to go off in case channel is already dialed. This is done because of the way dial_manager_ uses the event channel. A subsequent invocation of dial_manager_ without an intervening block will cause dial_manager_ to get out of step with the event messages. */ call timer_manager_$sleep (250000, "10"b); done: return; /* Handler for event call wakeups, utility procedures */ handler: entry (arg_event_call_infop); dcl arg_event_call_infop ptr; if ^reporting_enabled then return; event_call_info_ptr = arg_event_call_infop; call convert_dial_message_$return_io_module (event_call_info.message, channel_name, io_module, n_dialed, status_flags, code); if code ^= 0 then call com_err_ (code, name, "dial_manager_ error."); else do; if status_flags.control then call ioa_ ("^a: Channels dialed=^d", name, n_dialed); else call ioa_ ("^a: Channel ^a (^a) ^[dialed^]^[hungup^].", name, channel_name, io_module, status_flags.dialed_up, status_flags.hung_up); call iox_$control (iox_$user_output, "start", null (), code); end; return; get_arg: proc (msg); dcl msg char (*); call cu_$arg_ptr (next_arg, arg_ptr, arg_len, code); if code ^= 0 then do; call com_err_ (code, name, "^a", msg); go to done; end; next_arg = next_arg + 1; return; end get_arg; get_qualifier: proc; call get_arg ("qualifier"); dmap -> dial_manager_arg.dial_qualifier = arg; if next_arg <= arg_count then do; call get_access_class; dmap -> dial_manager_arg.privileged_operation = "1"b; end; return; end get_qualifier; get_access_class: procedure; call get_arg ("access class"); call convert_authorization_$from_string (dmap -> dial_manager_arg.access_class, arg, code); if code ^= 0 then do; call com_err_ (code, name, "^a", arg); go to done; end; dmap -> dial_manager_arg.access_class_required = "1"b; end get_access_class; get_channel: proc; call get_arg ("channel"); dmap -> dial_manager_arg.channel_name = arg; return; end get_channel; get_dial_out_destination: proc; call get_arg ("destination"); dmap -> dial_manager_arg.dial_out_destination = arg; return; end get_dial_out_destination; get_reservation_string: proc; call get_arg ("reservation"); dmap -> dial_manager_arg.reservation_string = arg; return; end get_reservation_string; %include dial_manager_arg; %include event_call_info; end dial_manager_call;  logout.pl1 08/04/87 1445.5rew 08/04/87 1221.3 92313 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ /* LOGOUT - Command to destroy a process and log the user off the system. logout -hold don't hangup the line...let another user login on this terminal logout -brief don't print logout message NEW_PROC - Command to destroy a process and create a new one for the same user. new_proc create a new process with same attributes as this one new_proc -auth new_authorization create a new process whose authorization is new_authorization Written 750406 by PG (split off from terminate_process_) Modified Aug 25, 1977 by S. Webber to add term_signal_handler_ Modified April 1979 by T. Casey for MR7.0a to make process type determination work right for foreground absentee jobs. Modified December 1980 by E. N. Kittlitz for absentee cancellation message Modified 3/82 BIM for new print_abs_msg_, finish_info.incl.pl1 Modified 84-06-24 BIM to check strict trusted path. */ /****^ HISTORY COMMENTS: 1) change(86-05-19,GDixon), approve(86-09-26,MCR7499), audit(86-10-08,Beattie), install(86-10-13,MR12.0-1183): Resolve uninitialized variable (logout_string) in new_proc command by moving no_more_arguments label so variable doesn't get referenced by the new_proc control path. (phx20351) 2) change(87-04-08,Parisek), approve(87-07-14,MCR7644), audit(87-07-24,GDixon), install(87-08-04,MR12.1-1055): Added the "disconnect" entry point. END HISTORY COMMENTS */ logout: procedure options (variable); /* automatic */ dcl process_type fixed bin; /* = 2 if this is an absentee process */ dcl argno fixed bin; dcl arg_length fixed bin (21); dcl arg_ptr ptr; dcl attr char (128) varying; dcl authorization bit (72) aligned; dcl code fixed bin (35); dcl my_name char (12); dcl term_structure_ptr ptr; dcl 1 logout_string aligned, /* information about logouts */ 2 version fixed bin, /* this is version 0 */ 2 hold bit (1) unaligned, /* don't hangup line */ 2 brief bit (1) unaligned, /* don't print logout message */ 2 pad bit (34) unaligned; /* must be zero */ dcl 1 new_proc_string aligned, /* information about new_procs */ 2 version fixed bin, /* this is version 1 */ 2 authorization_option bit (1) unaligned, /* use value of new_authorization, below */ 2 pad bit (35) unaligned, /* must be zero */ 2 new_authorization bit (72) aligned; /* authorization of new process */ dcl 1 disc_string aligned, /* info about user invoked disconnect */ 2 version fixed bin, /* this is version 0 */ 2 pad bit(36) aligned; /* init "0"b */ dcl 1 local_finish_info aligned like finish_info; %include finish_info; %include condition_info_header; %include trusted_path_flags; /* based */ dcl argument char (arg_length) based (arg_ptr); /* builtins */ dcl (addr, index, null, size, string, unspec) builtin; /* external static */ dcl error_table_$badopt fixed bin (35) external static; /* entries */ dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl com_err_ entry options (variable); dcl convert_access_class_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl execute_epilogue_ entry (bit (1) aligned); dcl get_process_authorization_ entry () returns (bit (72) aligned); dcl get_process_max_authorization_ entry returns (bit (72) aligned); dcl ioa_ entry options (variable); dcl print_abs_msg_$logout entry (); dcl save_on_disconnect entry; dcl signal_ entry (char (*), ptr, ptr); dcl system_info_$trusted_path_flags entry returns (bit (36) aligned); dcl terminate_process_ entry (char (*), ptr); dcl user_info_$attributes entry (char(*) varying); dcl user_info_$process_type entry (fixed bin); /* program */ my_name = "logout"; finish_info_ptr = addr (local_finish_info); finish_info.type = "logout"; call user_info_$process_type (process_type); /* we will need to know if this is absentee later */ logout_string.version = 0; logout_string.hold = "0"b; /* set default values for arguments */ logout_string.brief = "0"b; /* .. */ logout_string.pad = ""b; term_structure_ptr = addr (logout_string); do argno = 1 by 1; /* read all arguments */ call cu_$arg_ptr (argno, arg_ptr, arg_length, code); if code ^= 0 then go to no_more_logout_arguments; if argument = "-hold" | argument = "-hd" then logout_string.hold = "1"b; /* user doesn't want line hung up */ else if argument = "-brief" | argument = "-bf" then logout_string.brief = "1"b; /* user doesn't want logout message printed */ else go to bad_argument; end; no_more_logout_arguments: if ^logout_string.brief then do; /* print absentee logout message */ if process_type = 2 then call print_abs_msg_$logout; end; if logout_string.hold then do; string (trusted_path_flags) = system_info_$trusted_path_flags (); if trusted_path_flags.login then do; if logout_string.hold & my_name = "logout" then do; call com_err_ (0, my_name, "logout -hold is not permitted at this site to ensure secure logins."); return; end; end; end; no_more_arguments: if my_name = "disconnect" then do; call user_info_$attributes (attr); /* check for disconnect_ok */ if index (attr, "disconnect_ok") = 0 then do; call com_err_ (0, my_name, "You lack permission to disconnect your process. Check with your project administrator for more information."); return; end; call save_on_disconnect; /* Ensure process will be saved. */ call terminate_process_ (my_name, term_structure_ptr); return; end; /* assume that's what we want */ else do; finish_info.length = size (finish_info); finish_info.version = 1; finish_info.info_string = ""; unspec (finish_info.action_flags) = ""b; finish_info.status_code = 0; call signal_ ("finish", null (), addr (finish_info)); call execute_epilogue_ ("0"b); /* The "0"b says not just a run unit */ call terminate_process_ (my_name, term_structure_ptr); go to no_more_arguments; /* and don't come back */ end; new_proc: entry; /* entry to create a new process */ my_name = "new_proc"; finish_info_ptr = addr (local_finish_info); finish_info.type = "new_proc"; call user_info_$process_type (process_type); /* is this an process_type process? */ if process_type = 2 then do; /* yes! */ call com_err_ (0, my_name, "Invalid command for absentee process."); return; end; new_proc_string.version = 1; new_proc_string.authorization_option = "0"b; /* initialize options */ new_proc_string.new_authorization = ""b; /* .. */ new_proc_string.pad = ""b; term_structure_ptr = addr (new_proc_string); /* set ptr to argument */ do argno = 1 by 1; /* read all arguments */ call cu_$arg_ptr (argno, arg_ptr, arg_length, code); if code ^= 0 then go to no_more_arguments; /* go do it */ if argument = "-authorization" | argument = "-auth" then do; new_proc_string.authorization_option = "1"b; argno = argno + 1; call cu_$arg_ptr (argno, arg_ptr, arg_length, code); if code ^= 0 then do; call com_err_ (code, my_name, "-authorization must be followed by an authorization."); return; end; call convert_access_class_$from_string (authorization, argument, code); if code ^= 0 then do; call com_err_ (code, my_name, "^a", argument); return; end; /* get the max authorization of this process */ if ^aim_check_$greater_or_equal (get_process_max_authorization_ (), authorization) then do; call com_err_ (0, my_name, "You cannot new_proc to the requested authorization."); return; end; string (trusted_path_flags) = system_info_$trusted_path_flags (); if trusted_path_flags.login then if ^aim_check_$equal (get_process_authorization_ (), authorization) then do; call com_err_ (0, my_name, "new_proc -authorization is not permitted at this site to ensure secure logins."); return; end; new_proc_string.new_authorization = authorization; /* pass to terminate_process_ */ end; else go to bad_argument; end; bad_argument: call com_err_ (error_table_$badopt, my_name, argument); return; term_signal_handler_: entry; my_name = "term_signal"; finish_info_ptr = addr (local_finish_info); finish_info.type = "termsgnl"; call user_info_$process_type (process_type); if process_type = 2 then /* absentee cancellation */ call ioa_ ("^2/Process terminated by the system. The reason will be sent by Multics mail."); logout_string.version = 0; logout_string.hold = "0"b; logout_string.brief = "0"b; logout_string.pad = "0"b; term_structure_ptr = addr (logout_string); goto no_more_logout_arguments; disconnect: entry; my_name = "disconnect"; call user_info_$process_type (process_type); if process_type ^= 1 then do; call com_err_ (0, my_name, "Command valid for interactive processes only."); return; end; disc_string.version = 0; disc_string.pad = ""b; term_structure_ptr = addr (disc_string); do argno = 1 by 1; call cu_$arg_ptr (argno, arg_ptr, arg_length, code); if code ^= 0 then go to no_more_arguments; else go to bad_argument; end; end logout;  send_as_request_.pl1 10/28/86 1549.7r w 10/28/86 1024.7 46485 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* send_as_request_ -- common subroutine interface. */ /* format: style2 */ /**** Created 1984-12 */ /**** Modified 1985-02-21, BIM -- initialize code, create ev chan. */ /**** Modified 1985-03-18, E. Swenson to return error code if executed in the Initializer process. */ send_as_request_$block: procedure (Info_ptr, Info_length, Message_id, Reply, Code); declare Info_ptr pointer; declare Info_length fixed bin; declare Message_id bit (72) aligned; declare Reply bit (72) aligned; declare Code fixed bin (35); dcl system_info_$request_chn entry (bit (36) aligned, fixed bin (71), char (*), char (*)); dcl get_group_id_ entry () returns (char (32)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), bit (72) aligned, fixed bin (35)); dcl message_segment_$add_file entry (char (*), char (*), ptr, fixed bin (18), bit (72) aligned, fixed bin (35)) ; dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl block_flag bit (1) aligned; dcl code fixed bin (35); dcl request_process_id bit (36) aligned; dcl request_channel fixed bin (71); dcl request_uid bit (72) aligned; dcl ms_dir_name char (168); dcl ms_entryname char (32); dcl msg_ptr pointer; dcl msg_length fixed bin (18); dcl created_ev_chn bit (1) aligned; %include event_wait_channel; %include event_wait_info; dcl 1 EWI aligned like event_wait_info; dcl error_table_$action_not_performed fixed bin (35) external; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl cleanup condition; block_flag = "1"b; goto COMMON; send_as_request_$no_block: entry (Info_ptr, Info_length, Message_id, Code); block_flag = "0"b; COMMON: Code = 0; /**** The following code prevents this call from being made in the Initializer process. We do not want to invoke the AS request mechanism from within the Initializer process, because it would be possible to get into the AS request server recursively which doesn't work. (The event call channel is inhibited while executing the handler (as_request_server_) and therefore the server will not function recursively). */ if get_group_id_ () = "Initializer.SysDaemon.z" then do; Code = error_table_$action_not_performed; return; end; msg_ptr = Info_ptr; msg_length = Info_length * 36; if msg_ptr -> as_request_header.version ^= as_request_version_1 then do; Code = error_table_$unimplemented_version; return; end; created_ev_chn = "0"b; on cleanup begin; if created_ev_chn then call ipc_$delete_ev_chn (msg_ptr -> as_request_header.reply_channel, (0)); end; if block_flag & (msg_ptr -> as_request_header.reply_channel = 0) then do; created_ev_chn = "1"b; call ipc_$create_ev_chn (msg_ptr -> as_request_header.reply_channel, (0)); end; if test_flag then do; request_process_id = static_process_id; request_channel = static_channel; ms_dir_name = static_dir_name; ms_entryname = static_entryname; end; else call system_info_$request_chn (request_process_id, request_channel, ms_dir_name, ms_entryname); call message_segment_$add_file (ms_dir_name, ms_entryname, msg_ptr, msg_length, request_uid, code); if code ^= 0 then do; Code = code; go to RETURN; end; Message_id = request_uid; call hcs_$wakeup (request_process_id, request_channel, request_uid, code); if code ^= 0 then do; Code = code; go to RETURN; end; if msg_ptr -> as_request_header.reply_channel = 0 | ^block_flag then return; event_wait_channel.pad = ""b; event_wait_channel.channel_id (1) = msg_ptr -> as_request_header.reply_channel; call ipc_$block (addr (event_wait_channel), addr (EWI), code); if code ^= 0 then do; Code = code; go to RETURN; end; Reply = unspec (EWI.message); RETURN: if created_ev_chn then call ipc_$delete_ev_chn (msg_ptr -> as_request_header.reply_channel, (0)); return; test: entry (a_pid, a_event, a_dir, a_entryname); declare (a_dir, a_entryname) char (*); declare a_pid bit (36) aligned; declare a_event fixed bin (71); declare test_flag bit (1) aligned internal static init ("0"b); declare ( static_process_id bit (36) aligned, static_channel fixed bin (71), static_dir_name char (168), static_entryname char (32) ) int static; test_flag = "1"b; static_process_id = a_pid; static_channel = a_event; static_dir_name = a_dir; static_entryname = a_entryname; return; no_test: entry; test_flag = "0"b; return; %include as_request_header; end send_as_request_$block;  terminate_process_.pl1 08/04/87 1445.5rew 08/04/87 1221.3 105489 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* TERMINATE_PROCESS_ - This procedure terminates the process in which it is called. The arguments determine the exact nature of the termination. declare terminate_process_ entry (char (*), ptr); call terminate_process_ (action, info_ptr); 1. action indicates the type of termination and must be on of those . listed below. (Input) 2. info_ptr points to additional information about the termination and . its structure is dependent upon the action. (Input) Possible actions: 1. logout the process is simply to be logged out. dcl 1 info aligned based(info_ptr), 2 version fixed bin, /* must be 0 2 hold bit(1) unaligned, /* 1 if the console is to be held 2 brief bit(1) unaligned, /* 1 if no logout message is to be printed 2 pad bit(34) unaligned; /* must be 0 2. new_proc a new process is to be created for the user after this one is terminated. dcl 1 info aligned based(info_ptr), 2 version fixed bin, /* must be 1 2 authorization_option bit (1) unaligned, /* 1 if new_authorization is to be used. 2 pad bit (35) unaligned, /* must be 0 2 new_authorization bit (72) aligned; /* authorization of new process 3. fatal_error the process is doomed due to an unrecoverable error. dcl 1 info aligned based(info_ptr), 2 version fixed bin, /* must be 0 2 status_code fixed bin(35); /* status code describing error 4. init_error this process encountered an error during initialization. dcl 1 info aligned based(info_ptr), 2 version fixed bin, /* must be 0 2 status_code fixed bin(35); /* status code describing error 5. disconnect this process is to be disconnected. dcl 1 info aligned based(info_ptr), 2 version fixed bin, /* must be 0 2 pad bit(36) aligned; Originally coded by R. J. Feiertag on April 29, 1972 Modified 750406 by PG to remove logout & new_proc code, and handle version 1 new_proc structures */ /****^ HISTORY COMMENTS: 1) change(87-04-08,Parisek), approve(87-07-14,MCR7644), audit(87-07-24,GDixon), install(87-08-04,MR12.1-1055): Send AS the "disconn" user signal based on the invocation of the "disconnect" command. END HISTORY COMMENTS */ terminate_process_: procedure (action, info_ptr); /* parameters */ dcl (action char (*), /* indicates general nature of termination */ info_ptr ptr) parameter; /* points to additional information about termination */ /* automatic */ dcl 1 auto_ev_info aligned like event_wait_info; /* Automatic event info structure */ dcl 1 auto_ev_chn aligned like event_wait_channel; /* Automatic event channel structure */ dcl event_message fixed bin (71), /* message to answering service */ em_ptr ptr, /* points to message */ code fixed bin (35), /* status code */ logout_channel fixed bin (71), /* channel on which to signal logout */ logout_pid bit (36) aligned; /* process to which to signal logout */ dcl old_mask bit (36) aligned; dcl sig_mask bit (36) aligned; dcl sig_names (2) char (32) int static options (constant) init ("sus_", "trm_"); /* based */ dcl logout_message char (8) aligned based (em_ptr); /* character string version of message */ dcl 1 new_proc_auth aligned based (em_ptr), /* structure to overlay message */ 2 message char (2) unaligned, /* "np" */ 2 authorization bit (54) unaligned; /* an authorization */ dcl based_version fixed bin based (info_ptr); /* version number of all structures */ dcl 1 based_logout aligned based (info_ptr), 2 version fixed bin, 2 hold bit (1) unaligned, 2 brief bit (1) unaligned, 2 pad bit (34) unaligned; dcl 1 based_new_proc aligned based (info_ptr), 2 version fixed bin, /* must be 1 */ 2 authorization_option bit (1) unaligned, /* 1 if new_authorization is to be used */ 2 pad bit (35) unaligned, /* must be zero */ 2 new_authorization bit (72) aligned; /* authorization of new process */ dcl 1 based_disc aligned based (info_ptr), 2 version fixed bin, /* must be 0 */ 2 pad bit (36) unaligned; dcl 1 based_fatal_error aligned based (info_ptr), 2 version fixed bin, 2 fatal_code fixed bin (35); /* status code */ dcl 1 based_init_error aligned based (info_ptr), /* informations about initialization errors */ 2 version fixed bin, 2 init_code fixed bin (35); /* status code */ dcl 1 fatal_term aligned based (em_ptr), /* message to answering service */ 2 name char (4), /* "term" */ 2 status_code fixed bin (35); /* status code to answering service */ /* external static */ dcl error_table_$improper_termination ext fixed bin (35), error_table_$unimplemented_version ext fixed bin (35); /* conditions */ dcl (cleanup, quit) condition; /* builtins */ dcl (addr, null, substr) builtin; /* entries */ dcl continue_to_signal_ entry (fixed bin(35)), create_ips_mask_ entry (ptr, fixed bin, bit (36) aligned), get_process_id_ entry returns (bit (36) aligned), hcs_$block entry, hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned), hcs_$get_ips_mask entry (bit (36) aligned), hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned), hcs_$stop_process entry (bit (36) aligned), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), ipc_$block entry (ptr, ptr, fixed bin(35)), ipc_$create_ev_chn entry (fixed bin(71), fixed bin(35)), ipc_$delete_ev_chn entry (fixed bin(71), fixed bin(35)), sub_err_ entry options (variable), user_info_$logout_data entry options (variable); %include event_wait_info; %page; %include event_wait_channel; %page; %include sub_err_flags; %page; /* program */ em_ptr = addr (event_message); if action = "logout" then do; /* this is a simple logout */ if (based_logout.version ^= 0) | (based_logout.pad ^= ""b) then go to illegal_termination; /* invalid structure */ if based_logout.brief then do; /* don't print logout message */ if based_logout.hold then logout_message = "lhbrief"; /* hold and brief */ else logout_message = "lobrief"; /* breif only */ end; else do; /* print logout message */ if based_logout.hold then logout_message = "login"; /* hold only */ else logout_message = "logout"; /* no hold or brief */ end; end; else if action = "new_proc" then do; /* this is a new_proc */ if (based_new_proc.version ^= 1) | (based_new_proc.pad ^= ""b) then go to illegal_termination; /* naughty, naughty */ if based_new_proc.authorization_option then do; /* special handling here */ new_proc_auth.message = "np"; /* set identifying string */ new_proc_auth.authorization = substr (based_new_proc.new_authorization, 1, 54); /* ugh */ end; else logout_message = "new_proc"; /* map new_proc into proper key word */ end; else if action = "fatal_error" then do; /* this is a fatal error */ if based_fatal_error.version ^= 0 then go to illegal_termination; fatal_term.name = "term"; /* include proper key word */ fatal_term.status_code = based_fatal_error.fatal_code; /* pass on status code */ end; else if action = "init_error" then do; /* this is an initialization error */ if based_init_error.version ^= 0 then go to illegal_termination; logout_message = "init_err"; /* map into proper key word */ end; else if action = "io_attach" then do; /* cannot do initial ios_$attach */ if based_version ^= 0 then go to illegal_termination; logout_message = "no_ioatt"; end; else if action = "abs_order" then do; /* Cannot issue absentee outseg order */ if based_version ^= 0 then go to illegal_termination; logout_message = "abs_ordr"; end; else if action = "no_initproc" then do; /* Cannot find initial procedure */ if based_version ^= 0 then go to illegal_termination; logout_message = "no_initp"; end; else if action = "term_signal" then do; if based_version ^= 0 then goto illegal_termination; logout_message = "termsgnl"; end; else if action = "disconnect" then do; if (based_disc.version ^= 0) | (based_disc.pad ^= ""b) then do; call sub_err_ (error_table_$unimplemented_version, "disconnect", ACTION_CANT_RESTART, null (), (0), ""); return; end; logout_message = "disconn"; end; else do; /* illegal action */ illegal_termination: fatal_term.name = "term"; /* use proper key word */ fatal_term.status_code = error_table_$improper_termination; /* return proper status code */ end; call user_info_$logout_data (logout_channel, logout_pid); /* get logout information */ if action = "disconnect" then do; call create_ips_mask_ (addr (sig_names), (2), sig_mask); /* Create a mask of trm_ & sus_ signals */ sig_mask = ^sig_mask; /* Allow only trm_ & sus_ to wakeup our process */ call hcs_$get_ips_mask (old_mask); event_wait_channel.channel_id (1) = 0; event_wait_channel.pad = ""b; on cleanup begin; /* If we typed "release" in response to the QUIT condition */ if event_wait_channel.channel_id (1) ^= 0 then call ipc_$delete_ev_chn (event_wait_channel.channel_id (1), code); call hcs_$reset_ips_mask (old_mask, (""b)); /* Delete our event chn & reset the signal mask */ end; call ipc_$create_ev_chn (event_wait_channel.channel_id (1), code); call hcs_$set_ips_mask (sig_mask, old_mask); /* Create an event chn to send ourselves a wakeup on */ on quit begin; call hcs_$wakeup ((get_process_id_ ()), event_wait_channel.channel_id (1), 0, code); /* Send a wakeup to ourselves */ call continue_to_signal_ (code); /* Look for another "quit" handler and return */ end; call hcs_$wakeup (logout_pid, logout_channel, event_message, code); /* send message to answering service */ call ipc_$block (addr (event_wait_channel), addr (auto_ev_info), code); /* Have our process go blocked */ /* until a "quit" condition is signalled */ /* If we get here then we must have typed "start" */ /* in response to the QUIT condition */ revert quit; /* If we get the "quit" condition signalled, then revert it */ call ipc_$delete_ev_chn (event_wait_channel.channel_id (1), code); /* Delete our event chn after "start" on the quit condition */ call hcs_$reset_ips_mask (old_mask, (""b)); /* Reset IPS masks */ return; /* Return to caller */ end; else do; call hcs_$wakeup (logout_pid, logout_channel, event_message, code); /* send message to answering service */ call hcs_$stop_process ((get_process_id_ ())); /* stop the process */ do while ("1"b); /* wait for destruction */ call hcs_$block; end; end; end terminate_process_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved