



		    dial_out.pl1                    04/24/92  1445.5r w 04/24/92  1438.6      103410



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1991   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
dial_out:
     procedure options (variable);

/* dial_out: make a dial_out connection for a user. */
/* Written by C. Hornig, March 1980. */
/* Modified for installation by C. Hornig, April 1982 */
/* Modified January 1983 by C. Hornig for new features */
/* Modified April 1983 for connect entrypoint. */


/****^  HISTORY COMMENTS:
  1) change(91-08-16,Schroth), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Added 'force' mode to modes string for -8bit connections.
  2) change(91-08-19,JRGray), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Modified to note that 'dial_out_' prevents cleanup of profile_ptr
     after ssu_ takes responsibility for it. (Communications 457)
  3) change(91-08-19,JRGray), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Modified to add 'force' to the mode string for '-8bit' communication.
     This allows communication on those connections that don't support
     'no_outp' mode.
                                                   END HISTORY COMMENTS */



dcl  error_table_$bad_arg fixed bin (35) ext static;
dcl  error_table_$badopt fixed bin (35) ext static;
dcl  error_table_$io_no_permission fixed bin (35) ext static;
dcl  error_table_$wrong_no_of_args fixed bin (35) ext static;

dcl  com_err_ options (variable);
dcl  com_err_$suppress_name entry () options (variable);
dcl  cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35));
dcl  cu_$arg_list_ptr entry returns (ptr);
dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
dcl  dial_out_ entry (ptr, fixed bin (35));
dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  ioa_$rsnnl entry options (variable);
dcl  release_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  requote_string_ entry (char (*)) returns (char (*));
dcl  unique_chars_ entry (bit (*)) returns (char (15));

dcl  alp ptr;
dcl  dial_not_connect bit (1) aligned;
dcl  1 doi aligned like dial_out_info;
dcl  code fixed bin (35);
dcl  user_request_length fixed bin (21);
dcl  user_request_ptr ptr;

dcl  cleanup condition;

dcl  (addr, codeptr, index, length, null, rtrim, string, substr) builtin;

dcl  connect_request char (doi.request_length) based (doi.request_ptr);
dcl  user_request char (user_request_length) based (user_request_ptr);
%page;
	dial_not_connect = "1"b;
	doi.command_name = "dial_out";
	goto dial;

connect:
     entry options (variable);
	dial_not_connect = "0"b;
	doi.command_name = "connect";
	goto dial;

dial:
	doi.version = DIAL_OUT_INFO_VERSION_2;
	doi.cmd_version = "2";
	doi.net_iocb = null ();
	doi.request_table_ptr = null ();
	doi.request_ptr, doi.profile_ptr, doi.modes_ptr = null ();
	user_request_ptr = null ();
	doi.request_length, doi.modes_len = 0;
	doi.esc_char = "!";
	string (doi.flags) = ""b;
	if ^dial_not_connect then doi.no_startup_sw = "1"b;
	doi.flags.raw_sw = "1"b;

	on cleanup call cleaner;

	if ^dial_not_connect then do;
	     call get_temp_segment_ (doi.command_name, doi.request_ptr, code);
	     if doi.request_ptr = null () then do;
		call com_err_ (code, doi.command_name, "Getting temp segment.");
		go to return_to_caller;
		end;
	     end;

	alp = cu_$arg_list_ptr ();

	begin options (non_quick);			/* save stack space */

dcl  arg char (al) based (ap);

dcl  ap ptr;
dcl  al fixed bin (21);
dcl  nargs fixed bin;
dcl  i fixed bin;
dcl  (phone_given, bit8_sw) bit (1) aligned;
dcl  channel char (32);
dcl  phone varying char (48);
dcl  resource varying char (64);
dcl  atd char (168);
dcl  dirname char (168);
dcl  ename char (32);
dcl  1 stti aligned like set_term_type_info;

	     call cu_$arg_count_rel (nargs, alp, code);
	     if code ^= 0 then do;
		call com_err_ (code, doi.command_name);
		goto return_to_caller;
		end;

	     channel, phone, stti.name, resource = "";
	     phone_given, bit8_sw = "0"b;

	     do i = 1 to nargs;
		call cu_$arg_ptr_rel (i, ap, al, code, alp);

		if index (arg, "-") = 1
		then if (arg = "-raw") | (arg = "-send_cr") | (arg = "-line") then ;

		     else if arg = "-echo" then doi.echo_sw = "1"b;

		     else if arg = "-8bit" then bit8_sw = "1"b;

		     else if (arg = "-escape") | (arg = "-esc") then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing escape character.");
			     goto return_to_caller;
			     end;
			if length (arg) ^= 1 then do;
			     call com_err_ (error_table_$bad_arg, doi.command_name,
				"Escape sequence must be one character.");
			     goto return_to_caller;
			     end;
			doi.esc_char = arg;
			end;

		     else if (arg = "-terminal_type") | (arg = "-ttp") then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing terminal type.");
			     goto return_to_caller;
			     end;
			stti.name = arg;
			end;

		     else if (arg = "-resource") | (arg = "-rsc") then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing resource description.");
			     goto return_to_caller;
			     end;
			resource = arg;
			end;

		     else if (arg = "-request") | (arg = "-rq") then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing request.");
			     goto return_to_caller;
			     end;
			user_request_ptr = ap;
			user_request_length = al;
			end;

		     else if arg = "-modes" then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing modes.");
			     goto return_to_caller;
			     end;
			doi.modes_ptr = ap;
			doi.modes_len = al;
			end;

		     else if (arg = "-abbrev") | (arg = "-ab") then doi.flags.abbrev_sw = "1"b;

		     else if (arg = "-profile") then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, ap, al, code, alp);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "Missing profile pathname.");
			     goto return_to_caller;
			     end;
			call expand_pathname_$add_suffix (arg, "profile", dirname, ename, code);
			if code ^= 0 then do;
			     call com_err_ (code, doi.command_name, "^a", arg);
			     goto return_to_caller;
			     end;
			doi.flags.abbrev_sw = "1"b;
			call hcs_$initiate (dirname, ename, "", 0, 0, doi.profile_ptr, code);
			if doi.profile_ptr = null () then do;
			     call com_err_ (code, doi.command_name, "^a>^a", dirname, ename);
			     goto return_to_caller;
			     end;
			end;

		     else if (arg = "-brief") | (arg = "-bf") then doi.flags.brief_sw = "1"b;

		     else if (arg = "-no_start_up") | (arg = "-nsu") | (arg = "-ns")
		     then doi.flags.no_startup_sw = "1"b;

		     else do;
			call com_err_ (error_table_$badopt, doi.command_name, "^a", arg);
			goto return_to_caller;
			end;

		else if /* case */ channel = "" then channel = arg;

		else if ^phone_given then do;
		     phone = arg;
		     phone_given = "1"b;
		     end;

		else do;
		     call com_err_ (error_table_$wrong_no_of_args, doi.command_name, "^a", arg);
		     goto return_to_caller;
		     end;
	     end;

	     if ^doi.raw_sw then doi.echo_sw = "1"b;

	     if channel = "" then do;
		call com_err_$suppress_name (0, doi.command_name, "Usage: ^a CHANNEL {DEST} {-control_args}",
		     doi.command_name);
		goto return_to_caller;
		end;

	     phone = requote_string_ ((phone));

	     if ^dial_not_connect then do;
		doi.request_length = 3;
		connect_request = "ec ";
		if phone_given then do;
		     doi.request_length = 3 + length (phone);
		     substr (connect_request, 4) = phone;
		     end;
		else do;
		     doi.request_length = 3 + length (rtrim (channel));
		     substr (connect_request, 4) = channel;
		     end;
		if user_request_ptr ^= null () then do; /* add user command to this */
		     doi.request_length = doi.request_length + 1;
		     substr (connect_request, doi.request_length, 1) = ";";
		     doi.request_length = doi.request_length + user_request_length;
		     substr (connect_request, doi.request_length - user_request_length + 1) = user_request;
		     end;
		end;
	     else do;
		doi.request_ptr = user_request_ptr;
		doi.request_length = user_request_length;
		end;

	     call ioa_$rsnnl ("tty_ ^a^[ -destination ^a^;^s^]^[ -resource ^a^;^s^]", atd, (0), channel, phone_given,
		phone, (resource ^= ""), requote_string_ ((resource)));
	     call iox_$attach_name ("dial_out." || unique_chars_ (""b), doi.net_iocb, atd, codeptr (dial_out), code);
	     if code ^= 0 then do;
		call com_err_ (code, doi.command_name, "Attaching ^a.", atd);
		goto return_to_caller;
		end;

	     call iox_$open (doi.net_iocb, Stream_input_output, "0"b, code);
	     if code ^= 0 then do;
		call com_err_ (code, doi.command_name, "Opening ^a.", atd);
		goto return_to_caller;
		end;

	     if stti.name ^= "" then do;
		stti.version = stti_version_1;
		string (stti.flags) = ""b;
		stti.flags.set_modes, stti.flags.send_initial_string = "1"b;
		call iox_$control (doi.net_iocb, "set_term_type", addr (stti), code);
		end;
	     else do;
		call iox_$modes (doi.net_iocb, "force,init,rawi,rawo,breakall,ctl_char,^ll,fulldpx", (""), code);
		end;
	     if code ^= 0 then do;
		call com_err_ (code, doi.command_name, "Setting terminal type.");
		goto return_to_caller;
		end;

	     if bit8_sw then do;
		call iox_$modes (doi.net_iocb, "force,8bit,no_outp", (""), code);
		end;
	end;

	call dial_out_ (addr (doi), code);

	if code = error_table_$io_no_permission then do;
	     if ^doi.flags.brief_sw then call ioa_ ("dial_out: Connection closed.");
	     end;
	else if code ^= 0 then call com_err_ (code, doi.command_name);

return_to_caller:
	call cleaner;
	return;


cleaner:
     procedure;

	if doi.net_iocb ^= null () then do;
	     call iox_$close (doi.net_iocb, code);
	     call iox_$detach_iocb (doi.net_iocb, code);
	     call iox_$destroy_iocb (doi.net_iocb, code);
	     doi.net_iocb = null ();
	     end;
	/* COM 457: Note that dial_out_ sets profile_ptr to null() after ssu_ takes responsibility for it */
	if doi.profile_ptr ^= null () then do;
	     call hcs_$terminate_noname (doi.profile_ptr, code);
	     doi.profile_ptr = null ();
	     end;
	if ^dial_not_connect then call release_temp_segment_ (doi.command_name, doi.request_ptr, code);
	return;
     end cleaner;
%page;
%include dial_out_info;
%include iox_dcls;
%include iox_modes;
%include set_term_type_info;

     end dial_out;




		    dial_out_.pl1                   04/24/92  1445.5r w 04/24/92  1439.4       82431



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1991   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
dial_out_:
     procedure (Dial_out_info_ptr, Code);

/* dial_out: make a dial_out connection for a user. */
/* Written by C. Hornig, March 1980. */
/* Modified for installation, April 1982, by C. Hornig */
/* Modified January 1983 by C. Hornig to fix many bugs */
/* Modified March 1983 by K. Loepere to fix more bugs and enhance */


/****^  HISTORY COMMENTS:
  1) change(91-07-15,Oke), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Changed to zero doi local do_info structure in initialization.
  2) change(91-08-19,JRGray), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Set profile_ptr to null preventing 'dial_out' from cleaning it up
     after ssu_ becomes responsible for it. (Communications 457)
                                                   END HISTORY COMMENTS */


dcl  Code fixed bin (35) parameter;
dcl  Dial_out_info_ptr ptr parameter;

dcl  do_request_table_$do_request_table_ external;
dcl  ssu_request_tables_$standard_requests external;
dcl  sys_info$max_seg_size fixed bin (35) ext static;

dcl  error_table_$unimplemented_version fixed bin (35) ext static;
dcl  video_data_$terminal_iocb ptr external static;

dcl  continue_to_signal_ entry (fixed bin (35));
dcl  cu_$arg_list_ptr entry returns (ptr);
dcl  cu_$caller_ptr entry () returns (ptr);
dcl  cu_$cl entry (bit (36) aligned);
dcl  cu_$get_cl_intermediary entry (entry);
dcl  cu_$set_cl_intermediary entry (entry);
dcl  dial_out_modes_$set entry (ptr, char (*), fixed bin (35));
dcl  dial_out_util_$call_out entry (ptr, entry, ptr);
dcl  dial_out_util_$interaction_loop entry (ptr, bit (1) aligned, bit (1) aligned);
dcl  dial_out_util_$process_line_status entry (ptr);
dcl  dial_out_util_$reset_do_modes entry (ptr);
dcl  dial_out_util_$revert_fo entry (ptr);
dcl  dial_out_util_$set_do_modes entry (ptr);
dcl  get_process_id_ entry () returns (bit (36) aligned);
dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  ioa_ entry () options (variable);
dcl  ssu_$add_request_table entry (ptr, ptr, fixed bin, fixed bin (35));
dcl  ssu_$create_invocation entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed bin (35));
dcl  ssu_$destroy_invocation entry (ptr);
dcl  ssu_$execute_line entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  ssu_$execute_start_up entry () options (variable);
dcl  ssu_$get_temp_segment entry (ptr, char (*), ptr);
dcl  ssu_$print_blast entry (ptr, ptr, fixed bin, char (*), fixed bin (35));
dcl  ssu_$set_abbrev_info entry (ptr, ptr, ptr, bit (1) aligned);
dcl  ssu_$set_ec_search_list entry (ptr, char (32));
dcl  ssu_$set_ec_suffix entry (ptr, char (32));

dcl  based_atd varying char (256) based;
dcl  based_modes char (doi.modes_len) based (doi.modes_ptr);

dcl  code fixed bin (35);
dcl  1 hangup_proc_data aligned,
       2 entry_var variable entry (ptr),
       2 data_ptr ptr,
       2 prior fixed bin;
dcl  1 doi aligned like do_info;
dcl  in_video bit (1) aligned;
dcl  net_input_buff char (2048);
dcl  str_to_match char (1024);

dcl  (cleanup, quit) condition;

dcl  (addr, length, null, string, unspec) builtin;
%page;
/* find out initial modes, options, etc. */
	Code = 0;
	if (Dial_out_info_ptr -> dial_out_info.version ^= "doinfo_0")
	     & (Dial_out_info_ptr -> dial_out_info.version ^= "doinfo_1")
	     & (Dial_out_info_ptr -> dial_out_info.version ^= DIAL_OUT_INFO_VERSION_2) then do;
	     Code = error_table_$unimplemented_version;
	     return;
	     end;

	dop = addr (doi);
	unspec (doi) = ""b;
	doi.ci = Dial_out_info_ptr -> dial_out_info;

	if doi.ci.version = "doinfo_0" then doi.ci.cmd_version = "";
	if (doi.ci.version = "doinfo_0") | (doi.ci.version = "doinfo_1") then do;
	     doi.ci.modes_ptr = null ();
	     doi.ci.modes_len = 0;
	     end;

	doi.version = doi.ci.cmd_version || "/2a";
	doi.abort_label = return_to_caller;
	doi.abort_code = 0;
	doi.sci_ptr = null ();
	doi.fo_iocbp = null ();
	doi.temp_seg_p = null ();
	doi.match_length = 0;
	string (doi.flags) = ""b;
	doi.flags.echo_mode = "1"b;

	in_video = video_data_$terminal_iocb ^= null ();
	if doi.ci.modes_ptr ^= null () then do;
	     call dial_out_modes_$set (dop, based_modes, doi.abort_code);
	     if doi.abort_code ^= 0 then goto doi.abort_label;
	     end;

	doi.old_modes = "";
	call iox_$modes (iox_$user_input, "", doi.old_modes, code);

	doi.cmd_ptr = null ();
	call cu_$get_cl_intermediary (doi.saved_cl_intermediary);

	on cleanup call cleaner;

	call ssu_$create_invocation (doi.ci.command_name, (doi.version), addr (doi), doi.ci.request_table_ptr,
	     ">doc>subsystem>dial_out", doi.sci_ptr, doi.abort_code);
	if doi.abort_code ^= 0 then goto return_to_caller;
	call ssu_$add_request_table (doi.sci_ptr, addr (do_request_table_$do_request_table_), 2, doi.abort_code);
	if doi.abort_code ^= 0 then goto return_to_caller;
	call ssu_$add_request_table (doi.sci_ptr, addr (ssu_request_tables_$standard_requests), 3, doi.abort_code);
	if doi.abort_code ^= 0 then goto return_to_caller;

	call ssu_$print_blast (doi.sci_ptr, cu_$caller_ptr (), 1, "", code);
	call ssu_$set_abbrev_info (doi.sci_ptr, doi.ci.profile_ptr, null (), (doi.ci.flags.abbrev_sw));
	Dial_out_info_ptr -> dial_out_info.profile_ptr = null();	/* COM 457: it's now completely ssu_'s responsibility */
	call ssu_$set_ec_search_list (doi.sci_ptr, "dial_out");
	call ssu_$set_ec_suffix (doi.sci_ptr, "dial_out");

	call ssu_$get_temp_segment (doi.sci_ptr, "work_area", doi.temp_seg_p);
	doi.cmd_buff_len = sys_info$max_seg_size * 4;
	call ssu_$get_temp_segment (doi.sci_ptr, "command_area", doi.cmd_ptr);

	doi.match_string_p = addr (str_to_match);
	doi.match_length = 0;
	doi.match_max_length = length (str_to_match);
	doi.net_input_buff_ptr = addr (net_input_buff);
	doi.net_input_buff_len = length (net_input_buff);
	doi.net_input_last_char_filled = 0;
	doi.net_input_last_char_output = 0;

	on quit
	     begin;
	     if doi.ci.flags.quit_sw then do;
		call iox_$control (doi.ci.net_iocb, "interrupt", null (), doi.abort_code);
		if doi.abort_code ^= 0 then goto return_to_caller;
		end;
	     else call continue_to_signal_ (doi.abort_code);
	end;

	doi.my_cl_intermediary = do_cl_intermediary;
	call cu_$set_cl_intermediary (doi.my_cl_intermediary);

	hangup_proc_data.entry_var = process_hangup;
	hangup_proc_data.data_ptr = addr (doi);
	hangup_proc_data.prior = 1;
	call iox_$control (doi.ci.net_iocb, "hangup_proc", addr (hangup_proc_data), code);

	if ^doi.ci.flags.brief_sw
	then call ioa_ ("Ready on ^a...", doi.ci.net_iocb -> iocb.attach_descrip_ptr -> based_atd);

	call dial_out_util_$process_line_status (dop);
	call dial_out_util_$reset_do_modes (dop);	/* undo mode set above for running start_up, request */

	if ^doi.ci.flags.no_startup_sw then call ssu_$execute_start_up (doi.sci_ptr, code);

	if doi.ci.request_ptr ^= null ()
	then call ssu_$execute_line (doi.sci_ptr, doi.ci.request_ptr, doi.ci.request_length, code);

	call dial_out_util_$set_do_modes (dop);
%page;
/* The main work lies in util_.  This is so the interaction loop may , be
   reentered (recursively) from the wait request. */
	call dial_out_util_$interaction_loop (dop, "0"b, "0"b);

return_to_caller:
	call cleaner;
	Code = doi.abort_code;

	return;
%page;
/* * * * * * * * * * CLEANER * * * * * * * * * */

cleaner:
     procedure;

	call cu_$set_cl_intermediary (doi.saved_cl_intermediary);
	call dial_out_util_$reset_do_modes (dop);
	if doi.raw_sw
	then if ^in_video then call iox_$control (iox_$user_input, "send_initial_string", null (), code);
						/* we need to reset tabs, etc. that foreign screwed up - would be nice if
						   this wasn't necessary */
	call dial_out_util_$revert_fo (addr (doi));
	if doi.sci_ptr ^= null () then do;
	     call ssu_$destroy_invocation (doi.sci_ptr);
	     end;
	doi.cmd_ptr = null ();
	return;

     end cleaner;

/* * * * * * * * * * DO_CL_INTERMEDIARY * * * * * * * * * * */

do_cl_intermediary:
     procedure (Flags) options (non_quick);
dcl  Flags bit (36) aligned parameter;

	call dial_out_util_$call_out (dop, cu_$cl, cu_$arg_list_ptr ());
						/* This gets the modes right */
	return;
     end do_cl_intermediary;

/* * * * * * * * * * PROCESS_HANGUP * * * * * * * * * * */

process_hangup:
     procedure (Data_ptr);

dcl  code fixed bin (35);
dcl  Data_ptr ptr parameter;

	call hcs_$wakeup (get_process_id_ (), Data_ptr -> event_call_info.data_ptr -> do_info.net_rs.ev_chn, 0, code);
	return;

%include event_call_info;

     end process_hangup;

%page;
%include dial_out_invocation;
%include iocb;
%include iox_dcls;

     end dial_out_;




		    dial_out_modes_.pl1             07/18/83  0949.3r w 07/13/83  0949.3       31725



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
dial_out_modes_$set:
     procedure (Dop, Modes, Code);

/* Written January 1983 by C. Hornig */

dcl  Dop ptr parameter;
dcl  Modes char (*) parameter;
dcl  Code fixed bin (35) parameter;

dcl  error_table_$bad_mode fixed bin (35) ext static;
dcl  error_table_$bad_mode_value fixed bin (35) ext static;
dcl  error_table_$unimplemented_version fixed bin (35) ext static;

dcl  get_user_free_area_ entry () returns (ptr);
dcl  mode_string_$parse entry (char (*), ptr, ptr, fixed bin (35));

dcl  i fixed bin;
dcl  (set_raw, set_echo, set_lfecho) bit (1) aligned;

dcl  cleanup condition;

dcl  null builtin;

/* * * * * * * * * * SET * * * * * * * * * */

	dop = Dop;
	set_raw = do_info.raw_sw;
	set_echo = do_info.echo_sw;
	set_lfecho = do_info.lfecho_sw;

	mode_string_info_ptr = null ();
	on cleanup
	     begin;
		if mode_string_info_ptr ^= null () then free mode_string_info;
	     end;

	call mode_string_$parse (Modes, get_user_free_area_ (), mode_string_info_ptr, Code);
	if Code ^= 0 then return;

	if mode_string_info.version ^= mode_string_info_version_2 then call abort (error_table_$unimplemented_version);

	do i = 1 to mode_string_info.number;
	     if mode_string_info.modes (i).version ^= mode_value_version_3
	     then call abort (error_table_$unimplemented_version);

	     if /* case */ mode_string_info.modes (i).mode_name = "echo"
	     then if mode_string_info.modes (i).boolean_valuep
		then set_echo = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else if mode_string_info.modes (i).mode_name = "raw"
	     then if mode_string_info.modes (i).boolean_valuep
		then set_raw = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else if mode_string_info.modes (i).mode_name = "echo_lf"
	     then if mode_string_info.modes (i).boolean_valuep
		then set_lfecho = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else if mode_string_info.modes (i).mode_name = "send_lf"
	     then if mode_string_info.modes (i).boolean_valuep
		then do_info.flags.send_lf_sw = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else if mode_string_info.modes (i).mode_name = "quit"
	     then if mode_string_info.modes (i).boolean_valuep
		then do_info.flags.quit_sw = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else if mode_string_info.modes (i).mode_name = "line"
	     then if mode_string_info.modes (i).boolean_valuep
		then do_info.flags.no_breakall_sw = mode_string_info.modes (i).boolean_value;
		else call abort (error_table_$bad_mode_value);
	     else call abort (error_table_$bad_mode);
	end;

punt:
	free mode_string_info;

	do_info.ci.raw_sw = set_raw;
	do_info.ci.echo_sw = set_echo;
	do_info.ci.lfecho_sw = set_lfecho;

	return;

/* * * * * * * * * * ABORT * * * * * * * * * */

abort:
     procedure (Error);

dcl  Error fixed bin (35) parameter;

	Code = Error;
	goto punt;
     end abort;
%page;
%include dial_out_invocation;
%include mode_string_info;

     end dial_out_modes_$set;




		    dial_out_sl_default_.cds        02/16/88  1502.4r w 02/16/88  1409.5       26928



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
dial_out_sl_default_:
     procedure ();

/* automatic */

	declare code		 fixed binary (35);
	declare wdir		 char (168);

	declare 1 cdsa		 aligned like cds_args;

	declare 1 lists		 aligned,
		2 dial_out,
		  3 name_count	 fixed binary,
		  3 path_count	 fixed binary,
		  3 names		 (1) char (32),
		  3 paths		 (3) like search_path;

/* based */

	declare 1 search_path	 based,
		2 type		 fixed binary,
		2 pathname	 char (168);

/* builtin */

	declare addr		 builtin;
	declare hbound		 builtin;
	declare null		 builtin;
	declare rtrim		 builtin;
	declare size		 builtin;
	declare unspec		 builtin;

/* entry */

	declare com_err_		 entry options (variable);
	declare create_data_segment_	 entry (pointer, fixed binary (35));
	declare get_wdir_		 entry () returns (char (168));

%include sl_info;
%include cds_args;

/* program */

	lists.dial_out.name_count = hbound (lists.dial_out.names, 1);
	lists.dial_out.path_count = hbound (lists.dial_out.paths, 1);
	lists.dial_out.names (1) = "dial_out";
	lists.dial_out.paths (1).type = WORKING_DIR;
	lists.dial_out.paths (1).pathname = "-working_dir";
	lists.dial_out.paths (2).type = UNEXPANDED_PATH;
	lists.dial_out.paths (2).pathname = ">udd>[user project]>dial_out_dir";
	lists.dial_out.paths (3).type = ABSOLUTE_PATH;
	lists.dial_out.paths (3).pathname = ">site>dial_out_dir";

	unspec (cdsa) = ""b;
	cdsa.sections (1).p = addr (lists);
	cdsa.sections (1).len = size (lists);
	cdsa.sections (1).struct_name = "lists";
	cdsa.sections (2).p = null;
	cdsa.sections (2).struct_name = "";
	cdsa.seg_name = "dial_out_sl_default_";
	cdsa.exclude_array_ptr = null;
	cdsa.switches.have_text = "1"b;

	call create_data_segment_ (addr (cdsa), code);
	if code ^= 0
	then do;
		call com_err_ (code, "dial_out_sl_default_");
		return;
	     end;

	wdir = get_wdir_ ();

	call add_search_names (lists.dial_out.names (*));

	return;

add_search_names:
     proc (name_array);

	declare name_array		 dimension (*) char (32) aligned parameter;

	declare hbound		 builtin;
	declare lbound		 builtin;

	declare error_table_$segnamedup
				 fixed bin (35) ext static;

	declare hcs_$chname_file	 entry (char (*), char (*), char (*), char (*), fixed bin (35));

	declare i			 fixed bin;
	declare extra_name		 char (32);

	do i = lbound (name_array, 1) to hbound (name_array, 1);
	     extra_name = rtrim (name_array (i)) || ".search";
	     call hcs_$chname_file (wdir, "dial_out_sl_default_", "", extra_name, code);
	     if code ^= 0
	     then if code ^= error_table_$segnamedup
		then call com_err_ (code, "dial_out_sl_default_", "Adding name ^a", extra_name);
	end;

	return;
     end add_search_names;

     end dial_out_sl_default_;




		    dial_out_util_.pl1              04/24/92  1445.5r w 04/24/92  1439.1      216540



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1991   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
dial_out_util_:
     procedure;

/* Written January 1983 by C. Hornig */
/* Modified March 1983 by K. Loepere to fix bugs, enhance for waiting */
/* Modified September 1983 by R.J.C. Kissel to send lines to the remote */
/*  system wth their terminators in one put_chars call. (Mostly for 6M). */
/* Modified December 1983 by B. Margolin to change reset_do_modes to just
   call iox_$modes and iox_$control, rather than calling set_modes (which
   would set some tty modes improperly for a reset), and remove the minor
   optimization in set_modes which is no longer valid. */


/****^  HISTORY COMMENTS:
  1) change(91-07-15,Oke), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     To setup a length for substr's of input_buffer in escape and special
     character processing.  Previously this did not account for num_chars_read
     and thus indexed into uninitialized parts of the automatic variable
     input_buffer, with amusing results.
  2) change(91-08-15,Schroth), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Added cleanup handler to interaction_loop entry to reset the wait alarm
     timer when unwinding.
                                                   END HISTORY COMMENTS */


dcl  Active_function bit (1) aligned;
dcl  Arg_list ptr parameter;
dcl  Code fixed bin (35) parameter;
dcl  Dop ptr parameter;
dcl  Data_ptr ptr parameter;
dcl  Entry variable entry parameter;
dcl  Nelem fixed bin (21) parameter;
dcl  Silent bit (1) aligned parameter;
dcl  Waiting bit (1) aligned parameter;

dcl  CR char (1) static options (constant) init ("");
dcl  NL char (1) static options (constant) init ("
");

dcl  cleanup condition;
dcl  program_interrupt condition;
dcl  quit condition;

dcl  active_function bit (1) aligned init ("0"b);
dcl  active_len_before_quotes fixed bin (21);		/* see if final quotes pair */
dcl  active_result char (do_info.active_result_max_len) based (do_info.active_result_ptr) var;
dcl  cmd_buff char (do_info.cmd_buff_len) based (do_info.cmd_ptr);
						/* accumulated stuff to either send out or execute */
dcl  cmd_len fixed bin (21);
dcl  code fixed bin (35);
dcl  escape_seen bit (1) aligned;			/* last char was an escape char */
dcl  1 ev_msg aligned like event_wait_info;
dcl  in_command bit (1) aligned;			/* now reading a command */
dcl  need_to_echo_command bit (1) aligned;		/* have processed the command character */
dcl  need_to_check_net bit (1) aligned;			/* chars may be present at net */
dcl  need_to_check_term bit (1) aligned;		/* chars may be present at term */
dcl  net_input_buff char (do_info.net_input_buff_len) based (do_info.net_input_buff_ptr);
dcl  silent bit (1) aligned init ("0"b);		/* don't print stuff from net */
dcl  1 term_rs aligned like do_info.net_rs;
dcl  1 wait_list aligned,
       2 count fixed bin,
       2 pad fixed bin,
       2 ev_chn (2) fixed bin (71);
dcl  waiting bit (1) aligned init ("0"b);		/* in mode ignoring terminal input waiting for something from net */

dcl  error_table_$line_status_pending fixed bin (35) ext static;
dcl  error_table_$timeout fixed bin (35) ext static;

dcl  com_err_ entry () options (variable);
dcl  cu_$arg_list_ptr entry () returns (ptr);
dcl  cu_$generate_call entry (entry, ptr);
dcl  cu_$set_cl_intermediary entry (entry);
dcl  get_user_free_area_ entry returns (ptr);
dcl  ioa_$nnl entry () options (variable);
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ssu_$execute_line entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry, ptr);
dcl  timer_manager_$reset_alarm_call entry (entry);
dcl  requote_string_$quote_string entry (char (*)) returns (char (*));

dcl  (addcharno, addr, divide, index, length, min, mod, null, rtrim, substr) builtin;

/* * * * * * * * * SEND_CHARS * * * * * * * * * * */

send_chars:
     entry (Dop, Data_ptr, Nelem, Code);

	dop = Dop;
	call send (Data_ptr, Nelem, Code);
	return;

/* * * * * * * * * * SEND_NL * * * * * * * * * */

send_nl:
     entry (Dop, Code);

	dop = Dop;
	call send (addr (CR), 1, Code);
	if Code ^= 0 then return;
	if do_info.flags.send_lf_sw then do;
	     call send (addr (NL), 1, Code);
	     if Code ^= 0 then return;
	     end;
	return;

/* * * * * * * * * * SEND * * * * * * * * */

send:
     procedure (Data_ptr, Nelem, Code);

dcl  Code fixed bin (35) parameter;
dcl  Data_ptr ptr parameter;
dcl  Nelem fixed bin (21) parameter;

rewrite:
	call iox_$put_chars (do_info.ci.net_iocb, Data_ptr, Nelem, Code);
	if Code = error_table_$line_status_pending then do;
	     call line_status;
	     goto rewrite;
	     end;
	return;
     end send;

/* * * * * * * * * * PROCESS_LINE_STATUS * * * * * * * * * * */

process_line_status:
     entry (Dop);

	dop = Dop;
	call line_status;
	return;

/* * * * * * * * * * SET_DO_MODES * * * * * * * * * */

set_do_modes:
     entry (Dop);

	dop = Dop;
	call set_modes (do_info.ci.raw_sw, do_info.ci.echo_sw, do_info.ci.lfecho_sw);
	return;

/* * * * * * * * * * RESET_DO_MODES * * * * * * * * * */

reset_do_modes:
     entry (Dop);

	dop = Dop;
	call iox_$modes (iox_$user_input, do_info.old_modes, (""), (0));
	call iox_$control (iox_$user_input, "printer_on", null (), (0));
	return;

/* * * * * * * * * LINE_STATUS * * * * * * * * * * */

line_status:
     procedure;

dcl  ls_data bit (72) aligned;
dcl  code fixed bin (35);

	call iox_$control (do_info.ci.net_iocb, "line_status", addr (ls_data), code);
	call get_modes;
	return;
     end line_status;

/* * * * * * * * * GET_MODES * * * * * * * * * */

get_modes:
     procedure;

dcl  code fixed bin (35);
dcl  1 ftd aligned like foreign_terminal_data;
dcl  i fixed bin;

	ftd.version = FOREIGN_TERMINAL_DATA_VERSION_1;
	ftd.area_ptr = get_user_free_area_ ();
	call iox_$control (do_info.ci.net_iocb, "get_foreign_terminal_data", addr (ftd), code);
	if code ^= 0 then return;

	mode_string_info_ptr = ftd.mode_string_info_ptr;
	if mode_string_info.version = mode_string_info_version_2 then do;
	     do_info.flags.echo_sw = "0"b;
	     do i = 1 to mode_string_info.number;	/* process each mode */
		mode_value_ptr = addr (mode_string_info.modes (i));
		if mode_value.version = mode_value_version_3 then do;
		     if /* case */ ((mode_value.mode_name = "echoplex") | (mode_value.mode_name = "echo"))
			& mode_value.flags.boolean_valuep & mode_value.flags.boolean_value
		     then do_info.ci.flags.echo_sw = "1"b;
		     else if (mode_value.mode_name = "lfecho") & mode_value.flags.boolean_valuep
		     then do_info.ci.flags.lfecho_sw = mode_value.flags.boolean_value;
		     else if (mode_value.mode_name = "breakall") & mode_value.flags.boolean_valuep
		     then do_info.ci.flags.no_breakall_sw = ^mode_value.flags.boolean_value;
		     end;
	     end;
	     end;
	call set_modes (do_info.ci.raw_sw, do_info.ci.echo_sw, do_info.ci.lfecho_sw);
	free mode_string_info;
	return;

%include mode_string_info;

     end get_modes;

/* * * * * * * * * * SET_MODES * * * * * * * * * */

set_modes:
     procedure (Raw, Echo, Lfecho);

dcl  (Raw, Echo, Lfecho) bit (1) unaligned parameter;
dcl  code fixed bin (35);

	call iox_$modes (iox_$user_input, do_info.old_modes, (""), code);
	call iox_$control (iox_$user_input, "printer_on", null (), code);

	if Raw then call iox_$modes (iox_$user_input, "force,rawi,rawo,^replay,^polite,^prefixnl", (""), code);

	if ^do_info.no_breakall_sw then do;
	     call iox_$modes (iox_$user_input, "breakall", (""), code);
	     if ^Lfecho | ^Echo then call iox_$modes (iox_$user_input, "^lfecho", (""), code);
	     end;

	if ^Echo then do;
	     call iox_$modes (iox_$user_input, "force,^tabecho,^crecho", (""), code);
	     call iox_$control (iox_$user_input, "printer_off", null (), code);
	     end;

	do_info.raw_mode = Raw;
	do_info.echo_mode = Echo;
	do_info.lfecho_mode = Lfecho;
	return;
     end set_modes;
%page;
interaction_loop:
     entry (Dop, Waiting, Active_function);

/* This is the main loop that looks for chars coming from either end and
   normally just sends them to the other end.  The terminals chars are examined
   for escape sequences. */

	dop = Dop;
	waiting = Waiting;
	active_function, silent = Active_function;
	if active_function then do;
	     do_info.active_result_max_len = do_info.active_result_max_len - 1;
						/* leave room for final quote */
	     active_result = """";
	     end;

	if ^waiting
	then on program_interrupt			/* set only for main usage, not wait */
		begin;
		call set_do_modes (dop);		/* just in case */
		call cu_$set_cl_intermediary (do_info.my_cl_intermediary);
		call ioa_$nnl ("^1aInput:  ", do_info.ci.esc_char);
		call terminal_input ("1"b);
		waiting = "0"b;
		goto reenter_interaction_loop;
	     end;

	on cleanup
	     begin;
	     if waiting & do_info.time_out > 0 then call timer_manager_$reset_alarm_call (abort_wait);
	end;

reenter_interaction_loop:
	if waiting
	then if do_info.match_length > 0
	     then					/* did what he wants already come */
		if net_input_found () then goto interaction_done;
	in_command, need_to_echo_command, escape_seen = "0"b;
	need_to_check_net, need_to_check_term = "1"b;	/* set everything to give us a chance to see what's there */
	cmd_len = 0;
	term_rs.ev_chn = 0;
	do_info.abort_code = 0;

	do while ("1"b);
	     if need_to_check_net then do;
		call iox_$control (do_info.ci.net_iocb, "read_status", addr (do_info.net_rs), code);
		if code ^= 0 then do_info.net_rs.data_available = "1"b;

		if do_info.net_rs.data_available
		then call net_input;
		else need_to_check_net = "0"b;
		end;

	     if need_to_check_term & ^waiting then do;
		call iox_$control (iox_$user_input, "read_status", addr (term_rs), code);
		if code ^= 0 then term_rs.data_available = "1"b;

		if term_rs.data_available
		then call terminal_input ("0"b);
		else do;
		     need_to_check_term = "0"b;
		     if need_to_echo_command then do;
			call reset_do_modes (dop);
			if ^do_info.ci.flags.echo_sw
			then call ioa_$nnl ("^1a^a", do_info.ci.esc_char, substr (cmd_buff, 1, cmd_len));
			need_to_echo_command = "0"b;
			end;
		     end;
		end;

	     if (^need_to_check_term | waiting) & ^need_to_check_net then do;
						/* if we're convinced no one has something for us, wait */
		wait_list.ev_chn (1) = do_info.net_rs.ev_chn;
		if (term_rs.ev_chn ^= 0) & ^waiting then do;
		     wait_list.ev_chn (2) = term_rs.ev_chn;
		     wait_list.count = 2;
		     end;
		else wait_list.count = 1;

		if waiting & do_info.time_out > 0
		then call timer_manager_$alarm_call ((do_info.time_out), "11"b, abort_wait, null ());
		call ipc_$block (addr (wait_list), addr (ev_msg), do_info.abort_code);
		if waiting & do_info.time_out > 0 then call timer_manager_$reset_alarm_call (abort_wait);

		if do_info.abort_code ^= 0 then goto return_to_caller;
		if ev_msg.channel_index = 1
		then need_to_check_net = "1"b;
		else need_to_check_term = "1"b;
		end;
	end;

interaction_done:
	if active_function then do;			/* make sure that the final quotes pair correctly
						   (Normally, an extra quote is needed at the end to properly requote the result.
						   We may need to fiddle, though, for this to come out right if
						   we overflowed the end before.) */
	     do_info.active_result_max_len = do_info.active_result_max_len + 1;
						/* give room for one more quote */
	     active_len_before_quotes = length (rtrim (active_result, """"));
	     if active_len_before_quotes = 0
	     then					/* all quotes */
		if mod (length (active_result), 2) ^= 0
		then active_result = active_result || """";
						/* pair up */
		else ;
	     else if mod (length (active_result) - active_len_before_quotes, 2) = 0
	     then active_result = active_result || """";
	     else ;
	     end;
	return;

abort_wait:
     proc (mc_ptr, name, wc_ptr, data_ptr) options (non_quick);
						/* must be non_quick since it is called (non-locally) through an entry variable) */
dcl  (mc_ptr, wc_ptr, data_ptr) ptr;
dcl  name char (*);
	do_info.abort_code = error_table_$timeout;
	goto interaction_done;
     end;


/* * * * * * * * * PROCESS_NET_INPUT * * * * * * * * * */

process_net_input:
     entry (Dop, Silent);

	dop = Dop;
	silent = Silent;
	call net_input;
	return;

net_input:
     procedure;

dcl  half_size fixed bin;				/* amount to scroll down char matching area */
dcl  num_received fixed binary (21) automatic;

	if do_info.net_input_last_char_filled = do_info.net_input_buff_len then do;
						/* we filled matching area to end; scroll down last half over first half to
						   get more space and so new high half flows from end of old high half -
						   also update pointer to last char therein we matched on a wait */
	     half_size = divide (do_info.net_input_buff_len, 2, 17);
						/* since the chars we scroll over can't be seen again or matched - output them */
	     if do_info.net_input_last_char_output < half_size
	     then call output_net_input (half_size - do_info.net_input_last_char_output);
	     substr (net_input_buff, 1, half_size) = substr (net_input_buff, half_size + 1, half_size);
	     do_info.net_input_last_char_filled = half_size;
	     net_input_last_char_output = net_input_last_char_output - half_size;
	     end;

	call iox_$get_chars (do_info.ci.net_iocb, addcharno (addr (net_input_buff), do_info.net_input_last_char_filled),
	     do_info.net_input_buff_len - do_info.net_input_last_char_filled, num_received, do_info.abort_code);
						/* read as much as still fits in area */
	if do_info.abort_code = error_table_$line_status_pending then do;
	     call process_line_status (dop);
	     return;
	     end;
	if (num_received = 0) & (do_info.abort_code ^= 0) then goto return_to_caller;

	if num_received > 0 then do;
	     do_info.net_input_last_char_filled = do_info.net_input_last_char_filled + num_received;
	     if waiting				/* see if we have read desired chars */
	     then if net_input_found ()
		then goto interaction_done;
		else ;
	     else call output_net_input (do_info.net_input_last_char_filled - do_info.net_input_last_char_output);
	     end;
	return;
     end net_input;

net_input_found:
     proc () returns (bit (1) aligned);
dcl  match_string char (do_info.match_length) based (do_info.match_string_p);
dcl  matched_pos fixed bin;

/* net_input very nicely keeps a running script of what came from the net.
   He keeps scrolling this down, by halves, in the net_input_buff.  Thus, we
   can do an index to see if the string came in (from the marked point at which
   we last looked).  This will succeed as long as the string being searched for
   does not exceed half the size of net_input_buff. */

	if do_info.match_length = 0			/* any chars satisfy */
	then return ("1"b);
	else do;
	     matched_pos =
		index (
		substr (net_input_buff, do_info.net_input_last_char_output + 1,
		do_info.net_input_last_char_filled - do_info.net_input_last_char_output), match_string);
						/* search only in chars after what
						   matched a previous wait desire */
	     if matched_pos > 0 then do;
		call output_net_input (do_info.match_length + matched_pos - 1);
		return ("1"b);
		end;
	     end;
	return ("0"b);
     end;

output_net_input:
     proc (amount);

/* take desired chars and send to all appropriate places */
dcl  amount fixed bin (21);

	if amount <= 0 then return;
	if active_function then do;
	     active_result =
		active_result
		||
		requote_string_$quote_string (substr (net_input_buff, do_info.net_input_last_char_output + 1, amount))
		;
	     end;

	if ^silent then do;				/* not in send_file discard mode or active function */
	     call iox_$put_chars (iox_$user_output,
		addcharno (addr (net_input_buff), do_info.net_input_last_char_output), amount, do_info.abort_code);
	     if do_info.abort_code ^= 0 then goto return_to_caller;
	     end;
	if do_info.fo_iocbp ^= null () then do;		/* file out in progress */
	     call iox_$put_chars (do_info.fo_iocbp,
		addcharno (addr (net_input_buff), do_info.net_input_last_char_output), amount, code);
	     if code ^= 0 then do;
		call com_err_ (code, do_info.ci.command_name, "Error in file_output, reverting.");
		call revert_fo (addr (do_info));
		end;
	     end;
	do_info.net_input_last_char_output = do_info.net_input_last_char_output + amount;
     end;

terminal_input:
     procedure (Force_get_line);

dcl  Force_get_line bit (1) aligned parameter;
dcl  c char (1) aligned;				/* previous char examining */
dcl  code fixed bin (35);
dcl  fragment_len fixed bin (21);			/* amount of input to add to command or output */
dcl  indx fixed bin (21);				/* start of string being considered */
dcl  input_buffer char (128);
dcl  next_char fixed bin (21);			/* pos rel to indx of next char to consider */
dcl  next_whatever fixed bin (21);			/* pos rel to indx of nl, cr, being looked for */
dcl  num_bytes_read fixed bin (21);

/* * * * * * * * * * * * * * * * * * * * * * * * */

	num_bytes_read = 0;

	if Force_get_line | ^do_info.raw_mode
	then call iox_$get_line (iox_$user_input, addr (input_buffer), length (input_buffer), num_bytes_read,
		do_info.abort_code);
	else call iox_$get_chars (iox_$user_input, addr (input_buffer), length (input_buffer), num_bytes_read,
		do_info.abort_code);
	if (do_info.abort_code ^= 0) & (num_bytes_read = 0) then goto do_info.abort_label;

	if num_bytes_read = 0 then return;
	indx = 1;
	if escape_seen then do;			/* last char of previous buffer was escape */
	     escape_seen = "0"b;
	     fragment_len = 1;
	     c = substr (input_buffer, indx, 1);
	     if c = do_info.ci.esc_char then call insert; /* two esc's in a row make only one */
	     else if in_command then do;
		call switch;			/* leave command */
		call insert;			/* add char to regular input */
		end;
	     else if ^((c = CR) | (do_info.lfecho_mode & do_info.echo_mode & (c = NL))) then do;
		call switch;			/* start command */
		call insert;
		end;
	     else ;				/* esc CR is null command */
	     indx = 2;				/* first char used */
	     end;

/* loop, grabbing strings up to break chars (esc, nl, etc) */
	do while (indx <= num_bytes_read);		/* look for an interesting char (esc, CR,...) */
	     next_char = index (substr (input_buffer, indx, num_bytes_read - indx + 1), do_info.ci.esc_char);
	     if next_char = 0 then next_char = num_bytes_read - indx + 1;
						/* last char is considered interesting if no esc, nl... */
	     next_whatever = index (substr (input_buffer, indx, num_bytes_read - indx + 1), CR);
	     if next_whatever = 0 then next_whatever = num_bytes_read - indx + 1;
	     next_char = min (next_char, next_whatever);
	     if in_command | (do_info.lfecho_mode & do_info.echo_mode) then do;
						/* NL is interesting only in a command or when modes say it is */
		next_whatever = index (substr (input_buffer, indx, num_bytes_read - indx + 1), NL);
		if next_whatever = 0 then next_whatever = num_bytes_read - indx + 1;
		next_char = min (next_char, next_whatever);
		end;

	     c = substr (input_buffer, indx + next_char - 1, 1);
	     if /* case */ c = do_info.ci.esc_char then do;
		fragment_len = next_char - 1;
		call insert;			/* chars up to esc go to appropriate buffer */
		indx = indx + fragment_len + 1;	/* -> after esc */
		if indx > num_bytes_read
		then escape_seen = "1"b;		/* remember to look at in next buffer */
		else do;
		     fragment_len = 1;
		     c = substr (input_buffer, indx, 1);
		     if c = do_info.ci.esc_char then call insert;
						/* two esc's in a row make only one */
		     else if in_command then do;
			call switch;		/* leave command */
			call insert;		/* add char to regular input */
			end;
		     else if ^((c = CR) | (do_info.lfecho_mode & do_info.echo_mode & (c = NL))) then do;
			call switch;		/* start command */
			call insert;		/* add char to it */
			end;
		     else ;			/* esc CR is null command */
		     indx = indx + 1;
		     end;
		end;
	     else if (c = CR) | (c = NL /* if we thought they were interesting before */) then do;
		fragment_len = next_char - 1;
		call insert;			/* add chars to appropriate buffer */
		indx = indx + fragment_len + 1;	/* -> after CR */
		if in_command
		then call switch;			/* CR ends command */
		else do;				/* Send a line with its terminator. */
		     call insert_char (CR);
		     if do_info.flags.send_lf_sw then call insert_char (NL);
		     call transmit_buffer ();
		     end;
		end;
	     else do;				/* must be last char in buffer */
		fragment_len = next_char;
		call insert;			/* add to buffer */
		indx = indx + fragment_len;
		end;
	end;
	if ^in_command & (cmd_len > 0) then call transmit_buffer ();

	return;


switch:
	procedure ();
dcl  this_cmd_len fixed bin (21);

	     if in_command then do;			/* end to command detected - prepare to execute */
		this_cmd_len = cmd_len;
		cmd_len = 0;
		if need_to_echo_command & ^do_info.ci.flags.echo_sw
		then call ioa_$nnl ("^1a^a", do_info.ci.esc_char, substr (cmd_buff, 1, this_cmd_len));
		in_command, need_to_echo_command = "0"b;
		call cmd_proc (do_info.sci_ptr, do_info.cmd_ptr, this_cmd_len, code);
		end;
	     else do;				/* begin start of command */
		call transmit_buffer ();
		in_command, need_to_echo_command = "1"b;
		end;

	     return;

	end switch;


insert:
	procedure ();

/* add chars to output buffer */

	     substr (cmd_buff, cmd_len + 1, fragment_len) = substr (input_buffer, indx, fragment_len);
	     cmd_len = cmd_len + fragment_len;

	end insert;

insert_char:
	proc (Char);

dcl  Char char (1) parameter;

	     substr (cmd_buff, cmd_len + 1, 1) = Char;
	     cmd_len = cmd_len + 1;

	     return;

	end insert_char;

/* * * * * * * * * * TRANSMIT_BUFFER * * * * * * * * * */

transmit_buffer:					/* send characters to the remote */
	procedure;

	     call send_chars (dop, addr (cmd_buff), cmd_len, do_info.abort_code);
	     if do_info.abort_code ^= 0 then goto do_info.abort_label;
	     cmd_len = 0;
	     return;

	end transmit_buffer;

/* * * * * * * * * * COMMAND_PROC * * * * * * * * * */

cmd_proc:
	procedure (Sci_ptr, Cmd_ptr, Cmd_len, Code) options (non_quick);
						/* get a standard argument list */

dcl  (Cmd_ptr, Sci_ptr) ptr parameter;
dcl  Cmd_len fixed bin (21) parameter;
dcl  Code fixed bin (35) parameter;

	     call call_out (dop, ssu_$execute_line, cu_$arg_list_ptr ());
	     need_to_check_term = "1"b;
	     need_to_check_net = "1"b;		/* who knows what happened while we were gone */
	     call output_net_input (do_info.net_input_last_char_filled - do_info.net_input_last_char_output);
						/* after possible wait request, flush what wasn't  grabbed */
	     return;

	end cmd_proc;

     end terminal_input;

/* * * * * * * * * * REVERT_FO * * * * * * * * */

revert_fo:
     entry (Dop);

	dop = Dop;
	if do_info.fo_iocbp = null then return;
	call iox_$close (do_info.fo_iocbp, code);
	call iox_$detach_iocb (do_info.fo_iocbp, code);
	call iox_$destroy_iocb (do_info.fo_iocbp, code);
	do_info.fo_iocbp = null;
	return;

/* * * * * * * * * * CALL_OUT * * * * * * * * * */

call_out:
     entry (Dop, Entry, Arg_list);

	dop = Dop;
	on cleanup
	     begin;
	     call set_do_modes (dop);
	     call cu_$set_cl_intermediary (do_info.my_cl_intermediary);
	end;
	on quit system;

	call reset_do_modes (dop);
	call cu_$set_cl_intermediary (do_info.saved_cl_intermediary);

	call cu_$generate_call (Entry, Arg_list);

	call set_do_modes (dop);
	call cu_$set_cl_intermediary (do_info.my_cl_intermediary);
	return;

return_to_caller:
	return;
%page;
%include dial_out_invocation;
%include event_wait_info;
%include foreign_terminal_data;
%include iox_dcls;

     end dial_out_util_;




		    do_request_table_.alm           11/05/86  1220.3r w 11/04/86  1038.4       17865



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
	name	do_request_table_

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
" Common request table for dial_out_.
"
" Written by C. Hornig, April 1982.
" Modified January 1983 by C. Hornig to remove rdn and rdf.
" Modified February 1983 by C. Hornig to add wait.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	include	ssu_request_macros

	begin_table do_request_table_


	request	escape,
		do_requests_$escape_request,
		(esc),
		(Change the escape character.),
		flags.allow_command

	request	file_output,
		do_requests_$file_output_request,
		(fo),
		(Start copying output to a file.),
		flags.allow_command

	request	interrupt,
		do_requests_$interrupt_request,
		(int,break,brk,ip),
		(Send an interrupt signal.),
		flags.allow_command

	request	modes,
		do_requests_$modes_request,
		(),
		(Set dial_out modes.),
		flags.allow_both

	request	quit,
		do_requests_$quit_request,
		(q),
		(Leave subsystem.),
		flags.allow_command

	request	revert_output,
		do_requests_$revert_output_request,
		(ro),
		(Finish copying output to a file.),
		flags.allow_command

	request	send,
		do_requests_$send_request,
		(),
		(Send arguments as if typed.),
		flags.allow_command

	request	send_file,
		do_requests_$send_file_request,
		(sf),
		(Send file as if typed.),
		flags.allow_command

	request	switch_name,
		do_requests_$switch_name_request,
		(),
		(Return name of I/O switch.),
		flags.allow_both

	request	wait,
		do_requests_$wait_request,
		(),
		(Wait for data from foreign system.),
		flags.allow_both

" Tailor the standard table a bit.

	unknown_request	(ready_off,rdf)
	unknown_request	(ready_on,rdn)

	end_table	do_request_table_

	end




		    do_requests_.pl1                04/24/92  1445.5r w 04/24/92  1438.8      132444



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1991   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
do_requests_:
     procedure;

/* Written April 1982 by C. Hornig */
/* Modified 11 September 1982 by Richard Lamson to fix line_status problem in send and other requests. */
/* Modified January 1983 by C. Hornig to reorganize functions */
/* Modified March 1983 by K. Loepere so that send_file won't overflow FNP
   input buffer with remote echo and so wait request can wait for a string
   and so wait works in dial_out ecs */



/****^  HISTORY COMMENTS:
  1) change(91-08-15,Schroth), approve(91-09-09,MCR8247),
     audit(92-04-24,WAAnderson), install(92-04-24,MR12.5-1012):
     Added -inhibit_error/-no_inhibit_error to wait request to inhibit active
     function failure on timeouts.  If -inhibit_error is used with -timeout,
     whatever was received prior the the timer runout will be returned as the
     value of the active request.
                                                   END HISTORY COMMENTS */



dcl  (Sci_ptr, Do_ptr) ptr parameter;

dcl  NL char (1) static options (constant) init ("
");
dcl  SP char (1) static options (constant) init (" ");

dcl  error_table_$bad_arg fixed bin (35) ext static;
dcl  error_table_$bad_conversion fixed bin (35) ext static;
dcl  error_table_$end_of_info fixed bin (35) ext static;
dcl  error_table_$inconsistent fixed bin (35) ext static;
dcl  error_table_$line_status_pending fixed bin (35) ext static;
dcl  error_table_$long_record fixed bin (35) ext static;
dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$short_record fixed bin (35) ext static;
dcl  error_table_$wrong_no_of_args fixed bin (35) ext static;

dcl  cu_$set_cl_intermediary entry (entry);
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  dial_out_modes_$set entry (ptr, char (*), fixed bin (35));
dcl  dial_out_util_$interaction_loop entry (ptr, bit (1) aligned, bit (1) aligned);
dcl  dial_out_util_$process_line_status entry (ptr);
dcl  dial_out_util_$process_net_input entry (ptr, bit (1) aligned);
dcl  dial_out_util_$reset_do_modes entry (ptr);
dcl  dial_out_util_$send_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  dial_out_util_$send_nl entry (ptr, fixed bin (35));
dcl  dial_out_util_$set_do_modes entry (ptr);
dcl  ioa_ entry () options (variable);
dcl  ioa_$rsnnl entry () options (variable);
dcl  requote_string_ entry (char (*)) returns (char (*));
dcl  ssu_$abort_line entry options (variable);
dcl  ssu_$arg_count entry (ptr, fixed bin);
dcl  ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21));
dcl  ssu_$return_arg entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21));
dcl  unique_chars_ entry (bit (*)) returns (char (15));

dcl  abort_on_timeout bit (1) aligned;			/* timeout causes wait to abort */
dcl  af_sw bit (1) aligned;				/* request called as active request */
dcl  arg_num fixed bin;
dcl  buff char (512);				/* reading from send file */
dcl  code fixed bin (35);
dcl  i fixed bin;
dcl  iocbp ptr;
dcl  nargs fixed bin;
dcl  new_line bit (1) aligned;			/* on end of wait str */
dcl  nin fixed bin (21);				/* chars read from send file */
dcl  long_rec bit (1) aligned;			/* didn't read whole line from file */
dcl  path_found bit (1) aligned;			/* found path arg in send_file request */
dcl  silent bit (1) aligned;				/* discard foreign chars during transfer */

dcl  arg char (al) based (ap);			/* standard argument stuff */
dcl  al fixed bin (21);
dcl  ap ptr;
dcl  path char (path_len) based (path_ptr);		/* pathname for send_file request */
dcl  path_len fixed bin (21);
dcl  path_ptr ptr;
dcl  str_to_match_area char (do_info.match_max_length) based (do_info.match_string_p);
dcl  val varying char (val_len) based (val_ptr);		/* active request value */
dcl  val_len fixed bin (21);
dcl  val_ptr ptr;

dcl  cleanup condition;

dcl  (addr, codeptr, index, length, null, substr) builtin;
%page;
/* * * * * * * * * * QUIT * * * * * * * * * */

quit_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;
	do_info.abort_code = 0;
	goto do_info.abort_label;

/* * * * * * * * * * INTERRUPT * * * * * * * * * */

interrupt_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;
try_interrupt_request_again:
	call iox_$control (do_info.ci.net_iocb, "interrupt", null (), code);
	if code = error_table_$line_status_pending then do;
	     call dial_out_util_$process_line_status (dop);
	     go to try_interrupt_request_again;
	     end;
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code);
	return;

/* * * * * * * * * * MODES * * * * * * * * * */

modes_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$return_arg (Sci_ptr, nargs, af_sw, val_ptr, val_len);

	if af_sw then do;
	     call ioa_$rsnnl ("^[^^^]raw,^[^^^]echo,^[^^^]send_lf,^[^^^]echo_lf,^[^^^]quit,^[^^^]line", val, (0),
		^do_info.flags.raw_sw, ^do_info.flags.echo_sw, ^do_info.flags.send_lf_sw, ^do_info.flags.lfecho_sw,
		^do_info.flags.quit_sw, ^do_info.flags.no_breakall_sw);
	     end;

	if nargs < 1 then do;
	     if ^af_sw
	     then call ioa_ ("^[^^^]raw,^[^^^]echo,^[^^^]send_lf,^[^^^]echo_lf,^[^^^]quit,^[^^^]line",
		     ^do_info.flags.raw_sw, ^do_info.flags.echo_sw, ^do_info.flags.send_lf_sw,
		     ^do_info.flags.lfecho_sw, ^do_info.flags.quit_sw, ^do_info.flags.no_breakall_sw);
	     return;
	     end;

	if nargs > 1 then call ssu_$abort_line (Sci_ptr, error_table_$wrong_no_of_args);

	call ssu_$arg_ptr (Sci_ptr, 1, ap, al);

	call dial_out_modes_$set (dop, arg, code);
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code);

	return;

/* * * * * * * * * * ESCAPE * * * * * * * * * */

escape_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$return_arg (Sci_ptr, nargs, af_sw, val_ptr, val_len);

	if af_sw then do;
	     val = requote_string_ ((do_info.esc_char));
	     end;

	if nargs < 1 & ^af_sw then do;
	     call ioa_ ("^1a", do_info.esc_char);
	     return;
	     end;

	if nargs > 1 then call ssu_$abort_line (Sci_ptr, error_table_$wrong_no_of_args);

	call ssu_$arg_ptr (Sci_ptr, 1, ap, al);

	if length (arg) = 1
	then do_info.esc_char = arg;
	else call ssu_$abort_line (Sci_ptr, error_table_$bad_arg, "^a", arg);
	return;

/* * * * * * * * * * SEND * * * * * * * * * */

send_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$arg_count (Sci_ptr, nargs);
	if nargs < 1 then return;
	call ssu_$arg_ptr (Sci_ptr, 1, ap, al);
	call dial_out_util_$send_chars (dop, ap, al, code);
	if code ^= 0
	then
bad_write:
	     call ssu_$abort_line (Sci_ptr, code, "Writing.");
	do i = 2 to nargs;
	     call dial_out_util_$send_chars (dop, addr (SP), 1, code);
	     if code ^= 0 then goto bad_write;
	     call ssu_$arg_ptr (Sci_ptr, i, ap, al);
	     call dial_out_util_$send_chars (dop, ap, al, code);
	     if code ^= 0 then goto bad_write;
	end;
	return;

/* * * * * * * * * * SEND_FILE_REQUEST * * * * * * * * * */

send_file_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;
	silent = "1"b;

	call ssu_$arg_count (Sci_ptr, nargs);
	if nargs < 1 | nargs > 2 then call ssu_$abort_line (Sci_ptr, 0, "Usage: send_file path {-display_input}");
	path_found = "0"b;
	do i = 1 to nargs;
	     call ssu_$arg_ptr (Sci_ptr, i, ap, al);
	     if arg = "-display_input" | arg = "-dsin" then silent = "0"b;
	     else if arg = "-no_display_input" | arg = "-ndsin" then silent = "1"b;
	     else if index (arg, "-") = 1 then call ssu_$abort_line (Sci_ptr, error_table_$bad_arg, "^a", arg);
	     else do;
		if path_found then call ssu_$abort_line (Sci_ptr, 0, "More than one path specified. ^a", arg);
		path_found = "1"b;
		path_ptr = ap;
		path_len = al;
		end;
	end;

	iocbp = null ();
	on cleanup
	     begin;
	     call reset_do_state;
	     call clean_iocb (iocbp);
	end;

	call iox_$attach_name ("do.send_file." || unique_chars_ (""b), iocbp, "vfile_ " || path,
	     codeptr (send_file_request), code);
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Attaching vfile_ ^a", path);
	call iox_$open (iocbp, Stream_input, "0"b, code);
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Opening vfile_ ^a", path);

	call set_do_state;				/* coming here reset do state, we need it
						   back so process_net_input works */

	do while ("1"b);
	     call iox_$control (do_info.ci.net_iocb, "read_status", addr (do_info.net_rs), code);
						/* get incoming (echo?) */
	     if code ^= 0 then do_info.net_rs.data_available = "1"b;
	     if do_info.net_rs.data_available then call dial_out_util_$process_net_input (dop, silent);

	     long_rec = "0"b;
	     call iox_$get_line (iocbp, addr (buff), length (buff), nin, code);
	     if (code = error_table_$long_record) | (code = error_table_$short_record) then long_rec = "1"b;
	     else if (nin = 0) & (code = error_table_$end_of_info) then goto done_send_file;
	     else if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Reading from ^a", path);
	     else nin = nin - 1;			/* trim NL */

	     call dial_out_util_$send_chars (dop, addr (buff), nin, code);
	     if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Writing.", path);
	     if ^long_rec then do;
		call dial_out_util_$send_nl (dop, code);
		if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Writing NL.", path);
		end;
	end;

done_send_file:
	call reset_do_state;
	call clean_iocb (iocbp);
	return;

/* * * * * * * * * * SWITCH_NAME_REQUEST * * * * * * * * */

switch_name_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$return_arg (Sci_ptr, nargs, af_sw, val_ptr, val_len);
	if nargs ^= 0 then call ssu_$abort_line (Sci_ptr, 0, "Usage: switch_name");

	if af_sw
	then val = do_info.ci.net_iocb -> iocb.name;
	else call ioa_ ("^a", do_info.ci.net_iocb -> iocb.name);
	return;

/* * * * * * * * * * * FILE_OUTPUT_REQUEST * * * * * * * * * * */

file_output_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$arg_count (Sci_ptr, nargs);
	if nargs ^= 1 then call ssu_$abort_line (Sci_ptr, 0, "Usage: file_output path");
	if do_info.fo_iocbp ^= null () then call ssu_$abort_line (Sci_ptr, 0, "file_output already in progress.");
	call ssu_$arg_ptr (Sci_ptr, 1, ap, al);

	on cleanup call clean_iocb (do_info.fo_iocbp);

	call iox_$attach_name ("do.file_output." || unique_chars_ (""b), do_info.fo_iocbp,
	     "vfile_ " || arg || " -extend", codeptr (file_output_request), code);
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Attaching vfile_ ^a.", arg);
	call iox_$open (do_info.fo_iocbp, Stream_output, "1"b, code);
	if code ^= 0 then call ssu_$abort_line (Sci_ptr, code, "Opening vfile_ ^a.", arg);
	return;

/* * * * * * * * * * REVERT_OUTPUT_REQUEST * * * * * * * * * * */

revert_output_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$arg_count (Sci_ptr, nargs);
	if nargs ^= 0 then call ssu_$abort_line (Sci_ptr, 0, "Usage: revert_output");
	if do_info.fo_iocbp = null () then call ssu_$abort_line (Sci_ptr, 0, "No file_output in progress.");
	call clean_iocb (do_info.fo_iocbp);
	return;

/* * * * * * * * * * WAIT * * * * * * * * * * */

wait_request:
     entry (Sci_ptr, Do_ptr);

	dop = Do_ptr;

	call ssu_$return_arg (Sci_ptr, nargs, af_sw, val_ptr, val_len);

	do_info.time_out = 0;
	abort_on_timeout = "1"b;
	new_line = "0"b;
	do_info.match_length = 0;
	do arg_num = 1 to nargs;
	     call ssu_$arg_ptr (Sci_ptr, arg_num, ap, al);
	     if arg = "-timeout" | arg = "-tm" then do;
		if arg_num = nargs
		then call ssu_$abort_line (Sci_ptr, error_table_$noarg, "Timeout value.");
		else do;
		     arg_num = arg_num + 1;
		     call ssu_$arg_ptr (Sci_ptr, arg_num, ap, al);
		     do_info.time_out = cv_dec_check_ (arg, code);
		     if code ^= 0 | do_info.time_out < 1
		     then call ssu_$abort_line (Sci_ptr, error_table_$bad_conversion, "^a", arg);
		     end;
		end;
	     else if arg = "-no_timeout" | arg = "-ntm" then do_info.time_out = 0;
	     else if arg = "-nl" then new_line = "1"b;
	     else if arg = "-nnl" then new_line = "0"b;
	     else if arg = "-no_inhibit_error" | arg = "-nihe" then abort_on_timeout = "1"b;
	     else if arg = "-inhibit_error" | arg = "-ihe" then abort_on_timeout = "0"b;
	     else if substr (arg, 1, 1) = "-" then call ssu_$abort_line (Sci_ptr, error_table_$bad_arg, "^a", arg);
	     else do;
		if length (arg) > do_info.match_max_length - 1
						/* room for NL */
		then call ssu_$abort_line (Sci_ptr, 0, "Wait string too long; max is ^d.",
			do_info.match_max_length - 1);/* arg too long to print with error */
		else do;
		     substr (str_to_match_area, 1, length (arg)) = arg;
		     do_info.match_length = length (arg);
		     end;
		end;
	end;
	if ^abort_on_timeout & do_info.time_out = 0
	then call ssu_$abort_line (Sci_ptr, error_table_$inconsistent,
		"The use of -inhibit_error requires that -timeout be used as well.");
	if new_line then do;
	     do_info.match_length = do_info.match_length + 1;
	     substr (str_to_match_area, do_info.match_length, 1) = NL;
	     end;

	if af_sw then do;
	     do_info.active_result_ptr = val_ptr;
	     do_info.active_result_max_len = val_len;
	     val = "";
	     end;

	on cleanup call reset_do_state;
	call set_do_state;				/* get back do state so that interaction loop works
						   (it was reset on its way into here */

	call dial_out_util_$interaction_loop (dop, "1"b, af_sw);
						/* do normal net stuff 'til condition met */
	if do_info.abort_code ^= 0
	then if ^af_sw | abort_on_timeout then call ssu_$abort_line (Sci_ptr, do_info.abort_code);

	call reset_do_state;
	return;
%page;
/* * * * * * * * * * CLEAN_IOCB * * * * * * * * * * * */

clean_iocb:
     procedure (Iocbp);
dcl  code fixed bin (35);
dcl  Iocbp ptr parameter;

	if Iocbp ^= null () then do;
	     call iox_$close (Iocbp, code);
	     call iox_$detach_iocb (Iocbp, code);
	     call iox_$destroy_iocb (Iocbp, code);
	     Iocbp = null ();
	     end;
	return;
     end clean_iocb;

reset_do_state:
     proc;

	call dial_out_util_$reset_do_modes (dop);
	call cu_$set_cl_intermediary (do_info.saved_cl_intermediary);
	return;
     end;

set_do_state:
     proc;

	call dial_out_util_$set_do_modes (dop);
	call cu_$set_cl_intermediary (do_info.my_cl_intermediary);
	return;
     end;
%page;
%include dial_out_invocation;
%include iocb;
%include iox_dcls;
%include iox_modes;

     end do_requests_;



		    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
