



		    kermit.pl1                      10/14/90  0933.2rew 10/14/90  0915.0      233163



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1990   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8027), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bugs: PC_File_Transfer 18, 20, 23, 24.
  3) change(90-09-20,Huen), approve(90-09-20,MCR8203), audit(90-09-25,Gray),
     install(90-10-14,MR12.4-1039):
     phx21339 (pc_25): Change version to 1.4
                                                   END HISTORY COMMENTS */


kermit: proc;
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit				external	*/
  /*i	Input:	multics command line arguments		*/
  /*f	Function:	sets up the subsystem environment and call ssu_	*/
  /*f		to execute the kermit requests.		*/
  /*o	Ouptut:	none					*/
  /*							*/
  /*l	Written:	84-10-12	by Dean Elhard			*/
  /*l	Modified: 86-01-16  by Don Kozlowski - Change subsystem     */
  /*l			version to 1.1 . (kermit 13)		*/
  /*l     Modified: 86-10-09  by Don Kozlowski - Do not set "server"	*/
  /*l			and "transfer_modes_set" flags until	*/
  /*l			it is in server mode. (kermit 13)	*/
  /*l	Modified: 86-06-12  by Don Kozlowski - Change subsystem     */
  /*l			version to 1.2 . (kermit 16)		*/
  /*l	Modified:87-07-22	by Don Kozlowski - Use vfile for debug	*/
  /*l			to allow for msf traces (kermit 17)	*/
  /*l     Modified: 89-01-02  by S. Huen - Change subsystem version   */
  /*l			to 1.3. (PC_18, 20, 23, 24)    	*/
  /*l     Modified: 90-09-24  by S. Huen - Change subsystem version   */
  /*l			to 1.4. (PC_25)                         */
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl true		bit (1) static options (constant) init ("1"b);
  dcl false		bit (1) static options (constant) init ("0"b);
  
  dcl Subsystem_Name	char (6) static options (constant)
			     init ("kermit");
  dcl Subsystem_Version	char (3) static options (constant)
			     init ("1.4");
  dcl Subsystem_Info_Dir	char (168) static options (constant)
			     init (">doc>subsystem>kermit");
  dcl Default_prompt	char (29) static options (constant)
			     init ("^/Multics-Kermit^[ (^d)^]:^2x");
  
  /* procedures */
  
  dcl com_err_		entry() options(variable);
  dcl cu_$arg_count_rel	entry (fixed bin, ptr, fixed bin(35));
  dcl cu_$arg_list_ptr	entry (ptr);
  dcl cu_$arg_ptr_rel	entry (fixed bin, ptr, fixed bin(21),
			     fixed bin(35), ptr);
  dcl expand_pathname_	entry (char(*), char(*), char(*),
			     fixed bin(35));
  dcl expand_pathname_$add_suffix
			entry (char(*), char(*), char(*), char(*),
			     fixed bin(35));
  dcl get_system_free_area_	entry() returns(ptr);
  dcl initiate_file_	entry (char(*), char(*), bit(*), ptr,
			     fixed bin(24), fixed bin(35));
  dcl iox_$attach_name	entry (char (*), ptr, char (*), ptr, fixed bin (35));
  dcl iox_$close		entry (ptr, fixed bin (35));
  dcl iox_$detach_iocb	entry (ptr, fixed bin (35));
  dcl iox_$look_iocb	entry (char(*), ptr, fixed bin(35));
  dcl iox_$open		entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
  dcl pathname_		entry (char(*), char(*)) returns(char(168));
  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_start_up	entry () options (variable);
  dcl ssu_$execute_string	entry (ptr, char(*), fixed bin(35));
  dcl ssu_$get_temp_segment	entry (ptr, char(*), ptr);
  dcl ssu_$listen		entry (ptr, ptr, fixed bin(35));
  dcl ssu_$release_temp_segment
			entry (ptr, ptr);
  dcl ssu_$set_abbrev_info	entry (ptr, ptr, ptr, bit(1) aligned);
  dcl ssu_$set_prompt	entry (ptr, char(64) var);
  dcl ssu_$set_prompt_mode	entry (ptr, bit(*));
  dcl unique_chars_		entry (bit (*)) returns (char (15));  

  /* external */
  
  dcl error_table_$badopt	external fixed bin (35);
  dcl error_table_$noarg	external fixed bin (35);
  dcl error_table_$noentry	external fixed bin (35);
  dcl iox_$user_input	ptr ext static;
  dcl iox_$user_io		ptr ext static;
  dcl kermit_requests_$requests
			bit(36) aligned external;
  dcl ssu_et_$subsystem_aborted
			external fixed bin (35);
  dcl ssu_request_tables_$standard_requests
			bit(36) aligned external;
  
  /* structures */
  
  dcl 01 info		aligned like kermit_info;
  dcl 01 kermit_args	aligned,
       02 flags		aligned,
        03 request_loop	bit (1) unaligned,
        03 abbrev		bit (1) unaligned,
        03 prompt		bit (1) unaligned,
        03 start_up		bit (1) unaligned,
        03 debug		bit (1) unaligned,
        03 prompt_given	bit (1) unaligned,
        03 profile_given	bit (1) unaligned,
        03 switchname_given	bit (1) unaligned,
        03 request_given	bit (1) unaligned,
        03 pad		bit (27) unaligned,
       02 prompt		char (64) varying,
       02 profile		char (168),
       02 switchname	char (32),
       02 request		char (512) varying,
       02 debug_path	char (168) unaligned;
  
  /* automatic */
  
  dcl arg_listp		ptr;
  dcl ec			fixed bin (35);
  
  /* conditions */
  
  dcl cleanup		condition;
  
  /* builtin */
  
  dcl addr		builtin;
  dcl index		builtin;
  dcl null		builtin;
  
  /* include files */
  
%include access_mode_values;

%include iox_modes;

%include kermit_info;

%include kermit_dcls;

%include kermit_mode_info;

%include ssu_prompt_modes;

%include terminate_file;

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


  /* initialize the subsystem info structure prior to setting up	*/
  /* the cleanup handlers to free the kermit databases		*/
  
  info.version = kermit_info_version;
  info.sci_ptr     = null;
  info.perm_modesp = null;
  info.temp_modesp = null;
  info.log_infop   = null;
  info.comm_infop  = null;
  
  on cleanup call kermit_cleanup (addr (info));
  
  /* parse the command line arguments				*/
  
  call cu_$arg_list_ptr (arg_listp);
  
  call parse_command_line (arg_listp, addr (kermit_args));
  
  /* set up the subsystem invocation				*/
  
  call kermit_initialization (addr (kermit_args), addr (info));
  
  /* only enter the request loop if required			*/
  
  if kermit_args.request_loop
    then call ssu_$listen (info.sci_ptr, iox_$user_input, ec);
    
  call kermit_cleanup (addr (info));
  
  return;

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


parse_command_line: proc (arg_listp, argsp);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	parse_command_line			internal	*/
  /*i	Input:	arg_list_ptr				*/
  /*f	Function:	parses the control arguments detecting illegal	*/
  /*f		control args.				*/
  /*f		Legal control arguments are:			*/
  /*f		   -abbrev, -ab				*/
  /*f			specifies that abbrev processing by the	*/
  /*f			subsystem request processor is to be	*/
  /*f			initially enabled.			*/
  /*f		   -debug pathname, -db pathname		*/
  /*f			specifies the pathname of a segment in	*/
  /*f			which to log packet traffic for use in	*/
  /*f			debugging kermit.			*/
  /*f		   -io_switch switchname, -iosw switchname	*/
  /*f			specified the name of the io switch	*/
  /*f			over which to perform the file	*/
  /*f			transfer.  If not specified, the users	*/
  /*f			login channel is used.		*/
  /*f		   -no_abbrev, -nab				*/
  /*f			specified that abbrev processing by the	*/
  /*f			subsystem request processor is to be	*/
  /*f			initially disabled. (default)		*/
  /*f		   -no_prompt, -npmt			*/
  /*f			specified that no prompting is to be	*/
  /*f			done in the request loop.		*/
  /*f		   -no_start_up, -nsu, -ns			*/
  /*f			do not execute the kermit start_up.	*/
  /*f		   -profile pathname, -pf pathname		*/
  /*f			specifies the name of the profile	*/
  /*f			segment to be used as the default	*/
  /*f			profile for abbrev processing.  If this	*/
  /*f			is not specified, the users default	*/
  /*f			profile is used. NB. -profile implies	*/
  /*f			-abbrev				*/
  /*f		   -prompt prompt_string			*/
  /*f			specifies the prompt string to be used.	*/
  /*f		   -quit					*/
  /*f			do not enter the subsystem request	*/
  /*f			loop.  Quit the subsystem after	*/
  /*f			executing the request_string, if any.	*/
  /*f		   -request request_string, -rq request_string	*/
  /*f			execute request string as a subsystem	*/
  /*f			request line entering the subsystem	*/
  /*f			request loop			*/
  /*f		   -request_loop, -rql			*/
  /*f			enters the subsystem request loop after	*/
  /*f			executing the request_string, if any.	*/
  /*f			(default)				*/
  /*f		   -start_up, -su				*/
  /*f			The user's home directory, the project	*/
  /*f			directory, and >site are searched in	*/
  /*f			that order for a segment named	*/
  /*f			start_up.kermit.  (default)		*/
  /*o	Output:	request_string, quit_flag, abbrev_flag,		*/
  /*o		profile_path, start_up_flag, debug_flag,	*/
  /*o		debug_path, switchname			*/
  /*							*/
  /*l	Written:	84-10-12	by Dean Elhard			*/
  /*l	Modified:	84-11-01	by Dean Elhard to trap missing request,	*/
  /*l			prompt, profile, and switchname strings	*/
  /*l			embedded in the arg list.		*/
  /*l	Modified:	84-11-08	to add -start_up and -no_start_up	*/
  /*l	Modified:	84-11-15	to add -debug			*/
  /*							*/
  /********************************************************************/
  
  /* arguments */
  
  dcl arg_listp		ptr;
  dcl argsp		ptr;
  
  /* structures */
  
  dcl 01 args		aligned like kermit_args based (argsp);
  
  /* based */
  
  dcl arg			char (argl) based (argp);
  
  /* automatic */
  
  dcl argl		fixed bin (21);
  dcl argp		ptr;
  dcl debug_pending		bit (1);
  dcl ec			fixed bin (35);
  dcl i			fixed bin;
  dcl nargs		fixed bin;
  dcl profile_pending	bit (1);
  dcl prompt_pending	bit (1);
  dcl request_pending	bit (1);
  dcl switchname_pending	bit (1);
  
  /* initialize state to default before starting parse		*/
  
  args.flags.request_loop	= true;
  args.flags.abbrev		= false;
  args.flags.prompt		= true;
  args.flags.start_up	= true;
  args.flags.debug		= false;
  args.flags.prompt_given	= false;
  args.flags.profile_given	= false;
  args.flags.switchname_given = false;
  args.flags.request_given	= false;
  args.prompt		= "";
  args.profile		= "";
  args.switchname		= "";
  args.request		= "";
  args.debug_path		= "";
  
  profile_pending		= false;
  prompt_pending		= false;
  request_pending		= false;
  switchname_pending	= false;
  debug_pending		= false;
  
  /* get the arg count					*/
  
  call cu_$arg_count_rel (nargs, arg_listp, ec);
  if ec ^= 0
    then call abort (ec, "");
    
  do i = 1 to nargs;
    
    call cu_$arg_ptr_rel (i, argp, argl, ec, arg_listp);
    if ec ^= 0
      then call abort (ec, "");
      
  /* get the prompt text if the previous arg was -prompt		*/
  
    if prompt_pending
      then do;
        if index (arg, "-") = 1
	then call abort (error_table_$noarg, "Prompt string expected.");
        prompt_pending = false;
        args.flags.prompt_given = true;
        args.prompt = arg;
      end;
    
  /* get the profile pathname if the previous arg was -profile	*/
  
    else if profile_pending
      then do;
        if index (arg, "-") = 1
	then call abort (error_table_$noarg, "Profile pathname expected.");
        profile_pending = false;
        args.flags.profile_given = true;
        args.flags.abbrev = true;
        args.profile = arg;
      end;
    
  /* get the request string if the previous arg was -request	*/
  
    else if request_pending
      then do;
        if index (arg, "-") = 1
	then call abort (error_table_$noarg, "Request expected.");
        request_pending = false;
        args.flags.request_given = true;
        args.request = arg;
      end;
    
  /* get the switchname if the previous arg was -io_switch		*/
  
    else if switchname_pending
      then do;
        if index (arg, "-") = 1
	then call abort (error_table_$noarg, "Switch name expected.");
        switchname_pending = false;
        args.flags.switchname_given = true;
        args.switchname = arg;
      end;
    
  /* get the debug pathname if the previous are was -debug		*/
    
    else if debug_pending
      then do;
        if index (arg, "-") = 1
	then call abort (error_table_$noarg, "Debug pathname expected.");
        debug_pending = false;
        args.flags.debug = true;
        args.debug_path = arg;
      end;
      
  /* enable abbrev processing					*/

    else if arg = "-abbrev" | arg = "-ab"
      then args.flags.abbrev = true;
    
  /* flag that the next arg should be a debug segment path		*/
    
    else if arg = "-debug" | arg = "-db"
      then debug_pending = true;
    
  /* flag that the next arg should be a switchname		*/
  
    else if arg = "-io_switch" | arg = "-iosw"
      then switchname_pending = true;
    
  /* disable abbrev processing				*/
  
    else if arg = "-no_abbrev" | arg = "-nab"
      then args.flags.abbrev = false;
    
  /* disable subsystem prompting				*/
  
    else if arg = "-no_prompt" | arg = "-npmt"
      then args.flags.prompt = false;
    
  /* disable start_up.kermit execution				*/
  
    else if arg = "-no_start_up" | arg = "-nsu" | arg = "-ns"
      then args.flags.start_up = false;
      
  /* flag that the next arg should be a profile pathname		*/
  
    else if arg = "-profile" | arg = "-pfl"
      then profile_pending = true;
    
  /* flag that the next arg should be a prompt string		*/
  
    else if arg = "-prompt" | arg = "-pmt"
      then prompt_pending = true;
    
  /* disable request loop entry after processing the request str	*/
  
    else if arg = "-quit" | arg = "-no_request_loop" | arg = "-nrql"
      then args.flags.request_loop = false;
    
  /* flag that the next arg should be a request string		*/
  
    else if arg = "-request" | arg = "-rq"
      then request_pending = true;
    
  /* enable request loop entry after request processing		*/
  
    else if arg = "-request_loop" | arg = "-rql"
      then args.flags.request_loop = true;
    
  /* enable start_up.kermit execution				*/
    
    else if arg = "-start_up" | arg = "-su"
      then args.flags.start_up = true;
      
  /* otherwise complain since that is all the valid args		*/
  
      else call abort (error_table_$badopt, arg);
  end;
  
  /* if there were any supplementary args outstanding when we ran out	*/
  /* of command line arguments, complain and abort the subsystem	*/
  
  if request_pending
    then call abort (error_table_$noarg, "Request expected.");
  if profile_pending
    then call abort (error_table_$noarg, "Profile pathname expected.");
  if switchname_pending
    then call abort (error_table_$noarg, "Switch name expected.");
  if prompt_pending
    then call abort (error_table_$noarg, "Prompt string expected.");
  if debug_pending
    then call abort (error_table_$noarg, "Debug path expected.");
    
end parse_command_line;

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


kermit_initialization: proc (argsp, infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_initialization		internal	*/
  /*i	Input:	arg_info, info_ptr				*/
  /*f	Function:	initializes the subsystem_info structure, creates	*/
  /*f		an ssu_ invocation, initializes the profile and	*/
  /*f		abbrev state depending on the abbrev_flag and	*/
  /*f		profile_path, and calls the ssu_ request	*/
  /*f		processor to execute the request_string.	*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-12	by Dean Elhard			*/
  /*l	Modified:	84-11-01	by Dean Elhard to null iocbp in	*/
  /*l			log_info immediately to reduce cleanup	*/
  /*l			error window			*/
  /*l	Modified:	84-11-08	by Dean Elhard to execute start_up	*/
  /*							*/
  /********************************************************************/
  
  /* arguments */
  
  dcl argsp		ptr;
  dcl infop		ptr;
  
  /* based */
  
  dcl 01 args		aligned like kermit_args based (argsp);
  dcl 01 info		aligned like kermit_info based (infop);
  dcl 01 log_info		aligned like kermit_log_info
			     based (info.log_infop);
  dcl 01 perm_modes		aligned like kermit_perm_modes
			     based (info.perm_modesp);
  dcl 01 temp_modes		aligned like kermit_temp_modes
			     based (info.temp_modesp);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  dcl sys_area		area based (system_free_areap);
  
  /* automatic */
  
  dcl dname		char (168);
  dcl ec			fixed bin (35);
  dcl ename		char (32);
  dcl system_free_areap	ptr;
  dcl profile_ptr		ptr;
  dcl prompt_mode		bit (2);
  
  /* get the area to allocate the databases in			*/
  
  system_free_areap = get_system_free_area_ ();
  
  /* allocate the databases and set the version numbers		*/
  
  allocate log_info in (sys_area);
  
  /* null iocb pointer to minimize error window			*/
  
  log_info.log_file.iocbp = null;
  log_info.version = kermit_log_info_version;
  
  allocate perm_modes in (sys_area);
  perm_modes.version = kermit_perm_modes_version;
  
  allocate temp_modes in (sys_area);
  temp_modes.version = kermit_temp_modes_version;
  
  allocate comm_info in (sys_area);
  
  /* null input_buffer pointer to minimize error window		*/
  
  comm_info.input_buffer.bufferp = null;
  comm_info.debug_segp = null;
  comm_info.version = kermit_comm_info_version;
  comm_info.server = "0"b;	         /* Initialize server flag    	*/
  comm_info.transfer_modes_set = "0"b; /* Initialize transfer_modes_set flag */
  
  /* now create the ssu_ invocation				*/
  
  call ssu_$create_invocation (Subsystem_Name, Subsystem_Version, infop,
		addr (ssu_request_tables_$standard_requests),
		Subsystem_Info_Dir, info.sci_ptr, ec);
  
  if ec ^= 0
    then call abort (ec, "Unable to create subsystem invocation.");
    
  /* add our request table to the subsystem			*/
  
  call ssu_$add_request_table (info.sci_ptr, addr (kermit_requests_$requests),
		1, ec);
  
  /* set the prompt string if required and set up the prompt mode	*/
  
  if ^args.flags.prompt_given
    then args.prompt = Default_prompt;
    
  call ssu_$set_prompt (info.sci_ptr, args.prompt);
    
  if args.flags.prompt
    then prompt_mode = PROMPT | PROMPT_AFTER_NULL_LINES;
    else prompt_mode = DONT_PROMPT | PROMPT_AFTER_NULL_LINES;
  
  call ssu_$set_prompt_mode (info.sci_ptr, prompt_mode);
  
  /* find the profile if a non-standard profile was requested	*/
  
  if args.flags.profile_given
    then do;
      call expand_pathname_$add_suffix ((args.profile), "profile", dname,
				ename, ec);
      if ec ^= 0
        then call abort (ec, (args.profile));
      call initiate_file_ (dname, ename, R_ACCESS, profile_ptr, (0), ec);
      if profile_ptr = null
        then if ec = error_table_$noentry
	then call com_err_ (ec, Subsystem_Name, "^/^a does not exist.",
		pathname_ (dname, ename));
	else call abort (ec, (args.profile));
    end;
    else profile_ptr = null;
  
  /* set the abbrev info regarding the profile use and initial state	*/
  
  call ssu_$set_abbrev_info (info.sci_ptr, profile_ptr, profile_ptr,
		(args.flags.abbrev));
  
  /* if a switch was supplied, then make sure it exists and save	*/
  /* the iocb pointer for use by the communications stuff		*/
  
  if args.flags.switchname_given
    then do;
      call iox_$look_iocb ((args.switchname), comm_info.ft_iocbp, ec);
      if ec ^= 0
        then call abort (ec, (args.switchname));
    end;
    else comm_info.ft_iocbp = iox_$user_io;
  
  /* set the default modes in the permanent and temporary modes dbs	*/
  
  call kermit_mode_mgr_$store (infop, Permanent, Store_all,
			addr (Perm_defaults), ec);
  call kermit_mode_mgr_$store (infop, Temporary, Store_all,
			addr (Temp_defaults), ec);

  /* set up the initial logging state				*/
  
  log_info.flags.enabled = false;
  log_info.flags.stats_valid = false;
  
  /* get a temp-seg for use as an input buffer			*/
  
  call ssu_$get_temp_segment (info.sci_ptr, "buffer", comm_info.bufferp);
  
  /* set up the rest of the communications status info		*/
  
  comm_info.bufferl = 0;
  comm_info.old_modes = "";
  comm_info.old_framing_chars.start_char = "";
  comm_info.old_framing_chars.end_char = "";
  comm_info.old_wake_table.breaks (*) = false;
  comm_info.old_wake_table.mbz = ""b;
  
  /* set up the debug file if necessary				*/
  
  if args.flags.debug
    then do;
      call expand_pathname_ (args.debug_path, dname, ename, ec);
      if ec ^= 0
        then call abort (ec, args.debug_path);
      call iox_$attach_name ("kermit.debug." || unique_chars_ ("0"b),
	     comm_info.debug_segp, "vfile_ " || pathname_ (dname, ename),
	     null(), ec);
	call iox_$open (comm_info.debug_segp, Stream_output, "0"b, ec);
      if ec ^= 0
        then call abort (ec, pathname_ (dname, ename));
    end;
    
  /* execute the start_up if requested				*/
  
  if args.flags.start_up
    then do;
      call ssu_$execute_start_up (info.sci_ptr, ec);
      if ec = ssu_et_$subsystem_aborted
        then call abort (ec, "^/Abort occurred while executing start_up.");
    end;
    
  /* lastly, execute the request string (if any)			*/
  
  if args.flags.request_given
    then do;
      call ssu_$execute_string (info.sci_ptr, (args.request), ec);
      if ec = ssu_et_$subsystem_aborted
        then args.request_loop = false;
    end;
    
end kermit_initialization;

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


kermit_cleanup: proc (infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_cleanup			internal	*/
  /*i	Input:	subsystem_info_ptr				*/
  /*f	Function:	frees the subsystem_info structure and destroys	*/
  /*f		the ssu_ invocation				*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-12	by Dean Elhard			*/
  /*l	Modified:	84-11-01	by Dean Elhard to close log_file on	*/
  /*l			cleanup if open.			*/
  /*							*/
  /********************************************************************/
  
  /* arguments */
  
  dcl infop		ptr;
  
  /* structures */
  
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  dcl 01 info		aligned like kermit_info based (infop);
  dcl 01 log_info		aligned like kermit_log_info
			     based (info.log_infop);
  dcl 01 perm_modes		aligned like kermit_perm_modes
			     based (info.perm_modesp);
  dcl sys_area		area based (system_free_areap);
  dcl 01 temp_modes		aligned like kermit_temp_modes
			     based (info.temp_modesp);
  
  /* automatic */
  
  dcl system_free_areap	ptr;
  
  /* find the area to free the stuff into			*/
  
  system_free_areap = get_system_free_area_ ();
  
  /* free each of the databases				*/
  
  if info.comm_infop ^= null
    then do;
      
  /* free the input buffer temp-seg				*/
  
      if comm_info.input_buffer.bufferp ^= null
        then call ssu_$release_temp_segment (info.sci_ptr,
			comm_info.input_buffer.bufferp);
      
  /* terminate and set the bit_count on the debug file		*/
      
      if comm_info.debug_segp ^= null
        then do;
	 call iox_$close (comm_info.debug_segp, ec);
	 call iox_$detach_iocb (comm_info.debug_segp, ec);
        end;
        
  /* and then free the communications database			*/
  
      free comm_info in (sys_area);
    end;
    
  if info.perm_modesp ^= null
    then free perm_modes in (sys_area);
  if info.temp_modesp ^= null
    then free temp_modes in (sys_area);
  if info.log_infop ^= null
    then do;
      
  /* close and detach the log_file				*/
      
      call kermit_log_mgr_$disable (infop, ec);
      call kermit_log_mgr_$close_log (infop, ec);
        
  /* free the log_info database				*/
        
      free log_info in (sys_area);
    end;
    
  /* lastly, destroy the ssu_ invocation			*/
  
  if info.sci_ptr ^= null
    then call ssu_$destroy_invocation (info.sci_ptr);
    
end kermit_cleanup;

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


abort: proc (code, message);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	abort				internal	*/
  /*i	Input:	error_code, message				*/
  /*f	Function:	prints a message constructed from the error code	*/
  /*f		and message and then aborts the subsystem	*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-14	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl code		fixed bin (35);
  dcl message		char (*);
  
  /* cleanup the subsystem before we leave			*/
  
  call kermit_cleanup (addr (info));
  
  call com_err_ (code, Subsystem_Name, message);
  goto ABORT;
  
end abort;

ABORT:
  return;
  
end kermit;




		    kermit_comm_mgr_.pl1            10/17/88  1107.1r w 10/17/88  1033.2       91116



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(87-11-24,Huen), approve(87-11-24,MCR7803), audit(87-12-07,RWaters),
     install(88-09-16,MR12.2-1113):
     Fix kermit error 11 and 13.
                                                   END HISTORY COMMENTS */


kermit_comm_mgr_: proc;
  
  /********************************************************************/
  /*							*/
  /*n	kermit_comm_mgr_					*/
  /*							*/
  /*d	The communications manager is used to setup the state of	*/
  /*d	the file transfer communications line prior to the start	*/
  /*d	of a file transfer and to reset it on completion so that	*/
  /*d	normal command communications can occur.		*/
  /*							*/
  /*l	Written:	84-10-25	by Dean Elhard			*/
  /*m     Modified: 86-10-09  by Don Kozlowski - Use "transfer_mode   */
  /*m			_set" flag to prevent any lost of the   */
  /*m			initial line. (kermit 13)		*/
  /*m	Modified: 86-10-21  by Don Kozlowski - Use "blk_xfer" flag 	*/
  /*m			if not using "iox_$user_io" (kermit 11)	*/
  /*m	Modified: 86-10-22  by Don Kozlowski - Add "^breakall" flag.*/
  /*m			Set "^breakall" flag whenever "blk_xfer"*/
  /*m			flag is set. (kermit 11)		*/
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl true		bit (1) static options (constant) init ("1"b);
  dcl false		bit (1) static options (constant) init ("0"b);
  
  dcl Constant_modes	char (80) static options (constant)
	init ("blk_xfer,^breakall,rawi,rawo,^echoplex,wake_tbl,^lfecho,ctl_char,^replay,^polite");
  dcl X25_modes		char (26) static options (constant)
	init ("rawi,rawo,^echoplex,lfecho");
  
  dcl Eight_bit_byte_size	fixed bin (8) static options (constant) init (8);
  
  dcl No_parity		char (1) static options (constant) init ("N");
  dcl Mark_parity		char (1) static options (constant) init ("M");
  dcl Space_parity		char (1) static options (constant) init ("S");
  dcl Odd_parity		char (1) static options (constant) init ("O");
  
  dcl No_frame_begin	char (1) static options (constant) init("");
  
  /* parameters */
  
  dcl A_infop		ptr parameter;
  dcl A_code		fixed bin (35) parameter;
  
  /* procedures */
  
  dcl iox_$control		entry (ptr, char(*), ptr, fixed bin(35));
  dcl iox_$modes		entry (ptr, char(*), char(*), fixed bin(35));
  
  /* external */
  
  dcl kermit_et_$cannot_initialize_line
			external fixed bin (35);
  
  /* based */
  
  dcl 01 info		aligned like kermit_info based (A_infop);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  
  /* structures */
  
  dcl 01 break_info		aligned like swt_info;
  dcl 01 framing_chars	aligned,
       02 frame_begin	char (1) unaligned,
       02 frame_end		char (1) unaligned;
  dcl 01 ft_modes		aligned,
       02 eol_char		char (1) unaligned,
       02 parity		char (1) unaligned;
  dcl 01 delays		aligned like delay_struc;

  /* automatic */
  
  dcl line_byte_size	fixed bin (8) unaligned;
  dcl new_modes		char (512);
  dcl t_selector (1:2)	fixed bin;
  dcl p_selector (1:1)	fixed bin;
  dcl special_modes		char (32) varying;
  
  /* builtin */
  
  dcl addr		builtin;
  dcl null		builtin;
  dcl rank		builtin;
  
  /* include files */
  

%include kermit_dcls;

%include kermit_info;

%include kermit_mode_info;

%include set_wakeup_table_info;

%include tty_convert;

  return;

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


set_line_modes: entry (A_infop,	/* subsystem info pointer	*/
		   A_code);	/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_comm_mgr_$set_line_modes	external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function: Sets up the communications channel for file	*/
  /*f		transfer.					*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-25	by Dean Elhard			*/
  /*l	Modified:	84-10-27	by Dean Elhard to add X.25 support	*/
  /*							*/
  /********************************************************************/
  
  /* If transfer modes are currently set, then return                 */

  if comm_info.transfer_modes_set then return;


  /* get the prevailing kermit modes				*/
  
  t_selector (1) = I_eol_char;
  t_selector (2) = G_parity;
  
  call kermit_mode_mgr_$retrieve (A_infop, Temporary, t_selector,
				addr (ft_modes), A_code);
  
  p_selector (1) = Line_byte_size;
  
  call kermit_mode_mgr_$retrieve (A_infop, Permanent, p_selector,
				addr (line_byte_size), A_code);
  
  /* determine what tty_ modes to use for the file transfer		*/
  
  if line_byte_size = Eight_bit_byte_size
    then special_modes = "no_outp,8bit,";
  else if ft_modes.parity = Mark_parity |
	ft_modes.parity = Space_parity |
	ft_modes.parity = No_parity
    then special_modes = "no_outp,";
  else if ft_modes.parity = Odd_parity
    then special_modes = "^no_outp,oddp,";
    else special_modes = "^no_outp,^oddp,";
  
  new_modes = special_modes || Constant_modes;
  
  /* determine what framing characters to use			*/
  
  framing_chars.frame_begin = No_frame_begin;
  framing_chars.frame_end = ft_modes.eol_char;
  
  /* determine what break characters to use			*/
  				
  break_info.version = swt_info_version_1;
  break_info.new_table.wake_map (*) = false;
  break_info.new_table.mbz = ""b;
  break_info.old_table.wake_map (*) = false;
  break_info.old_table.mbz = ""b;
  
  break_info.new_table.wake_map (rank (ft_modes.eol_char)) = true;

  /* set the delays to zero					*/
  
  delays.version = DELAY_VERSION;
  delays.default = 0;
  delays.vert_nl = 0;
  delays.horz_nl = 0;
  delays.const_tab = 0;
  delays.var_tab = 0.0;
  delays.backspace = 0;
  delays.vt_ff = 0;
  
  /* get the old framing chars from tty_			*/
  
  call iox_$control (comm_info.ft_iocbp, "get_framing_chars",
		addr (comm_info.old_framing_chars), A_code);
  if A_code = 0
       then do;         /* get the old delay values	      */
       comm_info.old_delays.version = DELAY_VERSION;
       call iox_$control (comm_info.ft_iocbp, "get_delay",
	  	addr (comm_info.old_delays), A_code);
       end;

  if A_code = 0
    then do;      /* set the new framing chars		*/
       call iox_$control (comm_info.ft_iocbp, "set_framing_chars",
	  	addr (framing_chars), A_code);
       end;

  if A_code = 0
    then do;       /* set the new wakeup table and get the old one	*/
       call iox_$control (comm_info.ft_iocbp, "set_wakeup_table",
	  	addr (break_info), A_code);
       end;

  if A_code = 0
    then do; /* copy out the old wakeup table for later reference   */
       comm_info.old_wake_table = break_info.old_table;
       end;

  	       /* set the new modes				*/
  call iox_$modes (comm_info.ft_iocbp, new_modes,
       comm_info.old_modes, A_code);

  /* if that failed, try setting up an X.25 connection		*/
  
  if A_code ^= 0
    then call iox_$modes (comm_info.ft_iocbp, X25_modes,
		comm_info.old_modes, A_code);
    else call iox_$control (comm_info.ft_iocbp, "set_delay",
		addr (delays), A_code);

  if A_code ^= 0
    then A_code = kermit_et_$cannot_initialize_line;
    
  comm_info.transfer_modes_set = "1"b;

  return;

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


reset_line_modes: entry (A_infop,	/* subsystem info pointer	*/
		     A_code);	/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_comm_mgr_$reset_line_modes	external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	Resets the communications environment for a	*/
  /*f		user interface.				*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-25	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* If transfer modes are currently reset, then return. Else reset  */

  if ^comm_info.transfer_modes_set then return;
  else comm_info.transfer_modes_set = "0"b;

  /* reset the prevailing tty_ modes				*/
  
  call iox_$modes (comm_info.ft_iocbp, comm_info.old_modes, (""), A_code);
  if A_code ^= 0
    then return;
  
  /* reset the framing characters				*/
    
  call iox_$control (comm_info.ft_iocbp, "set_framing_chars",
		addr (comm_info.old_framing_chars), A_code);
  if A_code ^= 0
    then return;
    
  /* reset the wakeup table					*/
  
  break_info.version = swt_info_version_1;
  break_info.new_table = comm_info.old_wake_table;
  break_info.old_table.mbz = ""b;
  
  call iox_$control (comm_info.ft_iocbp, "set_wakeup_table",
		addr (break_info), A_code);
  
  /* reset the delays					*/
  
  call iox_$control (comm_info.ft_iocbp, "set_delay",
		addr (comm_info.old_delays), A_code);
		
  return;

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


flush_input: entry (A_infop,		/* subsystem info pointer	*/
	          A_code);		/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_comm_mgr_$flush_input		external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function: Flushes all pending input from the communications	*/
  /*f		channel.					*/
  /*o	Output:	error_code				*/
  /*							*/
  /*	Written:	84-10-25	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  call iox_$control (comm_info.ft_iocbp, "resetread", null, A_code);
  
  return;
  
end kermit_comm_mgr_;





		    kermit_et_.alm                  11/05/86  1232.6r w 11/04/86  1038.4       18720



"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
"							"
"	kermit_et_					"
"							"
"	This is the error table defining the error codes and	"
"	messages for the kermit subsystem.			"
"							"
"	Written: 	84-10-15	by Dean Elhard, Maureen Mallmes	"
"							"
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

	include	et_macros

	et	kermit_et_

	ec	archive_star,acstarnm,
		(Starnames may not be used in a component specification.)
	ec	bad_mode_value,badvalue,
		(Illegal mode value supplied.)
	ec	big_seg,bigseg,
		(Unable to completely receive file.  Segment is too large.)
	ec	cannot_decode,nodecode,
		(The data cannot be decoded.)
	ec	cannot_initialize_line,cantinit,
		(The communication line cannot be initialized for file transfer.)
	ec	crc_error,bad_crc,
		(Calculated and received checksums do not match.)
	ec	fatal_error,fatalerr,
		(Fatal error encountered by remote.  Transaction terminated.)
	ec	length_mismatch,badlen,
		(The actual and received length do not match.)
	ec	log_not_disabled,logntoff,
		(Logging of file transfers is enabled on this log file.)
	ec	log_open,log_open,
		(There is already a log file open.  Use quit_log first.)
	ec	mangled_packet,mangled,
		(The packet is unrecognizable.  Required fields missing.)
	ec	no_file_abort,noabort,
		(Unable to abort receipt of a single file.  Transaction terminated.)
	ec	no_initialization,bad_init,
		(Unable to initialize with remote.  Transaction terminated.)
	ec	no_log,no_log,(There is no log file open.)
	ec	no_rename,badname,
		(Unable to rename file.  File not received.)
	ec	no_valid_stats,no_stats,
		(There has been no file transfer in this session.)
	ec	remote_file_abort,segabort,
		(File terminated by remote system.)
	ec	remote_group_abort,grpabort,
		(Transaction terminated by remote system.)
	ec	too_many_retries,bad_rtry,
		(Packet retry count exceeded.  Transaction terminated.)
	ec	unimplemented_check_type,bdcktype,
		(The specified check type is not implemented.)
	ec	unknown_mode,bad_mode,
		(The specified mode does not exist.)

	end




		    kermit_get_filenames_.pl1       03/01/89  1437.6rew 03/01/89  1434.9       64350



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8036), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bug: PC_File_Transfer 24 - kermit is being changed to correctly
     handle links to multisegment files.
                                                   END HISTORY COMMENTS */


kermit_get_filenames_:
     proc (infop, argument, filenames_areap, reason, ec);


/**********************************************************************/
/*							*/
/*n	Name:	kermit_get_filenames_		internal	*/
/*i	Input:	argument, filenames_areap        		*/
/*f	Function: Gets the filenames and stores them in the 	*/
/*f		area pointed to filenames_areap.		*/
/*o	Output:	reason, ec				*/
/*							*/
/*l	Written:	84-10-23	by Maureen Mallmes			*/
/*l	Modified:	84-11-05	to add archive support		*/
/*l	Modified:	87-06-24	by Don Kozlowski - Support msf file 	*/
/*l			(kermit 17)                             */
/*l       Modified: 89-01-02  by S Huen - Handle links to multisegment*/
/*l                 file correctly. (pc_24)                           */
/*							*/
/**********************************************************************/

/*  constants  */

	dcl     All_match_star_name	 fixed bin internal static options (constant) init (2);
	dcl     Non_star_name	 fixed bin internal static options (constant) init (0);
	dcl     Star_name		 fixed bin internal static options (constant) init (1);

/*  parameters  */

	dcl     argument		 char (*);
	dcl     infop		 ptr;
	dcl     filenames_areap	 ptr;
	dcl     reason		 char (*);
	dcl     ec		 fixed bin (35);

/*  Automatic  */

	dcl     bit_count		 fixed bin (24);
	dcl     idx		 fixed binary;
	dcl     ename		 char (32);
	dcl     kermit_scip		 ptr;
	dcl     select_sw		 fixed binary (2);
	dcl     segp		 ptr;
	dcl     source_component	 char (32);
	dcl     source_dir		 character (168);
	dcl     source_ename	 character (32);
	dcl     source_stars	 fixed binary (35);
	dcl     system_area_ptr	 ptr;

/*  Based  */

	dcl     01 filenames	 like kermit_filenames based (filenames_areap);
	dcl     01 ki		 like kermit_info based (infop);

/*  Builtin  */

	dcl     (null, sum) builtin;

/*  Areas    */

	dcl     system_area		 area based (system_area_ptr);

/*  Externals  */

	dcl     error_table_$dirseg	 fixed bin (35) ext static;
	dcl     kermit_et_$archive_star
				 fixed bin (35) ext static;

/*  Procedures  */

	dcl     expand_pathname_$component
				 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     check_star_name_$entry entry (char (*), fixed bin (35));
	dcl     get_system_free_area_	 entry () returns (pointer);
	dcl     hcs_$star_		 entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
	dcl     hcs_$status_minf	 entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
	dcl     initiate_file_$component
				 entry (char(*), char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35));
	dcl     pathname_$component	 entry (char (*), char (*), char (*)) returns (char (194));
	dcl     terminate_file_	 entry (ptr, fixed bin(24), bit(*), fixed bin(35));

/*  conditions  */

	dcl     cleanup		 condition;

/*  Include files  */
%include access_mode_values;

%include kermit_info;

%include kermit_transfer_info;

%include star_structures;

%include terminate_file;

	kermit_scip = ki.sci_ptr;
	select_sw = star_BRANCHES_ONLY;
	star_entry_ptr, star_names_ptr = null;

/*  Get the pathname  */
	call expand_pathname_$component (argument, source_dir, source_ename, source_component, ec);
	if ec ^= 0 then do;
	     reason = argument;
	     return;
	end;


	call check_star_name_$entry (source_ename, source_stars);
	if (source_stars ^= Non_star_name) & (source_stars ^= Star_name) & (source_stars ^= All_match_star_name)
	then do;
	     reason = pathname_$component (source_dir, source_ename, source_component);
	     ec = source_stars;
	     return;
	end;
	
	if source_stars = Non_star_name then do;	/* not a star name  */
		
		/* see if we can find the segment/component */
		
		call initiate_file_$component (source_dir, source_ename, source_component, R_ACCESS, segp, bit_count, ec);
		if ec = error_table_$dirseg & source_component = ""
		     then do;
		         call hcs_$status_minf (source_dir,
			    source_ename, (1), (0), bit_count , ec);
		         if bit_count ^= 0 then do;
			    call initiate_file_$component (
			         pathname_$component (source_dir, source_ename, ""),
			         "0", "", R_ACCESS, segp, bit_count, ec);
			    end;
		         else ec = error_table_$dirseg;
		     end;
		     if ec ^= 0 then do;
		     reason = pathname_$component (source_dir, source_ename, source_component);
		     return;
		end;
		
		/* clean up the address space */
		
	          if segp ^= null then
		     call terminate_file_ (segp, bit_count, TERM_FILE_TERM, ec);
		
/* Save the filename  */

		filenames.n_paths = filenames.n_paths + 1;
		filenames.pathname.directory (filenames.n_paths) = source_dir;
		filenames.pathname.entry_name (filenames.n_paths) = source_ename;
		filenames.pathname.component (filenames.n_paths) = source_component;
		return;
	     end;

	else do;					/*  get star names  */

		if source_component ^= "" then do;
		     ec = kermit_et_$archive_star;
		     reason = pathname_$component (source_dir, source_ename, source_component);
		     return;
		end;

		system_area_ptr = get_system_free_area_ ();
		on cleanup call filenames_cleanup;

		call hcs_$star_ (source_dir, source_ename, select_sw, system_area_ptr,
		     star_entry_count, star_entry_ptr, star_names_ptr, ec);
		if ec ^= 0 then do;
		     reason = pathname_$component (source_dir, source_ename, source_component);
		     return;
		end;


/*  Save the filenames  */
		do idx = 1 to star_entry_count;
		     ename = star_names (star_entries (idx).nindex);
		     filenames.n_paths = filenames.n_paths + 1;
		     filenames.pathname.directory (filenames.n_paths) = source_dir;
		     filenames.pathname.entry_name (filenames.n_paths) = ename;
		     filenames.pathname.component (filenames.n_paths) = "";
		end;
	     end;
	call filenames_cleanup;
	return;

/* cleanup star names area  */

filenames_cleanup:
     proc;

	if star_names_ptr ^= null
	then do;
		free star_names in (system_area);
		star_names_ptr = null;
	     end;

	if star_entry_ptr ^= null
	then do;
		free star_entries in (system_area);
		star_entry_ptr = null;
	     end;

	return;
     end filenames_cleanup;

     end kermit_get_filenames_;




		    kermit_log_mgr_.pl1             07/05/88  1407.3r w 07/05/88  1400.0      144333



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */

kermit_log_mgr_: proc;
  
  /********************************************************************/
  /*							*/
  /*n	kermit_log_mgr_					*/
  /*							*/
  /*d	The kermit log manager controls the enabling and disabling 	*/
  /*d	of the logging function from both the subroutine and	*/
  /*d	request levels, as well as the printing of statistics that	*/
  /*d	are derived from the logged info and the logging itself.	*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl true		bit (1) static options (constant) init ("1"b);
  dcl false		bit (1) static options (constant) init ("0"b);
  
  dcl Unused		bit (1) aligned static options (constant)
			     init ("0"b);
  dcl Default_log		char (10) static options (constant)
			     init ("kermit.log");
  
  /* arguments */
  
  dcl A_code		fixed bin (35) parameter;
  dcl A_filename		char (*) varying;
  dcl A_infop		ptr parameter;
  dcl A_sci_ptr		ptr parameter;
  dcl A_statisticsp		ptr parameter;
  
  /* procedures */
  
  dcl get_shortest_path_	entry (char(*)) returns(char(168));
  dcl ioa_		entry() options(variable);
  dcl ioa_$ioa_switch	entry() options(variable);
  dcl iox_$attach_name	entry (char(*), ptr, char(*), ptr,
			     fixed bin(35));
  dcl iox_$close		entry (ptr, fixed bin(35));
  dcl iox_$detach_iocb	entry (ptr, fixed bin(35));
  dcl iox_$open		entry (ptr, fixed bin, bit(1) aligned,
			     fixed bin(35));
  dcl convert_status_code_	entry (fixed bin(35), char(8) aligned,
			     char(100) aligned);
  dcl date_time_$format	entry (char(*), fixed bin(71), char(*), char(*))
			     returns (char (250) varying);
  dcl expand_pathname_$component
			entry (char(*), char(*), char(*), char(*),
			     fixed bin(35));
  dcl pathname_$component	entry (char(*), char(*), char(*)) 
			    returns(char(194));
  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));
  
  /* external */
  
  dcl error_table_$badopt	external fixed bin (35);
  dcl error_table_$noarg	external fixed bin (35);
  dcl error_table_$too_many_args
			external fixed bin (35);
  dcl kermit_et_$log_not_disabled
			external fixed bin (35);
  dcl kermit_et_$log_open	external fixed bin (35);
  dcl kermit_et_$no_log	external fixed bin (35);
  dcl kermit_et_$no_valid_stats
			external fixed bin (35);
  
  /* based */
  
  dcl arg			char (argl) based (argp);
  dcl 01 info		aligned like kermit_info based (A_infop);
  dcl 01 log_info		aligned like kermit_log_info
			     based (info.log_infop);
  dcl 01 stats		aligned like kermit_stats_info
			     based (A_statisticsp);
  
  /* automatic */
  
  dcl argl		fixed bin (21);
  dcl argp		ptr;
  dcl atd			char (256) varying;
  dcl cps			fixed bin (21);
  dcl cnm			char (32);
  dcl dnm			char (168);
  dcl ec			fixed bin (35);
  dcl enm			char (32);
  dcl extend		bit (1);
  dcl finished		char (250) varying;
  dcl i			fixed bin;
  dcl interval		fixed bin (71);
  dcl iocbp		ptr;
  dcl last_send		bit (1);
  dcl message		char (100) aligned;
  dcl nargs		fixed bin;
  dcl path		char (194);
  dcl started		char (250) varying;
  dcl time		float bin (63);
  
  /* conditions */
  
  /* builtin */
  
  dcl null		builtin;
  
  /* include files */
  

%include iox_modes;

%include kermit_dcls;

%include kermit_info;

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


close_log: entry (A_infop, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$close_log		external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	checks if there is currently a log_file open and	*/
  /*f		closes it if there is.			*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  A_code = 0;
  
  /* make sure there is a log_file open first			*/
  
  if log_info.log_file.iocbp = null
    then A_code = kermit_et_$no_log;
    
  /* make sure logging is disabled on the file before closing it	*/
  
  else if log_info.enabled
    then A_code = kermit_et_$log_not_disabled;
    else do;
      call iox_$close (log_info.log_file.iocbp, A_code);
      if A_code = 0
        then call iox_$detach_iocb (log_info.log_file.iocbp, A_code);
      log_info.log_file.iocbp = null;
    end;
  
  return;

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


disable: entry (A_infop, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$suspend_logging	external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	clears the logging_enabled switch in the log_info	*/
  /*f		database.					*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* make sure we have a log file attached			*/
  
  if log_info.log_file.iocbp = null
    then A_code = kermit_et_$no_log;
    else log_info.flags.enabled = false;
  
  return;

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


display_statistics: entry (A_sci_ptr, A_infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$display_statistics	external	*/
  /*i	Input:	sci_ptr, info_ptr				*/
  /*f	Function:	extracts the statistics info from the log_info	*/
  /*f		database, calculates the derived values, then	*/
  /*f		formats and displays the resulting statistics.	*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-11-02	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* abort if thewre are no valid statistics avaliable		*/
  
  if ^log_info.flags.stats_valid
    then call ssu_$abort_line (A_sci_ptr, kermit_et_$no_valid_stats);
    
  /* see if the caller was send				*/
  
  last_send = (log_info.statistics.caller = "send");
  
  /* header line						*/
  
  call ioa_ ("Statistics for ^[un^]successful ^[send^;receive^] of file",
	(log_info.statistics.status ^= 0), last_send);
  
  /* pathname of the transferred file				*/
  
  call expand_pathname_$component (log_info.statistics.filename,
				dnm, enm, cnm, ec);
  log_info.statistics.filename = pathname_$component (dnm, enm, cnm);
  
  call ioa_ ("  ^a", get_shortest_path_ (log_info.statistics.filename));
  
  /* converted status code message if non-zero			*/
  
  if log_info.statistics.status ^= 0
    then do;
      call convert_status_code_ (log_info.statistics.status, (""), message);
      call ioa_ ("  Reason:^17t^a", message);
    end;
    
  /* error message from remote, (if one was supplied)		*/
  
  if log_info.statistics.error_message ^= ""
    then call ioa_ ("  Error message:^17t^a",
	log_info.statistics.error_message);
  
  /* calculate start and finish times				*/
  
  started = date_time_$format ("date_time",
		log_info.statistics.start_time, "", "");
  finished = date_time_$format ("date_time",
		log_info.statistics.end_time, "", "");
  
  call ioa_ ("  Started:^30t^a", started);
  call ioa_ ("  Finished:^30t^a", finished);
  
  /* print out statistics					*/
  
  call ioa_ ("  Length of file:^30t^d characters",
	log_info.statistics.file_len);
  call ioa_ ("  File characters ^[sent^;received^]:^30t^d characters",
	last_send, log_info.statistics.char_count);
  call ioa_ ("  Packets ^[sent^;received^]:^30t^d packets", last_send,
	log_info.statistics.packet_count);
  call ioa_ ("  Characters ^[sent^;received^]:^30t^d characters",
	last_send, log_info.statistics.packet_chars);
  call ioa_ ("  Retries:^30t^d packets", log_info.statistics.packet_retries);
  
  /* calculate effective transmission rate			*/
  
  interval = log_info.statistics.end_time - log_info.statistics.start_time;
  
  /* convert time to seconds from microseconds			*/
  
  time = float (interval) / 1000000.0;
  if time = 0.0
    then cps = 0;
    else cps = log_info.statistics.char_count / time;
  
  call ioa_ ("  Transmission rate:^30t^d characters/second", cps);
  
  return;

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


enable: entry (A_infop, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$enable		external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	sets the logging_enabled switch in the log_info	*/
  /*f		database					*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  A_code = 0;
  
  /* make sure there is a log_file open first			*/
  
  if log_info.log_file.iocbp = null
    then A_code = kermit_et_$no_log;
    else log_info.flags.enabled = true;
  
  return;

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


end_log: entry (A_sci_ptr, A_infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$end_log		external	*/
  /*i	Input:	sci_ptr, info_ptr				*/
  /*f	Function:	calls kermit_log_mgr_$disable to terminate the	*/
  /*f		logging operation, then calls			*/
  /*f		kermit_log_mgr_$close_log to close the log file.	*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* disable logging and close the log				*/
  
  call kermit_log_mgr_$disable (A_infop, ec);
  call kermit_log_mgr_$close_log (A_infop, ec);
  
  /* print a message if it didn't work				*/
  
  if ec ^= 0
    then call ssu_$abort_line (A_sci_ptr, ec);
    
  return;

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


log_message: entry (A_infop, A_statisticsp);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$log_message		external	*/
  /*i	Input:	info_ptr, statistics_ptr			*/
  /*f	Function:	writes the statistics info into the log_info	*/
  /*f		database.  Then checks the logging_enabled switch	*/
  /*f		and formats the statistics and writes them to the	*/
  /*f		log_file if logging_enabled is on.		*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* copy the stats info and mark it as valid			*/
  
  log_info.statistics = stats;
  log_info.stats_valid = true;
  
  iocbp = log_info.log_file.iocbp;
  
  /* if we have a log open, format a message			*/
  
  if log_info.enabled
    then do;
      
  /* format the initial log message line			*/
      
      if stats.status = 0
        then call ioa_$ioa_switch (iocbp,
		"^a:^10tFile ^[sent^;received^] successfully",
		stats.caller, (stats.caller = "send"));
        else do;
	call convert_status_code_ (stats.status, (""), message);
	call ioa_$ioa_switch (iocbp, "^a:^10t^a", stats.caller, message);
        end;
      
  /* format the pathname of the segment				*/
      
      call expand_pathname_$component (stats.filename, dnm, enm, cnm, ec);
      path = pathname_$component (dnm, enm, cnm);
      path = get_shortest_path_ (path);
      
      call ioa_$ioa_switch (iocbp, "^5t^a", path);
      
  /* format the statistics info				*/
      
      call ioa_$ioa_switch (iocbp, 
	"^5tFile contains ^d chars, ^d chars ^[sent^;received^]",
	stats.file_len, stats.char_count, (stats.caller = "send"));
      call ioa_$ioa_switch (iocbp,
	"^5t^d packets ^[sent^;received^] totalling ^d chars, ^d retries",
	stats.packet_count, (stats.caller = "send"),
	stats.packet_chars, stats.packet_retries);
      
  /* format the start and end times				*/
  
      started = date_time_$format ("date_time", stats.start_time, "", "");
      finished = date_time_$format ("date_time", stats.end_time, "", "");
      call ioa_$ioa_switch (iocbp, "^5tStarted: ^a,  Finished: ^a",
	started, finished);
      
  /* format the remote error message if supplied			*/
      
      if stats.status ^= 0
        then call ioa_$ioa_switch (iocbp, "^5t^a", stats.error_message);
    end;
          
  return;

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


open_log: entry (A_infop, A_filename, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$open_log		external	*/
  /*i	Input:	info_ptr, log_file_name			*/
  /*f	Function:	attempts to open the named file for output	*/
  /*f		and stores the iocbp in the log_info database.	*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* make sure there is not already a log_file open		*/
  
  if log_info.log_file.iocbp ^= null
    then A_code = kermit_et_$log_open;
    else do;
      atd = "vfile_ " || A_filename;
      call iox_$attach_name ("kermit_log", log_info.log_file.iocbp,
	(atd), null, A_code);
      if A_code = 0
        then call iox_$open (log_info.log_file.iocbp, Stream_output, Unused,
	A_code);
    end;
          
  return;

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


start_log: entry (A_sci_ptr, A_infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_log_mgr_$start_log		external	*/
  /*i	Input:	sci_ptr, info_ptr	 			*/
  /*f	Function:	opens the file specified by log path if given or	*/
  /*f		the default log file if no log_file_path was	*/
  /*f		specified. Then call kermit_log_mgr_$enable to	*/
  /*f		enable logging operation.			*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-31	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* get the arg count					*/
  
  call ssu_$arg_count (A_sci_ptr, nargs);
  
  extend = true;
  atd = "";
  
  /* parse the arguments					*/
  
  do i = 1 to nargs;
    call ssu_$arg_ptr (A_sci_ptr, i, argp, argl);
    
    if index (arg, "-") ^= 1
      then atd = arg;
    else if arg = "-truncate" | arg = "-tc"
      then extend = false;
    else if arg = "-extend"
      then extend = true;
      else call ssu_$abort_line (A_sci_ptr, error_table_$badopt, arg);
  end;
  
  if atd = ""
    then atd = Default_log;
    
  /* setup the atd for truncation/extension			*/
  
  if extend
    then atd = atd || " -extend";
  
  /* open the log file and enable logging			*/
  
  call kermit_log_mgr_$open_log (A_infop, atd, ec);
  
  if ec ^= 0
    then call ssu_$abort_line (A_sci_ptr, ec);
    
  call kermit_log_mgr_$enable (A_infop, ec);
  
  return;
  
end kermit_log_mgr_;




		    kermit_mode_mgr_.pl1            07/05/88  1407.3rew 07/05/88  1356.6      339939



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
                                                   END HISTORY COMMENTS */


kermit_mode_mgr_: proc;
  
  /********************************************************************/
  /*							*/
  /*n	kermit_mode_mgr_					*/
  /*							*/
  /*d	The mode manager contains the subroutines and commands that	*/
  /*d	are responsible for the maintainance of the two modes	*/
  /*d	databases. A subset of the permanent modes are user-visible	*/
  /*d	and user-settable.					*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l     Modified: 86-01-17  by Don Kozlowski - Fix typo in parity	*/
  /*l                         value. (kermit 14)              	*/
  /*l     Modified: 87-06-19  by Don Kozlowski - Move CR and NL       */
  /*l                         constant definitions to include file.   */
  /*l                         (kermit 15)                             */
  /*l	Modified: 87-06-19  by S Huen - Add extended packet support	*/
  /*l               based on D. Kozlowski's version. (kermit 16)      */
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl true		bit (1) static options (constant) init ("1"b);
  dcl false		bit (1) static options (constant) init ("0"b);
  
  dcl Print_all		bit (1) static options (constant) init ("1"b);
  dcl Print_one		bit (1) static options (constant) init ("0"b);
  
  dcl Ascii		char (1) static options (constant) init ("A");
  dcl Binary		char (1) static options (constant) init ("B");
  dcl On			char (1) static options (constant) init ("Y");
  dcl Off			char (1) static options (constant) init ("N");
  dcl Discard		char (1) static options (constant) init ("D");
  dcl Keep		char (1) static options (constant) init ("K");
  dcl None		char (1) static options (constant) init ("N");
  dcl Mark		char (1) static options (constant) init ("M");
  dcl Space		char (1) static options (constant) init ("S");
  dcl Even		char (1) static options (constant) init ("E");
  dcl Odd			char (1) static options (constant) init ("O");
  dcl Accept_eight_bit	char (1) static options (constant) init ("Y");
  dcl No_eight_bit		char (1) static options (constant) init ("N");
  dcl No_repeat		char (1) static options (constant) init (" ");
  dcl Seven_bit		fixed bin static options (constant) init (7);
  dcl Eight_bit		fixed bin static options (constant) init (8);
  
  /* parameters */
  
  dcl A_code		fixed bin (35);
  dcl A_db		fixed bin parameter;
  dcl A_infop		ptr parameter;
  dcl A_sci_ptr		ptr parameter;
  dcl A_selector (*)	fixed bin parameter;
  dcl A_valuep		ptr parameter;
  
  /* procedures */
  
  dcl cv_dec_check_		entry (char(*), fixed bin(35)) 
			    returns(fixed bin(35));
  dcl ioa_		entry() options(variable);
  dcl ioa_$rsnnl		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_$abort_line	entry() options(variable);
  
  /* external */
  
  dcl error_table_$wrong_no_of_args
			external fixed bin (35);
  dcl kermit_et_$bad_mode_value
			external fixed bin (35);
  dcl kermit_et_$unknown_mode external fixed bin (35);
  
  /* based */
  
  dcl arg			char (argl) based (argp);
  dcl 01 info		aligned like kermit_info based (A_infop);
  dcl 01 temp_modes		aligned like kermit_temp_modes
			     based (info.temp_modesp);
  dcl 01 perm_modes		aligned like kermit_perm_modes
			     based (info.perm_modesp);
  dcl db (1:db_sz)		char (1) unal based (dbp);
  dcl mode_name		char (mnl) based (mnp);
  dcl mode_value		char (mvl) based (mvp);
  dcl value (1:value_sz)	char (1) unal based (A_valuep);
  dcl checkpoint (1:db_sz)	char (1) unal based (ckp);
  
  /* automatic */
  
  dcl argl		fixed bin (21);
  dcl argp		ptr;
  dcl checkpointed		bit (1);
  dcl ckp			ptr;
  dcl dbp			ptr;
  dcl db_sz		fixed bin;
  dcl ec			fixed bin (35);
  dcl i			fixed bin;
  dcl item		fixed bin;
  dcl mnl			fixed bin (21);
  dcl mnp			ptr;
  dcl mode		char (1) unaligned;
  dcl mode2 (1:4)		fixed bin (9) unsigned unaligned;
  dcl mvl			fixed bin (21);
  dcl mvp			ptr;
  dcl nargs		fixed bin;
  dcl select (1:1)		fixed bin;
  dcl select2 (1:4)		fixed bin;
  dcl value_sz		fixed bin;
  
  /* conditions */
  
  dcl cleanup		condition;
  
  /* builtin */
  
  dcl addr                    builtin;
  dcl byte		builtin;
  dcl hbound		builtin;
  dcl index		builtin;
  dcl length		builtin;  
  dcl mod			builtin;
  dcl null		builtin;
  dcl rank		builtin;
  dcl translate		builtin;
  dcl unspec		builtin;

  /* include files */
  

%include kermit_dcls;

%include kermit_info;

%include kermit_mode_info;

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


get: entry (A_sci_ptr, A_infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_mode_mgr_$get		external	*/
  /*i	Input:	sci_ptr, subsystem_info_ptr			*/
  /*f	Function:	looks up the mode name in the list of user	*/
  /*f		visible modes, calls get_modes to get the value,	*/
  /*f		looks up the format of the value for the	*/
  /*f		specified mode and displays it.		*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-30	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  call ssu_$arg_count (A_sci_ptr, nargs);
  
  /* if no arguments were supplied, display all the modes		*/
  
  if nargs = 0
    then call print_mode (A_infop, Print_all, "");
    else do i = 1 to nargs;
      call ssu_$arg_ptr (A_sci_ptr, i, argp, argl);
      call print_mode (A_infop, Print_one, arg);
    end;
    
  return;

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


set: entry (A_sci_ptr, A_infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_mode_mgr_$set		external	*/
  /*i	Input:	sci_ptr, info_ptr				*/
  /*f	Function:	looks up the mode name in the list of		*/
  /*f		user-settable modes, insures that the value is	*/
  /*f		legal for that mode, and calls store_modes to	*/
  /*f		write them into the modes database.		*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-30	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  call ssu_$arg_count (A_sci_ptr, nargs);
  
  if nargs ^= 2
    then call ssu_$abort_line (A_sci_ptr, error_table_$wrong_no_of_args);
    
  /* get the mode name					*/
  
  call ssu_$arg_ptr (A_sci_ptr, 1, mnp, mnl);
  
  /* get the mode value					*/
  
  call ssu_$arg_ptr (A_sci_ptr, 2, mvp, mvl);
  
  /* try to encode the value based on the mode name		*/
  
  call encode_mode (A_infop, mode_name, select (1), mode_value, mode, ec);
  if ec ^= 0
    then if select (1) = 0
      then call ssu_$abort_line (A_sci_ptr, ec, mode_name);
      else call ssu_$abort_line (A_sci_ptr, ec, mode_value);
  
  return;

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


retrieve: entry (A_infop, A_db, A_selector, A_valuep, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_mode_mgr_$retrieve		external	*/
  /*i	Input:	info_ptr, db_selector, mode_set_specifier	*/
  /*f	Function:	gets the modes specified by the mode set	*/
  /*f		specifier from the specified mode_info database	*/
  /*f		and places the values into the mode value list	*/
  /*o	Output:	mode_value_list, error_code			*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* select the database to be used and get the size		*/
  
  if A_db = Permanent
    then do;
      dbp = addr (perm_modes.mode);
      db_sz = hbound (perm_modes.mode, 1);
    end;
    else do;
      dbp = addr (temp_modes.mode);
      db_sz = hbound (temp_modes.mode, 1);
    end;
  
  A_code = 0;
  value_sz = hbound (A_selector, 1);
  
  /*  special case the Retrieve_all case			*/
  
  if value_sz = 1 & A_selector (1) = 0
    then do;
      value_sz = db_sz;
      value (*) = db (*);
    end;
    
  /* otherwise iterate throught the selectors and copy out the	*/
  /* requested modes into the mode value array			*/
  
    else do i = 1 to value_sz while (A_code = 0);
      item = A_selector (i);
      if item < 1 | item > db_sz
        then A_code = kermit_et_$unknown_mode;
        else value (i) = db (item);
    end;
  
  return;

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


store: entry (A_infop, A_db, A_selector, A_valuep, A_code);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_mode_mgr_$store		external	*/
  /*i	Input:	info_ptr, db_selector, mode_set_specifier,	*/
  /*i		mode_value_list				*/
  /*f	Function:	writes the mode values from the mode value list	*/
  /*f		into the modes specified by the mode set	*/
  /*f		specifier in the database selected by db_selector	*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l	Modified:	84-10-27	by Dean Elhard to add mode validation	*/
  /*l			and checkpointing			*/
  /*							*/
  /********************************************************************/
  
  /* select the database to write the modes to			*/
  
  if A_db = Permanent
    then do;
      dbp = addr (perm_modes.mode);
      db_sz = hbound (perm_modes.mode, 1);
    end;
    else do;
      dbp = addr (temp_modes.mode);
      db_sz = hbound (temp_modes.mode, 1);
    end;
  
  value_sz = hbound (A_selector, 1);
  A_code = 0;
  
  ckp = null;
  checkpointed = false;
  
  /* insure cleanup of checkpoint data on a release		*/
  
  on cleanup begin;
    if ckp ^= null
      then do;
        if checkpointed
	then db (*) = checkpoint (*);
        free checkpoint;
      end;
  end;
  
  /* checkpoint against invalid mode specification		*/
  
  allocate checkpoint;
  
  checkpoint (*) = db (*);
  checkpointed = true;
  
  /* special case the Store_all case				*/
  
  if value_sz = 1 & A_selector (1) = 0
    then do;
      value_sz = db_sz;
      db (*) = value (*);
    end;
    
  /* otherwise iterate throught the selected modes writing the	*/
  /* values from the value array into the modes db		*/
  
    else do i = 1 to value_sz while (A_code = 0);
      item = A_selector (i);
      if item < 1 | item > db_sz
        then A_code = kermit_et_$unknown_mode;
        else db (item) = value (i);
    end;
  
  /* validate that the new modes are legitimate			*/
  
  call validate_modes (A_infop, A_db, A_code);
  
  /* if not, restore the db to it's previous state		*/
  
  if A_code ^= 0
    then db (*) = checkpoint (*);
    
  /* release the checkpoint information				*/
  
  checkpointed = false;
  free checkpoint;
  
  return;

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


validate_modes: proc (infop, db, ec);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	validate_modes			internal	*/
  /*i	Input:	info_ptr, db_selector			*/
  /*f	Function:	validates that the modes currently set into the	*/
  /*f		permanent and temporary modes databases are valid	*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-27	by Dean Elhard			*/
  /*l	Modified: 87-06-19  by S. Huen - Change Max_maxl to 1500    */
  /*l		which is the maximum packet length. (kermit 16)   */
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl Min_maxl		fixed bin static options (constant) init (20);
  dcl Max_maxl		fixed bin static options (constant) init (1500);
  
  dcl Min_time		fixed bin static options (constant) init (5);
  dcl Max_time		fixed bin static options (constant) init (20);
  
  dcl Min_eol		fixed bin static options (constant) init (1);
  dcl Max_eol		fixed bin static options (constant) init (31);
  
  dcl Min_ctl_1		fixed bin static options (constant) init (33);
  dcl Max_ctl_1		fixed bin static options (constant) init (62);
  dcl Min_ctl_2		fixed bin static options (constant) init (96);
  dcl Max_ctl_2		fixed bin static options (constant) init (126);
  
  dcl On			fixed bin static options (constant) init (89);
  dcl Off			fixed bin static options (constant) init (78);
  
  dcl No_repeat		fixed bin static options (constant) init (32);
  
  dcl Max_start		fixed bin static options (constant) init (31);
  
  dcl Min_ck_type		fixed bin static options (constant) init (1);
  dcl Max_ck_type		fixed bin static options (constant) init (1);
  
  dcl No_parity		fixed bin static options (constant) init (78);
  dcl Even_parity		fixed bin static options (constant) init (69);
  dcl Odd_parity		fixed bin static options (constant) init (79);
  dcl Space_parity		fixed bin static options (constant) init (83);
  dcl Mark_parity		fixed bin static options (constant) init (77);
  
  dcl Keep_incomplete	fixed bin static options (constant) init (75);
  dcl Discard_incomplete	fixed bin static options (constant) init (68);
  
  dcl Binary		fixed bin static options (constant) init (66);
  dcl Ascii		fixed bin static options (constant) init (65);
  
  dcl Min_retry_threshold	fixed bin static options (constant) init (5);
  dcl Max_retry_threshold	fixed bin static options (constant) init (20);
  
  dcl Seven_bit		fixed bin static options (constant) init (7);
  dcl Eight_bit		fixed bin static options (constant) init (8);
  
  /* parameters */
  
  dcl infop		ptr;
  dcl db			fixed bin;
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl 01 perm		aligned based (info.perm_modesp),
       02 version		char (8) unaligned,
       02 maxl		fixed bin (8) unaligned,
       02 time		fixed bin (8) unaligned,
       02 npad		fixed bin (8) unaligned,
       02 padc		char (1) unaligned,
       02 eol		fixed bin (9) unsigned unaligned,
       02 qctl		fixed bin (9) unsigned unaligned,
       02 qbin		fixed bin (9) unsigned unaligned,
       02 rept		fixed bin (9) unsigned unaligned,
       02 start		fixed bin (9) unsigned unaligned,
       02 chkt		fixed bin (8) unaligned,
       02 parity		fixed bin (9) unsigned unaligned,
       02 incomplete	fixed bin (9) unsigned unaligned,
       02 file_warning	fixed bin (9) unsigned unaligned,
       02 file_type		fixed bin (9) unsigned unaligned,
       02 retry_threshold	fixed bin (8) unaligned,
       02 line_byte_size	fixed bin (8) unaligned;
  
  dcl 01 temp		aligned based (info.temp_modesp),
       02 version		char (8) unaligned,
       02 i_maxl		fixed bin (8) unaligned,
       02 i_time		fixed bin (8) unaligned,
       02 i_npad		fixed bin (8) unaligned,
       02 i_padc		char (1) unaligned,
       02 i_eol		fixed bin (9) unsigned unaligned,
       02 i_qctl		fixed bin (9) unsigned unaligned,
       02 o_maxl		fixed bin (8) unaligned,
       02 o_time		fixed bin (8) unaligned,
       02 o_npad		fixed bin (8) unaligned,
       02 o_padc		char (1) unaligned,
       02 o_eol		fixed bin (9) unsigned unaligned,
       02 o_qctl		fixed bin (9) unsigned unaligned,
       02 qbin		fixed bin (9) unsigned unaligned,
       02 rept		fixed bin (9) unsigned unaligned,
       02 start		fixed bin (9) unsigned unaligned,
       02 chkt		fixed bin (8) unaligned,
       02 parity		fixed bin (9) unsigned unaligned;
  
  /* automatic */
  
  dcl valid		bit (1);
  
  ec = 0;
  
  /* validate permanent modes					*/
  
  if db = Permanent
    then do;
      valid = (perm.maxl >= Min_maxl) & (perm.maxl <= Max_maxl);
      valid = valid & (perm.time >= Min_time) & (perm.time <= Max_time);
      valid = valid & (perm.eol >= Min_eol) & (perm.eol <= Max_eol);
      valid = valid & (((perm.qctl >= Min_ctl_1) & (perm.qctl <= Max_ctl_1)) |
		  ((perm.qctl >= Min_ctl_2) & (perm.qctl <= Max_ctl_2)));
      valid = valid & (((perm.qbin >= Min_ctl_1) & (perm.qbin <= Max_ctl_1)) |
		   ((perm.qbin >= Min_ctl_2) & (perm.qbin <= Max_ctl_2)) |
		   (perm.qbin = On) | (perm.qbin = Off)) &
		  (perm.qbin ^= perm.qctl);
      valid = valid & (((perm.rept >= Min_ctl_1) & (perm.rept <= Max_ctl_1)) |
		   ((perm.rept >= Min_ctl_2) & (perm.rept <= Max_ctl_2)) |
		   (perm.rept = No_repeat)) &
		  (perm.rept ^= perm.qctl) & (perm.rept ^= perm.qbin);
      valid = valid & (perm.start <= Max_start) & (perm.start ^= perm.eol) &
		  (perm.start ^= CR_fixed);
      valid = valid & (perm.chkt >= Min_ck_type) & (perm.chkt <= Max_ck_type);
      valid = valid & ((perm.parity = No_parity) |
		   (perm.parity = Even_parity) |
		   (perm.parity = Odd_parity) |
		   (perm.parity = Space_parity) |
		   (perm.parity = Mark_parity));
      valid = valid & ((perm.incomplete = Keep_incomplete) |
		   (perm.incomplete = Discard_incomplete));
      valid = valid & ((perm.file_warning = On) | (perm.file_warning = Off));
      valid = valid & ((perm.file_type = Binary) | (perm.file_type = Ascii));
      valid = valid & (perm.retry_threshold >= Min_retry_threshold) &
		  (perm.retry_threshold <= Max_retry_threshold);
      valid = valid & ((perm.line_byte_size = Seven_bit) |
		   (perm.line_byte_size = Eight_bit));
      
    end;
      
  /* validate temporary modes					*/
  
  if db = Temporary
    then do;
      valid = (temp.i_maxl >= Min_maxl) & (temp.i_maxl <= Max_maxl);
      valid = valid & (temp.i_time >= Min_time) & (temp.i_time <= Max_time);
      valid = valid & (temp.i_eol >= Min_eol) & (temp.i_eol <= Max_eol);
      valid = valid & (((temp.i_qctl >= Min_ctl_1) &
		    (temp.i_qctl <= Max_ctl_1)) |
		   ((temp.i_qctl >= Min_ctl_2) &
		    (temp.i_qctl <= Max_ctl_2)));
      valid = valid & (temp.o_maxl >= Min_maxl) & (temp.o_maxl <= Max_maxl);
      valid = valid & (temp.o_time >= Min_time) & (temp.o_time <= Max_time);
      valid = valid & (temp.o_eol >= Min_eol) & (temp.o_eol <= Max_eol);
      valid = valid & (((temp.o_qctl >= Min_ctl_1) &
		    (temp.o_qctl <= Max_ctl_1)) |
		   ((temp.o_qctl >= Min_ctl_2) &
		    (temp.o_qctl <= Max_ctl_2)));
      valid = valid & (((temp.qbin >= Min_ctl_1) & (temp.qbin <= Max_ctl_1)) |
		   ((temp.qbin >= Min_ctl_2) & (temp.qbin <= Max_ctl_2)) |
		   (temp.qbin = On) | (temp.qbin = Off)) &
		  (temp.qbin ^= temp.i_qctl) & (temp.qbin ^= temp.o_qctl);
      valid = valid & (((temp.rept >= Min_ctl_1) & (temp.rept <= Max_ctl_1)) |
		   ((temp.rept >= Min_ctl_2) & (temp.rept <= Max_ctl_2)) |
		   (temp.rept = No_repeat)) &
		  (temp.rept ^= temp.i_qctl) &
		  (temp.rept ^= temp.o_qctl) &
		  (temp.rept ^= temp.qbin);
      valid = valid & (temp.start <= Max_start) &
		  (temp.start ^= temp.i_eol) &
		  (temp.start ^= temp.o_eol) &
		  (temp.start ^= CR_fixed);
      valid = valid & (temp.chkt >= Min_ck_type) & (temp.chkt <= Max_ck_type);
      valid = valid & ((temp.parity = No_parity) |
		   (temp.parity = Even_parity) |
		   (temp.parity = Odd_parity) |
		   (temp.parity = Space_parity) |
		   (temp.parity = Mark_parity));
    end;
    
  if ^valid
    then ec = kermit_et_$bad_mode_value;
  
end validate_modes;

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


print_mode: proc (infop, all_sw, mode_name);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	print_mode			internal	*/
  /*i	Input:	info_ptr, all_switch, mode_name		*/
  /*f	Function:	prints out the value of a given mode or of all	*/
  /*f		the kermit user visible modes			*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-10-30	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl all_sw		bit (1);
  dcl mode_name		char (*);
  
  /* based */
  
  dcl 01 info		aligned like kermit_info based (infop);
  
  /* automatic */
  
  dcl chr			char (1) unaligned;
  dcl chrp		ptr;
  dcl found		bit (1);
  dcl num (1:4)		fixed bin (8) unaligned;
  dcl num2		fixed bin unaligned;
  dcl nump		ptr;
  dcl select (1:1)		fixed bin;
  dcl string		char (3) varying;
  
  found = false;
  chrp = addr (chr);
  nump = addr (num);
  
  /* display the value of the line_byte_size mode			*/
  
  if mode_name = "line_byte_size" | all_sw
    then do;
      found = true;
      select (1) = Line_byte_size;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, nump, ec);
      call ioa_ ("Line byte size   = ^d bit", num (1));
    end;
    
  /* display the value of the file_type mode			*/
  
  if mode_name = "file_type" | all_sw
    then do;
      found = true;
      select (1) = File_type;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("File type        = ^[binary^;ascii^]", (chr = Binary));
    end;
    
  /* display the value of the file_warning mode			*/
  
  if mode_name = "file_warning" | all_sw
    then do;
      found = true;
      select (1) = File_warning;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("File warning     = ^[on^;off^]", (chr = On));
    end;
    
  /* display the value of the incomplete mode			*/
  
  if mode_name = "incomplete" | all_sw
    then do;
      found = true;
      select (1) = Incomplete;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("Incomplete       = ^[keep^;discard^]", (chr = Keep));
    end;
    
  /* display the value of the control_prefix character		*/
  
  if mode_name = "control_prefix" | mode_name = "cp" | all_sw
    then do;
      found = true;
      select (1) = Quote_char;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("Control prefix   = ""^a""", chr);
    end;
    
  /* display the value of the eight_bit_prefix character		*/
  
  if mode_name = "eight_bit_prefix" | mode_name = "ebp" | all_sw
    then do;
      found = true;
      select (1) = Eight_bit_char;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("Eight bit prefix = ^[""^a""^;off^s^;From remote^s^]",
		1+index (No_eight_bit || Accept_eight_bit, chr), chr);
    end;
    
  /* display the value of the repeat_prefix character		*/
  
  if mode_name = "repeat_prefix" | mode_name = "rp" | all_sw
    then do;
      found = true;
      select (1) = Repeat_char;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("Repeat prefix    = ^[off^s^;""^a""^]",
		(chr = No_repeat), chr);
    end;
    
  /* dispaly the value of the start_of_packet character		*/
  
  if mode_name = "start_of_packet" | mode_name = "sop" | all_sw
    then do;
      found = true;
      select (1) = Start_char;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      
  /* special encoding to insure \NNN display format		*/
      
      call ioa_$rsnnl ("^3o", string, 3, rank (chr));
      string = translate (string, "0", " ");
      call ioa_ ("Start of packet  = ""\^a""", string);
    end;
    
  /* display the value of the end_of_packet character		*/
  
  if mode_name = "end_of_packet" | mode_name = "eop" | all_sw
    then do;
      found = true;
      select (1) = Eol_char;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      
  /* special encoding to insure \NNN format			*/
      
      call ioa_$rsnnl ("^3o", string, 3, rank (chr));
      string = translate (string, "0", " ");
      call ioa_ ("End of packet    = ""\^a""",string);
    end;
    
  /* display the value of the parity mode			*/
  
  if mode_name = "parity" | all_sw
    then do;
      found = true;
      select (1) = Parity;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, chrp, ec);
      call ioa_ ("Parity           = ^[none^;mark^;space^;even^;odd^]",
		index ("NMSEO", chr));
    end;
    
  /* display the value of the packet_length mode			*/
  
  if mode_name = "packet_length" | mode_name = "pl" | all_sw
    then do;
      found = true;
      select2 (1) = Maxl;
      select2 (2) = Capabilities;
      select2 (3) = Max_len_ext_1;
      select2 (4) = Max_len_ext_2;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select2, nump, ec);
      if num (1) < 94
	 then call ioa_ ("Packet length    = ^d", num (1));
      else if num(1) = 94 
	 then do;
	      num2 = (num (3) * 95) + num (4);
	      if unspec (num (2)) & Ext_Headers
		 then call ioa_ ("Packet length    = ^d", num2);
	      else call ioa_ ("Packet length    = ^d", num (1));
	      end;
    end;
    
  /* display the value of the retry_threshold mode		*/
  
  if mode_name = "retry_threshold" | mode_name = "rt" | all_sw
    then do;
      found = true;
      select (1) = Retry_threshold;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, nump, ec);
      call ioa_ ("Retry threshold  = ^d", num (1));
    end;
    
  /* display the value of the timeout mode			*/
  
  if mode_name = "timeout" | all_sw
    then do;
      found = true;
      select (1) = Timeout;
      call kermit_mode_mgr_$retrieve (infop, Permanent, select, nump, ec);
      call ioa_ ("Timeout          = ^d", num (1));
    end;
    
  /* if no matching mode name was found then abort the command	*/
  
  if ^found
    then call ssu_$abort_line (info.sci_ptr, kermit_et_$unknown_mode);
    
end print_mode;

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


encode_mode: proc (infop, name, index, value, encoded, ec);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	encode_mode			internal	*/
  /*i	Input:	info_ptr, mode_name, mode_value		*/
  /*f	Function:	Given a mode name and value, determines the index	*/
  /*f		for the specified mode and the encoded value for	*/
  /*f		the mode given				*/
  /*o	Output:	mode_index, encoded_value, error_code		*/
  /*							*/
  /*l	Written:	84-10-30	by Dean Elhard			*/
  /*l	Modified: 86-01-31  by Don Kozlowki fix typo in odd parity	*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl name		char (*);
  dcl index		fixed bin;
  dcl value		char (*);
  dcl encoded		char (1);
  dcl ec			fixed bin (35);
  
  /* constants */
  
  dcl valid_modes (1:22)	char (16) varying static options (constant)
			     init ("control_prefix",
				 "cp",
				 "eight_bit_prefix",
				 "ebp",
				 "end_of_packet",
				 "eop",
				 "file_type",
				 "file_warning",
				 "incomplete",
				 "line_byte_size",
				 "packet_length",
				 "pl",
				 "parity",
				 "repeat_prefix",
				 "rp",
				 "retry_threshold",
				 "rt",
				 "start_of_packet",
				 "sop",
				 "timeout",
				 "window_size",
				 "ws");
  
  /* automatic */
  
  dcl num			fixed bin (35);
  dcl i			fixed bin;
  
  index = 0;
  ec = 0;
  
  /* scan the list of user-visible mode names for the name given	*/
  
  do i = 1 to hbound (valid_modes, 1) while (index = 0);
    if valid_modes (i) = name
      then index = i;
  end;
  
  /* if not found, return with an appropriate error code		*/
  
  if index = 0
    then do;
      ec = kermit_et_$unknown_mode;
      return;
    end;
    
  /* now go process the value encoding appropriately for the mode	*/
  
  goto MODE (index);

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


MODE (1):
MODE (2):		/* control prefix */
  
  /* the control prefix must be a single character, illegal chars are	*/
  /* trapped when the mode is stored				*/
  
  if length (value) ^= 1
    then ec = kermit_et_$bad_mode_value;
    else mode = value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Quote_char;
  goto DONE;

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


MODE (3):
MODE (4):		/* eight bit prefix */
  
  /* the values "on" and "off" are translated into "Y" and "N"	*/
  /* respectively, otherwise, a single character is expected.	*/
  /* Illegal values are trapped when the mode is stored.		*/
  
  if value = "on"
    then mode = On;
  else if value = "off"
    then mode = Off;
  else if length (value) ^= 1
    then ec = kermit_et_$bad_mode_value;
    else mode = value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Eight_bit_char;
  goto DONE;

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


MODE (5):
MODE (6):		/* end of packet */
  
  /* any single character is a valid encoding. Illegal characters	*/
  /* are trapped when the store is attempted.			*/
  
  if length (value) ^= 1
    then ec = kermit_et_$bad_mode_value;
    else mode = value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Eol_char;
  goto DONE;

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


MODE (7):		/* file type */
  
  /* Two legal values are permitted.  "binary" and "ascii"		*/
  
  if value = "binary"
    then mode = Binary;
  else if value = "ascii"
    then mode = Ascii;
    else ec = kermit_et_$bad_mode_value;
  
  /* set the index to the correct database index			*/
  
  select (1) = File_type;
  goto DONE;

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


MODE (8):		/* file warning */
  
  /* file warning has two legal encodings, "on" and "off"		*/
  
  if value = "on"
    then mode = On;
  else if value = "off"
    then mode = Off;
    else ec = kermit_et_$bad_mode_value;
  
  /* set the index to the correct database index			*/
  
  select (1) = File_warning;
  goto DONE;

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


MODE (9):		/* incomplete */
  
  /* incomplete has two legal encodings, "on" and "off"		*/
  
  if value = "keep"
    then mode = Keep;
  else if value = "discard"
    then mode = Discard;
    else ec = kermit_et_$bad_mode_value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Incomplete;
  goto DONE;

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


MODE (10):	/* line byte size */
  
  /* line byte size must be either 7 or 8			*/
  
  if value = "7bit" | value = "7"
    then mode = byte (Seven_bit);
  else if value = "8bit" | value = "8"
    then mode = byte (Eight_bit);
    else ec = kermit_et_$bad_mode_value;
  
  /* set the index to the correct data base index			*/
  
  select (1) = Line_byte_size;
  goto DONE;
  
  
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


MODE (11):
MODE (12):	/* packet length */
  
  /* packet length must be a valid numeric value. illegal values	*/
  /* are trapped when the store is attempted.			*/
  
  num = cv_dec_check_ (value, ec);
  
  /* make sure the value supplied can be encoded in nine bits	*/

  
  if (ec ^= 0) & (num >= 0) & (num < 1100)
    then ec = kermit_et_$bad_mode_value;
    else do;
  
  /* set the index to the correct database index			*/

         select (1) = Capabilities;
         call kermit_mode_mgr_$retrieve (infop, Permanent, select, addr (mode), ec);
         if num > 1500   /* Packet length exceeds the maximum */
                then do;
                     call ioa_ ("kermit (set): Mode value exceeds 1500 which is the maximum packet length.");
                     ec = kermit_et_$bad_mode_value;
                     call ssu_$abort_line (A_sci_ptr, ec, mode_value);
                     return;
                end;
         else if num > 94     /* Extended packets requested */
	    then unspec (mode) = unspec (mode) | Ext_Headers;
         else unspec (mode) = unspec (mode) & ^Ext_Headers;
         select2 (1) = Maxl;
         select2 (2) = Capabilities;
         select2 (3) = Max_len_ext_1;
         select2 (4) = Max_len_ext_2;

         mode2 (1) = min (num, 94);
         unspec (mode2 (2)) = unspec (mode);
         mode2 (3) = num / 95;
         mode2 (4) = mod(num, 95);
         call kermit_mode_mgr_$store (A_infop, Permanent, select2, addr (mode2), ec);		   

   end;
   if ec ^= 0
       then call ssu_$abort_line (A_sci_ptr, ec, mode_value);
   return;
   
  

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


MODE (13):	/* parity */
  
  /* parity can have 5 values: "none", "space", "mark", "even", "odd"	*/
  
  if value = "none"
    then mode = None;
  else if value = "space"
    then mode = Space;
  else if value = "mark"
    then mode = Mark;
  else if value = "even"
    then mode = Even;
  else if value = "odd"
    then mode = Odd;
    else ec = kermit_et_$bad_mode_value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Parity;
  goto DONE;

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


MODE (14):
MODE (15):	/* repeat prefix */
  
  /* the repeat prefix can be "off", or a single character value.	*/
  /* illegal characters are trapped when the store is attempted	*/
  
  if value = "off"
    then mode = No_repeat;
  else if length (value) ^= 1
    then ec = kermit_et_$bad_mode_value;
    else mode = value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Repeat_char;
  goto DONE;

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


MODE (16):
MODE (17):	/* retry threshold */
  
  /* retry threshold must be a valid numeric encoding. Illegal values	*/
  /* are trapped when the store is attempted.			*/
  
  num = cv_dec_check_ (value, ec);
  
  /* make sure the value supplied can be encoded in nine bits	*/
  
  if (ec ^= 0) & (num >= 0) & (num < 512)
    then ec = kermit_et_$bad_mode_value;
    else mode = byte (num);
  
  /* set the index to the correct database index			*/
  
  select (1) = Retry_threshold;
  goto DONE;

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


MODE (18):
MODE (19):	/* start of packet */
  
  /* the start_of_packet character must be a single character.	*/
  /* illegal values are trapped when the store is attempted.	*/
  
  if length (value) ^= 1
    then ec = kermit_et_$bad_mode_value;
    else mode = value;
  
  /* set the index to the correct database index			*/
  
  select (1) = Start_char;
  goto DONE;

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


MODE (20):	/* timeout */
  
  /* timeout must be a valid numeric encoding.  Illegal values are	*/
  /* trapped when the store is attempted			*/
  
  num = cv_dec_check_ (value, ec);
  
  /* make sure the value supplied can be encoded in nine bits	*/
  
  if (ec ^= 0) & (num >= 0) & (num < 512)
    then ec = kermit_et_$bad_mode_value;
    else mode = byte (num);
  
  /* set the index to the correct database index			*/
  
  select (1) = Timeout;
  goto DONE;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


MODE (21):	/* window size */
MODE (22):	/* window size */
  
  /* The only currently supported window size is one (1)	*/
  
  num = cv_dec_check_ (value, ec);
  
  if (ec ^= 0) & (num ^= 1)
    then ec = kermit_et_$bad_mode_value;
    else mode = byte (num);
  
  /* set the index to the correct database index			*/
  
  select (1) = Window_size;
  goto DONE;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

DONE:
  /* if we could encode it, try to store it in the modes db		*/
  
  call kermit_mode_mgr_$store (A_infop, Permanent, select, addr (mode), ec);
  if ec ^= 0
    then call ssu_$abort_line (A_sci_ptr, ec, mode_value);


  return;

end encode_mode;

end kermit_mode_mgr_;




		    kermit_pad_.pl1                 03/01/89  1437.6rew 03/01/89  1433.7      487989



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8027), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bugs: PC_File_Transfer 18, 20, and 23.
                                                   END HISTORY COMMENTS */


kermit_pad_: proc;
  
  /********************************************************************/
  /*							*/
  /*n	kermit_pad_					*/
  /*							*/
  /*d	This routine is the Packet Assembler/Disassembler that is	*/
  /*d	responsible for taking text and formatting it into packets	*/
  /*d	and taking incoming packets and decoding them.		*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l	Modified: 86-09-29  by Don Kozlowski - Check if the server	*/
  /*l		kermit will honour the encoding of Receive_init	*/
  /*l		packets before the encoding is done. (kermit 12)	*/
  /*l     Modified: 87-06-12  by Don Kozlowski - Move  CR and NL      */
  /*l               constant definitions to include file. (kermit 15) */
  /*l     Modified: 87-06-12  by S.Huen - Add extended packet length  */
  /*l               support based on D. Kozlowski version.(kermit 16) */
  /*l	Modified:	87-07-22	by Don Kozlowski - Add packet_fix and	*/
  /*l		packet_type to get around optimizer bug.	*/
  /*l		for msf file support. (kermit 18)		*/
  /*l	Modified:	87-08-26	by Don Kozlowski - use offsets into	*/
  /*l		packet in decode_data procedure. (kermit 18)	*/
  /*							*/
  /********************************************************************/
  
  /* constants */
  
  dcl true		bit (1) static options (constant) init ("1"b);
  dcl false		bit (1) static options (constant) init ("0"b);
  
  dcl Seconds_to_microseconds fixed bin (71) static options (constant)
			     init (1000000);
  
  dcl Transmit		char (1) static options (constant) init (">");
  dcl Receive		char (1) static options (constant) init ("<");
  
  dcl Char_encoding_offset	fixed bin static options (constant) init (32);
  dcl Max_packet_size	fixed bin static options (constant) init (1500);
  dcl No_eight_bit_encoding	char (1) static options (constant) init ("N");
  dcl No_repeat_encoding	char (1) static options (constant) init (" ");
  dcl Binary_file_type	char (1) static options (constant) init ("B");
  dcl Ascii_file_type	char (1) static options (constant) init ("A");
  
  dcl Eight_bit_byte_size	fixed bin (8) static options (constant) init (8);
  
  dcl Receive_init_packet_type char (1) static options (constant) init ("R");
  dcl Send_init_packet_type	char (1) static options (constant) init ("S");
  dcl Ack_packet_type	char (1) static options (constant) init ("Y");
  dcl Server_init_packet_type char (1) static options (constant) init ("I");
  
  dcl Ascii_ctl_limit	fixed bin static options (constant) init (31);
  dcl Ascii_printable_limit	fixed bin static options (constant) init (126);
  dcl Ascii_pad_char	fixed bin static options (constant) init (127);
  
  dcl Max_repeat_encoding	fixed bin static options (constant) init (94);
  dcl Min_repeat_encoding	fixed bin static options (constant) init (4);
  
  dcl Mark_parity		char (1) static options (constant) init ("M");
  dcl Space_parity		char (1) static options (constant) init ("S");
  dcl No_parity		char (1) static options (constant) init ("N");
  
  /* parameters */
  
  dcl A_infop		ptr parameter;
  dcl A_crnl		bit (1) parameter;
  dcl A_rcvd		fixed bin (21) parameter;
  dcl A_sent		fixed bin (21) parameter;
  dcl A_size		fixed bin (21) parameter;
  dcl A_datal		fixed bin (21) parameter;
  dcl A_datap		ptr parameter;
  dcl A_code		fixed bin (35) parameter;
  dcl A_bufl		fixed bin (21) parameter;
  dcl A_bufp		ptr parameter;
  dcl A_seq_no		fixed bin parameter;
  dcl A_type		char (1) parameter;
  
  /* procedures */
  
  dcl add_char_offset_	entry (ptr, fixed bin(21)) 
			    returns(ptr) reducible;
  dcl iox_$control		entry (ptr, char(*), ptr, fixed bin(35));
  dcl iox_$put_chars	entry (ptr, ptr, fixed bin(21), fixed bin(35));
  dcl timed_io_$get_chars	entry (ptr, fixed bin(71), ptr, fixed bin(21),
			     fixed bin(21), fixed bin(35));
  
  /* external */
  
  dcl error_table_$line_status_pending
			external fixed bin (35);
  dcl error_table_$timeout
			external fixed bin (35);
  dcl kermit_et_$cannot_decode
			external fixed bin (35);
  dcl kermit_et_$crc_error	external fixed bin (35);
  dcl kermit_et_$length_mismatch
			external fixed bin (35);
  dcl kermit_et_$mangled_packet
			external fixed bin (35);
  dcl kermit_et_$unimplemented_check_type
			external fixed bin (35);
  dcl sys_info$max_seg_size	external fixed bin (35);
  
  /* based */
  
  /* automatic */
  
  dcl ec			fixed bin (35);
  dcl packet		char (Max_packet_size) varying;
  
  /* builtin */
  
  dcl addr		builtin;
  dcl addrel		builtin;
  dcl bin			builtin;
  dcl bool		builtin;
  dcl byte		builtin;  
  dcl copy		builtin;
  dcl index		builtin;
  dcl length		builtin;
  dcl min	                    builtin;
  dcl mod			builtin;
  dcl null		builtin;
  dcl rank		builtin;
  dcl rtrim		builtin;
  dcl string                  builtin;  
  dcl substr                  builtin;
  dcl unspec                  builtin;
  dcl verify		builtin;
  
  /* include files */
  

%include kermit_dcls;

%include kermit_info;

%include kermit_mode_info;

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


send: entry (A_infop,	/* subsystem info pointer		*/
	   A_type,	/* packet type			*/
	   A_datap,	/* pointer to the data buffer		*/
	   A_datal,	/* length of the data buffer		*/
	   A_seq_no,	/* packet sequence number		*/
	   A_sent,	/* number of chars sent from buffer	*/
	   A_size,	/* length of packet in chars		*/
	   A_code);	/* returned status code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_pad_$send			external	*/
  /*i	Input:	packet_type, data, sequence_no, info_ptr	*/
  /*f	Function:	calls encode_data to encode the data, calls	*/
  /*f		append_ctl_info to add the sequence_number and	*/
  /*f		length, calls append_checksum to calculate and	*/
  /*f		add the checksum, and the calls transmit_packet	*/
  /*f		to add parity if required and send the packet to	*/
  /*f		the remote system.				*/
  /*o	Output:	error_code, characters_transmitted, packet_size	*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  call encode_data (A_infop, A_type, A_datap, A_datal, packet,
			A_sent, ec);
  
  call append_ctl_info (A_infop, A_seq_no, packet);
  
  call append_checksum (A_infop, packet, A_code);
  if A_code ^= 0
    then return;
    
  A_size = length (packet) + 2;
  
  call transmit_packet (A_infop, packet, A_code);
  if A_code = 0
    then A_code = ec;
    
  return;

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


receive: entry (A_infop,	/* subsystem info pointer		*/
	      A_type,	/* packet type received		*/
	      A_bufp,	/* pointer to text buffer		*/
	      A_bufl,	/* length of text buffer		*/
	      A_seq_no,	/* sequence number of packet received	*/
	      A_rcvd,	/* number of decoded chars received	*/
	      A_size,	/* size or received packet		*/
	      A_crnl,	/* flag if CR/NL encoding spans packet	*/
	      A_code);	/* output status code		*/

  /********************************************************************/
  /*							*/
  /*n	Name:	kermit_pad_$receive			external	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	calls receive_packet to get the packet, then	*/
  /*f		calls validate_checksum to make sure the checksum	*/
  /*f		is correct and to remove it from the packet, then	*/
  /*f		calls check_ctl_info to extract the sequence_no	*/
  /*f		and validate that the length is correct,	*/
  /*f		and then calls decode_data to decode the data	*/
  /*f		section of the packet.			*/
  /*o	Output:	data, packet_type, sequence_number, packet_size,	*/
  /*o		chars_recieved, spanned_cr/nl_flag, error_code	*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  A_rcvd = 0;
  A_size = 0;
  A_seq_no = 0;
  
  call receive_packet (A_infop, packet, A_size, A_code);
  if A_code ^= 0
    then return;
    
  call validate_checksum (A_infop, packet, A_code);
  if A_code ^= 0
    then return;
    
  call check_ctl_info (A_infop, packet, A_seq_no, A_code);
  if A_code ^= 0
    then return;
    
  call decode_data (A_infop, A_bufp, A_bufl, A_type, packet, A_rcvd,
		A_crnl, A_code);
  
  return;

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


encode_data: proc (infop,	/* subsystem info pointer		*/
	         type,	/* packet type to encode		*/
	         datap,	/* ptr to data to be encoded		*/
	         datal,	/* length of data to be encoded	*/
	         packet,	/* encoded data packet		*/
	         n_sent,	/* number of characters encoded	*/
	         ec);	/* error code			*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	encode_data			internal	*/
  /*i	Input:	data, type, info_ptr			*/
  /*f	Function:	for each character until the buffer is full, call	*/
  /*f		encode_char to encode it into a sequence.  If the	*/
  /*f		sequence can be added to the packet,  add it and	*/
  /*f		continue, otherwise, prepend the type and quit	*/
  /*f		returning the number of chars encoded.		*/
  /*o	Output:	error_code, encoded_data, characters_encoded	*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l     Modified: 89-01-02  by S.Huen - kermit should use the packet*/
  /*l               length and control quoting character expected by  */
  /*l               the external kermit. (pc_18)                      */
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl type		char (1);
  dcl datap		ptr;
  dcl datal		fixed bin (21);
  dcl packet		char (*) varying;
  dcl n_sent		fixed bin (21);
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl data		char (datal) based (datap);
  
  /* automatic */
  
  dcl t_selector (1:8)	fixed bin;
  dcl p_selector (1:2)	fixed bin;
  dcl 01 perm_modes		aligned,
       02 line_byte_size	fixed bin (8) unaligned,
       02 file_type		char (1) unaligned;
  dcl 01 capabilities	aligned,
       02 bit_string,
         03 eight_bit	bit (1) unaligned,
         03 repeat		bit (1) unaligned,
         03 binary		bit (1) unaligned,
         03 raw		bit (1) unaligned,
         03 ext_header	bit (1) unaligned,
         03 mbz		bit (33) unaligned,
       02 max_len		fixed bin;
	   

  dcl 01 modes		aligned,
       02 maxl		fixed bin (8) unaligned,
       02 quote		char (1) unaligned,
       02 eight_bit		char (1) unaligned,
       02 repeat		char (1) unaligned,
       02 check_type	fixed bin (8) unaligned,
       02 capas		bit (9) unaligned,
       02 maxlnx1		fixed bin (9) unsigned unaligned,
       02 maxlnx2		fixed bin (9) unsigned unaligned;

  dcl done		bit (1);
  dcl subsetp		ptr;
  dcl subsetl		fixed bin (21);
  dcl sequence		char (5) varying;
  dcl n_chars		fixed bin;
  dcl header_size		fixed bin;  
  packet = "";
  ec = 0;
  
  /* fetch the packet length, check type and prefix characters	*/
  /* Fix bug 18 - Fetch the correct packet length and control quoting characters */
  
  t_selector (1) = O_maxl;
  t_selector (2) = O_quote_char;
  t_selector (3) = G_eight_bit_char;
  t_selector (4) = G_repeat_char;
  t_selector (5) = G_check_type;
  t_selector (6) = G_capabilities;
  t_selector (7) = O_max_lenx1;
  t_selector (8) = O_max_lenx2;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, t_selector,
			addr (modes), ec);
  
  /* fetch the line type					*/
  
  p_selector (1) = Line_byte_size;
  p_selector (2) = File_type;
  
  call kermit_mode_mgr_$retrieve (infop, Permanent, p_selector,
			addr (perm_modes), ec);
  
  string (capabilities.bit_string) = ""b;
  
  /* determine the capabilities from the line type and prefix chars	*/
  if modes.capas & Ext_Headers         /* extended packet headers	      */
       then do;
       capabilities.ext_header = true;
       capabilities.max_len = modes.maxlnx1 * 95 + modes.maxlnx2;
       end;
  else capabilities.max_len = modes.maxl;

  if modes.eight_bit ^= No_eight_bit_encoding
    then capabilities.eight_bit = true;
  if modes.repeat ^= No_repeat_encoding
    then capabilities.repeat = true;
    
  if perm_modes.line_byte_size = Eight_bit_byte_size
    then do;
      capabilities.raw = true;
      capabilities.eight_bit = false;
    end;
  
  if perm_modes.file_type = Binary_file_type
    then capabilities.binary = true;
    
  n_sent = 0;
  done = false;
  if capabilities.ext_header & (datal > 94)
       then header_size = 6;       /* Extended length packet header     */
  else header_size = 3;	         /* Normal packet header	      */

  
  /* skip encoding if there is no data to send			*/
  
  if datal = 0
    then do;
      n_sent = 0;
      packet = "";
    end;
    
   /* Do not encode send_init, server_init, ack, and receive_init      */
   /* packets before determining whether the server kermit will        */
   /* honour its encoding.                                             */
  
  else if type = Send_init_packet_type |
	type = Receive_init_packet_type |
	type = Ack_packet_type |
	type = Server_init_packet_type
    then do;
      n_sent = min (datal, capabilities.max_len);
      packet = substr (data, 1, n_sent);
    end;
    else do while (^done);
      subsetp = add_char_offset_ (datap, (n_sent));
      subsetl = datal - n_sent;
      
      call encode_char (infop, subsetp, subsetl, sequence, n_chars,
			modes.quote, modes.eight_bit, modes.repeat,
			string (capabilities.bit_string));
      
      if length(packet) + length(sequence) > capabilities.max_len - modes.check_type - header_size
        then done = true;
        else do;
	packet = packet || sequence;
	n_sent = n_sent + n_chars;
	if n_sent >= datal
	  then done = true;
        end;
    end;
  
  /* prepend the packet type					*/

  packet = type || packet;

end encode_data;

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


append_ctl_info: proc (infop,		/* subsystem info pointer	*/
		   seq_no,	/* sequence number to add	*/
		   packet);	/* packed to add info to	*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	append_ctl_info			internal	*/
  /*i	Input:	encoded_data, info_ptr, sequence_no		*/
  /*f	Function:	gets the checksum type from the temp modes to	*/
  /*f		calculate the length of the packet, encodes the	*/
  /*f		length and sequence number and adds them to the	*/
  /*f		packet.					*/
  /*o	Output:	partial_packet				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl seq_no		fixed bin;
  
  /* automatic */
  
  dcl selector (1:1)	fixed bin init (G_check_type);
  dcl chk_tp		fixed bin (8) unal;
  dcl ec			fixed bin (35);
  dcl (len, lenx1, lenx2)	fixed bin;
  dcl check		fixed bin;
  dcl hcheck		fixed bin (9) unsigned;
  dcl packet_fix		char (1);
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector, 
			addr (chk_tp), ec);
   
  /* calculate the length of the packet				*/
  
  len = length (packet) + chk_tp + 1;

  /* prepend the encoded length and sequence number		*/
  if len > 94
       then do;
       packet_fix = packet;	         /* Use packet_fix to strip off first */
			         /* character of packet since substr  */
			         /* doesn't work with -optimize	here  */
       len = len - 2;	         /* Calculate size after header	      */
       lenx1 = (len / 95) + Char_encoding_offset;
       lenx2 = mod (len, 95) + Char_encoding_offset;
       check = (Char_encoding_offset * 2) + seq_no
	  + rank (packet_fix) + lenx1 + lenx2;

       hcheck = mod(check + (mod (check, 256) / 64), 64) + Char_encoding_offset;
       packet = substr (packet, 2);
       packet = byte (Char_encoding_offset) ||   /* Len = 0 	      */
	      byte (seq_no + Char_encoding_offset) ||
	      packet_fix ||	         /* Type		      */
	      byte (lenx1) || byte (lenx2) ||
	      byte (hcheck) || packet;
       end;
     else packet = byte (len + Char_encoding_offset) ||
	byte (seq_no + Char_encoding_offset) || packet;
  
end append_ctl_info;

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


append_checksum: proc (infop,		/* subsystem info pointer	*/
		   packet,	/* packet to add checksum to	*/
		   ec);		/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	append_checksum			internal	*/
  /*i	Input:	partial_packet, info_ptr			*/
  /*f	Function:	calls calculate_checksum to get the checksum	*/
  /*f		value, and appends it to the partial packet	*/
  /*o	Output:	packet					*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl ec			fixed bin (35);
  
  /* automatic */
  
  dcl checksum		char (3) varying;
  
  call calculate_checksum (infop, packet, checksum, ec);
  if ec ^= 0
    then return;
    
  packet = packet || checksum;
  
end append_checksum;

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


transmit_packet: proc (infop,		/* subsystem info pointer	*/
		   packet,	/* packet to transmit	*/
		   ec);		/* error code		*/
    
  /********************************************************************/
  /*							*/
  /*n	Name:	transmit_packet			internal	*/
  /*i	Input:	packet, info_ptr				*/
  /*f	Function:	prepends the mark character and the EOL		*/
  /*f		character, calls set_parity to set the parity	*/
  /*f		bits on the data if mark or space parity is	*/
  /*f		selected, appends the appropriate number of pad	*/
  /*f		characters and transmits the packet to the remote	*/
  /*f		computer.					*/
  /*o	Output:	error_code				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l	Modified:	84-11-06	by Dean Elhard to handle line_status	*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  dcl 01 info		aligned like kermit_info based (infop);
  
  /* automatic */
  
  dcl selector (1:4)	fixed bin;
  dcl 01 modes		aligned,
       02 start_ch		char (1) unaligned,
       02 eol_ch		char (1) unaligned,
       02 pad_char		char (1) unaligned,
       02 pad_count		fixed bin (8) unaligned;
  
  selector (1) = G_start_char;
  selector (2) = O_eol_char;
  selector (3) = O_pad_char;
  selector (4) = O_n_pads;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (modes), ec);
  
  /* add the mark and eol characters to the packet		*/
  
  packet = modes.start_ch || packet || modes.eol_ch;
  
  if modes.eol_ch ^= CR
    then packet = packet || CR;
    
  /* add any padding that may be required			*/
  
  packet = copy (modes.pad_char, modes.pad_count) || packet;
  
  /* set the parity on the packet				*/
  
  call set_parity (infop, packet);
  
  /* send the packet to the remote system			*/
  
  ec = error_table_$line_status_pending;
  
  do while (ec = error_table_$line_status_pending);
    call iox_$put_chars (comm_info.ft_iocbp, addrel (addr (packet), 1),
		length (packet), ec);
    if ec = error_table_$line_status_pending
      then call process_line_status (infop);
  end;
  
  if ec = 0 & comm_info.debug_segp ^= null
    then call debug_log (infop, Transmit, (packet));
    
end transmit_packet;

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


receive_packet: proc (infop,		/* subsystem info pointer	*/
		  packet,		/* packet received		*/
		  char_count,	/* packet length		*/
		  ec);		/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	receive_packet			internal	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	reads a line of text in from the remote system,	*/
  /*f		and calls strip_parity to remove the parity bits	*/
  /*f		Then the mark and EOL characters are removed.	*/
  /*o	Output:	packet, char_count, error_code		*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l	Modified:	84-11-06	by Dean Elhard to handle line_status	*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl char_count		fixed bin (21);
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl 01 info		aligned like kermit_info based (infop);
  dcl input_buffer		char (comm_info.input_buffer.bufferl)
			     based (comm_info.input_buffer.bufferp);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  
  
  /* automatic */
  
  dcl buffer_len		fixed bin (21);
  dcl eol_index		fixed bin (21);
  dcl start_index		fixed bin (21);
  dcl input_time		fixed bin (71);
  dcl add_to_buffer		char (chars_read) based (buffer_offsetp);
  dcl buffer_offsetp	ptr;	      
  dcl chars_read		fixed bin (21);
  dcl 01 modes		aligned,
       02 timeout		fixed bin (8) unaligned,
       02 start_ch		char (1) unaligned,
       02 eol_char		char (1) unaligned;
  dcl selector (1:3)	fixed bin;
  
  selector (1) = I_timeout;
  selector (2) = G_start_char;
  selector (3) = I_eol_char;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (modes), ec);
  
  /* calculate the timeout time value				*/
  
  input_time = modes.timeout * Seconds_to_microseconds;
  buffer_len = sys_info$max_seg_size * 4;
  
  packet = "";
  
  do while (length (packet) = 0);
       eol_index = 0;
       do while (eol_index = 0);
	  eol_index = index (input_buffer, modes.eol_char);
	  /* if eol is a CR, check for a NL instead.  It may be translated.   */
	  if eol_index = 0 & modes.eol_char = CR
	       then eol_index = index (input_buffer, NL);
	  buffer_offsetp = add_char_offset_ (
	       comm_info.input_buffer.bufferp, 
	       comm_info.input_buffer.bufferl);
      
		  /* read a packet from the remote system	      */
	  if eol_index = 0 then      /* Wait patiently for it	      */
	       call timed_io_$get_chars (comm_info.ft_iocbp, input_time,
	       buffer_offsetp, buffer_len - comm_info.input_buffer.bufferl,
	       chars_read, ec);
	  else		         /* Don't wait around for it	      */
	       call timed_io_$get_chars (comm_info.ft_iocbp, 1,
	       buffer_offsetp, buffer_len - comm_info.input_buffer.bufferl,
	       chars_read, ec);
	  
	  comm_info.input_buffer.bufferl = comm_info.input_buffer.bufferl + chars_read;
	  if ec = 0 & comm_info.debug_segp ^= null
	       then call debug_log (infop, Receive, (add_to_buffer));
      
	  if ec = error_table_$timeout & eol_index ^= 0
	       then ec = 0;	         /* We can ignore this	      */

	  if ec = error_table_$line_status_pending
	       then do;
	       call process_line_status (infop);
	       end;
	  else if ec ^= 0 
	       then return;
	  /* strip the parity bits off the received packet	      */
	  call strip_parity (infop, add_to_buffer);
	  end;
       packet = substr (input_buffer, 1, eol_index - 1);
       input_buffer = substr (input_buffer, eol_index + 1);
       comm_info.input_buffer.bufferl = comm_info.input_buffer.bufferl - eol_index;
       
    /* find the start character in the received packet		*/
    
    start_index = index (packet, modes.start_ch);
    if start_index = 0 then packet = "";    /* Nothing there	      */
    else do;
         packet = substr (packet, start_index + 1);
         char_count = length(packet) + 2;
         start_index = index (input_buffer, modes.start_ch);
         if start_index > 0 then do;
	    eol_index = index (substr (input_buffer, start_index),
	         modes.eol_char);
	  /* if eol is a CR, check for a NL instead.  It may be translated.  */
	    if eol_index = 0 & modes.eol_char = CR
	         then eol_index = index (substr (input_buffer, start_index),
	         NL);
	    if eol_index > 0
	         then packet = "";   /* Discard it, check next packet   */
	    end;
         end;
  end;

end receive_packet;

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


validate_checksum: proc (infop,	/* subsystem info pointer	*/
		     packet,	/* packet to be validated	*/
		     ec);		/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	validate_checksum			internal	*/
  /*i	Input:	packet, info_ptr				*/
  /*f	Function:	calculates a checksum for the packet and compares	*/
  /*f		it with the checksum in the packet. If the	*/
  /*f		checksums match, the checksum is stripped from	*/
  /*f		the packet.				*/
  /*o	Output:	packet, error_code				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl ec			fixed bin (35);
  
  /* automatic */
  
  dcl selector (1:1)	fixed bin;
  dcl ck_type		fixed bin (8) unaligned;
  dcl new_packet		char (Max_packet_size) varying;
  dcl received_checksum	char (3) varying;
  dcl calculated_checksum	char (3) varying;
  
  selector (1) = G_check_type;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (ck_type), ec);
  
  /* make sure there are enough characters in the packet to contain	*/
  /* a length, sequence number, and checksum			*/
  
  if length (packet) < ck_type + 2
    then do;
      ec = kermit_et_$mangled_packet;
      return;
    end;
    
  /* extract the portion of the packet excluding the checksum	*/
  
  new_packet = substr (packet, 1, length(packet)-ck_type);
  
  /* extract the transmitted checksum				*/
  
  received_checksum = substr (packet, length(packet)+1-ck_type, ck_type);
  
  /* calculate a checksum from the packet			*/
  
  call calculate_checksum (infop, new_packet, calculated_checksum, ec);
  if ec ^= 0
    then return;
    
  /* see if the calculated checksum matches the received checksum	*/
  
  if calculated_checksum ^= received_checksum
    then ec = kermit_et_$crc_error;
    
  packet = new_packet;
  
end validate_checksum;

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


check_ctl_info: proc (infop,	/* subsystem info pointer		*/
		  packet,	/* packet to check			*/
		  seq_no,	/* sequence no extracted from packet	*/
		  ec);	/* error code			*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	check_ctl_info			internal	*/
  /*i	Input:	partial_packet, info_ptr			*/
  /*f	Function:	decodes the length and sequence_no from the	*/
  /*f		partial_packet and validates that the length is	*/
  /*f		correct and returns the sequence number		*/
  /*o	Output:	encoded_data, seq_no, error_code		*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl seq_no		fixed bin;
  dcl ec			fixed bin (35);
  
  /* automatic */
  
  dcl selector (1:1)	fixed bin;
  dcl ck_type		fixed bin (8) unaligned;
  dcl len			fixed bin;
  dcl check		fixed bin;
  dcl hcheck		fixed bin (9) unsigned;
  dcl packet_fix		char(3);  

  selector (1) = G_check_type;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (ck_type), ec);
  
  /* make sure the packet has enough characters to contain the length	*/
  /* byte and encoded sequence number				*/
  
  if length (packet) < 2
    then do;
      ec = kermit_et_$mangled_packet;
      return;
    end;
    
  /* decode the sequence number				*/
  
  seq_no = rank (substr (packet, 2, 1)) - Char_encoding_offset;
  
  /* check that the length byte matches the actual packet length	*/
  
  len = rank (substr (packet, 1, 1)) - Char_encoding_offset;
  if len = 0
       then do;		         /* extended packet header	      */
       check = rank (substr (packet, 1, 1)) + rank (substr (packet, 2, 1))
	   + rank (substr (packet, 3, 1)) + rank (substr (packet, 4, 1))
	   + rank (substr (packet, 5, 1));
       hcheck = mod(check + (mod (check, 256) / 64), 64);
       if hcheck ^= rank (substr (packet, 6, 1)) - Char_encoding_offset
	  then do;
	  ec = kermit_et_$mangled_packet;
	  return;
	  end;
       len = (rank (substr (packet, 4, 1)) - Char_encoding_offset) * 95
	  + rank (substr (packet, 5, 1)) - Char_encoding_offset;
       if len ^= length (packet) + ck_type - 6
	  then ec = kermit_et_$length_mismatch;
       packet_fix = packet;
       packet = substr (packet_fix, 3, 1) || substr (packet, 7);
       end;
  else do;
       if len ^= length (packet) + ck_type - 1
	  then ec = kermit_et_$length_mismatch;
       packet = substr (packet, 3);
       end;
  
  
end check_ctl_info;
    
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


decode_data: proc (infop,	/* subsystem info pointer		*/
	         bufp,	/* decoded text buffer pointer	*/
	         bufl,	/* decoded text buffer length		*/
	         type,	/* packet type			*/
	         packet,	/* packet to be decoded		*/
	         rcvd,	/* received character count		*/
	         crnl_sw,	/* spanned CR/NL pair switch		*/
	         ec);	/* error code			*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	decode_data			internal	*/
  /*i	Input:	encoded_data, info_ptr			*/
  /*f	Function:	removes the prefix encoding characters and	*/
  /*f		returns the decoded text.			*/
  /*o	Output:	data					*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl bufp		ptr;
  dcl bufl		fixed bin (21);
  dcl type		char (1);
  dcl packet		char (*) varying;
  dcl rcvd		fixed bin (21);
  dcl crnl_sw		bit (1);
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl buf			char (bufl) based (bufp);
  
  /* automatic */
  
  dcl pkt_len		fixed bin;
  dcl pkt_chr		fixed bin;
  dcl 01 capabilities	aligned,
       02 eight_bit		bit (1) unaligned,
       02 repeat		bit (1) unaligned,
       02 mbz		bit (34) unaligned;
  dcl t_selector (1:3)	fixed bin;
  dcl p_selector (1:2)	fixed bin;
  dcl 01 modes		aligned,
       02 quote		char (1) unaligned,
       02 eight_bit		char (1) unaligned,
       02 repeat		char (1) unaligned;
  dcl 01 perm_modes		aligned,
       02 line_byte_size	fixed bin (8) unaligned,
       02 file_type		char (1) unaligned;
  dcl sequence		char (Max_repeat_encoding) varying;
  dcl seql		fixed bin;
  
  rcvd = 0;
  pkt_len = length (packet);
  pkt_chr = 1;
  /* make sure we have something to decode			*/
  
  if pkt_len = 0
    then do;
      ec = kermit_et_$mangled_packet;
      return;
    end;
    
  /* extract the type from the packet				*/
  
  type = substr (packet, 1, 1);
  pkt_chr = 2;
  
  /* Do not decode send_init, server_init and ack packets.            */
  /* Decode receive_init packet only.                                 */
  
  if type = Send_init_packet_type |
/*     type = Receive_init_packet_type | * for compatibility with phx: */
     type = Server_init_packet_type |
     type = Ack_packet_type
    then do;
      rcvd = pkt_len - 1;
      substr (buf, 1, rcvd) = substr (packet, 2);
      return;
    end;
    
  t_selector (1) = I_quote_char;
  t_selector (2) = G_eight_bit_char;
  t_selector (3) = G_repeat_char;
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, t_selector,
			addr (modes), ec);
  
  p_selector (1) = Line_byte_size;
  p_selector (2) = File_type;
  
  call kermit_mode_mgr_$retrieve (infop, Permanent, p_selector,
			addr (perm_modes), ec);
  
  string (capabilities) = ""b;
  
  /* calculate the capabilities from the prefix chars and file type	*/
  
  if modes.eight_bit ^= No_eight_bit_encoding &
     perm_modes.line_byte_size ^= Eight_bit_byte_size
    then capabilities.eight_bit = true;
  if modes.repeat ^= No_repeat_encoding
    then capabilities.repeat = true;
    
  do while (pkt_chr <= pkt_len);
    call decode_char (infop, packet, pkt_chr, pkt_len, sequence, modes.quote,
         			modes.eight_bit, modes.repeat,
         			string (capabilities), ec);
    if ec ^= 0
      then return;
      
    /* handle special decoding of CR/NL to nl and detection of	*/
    /* CR/NL sequences spanning multiple packets			*/
    
    if sequence = NL & perm_modes.file_type = Ascii_file_type
      then if rcvd = 0
        then crnl_sw = true;
        else if substr (buf, rcvd, 1) = CR
	then rcvd = rcvd - 1;
    
    /* append the decoded sequence to the buffer			*/
    
    seql = length (sequence);
    substr (buf, rcvd+1, seql) = sequence;
    rcvd = rcvd + seql;
  end;
  
end decode_data;

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


encode_char: proc (infop,		/* subsystem info pointer	*/
	         datap,		/* ptr to data to encode	*/
	         datal,		/* length of data to encode	*/
	         sequence,		/* resulting output sequence	*/
	         char_count,	/* number of chars encoded	*/
	         quote_ch,		/* control quote char	*/
	         eight_bit_ch,	/* 8-bit prefix char	*/
	         repeat_ch,		/* repeat prefix char	*/
	         capability_str);	/* capability flags		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	encode_char			internal	*/
  /*i	Input:	info_ptr, data, quote_char, 8bit_char,		*/
  /*i		repeat_char				*/
  /*f	Function:	encodes the first character(s) in the data passed	*/
  /*f		returning the encoded sequence and the number of	*/
  /*f		characters encoded.				*/
  /*o	Output:	encoded_sequence, char_count			*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*l	Modified:	84-11-15	by Dean Elhard for correct encoding of	*/
  /*l			8-bit characters over 8-bit lines	*/
  /*l	Modified:	85-03-26	by M. Mallmes for correct encoding of	*/
  /*l			8-bit characters over 8-bit lines	*/
  /*l			when optimized.			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl datap		ptr;
  dcl datal		fixed bin (21);
  dcl sequence		char (*) varying;
  dcl char_count		fixed bin;
  dcl quote_ch		char (1);
  dcl eight_bit_ch		char (1);
  dcl repeat_ch		char (1);
  dcl capability_str	bit (38) aligned;
  
/*  constants  */

  dcl Bit_8_mask		bit (9) aligned static options (constant) init ("200"b3);
  dcl Clear_bit_8		bit (9) aligned static options (constant) init ("577"b3);
  dcl Clear_bit_9		bit (9) aligned static options (constant) init ("377"b3);

  /* based */
  
  dcl data		char (datal) based (datap);
  dcl 01 capabilities	aligned based (addr (capability_str)),
       02 eight_bit		bit (1) unaligned,
       02 repeat		bit (1) unaligned,
       02 binary		bit (1) unaligned,
       02 raw		bit (1) unaligned,
       02 mbz		bit (32) unaligned;
  dcl char_to_code            char (1) aligned;
			
  /* automatic */
  
  dcl bit_8_value		bit (9) aligned;
  
  /* don't bother if there is no data */
  
  if datal = 0
    then return;
    
  char_to_code =  substr (data, 1, 1);
  
  /* clear the ninth bit if set */
  
  unspec (char_to_code) = (unspec (char_to_code) & Clear_bit_9);
  
  /* get the mask for the 8th bit  */

  bit_8_value = (unspec (char_to_code) & Bit_8_mask);

  /*  clear the 8th bit  */

  unspec (char_to_code) = (unspec (char_to_code) & Clear_bit_8);

  /* clear the eighth bit flag if we cannot send the eighth bit */
  
  if ^capabilities.raw & ^capabilities.eight_bit
    then bit_8_value = "0"b;
      
  if capabilities.eight_bit & (bit_8_value ^= "0"b)
    then sequence = eight_bit_ch;
    else sequence = "";
  
  /* see if we are encoding one of our prefix characters */
  
  if char_to_code = quote_ch |
     (char_to_code = eight_bit_ch & capabilities.eight_bit) |
     (char_to_code = repeat_ch & capabilities.repeat)
    then do;
      if capabilities.raw then unspec (char_to_code) = (unspec (char_to_code) | bit_8_value);
      sequence = sequence || quote_ch || char_to_code;
    end;
    
  /* see if we are encoding an newline character */
  
  else if rank (char_to_code) = NL_fixed & (bit_8_value = "0"b) &
	^capabilities.binary
    then sequence = quote_ch || "M" || quote_ch || "J";
    
  /* see if we are encoding a normal control character */
  
  else if rank (char_to_code) <= Ascii_ctl_limit
    then do;
      if capabilities.raw then unspec (char_to_code) = (unspec (char_to_code) | bit_8_value);
      sequence = sequence || quote_ch || ctl_encode  (rank (char_to_code));
    end;
    
  /* see if we are encoding a normal printing character */
  
  else if  rank (char_to_code) <= Ascii_printable_limit
    then do;
      if capabilities.raw then unspec (char_to_code) = (unspec (char_to_code) | bit_8_value);
      sequence = sequence || char_to_code;
    end;
    
  /* see if we are encoding a pad character (177 octal) */
  
  else if  rank (char_to_code) = Ascii_pad_char
    then do;
      if capabilities.raw then unspec (char_to_code) = (unspec (char_to_code) | bit_8_value);
      sequence = sequence || quote_ch || ctl_encode (rank (char_to_code));
    end;
    else sequence = sequence || char_to_code;
  
  char_count = verify (data, substr (data, 1, 1)) - 1;
  if char_count < 0
    then char_count = datal;
    
  /* don't try to repeat encode newlines due to special NL encoding */
  
  if rank (char_to_code) = NL_fixed & (bit_8_value = "0"b) & ^capabilities.binary
    then char_count = 1;
    
  /* limit encoding count to max representable repeat value */
  
  else if char_count > Max_repeat_encoding
    then char_count = Max_repeat_encoding;
    
  /* don't encode if there are not enough chars to make it worthwhile */
  
  if char_count > Min_repeat_encoding & capabilities.repeat
    then sequence = repeat_ch ||
		byte (char_count + Char_encoding_offset) || sequence;
    else char_count = 1;
    
end encode_char;


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


set_parity: proc (infop,	/* subsystem info pointer		*/
	        packet);	/* packet to set parity on		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	set_parity			internal	*/
  /*i	Input:	complete_packet, info_ptr			*/
  /*f	Function:	if mark or space parity is in effect, set the	*/
  /*f		eighth bit of each character in the packet	*/
  /*f		appropriately				*/
  /*o	Output:	complete_packet				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  
  /* automatic */
  
  dcl ec			fixed bin (35);
  dcl mask		bit (Max_packet_size * 9) varying;
  dcl parity		char (1) unal;
  dcl selector (1:1)	fixed bin init (G_parity);
  dcl workspace		bit (Max_packet_size * 9) varying;
  dcl 01 wksp_overlay	based (addr (workspace)),
       02 len		fixed bin (24),
       02 chars		char (Max_packet_size);
  
  /* get the prevailing parity				*/
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (parity), ec);
  
  /* ***** NB. kludge to get around PL/I padded-reference bug ***** */
  
  if rank (parity) = rank (Mark_parity) | rank (parity) = rank (Space_parity)
    then do;
      wksp_overlay.chars = packet;
      wksp_overlay.len = 9 * length (packet);
      mask = copy ("200"b3, length (packet));
  
  /* ***** NB. kludge to get around PL/I padded-reference bug ***** */
  
      if rank (parity) = rank (Mark_parity)
        then workspace = workspace | mask;
        else workspace = workspace & ^mask;
      packet = substr (wksp_overlay.chars, 1, length (packet));
    end;
    
end set_parity;

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


strip_parity: proc (infop,	/* subsystem info pointer		*/
	          packet);	/* packet to strip parity from	*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	strip_parity			internal	*/
  /*i	Input:	complete_packet, info_ptr			*/
  /*f	Function:	zeroes the parity bits on an incoming packet	*/
  /*o	Output:	complete_packet				*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*);
  
  /* automatic */
  
  dcl selector (1:1)	fixed bin init (G_parity);
  dcl parity		char (1) unal;
  dcl workspace		bit (length (packet) * 9) based (addr (packet));
  dcl ec			fixed bin (35);
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (parity), ec);
  
  /* for anything except "No Parity", strip the parity bit */
  
  /* ***** NB. kludge to get around PL/I padded-reference bug ***** */
  
  if rank (parity) ^= rank (No_parity)
    then workspace = bool(workspace, copy("600"b3, length(packet)), "0010"b);
    else workspace = bool(workspace, copy("400"b3, length(packet)), "0010"b);
  
end strip_parity;

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


decode_char: proc (infop,		/* subsystem info pointer	*/
	         packet,		/* packet to decode from	*/
	         pkt_chr,		/* offset in packet		*/
	         pkt_len,		/* packet length		*/
	         sequence,		/* decoded character sequence	*/
	         quote_ch,		/* control quote character	*/
	         eight_bit_ch,	/* 8 bit prefix character	*/
	         repeat_ch,		/* repeat prefix character	*/
	         capability_str,	/* decode capability string	*/
	         ec);		/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	decode_char			internal	*/
  /*i	Input:	info_ptr, packet, quote_char, 8bit_char,	*/
  /*i		repeat_char, capabilities			*/
  /*f	Function:	decodes the first sequence in the packet based	*/
  /*f		on the current capabilities and prefix chars	*/
  /*f		and returns the resulting sequence.  The encoded	*/
  /*f		sequence is stripped from the start of the packet	*/
  /*o	Output:	decoded_sequence, packet, error_code		*/
  /*							*/
  /*l	Written:	84-10-23	by Dean Elhard			*/
  /*l	Modified:	84-10-28	by Dean Elhard to fix decoding of	*/
  /*l			prefix characters			*/
  /*l	Modified:	84-11-15	by Dean Elhard for correct decoding of	*/
  /*l			8-bit characters over 8-bit lines	*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl (pkt_chr, pkt_len)	fixed bin;
  dcl sequence		char (*) varying;
  dcl quote_ch		char (1);
  dcl eight_bit_ch		char (1);
  dcl repeat_ch		char (1);
  dcl capability_str	bit (36) aligned;
  dcl ec			fixed bin (35);
  
  /* based */
  
  dcl 01 capabilities	aligned based (addr (capability_str)),
       02 eight_bit		bit (1) unaligned,
       02 repeat		bit (1) unaligned,
       02 mbz		bit (34) unaligned;
  dcl 01 char_overlay	unaligned based (addr (decoded_char)),
       02 bit_9		bit (1) unaligned,
       02 bit_8		bit (1) unaligned,
       02 ascii_bits	bit (7) unaligned;
  dcl 01 seven_bit_overlay	unaligned based (addr (seven_bit_char)),
       02 bit_9		bit (1) unaligned,
       02 bit_8		bit (1) unaligned,
       02 ascii_bits	bit (7) unaligned;
  
  /* automatic */
  
  dcl repeat_count		fixed bin;
  dcl set_eighth_bit	bit (1);
  dcl seven_bit_char	char (1);
  dcl control_decode	bit (1);
  dcl decoded_char		char (1);
  
  /* check if there is a repeat prefix on the sequence		*/
  
  if capabilities.repeat & substr (packet, pkt_chr, 1) = repeat_ch
    then do;
      
      /* if there are not enough chars in the packet for a repeat	*/
      /* sequence, abort the packet decodeing			*/
      
      if pkt_len - pkt_chr < 2
        then do;
	ec = kermit_et_$cannot_decode;
	return;
        end;
        
      /* decode the repeat count and strip the prefix and count	*/
      
      repeat_count = rank (substr (packet, pkt_chr + 1, 1)) - Char_encoding_offset;
      pkt_chr = pkt_chr + 2;
    end;
    else repeat_count = 1;
  
  /* see if there is an eight-bit prefix on the sequence		*/
  
  if capabilities.eight_bit & substr (packet, pkt_chr, 1) = eight_bit_ch
    then do;
      
      /* if there are not enought characters in the packet for a	*/
      /* eight-bit prefixed sequence, then yell			*/
      
      if pkt_len - pkt_chr < 1
        then do;
	ec = kermit_et_$cannot_decode;
	return;
        end;
        
      /* set the eight-bit flag and strip the prefix		*/
      
      set_eighth_bit = true;
      pkt_chr = pkt_chr + 1;
    end;
    else set_eighth_bit = false;
  
  /* see if there is a control prefix on the sequence		*/
  
  if substr (packet, pkt_chr, 1) = quote_ch
    then do;
      
      /* if there are not enough characters in the packet to contain	*/
      /* a valid control-prefixed sequence, then yell		*/
      
      if pkt_len - pkt_chr < 1
        then do;
	ec = kermit_et_$cannot_decode;
	return;
        end;
        
      /* set the flag indicating that control decoding is required	*/
      /* and strip the control prefix from the packet		*/
      
      control_decode = true;
      pkt_chr = pkt_chr + 1;
    end;
    else control_decode = false;
  
  /* extract the target character of the sequence from the packet	*/
  
  decoded_char = substr (packet, pkt_chr, 1);
  pkt_chr = pkt_chr + 1;
  
  seven_bit_char = decoded_char;
  seven_bit_overlay.bit_8 = false;
  
  /* perform control decoding if required special casing control	*/
  /* encoded prefix characters				*/
  
  if control_decode
    then if (seven_bit_char ^= quote_ch) &
	  ((seven_bit_char ^= eight_bit_ch) | ^capabilities.eight_bit) &
	  ((seven_bit_char ^= repeat_ch) | ^capabilities.repeat)
      then decoded_char = ctl_encode (rank (decoded_char));
    
  /* perform eight-bit decoding if required			*/
  
  if set_eighth_bit
    then char_overlay.bit_8 = true;
    
  /* copy the character as required by repeat prefixing		*/
  
  sequence = copy (decoded_char, repeat_count);
  
end decode_char;

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


calculate_checksum: proc (infop,	/* subsystem info pointer	*/
		      packet,	/* packet do calc cksum for	*/
		      checksum,	/* calculated checksum	*/
		      ec);	/* error code		*/
  
  /********************************************************************/
  /*							*/
  /*n	Name:	calculate_checksum			internal	*/
  /*i	Input:	packet, info_ptr				*/
  /*f	Function:	calculates the checksum based on the prevailing	*/
  /*f		checksum type and returns the character sequence	*/
  /*f		representing the checksum			*/
  /*o	Output:	checksum, error_code			*/
  /*							*/
  /*l	Written:	84-10-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl packet		char (*) varying;
  dcl checksum		char (*) varying;
  dcl ec			fixed bin (35);
  
  /* automatic */
  
  dcl check_type		fixed bin (8) unal;
  dcl i			fixed bin;
  dcl selector (1:1)	fixed bin init (G_check_type);
  dcl six_seven_mask	bit (36) aligned static options (constant)
			     init ("000000000300"b3);
  dcl sum			fixed bin (35) aligned;
  dcl sum_bits		bit (36) aligned based (addr (sum));
  dcl zero_five_mask	bit (36) aligned static options (constant)
			     init ("000000000077"b3);
  
  /* get the current checksum type				*/
  
  call kermit_mode_mgr_$retrieve (infop, Temporary, selector,
			addr (check_type), 0);
  
  ec = 0;
  
  /* check type 1  -  single character encoded checksum		*/
  
  if check_type = 1
    then do;
      sum = 0;
      
      /* sum the ascii values of the packet			*/
      
      do i = 1 to length (packet);
        sum = sum + rank (substr (packet, i, 1));
      end;
      
      /* adjust the checksum into a 6 bit value			*/
      
      sum = sum + (bin (sum_bits & six_seven_mask) / 64);
      sum_bits = sum_bits & zero_five_mask;
      
      /* encode the checksum into a printable ascii character	*/
      
      checksum = byte (sum + Char_encoding_offset);
    end;
    
  /* no other checksum types are currently supported		*/
  
    else ec = kermit_et_$unimplemented_check_type;
  
end calculate_checksum;

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


ctl_encode: proc (value_to_encode) returns (char (1)) reducible;
  
  /********************************************************************/
  /*							*/
  /*n	Name:	ctl_encode			internal	*/
  /*i	Input:	ascii_value				*/
  /*f	Function:	performs the kermit ctl() encoding function which	*/
  /*f		toggles bit 7 in the specified value.		*/
  /*o	Output:	encoded_char				*/
  /*							*/
  /*l	Written:	84-10-18	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl value_to_encode	fixed bin (35) aligned;
  
  /* based */
  
  dcl bit_overlay		bit (36) aligned based (addr (value_to_encode));
  dcl 01 char_overlay	aligned based (addr (encoded_value)),
       02 pad		char (3) unaligned,
       02 encoded_char	char (1) unaligned;
  
  /* automatic */
  
  dcl encoded_value		bit (36) aligned;
  
  /* control encode by XORing the ascii value with 64		*/
  
  encoded_value = bool (bit_overlay, "000000000100"b3, "0110"b);
  
  return (char_overlay.encoded_char);
  
end ctl_encode;

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


process_line_status: proc (infop);
  
  /********************************************************************/
  /*							*/
  /*n	Name:	process_line_status			internal	*/
  /*i	Input:	info_ptr					*/
  /*f	Function:	clears the line status on the file transfer	*/
  /*f		switch.					*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-11-05	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  
  /* based */
  
  dcl 01 info		aligned like kermit_info based (infop);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  
  /* automatic */
  
  dcl ls_data		bit (72) aligned;
  dcl ec			fixed bin (35);
  
  call iox_$control (comm_info.ft_iocbp, "line_status", addr (ls_data), ec);
  
end process_line_status;

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


debug_log: proc (infop, direction, data);
  
  /********************************************************************/
  /*  							*/
  /*n	Name:	debug_log				internal	*/
  /*i	Input:	info_ptr, direction, packet_data		*/
  /*f	Function:	logs the packet traffic in a segment to aid in	*/
  /*f		debugging.				*/
  /*o	Output:	none					*/
  /*							*/
  /*l	Written:	84-11-15	by Dean Elhard			*/
  /*							*/
  /********************************************************************/
  
  /* parameters */
  
  dcl infop		ptr;
  dcl direction		char (1);
  dcl data		char (*);
  
  /* based */
  
  dcl 01 info		aligned like kermit_info based (infop);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  
  /* automatic */
  
  dcl str			char (4000);
  
  /* insert direction marker					*/
  str = direction || data || NL;
  call iox_$put_chars (comm_info.debug_segp, addr (str), length (rtrim (str)), ec);

end debug_log;

end kermit_pad_;




		    kermit_receive_.pl1             03/01/89  1437.6rew 03/01/89  1434.1      363627



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8036), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bug: PC_File_Transfer 24 - kermit is being changed to correctly
     handle links to multisegment files.
                                                   END HISTORY COMMENTS */


kermit_receive_:
     proc;

/**********************************************************************/
/*							*/
/*n	kermit_receive_					*/
/*							*/
/*d	This routine is responsible for receiving files from a	*/
/*d	remote kermit.					*/
/*							*/
/*l	Written:	84-11-01	by Maureen Mallmes			*/
/*l	Modified:	85-01-23	by Maureen Mallmes 			*/
/*l			modified the routine, find_file, to get	*/
/*l			a proper suffixed name when given an	*/
/*l			absolute path.			*/
/*l       Modified: 87-06-19  by Don Kozlowski - Move CR and NL       */
/*l	                    constant definitions to include file.   */
/*l                           (kermit 15)                             */
/*l	Modified:	87-07-22	by Don Kozlowski - Support msf file	*/
/*l			and be more strict with lost packets	*/
/*l                           (kermit 17)                             */
/*							*/
/**********************************************************************/

/*  Not an entry  */
	return;



/* parameters  */

	dcl     ec		 fixed bin (35);
	dcl     file_sw		 bit (1);
	dcl     files_received	 fixed bin;
	dcl     first_filename	 char (*);
	dcl     infop		 ptr;
	dcl     initial_seq_n	 fixed bin;
	dcl     initial_state	 fixed bin;

/*  automatic  */

	dcl     abnormal_termination	 bit (1);
	dcl     abort_sent		 bit (1);
	dcl     discard_sw		 bit (1);
	dcl     fw_sw		 bit (1);
	dcl     ktip		 ptr;
	dcl     01 path		 aligned,
		02 dir_name	 char (168) unal,
		02 entry_name	 char (32) unal;
	dcl     receive_file_modes	 (3) fixed bin (8) unal;
	dcl     receive_file_select	 (3) fixed bin;
	dcl     state		 fixed bin;

/*  based */

	dcl     01 kermit_stats	 aligned like kermit_stats_info;
	dcl     01 kti		 like kermit_transfer_info;

/*  labels  */

	dcl     receive_state	 (0:5) label init (Rec_Init, Rec_File, Rec_Data, Rec_File_Abort, Rec_Abort, Rec_Complete);

/*  constants  */

	dcl     Discard		 char (1) internal static options (constant) init ("D");
	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Max_packet_size	 fixed bin (21) internal static options (constant) init (94);
	dcl     Max_remote_packet_size fixed bin (21) internal static options (constant) init (10000);

	dcl     Mod_64		 fixed bin internal static options (constant) init (64);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);
	dcl     Whoami		 char (7) internal static options (constant) init ("receive");
	dcl     Yes		 char (1) internal static options (constant) init ("Y");

/*  builtin  */

	dcl     (addr, byte, char, index, length, ltrim, min, mod, rtrim, substr, null) builtin;

/*  conditions */

	dcl     (cleanup, record_quota_overflow) condition;

/*  external  */

	dcl     error_table_$rqover	 fixed bin (35) ext static;
	dcl     kermit_et_$fatal_error fixed bin (35) ext static;
	dcl     kermit_et_$no_file_abort fixed bin (35) ext static;
	dcl     kermit_et_$no_initialization fixed bin (35) ext static;
	dcl     kermit_et_$no_rename	 fixed bin (35) ext static;
	dcl     kermit_et_$remote_file_abort fixed bin (35) ext static;
	dcl     kermit_et_$too_many_retries fixed bin (35) ext static;

/*  procedures  */

	dcl     clock_		 entry () returns (fixed bin (71));
	dcl     delete_$path	 entry (char (*), char (*), bit (6), char (*), fixed bin (35));
	dcl     expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35));
	dcl     hcs_$status_minf	 entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
	dcl     iox_$attach_name	 entry (char (*), ptr, char (*), ptr, fixed bin (35));
	dcl     iox_$close		 entry (ptr, fixed bin (35));
	dcl     iox_$detach_iocb	 entry (ptr, fixed bin (35));
	dcl     iox_$open		 entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
	dcl     iox_$put_chars	 entry (ptr, ptr, fixed bin (21), fixed bin (35));
	dcl     pathname_		 entry (char (*), char (*)) returns (char (168));
	dcl     suffixed_name_$make	 entry (char (*), char (*), char (32), fixed bin (35));
	dcl     terminate_file_	 entry (ptr, fixed bin (24), bit (*), fixed bin (35));
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	

/* include files  */
%include access_mode_values;

%include kermit_dcls;

%include kermit_info;

%include kermit_mode_info;

%include kermit_transfer_info;

%include iox_modes;


receive_from_remote:
     entry (infop, initial_state, initial_seq_n, first_filename, file_sw, files_received, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$receive_from_remote	external	*/
/*i 	Input:	infop, initial_state, first_filename,		*/
/*i		file_sw					*/
/*f 	Function: Receives a file or file group from the 		*/
/*f		remote.  Provides a state-switching mechanism	*/
/*f		and data interface via calls to receive_init	*/
/*f		receive_filename, receive_data, abort_receive	*/
/*f		and complete.  Updates the log		*/
/*o 	Output:	files_received, ec				*/
/*							*/
/**********************************************************************/


/*  initialize file transfer data  */

	ktip = addr (kti);
	kti.statisticsp = addr (kermit_stats);

/*  In case we can't get past the Send-Init  */
	path.dir_name = " ";
	if file_sw then
	     path.entry_name = first_filename;
	else path.entry_name = "????";

	kti.filenamesp = addr (path);
	kti.retry_count = 0;
	kti.sequence_n = initial_seq_n;
	kti.filenames_idx = 0;
	kti.filep = null ();
	kti.buffp = null ();
	kti.iocb_ptr = null ();
	kti.msf = False;
	kti.file_count = 0;
	kti.statisticsp = addr (kermit_stats);

	kermit_stats.caller = Whoami;
	call init_file_stats (ktip);

	receive_file_select (1) = Retry_threshold;
	receive_file_select (2) = File_warning;
	receive_file_select (3) = Incomplete;

	call kermit_mode_mgr_$retrieve (infop, Permanent, receive_file_select, addr (receive_file_modes), ec);

	kti.retry_threshold = receive_file_modes (1);
	fw_sw = (byte (receive_file_modes (2)) = Yes);
	discard_sw = (byte (receive_file_modes (3)) = Discard);



/*  Handlers  */
	on cleanup begin;
		abnormal_termination = True;
		call terminate_file (ktip, discard_sw, abnormal_termination);
	     end;

	on record_quota_overflow
	     begin;
		abnormal_termination = True;
		call terminate_file (ktip, discard_sw, abnormal_termination);
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);
		ec = error_table_$rqover;
		goto Rec_Complete;
	     end;

	abort_sent = False;
	files_received = 0;
	state = initial_state;

/*  State switcher  */

	do while ("1"b);

	     goto receive_state (state);

Rec_Init:
	     call receive_init (infop, ktip, state);
	     goto exit_state;

Rec_File:
	     call receive_filename (infop, ktip, first_filename, file_sw, fw_sw, state);
	     goto exit_state;
Rec_Data:
	     call receive_data (infop, ktip, discard_sw, abort_sent, state);
	     goto exit_state;

Rec_File_Abort:
	     call receive_file_abort (infop, ktip, discard_sw, abort_sent, state);
	     goto exit_state;

Rec_Abort:					/*  Are we here because we couldn't abort a single file?  */
	     if abort_sent then
		ec = kermit_et_$no_file_abort;	/* yes */
	     else ec = kermit_stats.status;		/* no */
	     call update_log (infop, ktip, discard_sw);

Rec_Complete:
	     files_received = kti.file_count;
	     return;

exit_state:
	end;

	return;



receive_data:
     proc (infop, ktip, discard_sw, abort_sent, state);


/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$receive_data		internal	*/
/*i 	Input:	infop, ktip, discard_sw			*/
/*f 	Function: Waits for File-Data Packet.			*/
/*f		If data cannot be stored (segment too big), then	*/
/*f		an attempt is made to abort the receipt of the	*/
/*f		single file by placing an "X" in the data portion */
/*f		of the Ack packet.				*/
/*o 	Output:	state, abort_sent				*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     abort_sent		 bit (1);
	dcl     discard_sw		 bit (1);
	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     abort_char		 char (1);
	dcl     abort_char_lth	 fixed bin (21);
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     r_packet_size	 fixed bin (21);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;


/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:4) label init (Other, File_header, Data, Eof, Error);

/*  constants  */
	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);
	dcl     Discard_char	 char (1) internal static options (constant) init ("X");
	dcl     Packet_string	 char (4) internal static options (constant) init ("FDZE");
	dcl     Remote_discard	 char (1) internal static options (constant) init ("D");


	ec = 0;
	abort_sent = False;
	abort_char_lth = 0;
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?? */
	if kti.retry_count > kti.retry_threshold then do;
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);
		kermit_stats.status = kermit_et_$too_many_retries;
		state = Rec_abort;
		return;
	     end;

/*  Get a packet  */
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
	     r_packet_size, eol_split, ec);

	if ec ^= 0 then goto Retry_packet;

/*  Respond to remote packet  */
	idx = index (Packet_string, packet_type);
	goto packet (idx);


Data:						/*  Received remote DATA packet  */
	if kti.sequence_n ^= packet_n then do;		/*  Remote lost a previous ack?  */
		call check_lost_packet (infop, ktip, packet_n);
		return;
	     end;

	if chars_received ^= 0 then call store_data (ktip, eol_split, remote_data, chars_received, r_packet_size, ec);
	if ec ^= 0 then do;				/*  Have to abort receipt of this file  */
		kermit_stats.status = ec;
		abort_char = Discard_char;
		abort_char_lth = 1;
		abort_sent = True;			/* Record the attempted abort  */
	     end;

	call kermit_pad_$send (infop, Ack_packet, addr (abort_char), abort_char_lth, kti.sequence_n, chars_sent, packet_size, ec);

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	if abort_sent then state = Rec_file_abort;
	return;



File_header:					/*  Received FILE-HEADER packet  */
						/*  Remote may have lost our previous ACK  */
	call check_lost_packet (infop, ktip, packet_n);
	return;



Eof:						/*  Received EOF packet  */
	if kti.sequence_n ^= packet_n then goto Retry_packet;

/*  Otherwise, we have a valid eof packet.  Check to see if the remote
	   wants to abort it or terminate it normally  */
	if chars_received ^= 0 then do;
		if substr (remote_data, 1, chars_received) = Remote_discard then
		     kermit_stats.status = kermit_et_$remote_file_abort;
	     end;


	call kermit_pad_$send (infop, Ack_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	kermit_stats.end_time = clock_ ();
	call update_log (infop, ktip, discard_sw);
	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Rec_file_header;
	return;



Error:						/*  Received ERROR packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Rec_abort;
	return;

Other:						/*  Received unexpected packet  */
Retry_packet:
	call kermit_pad_$send (infop, Nak_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;

     end receive_data;

receive_filename:
     proc (infop, ktip, user_filename, user_file_sw, file_warning_sw, state);


/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$receive_filename	internal	*/
/*i 	Input:	infop, ktip, user_filename, user_file_sw	*/
/*i		file_warning_sw				*/
/*f 	Function: Waits for File-Header Packet.			*/
/*f		If there is data in the data portion of the	*/
/*f		packet, i.e. remote has supplied a filename, an	*/
/*f		Ack packet is sent to the remote.		*/
/*f		Verification of the filename now occurs:	*/
/*f		If the data can be stored under the supplied 	*/
/*f		filename, all is okay.   If the data cannot be	*/
/*f		stored under the given filename, an attempt will	*/
/*f		later be made to abort receipt of the file, (next	*/
/*f		state = receive_file_abort).			*/
/*o 	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     file_warning_sw	 bit (1);
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;
	dcl     user_file_sw	 bit (1);
	dcl     user_filename	 char (*);

/*  automatic  */

	dcl     ack_init_data	 char (Max_packet_size);
	dcl     ack_init_data_lth	 fixed bin (21);
	dcl     ack_init_datap	 ptr;
	dcl     ack_init_packet	 char (Max_packet_size);
	dcl     ack_init_packet_lth	 fixed bin (21);
	dcl     ack_init_packetp	 ptr;
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     file_ptr		 ptr;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     rec_filename	 char (168);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     source_dir		 char (168);
	dcl     source_ename	 char (32);


/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);
	dcl     01 path		 aligned based (kti.filenamesp),
		02 dir_name	 char (168) unal,
		02 entry_name	 char (32) unal;

/*  labels  */

	dcl     packet		 (0:5) label init (Other, File_header, Send_init, Eof, Break, Error);

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Packet_string	 char (5) internal static options (constant) init ("FSZBE");

	ec = 0;
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up??  */
	if kti.retry_count > kti.retry_threshold then do;
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);
		kermit_stats.status = kermit_et_$too_many_retries;
		state = Rec_abort;
		return;
	     end;

/*  Get the remote's packet  */
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
	     packet_size, eol_split, ec);

	if ec ^= 0 then goto Retry_packet;

/*  Respond to the remote's packet  */
	idx = index (Packet_string, packet_type);
	goto packet (idx);


File_header:					/*  Received FILE-HEADER packet  */
	if kti.sequence_n ^= packet_n then goto Retry_packet;

/* make sure there's something that can be used as a filename  */
	if chars_received = 0 then goto Retry_packet;

/*  Acknowledge receipt of filename  */
	call kermit_pad_$send (infop, Ack_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);

/*  Have we already set up the file  */
	if kti.iocb_ptr = null then do;    /* no */
		kermit_stats.status = 0;		/*  Are we using the user-supplied filename?  */
		if user_file_sw then do;
			rec_filename = user_filename;
			user_file_sw = False;
		     end;

		else do;
			rec_filename = substr (remote_data, 1, chars_received);
						/*  delete all trailing '.' on the remote-supplied filename  */
			rec_filename = rtrim (rtrim (rec_filename), ".");
		     end;

		call find_file (rec_filename, file_warning_sw, source_dir, source_ename, file_ptr, ec);

		kti.iocb_ptr = file_ptr;
		path.dir_name = source_dir;
		path.entry_name = source_ename;
		kermit_stats.start_time = clock_ ();

		if ec ^= 0 then do;			/*  can't receive this file  */
			kermit_stats.status = ec;
			kermit_stats.end_time = kermit_stats.start_time;
			state = Rec_file_abort;	/* where we'll tell the remote we can't receive it  */
			return;
		     end;

/* otherwise, we have sucessfully initiated the file for receiving  */

	     end;

	state = Rec_data;
	return;


Send_init:					/* Receive SEND-INIT packet  */
						/*  The remote may have lost our ACK to his send_init so send the parameters
						   again.  */
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	if mod (packet_n + 1, 64) = kti.sequence_n then do;
		ack_init_datap = addr (ack_init_data);
		ack_init_packetp = addr (ack_init_packet);
		call kermit_xfer_modes_$get_local_params (infop, ack_init_datap, ack_init_data_lth, ack_init_packetp,
		     ack_init_packet_lth, ec);

/*  this should never happen  */
		if ec ^= 0 then goto Retry_packet;
		call kermit_pad_$send (infop, Ack_packet, ack_init_packetp, ack_init_packet_lth, packet_n, chars_sent, packet_size, ec);
	     end;

	else goto Retry_packet;
	return;


Eof:						/*  Received EOF packet  */
						/*  Remote may have lost our previous ACK  */
	call check_lost_packet (infop, ktip, packet_n);
	return;

Break:						/*  Received a BREAK packet  */
	if kti.sequence_n ^= packet_n then goto Retry_packet;

	call kermit_pad_$send (infop, Ack_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);

	call verify_receipt (infop, ktip);
	state = Rec_complete;			/* change state  */
	return;

Error:						/*  Received ERROR packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Rec_abort;
	return;

Other:						/*  Received unexpected packet  */
Retry_packet:
	call kermit_pad_$send (infop, Nak_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end receive_filename;


receive_init:
     proc (infop, ktip, state);


/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$receive_init		internal	*/
/*i 	Input:	infop, ktip				*/
/*f 	Function: Performs the initialization of the required modes */
/*f		for communicating with the remote system.	*/
/*f		Waits for a Send-Initiate (S) packet specifying	*/
/*f		the remote's parameters.			*/
/*f		Responds with its own parameters via an ACK	*/
/*f		(Y) packet.  The results of this negotiation are	*/
/*f		recorded in New-Modes.			*/
/*o 	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     ack_init_data	 char (Max_packet_size);
	dcl     ack_init_datap	 ptr;
	dcl     ack_init_data_lth	 fixed bin (21);
	dcl     ack_init_packet	 char (Max_packet_size);
	dcl     ack_init_packet_lth	 fixed bin (21);
	dcl     ack_init_packetp	 ptr;

/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:2) label init (Other, Send_init, Error);

/*  constants  */

	dcl     Packet_string	 char (2) internal static options (constant) init ("SE");

	ec = 0;
	ack_init_datap = addr (ack_init_data);
	ack_init_packetp = addr (ack_init_packet);
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);
		kermit_stats.status = kermit_et_$no_initialization;
		state = Rec_abort;
		return;
	     end;

/*  Get remote send-init data  */
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
	     packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);



Send_init:					/* Received SEND-INIT packet  */
	if packet_n ^= kti.sequence_n then goto Retry_packet;

/* Have the remote init data, so set the modes  database  */
	call kermit_xfer_modes_$get_local_params (infop, ack_init_datap, ack_init_data_lth, ack_init_packetp, ack_init_packet_lth, ec);
	if ec ^= 0 then goto Retry_packet;

	call kermit_xfer_modes_$check_params (infop, remote_datap, chars_received, ack_init_datap, ec);
	if ec ^= 0 then
	     goto Retry_packet;

/* else all is fine, so give the remote kermit the local modes  */
	call kermit_pad_$send (infop, Ack_packet, ack_init_packetp, ack_init_packet_lth, kti.sequence_n, chars_sent,
	     packet_size, ec);
	if ec ^= 0 then
	     goto Retry_packet;


/* All okay, so set the tty_ line to the new modes  */
	call kermit_xfer_modes_$process_params (infop, remote_datap, chars_received, ack_init_datap, ec);
	if ec ^= 0 then
	     goto Retry_packet;

	call kermit_comm_mgr_$reset_line_modes (infop, ec);
	call kermit_comm_mgr_$set_line_modes (infop, ec);

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Rec_file_header;
	return;

Error:						/*  Received ERROR packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Rec_abort;
	return;

Other:						/*  Received unexpected packet  */
Retry_packet:
	call kermit_pad_$send (infop, Nak_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end receive_init;


receive_file_abort:
     proc (infop, ktip, discard_sw, abort_sent, state);


/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$receive_file_abort	internal	*/
/*i 	Input:	infop, ktip, discard_sw, abort_sent		*/
/*f 	Function: Responsible for handling the abort of a single	*/
/*f		file initiated by the local kermit.		*/
/*f		To abort a single file, put an "X" in the data	*/
/*f		portion of the Ack to a DATA packet.  If the	*/
/*f		remote understands 'single file aborts', it will	*/
/*f		respond with a "D" in the data field of an EOF	*/
/*f		packet.					*/
/*f		Kermits that do not understand a single file	*/
/*f		abort will continue sending Data packets.  If this */
/*f		occurs, the local kermit must abort the whole	*/
/*f		transaction.				*/
/*f		If abort_sent = True then an abortive Ack packet	*/
/*f		has already been sent.  Receiving a data packet	*/
/*f		then means that the remote does not understand.	*/
/*f		If abort_sent = False then we have yet to send	*/
/*f		out the abortive Ack.  As soon as we get a Data	*/
/*f		packet, send out the abortive Ack, and return to	*/
/*f		this state.				*/
/*o 	Output:	abort_sent, state				*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     abort_sent		 bit (1);
	dcl     discard_sw		 bit (1);
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     abort_char		 char (1);
	dcl     abort_charp		 ptr;
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     r_packet_size	 fixed bin (21);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;


/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:4) label init (Other, File_header, Data, Eof, Error);

/*  constants  */

	dcl     Discard_char	 char (1) internal static options (constant) init ("X");
	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Packet_string	 char (4) internal static options (constant) init ("FDZE");
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

	ec = 0;
	abort_char = Discard_char;
	abort_charp = addr (abort_char);
	remote_datap = addr (remote_data);

	kti.retry_count = kti.retry_count + 1;

/*  Should we give up??  */
	if kti.retry_count > kti.retry_threshold then do;
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);
		kermit_stats.status = kermit_et_$too_many_retries;
		state = Rec_abort;
		return;
	     end;

/*  Get the remote's packet */
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
	     r_packet_size, eol_split, ec);

	if ec ^= 0 then goto Retry_packet;

/*  Respond to remote's packet  */
	idx = index (Packet_string, packet_type);
	goto packet (idx);



Data:						/*  Received remote DATA packet  */
	if kti.sequence_n ^= packet_n then do;		/*  Remote lost a previous ack?  */
						/*  yes  */
		if mod (packet_n + 1, 64) = kti.sequence_n then do;
			call kermit_pad_$send (infop, Ack_packet, abort_charp, 1, packet_n, chars_sent, packet_size, ec);
			kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
			abort_sent = "1"b;
			return;
		     end;
		else goto Retry_packet;		/*  No  */
	     end;

/*  We are trying to abort a single file */
/*  If we haven't signalled the abort yet, do so now  */
	if ^abort_sent then do;
		call kermit_pad_$send (infop, Ack_packet, abort_charp, 1, kti.sequence_n, chars_sent, packet_size, ec);
		kti.retry_count = 0;
		kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
		abort_sent = True;
		return;
	     end;					/*  We already sent the abort, but remote obviously doesn't understand, so
						   kill the transaction  */
	else if abort_sent then do;
		call kermit_pad_$send (infop, Error_packet, null (), 0, kti.sequence_n, 0, 0, ec);

		state = Rec_abort;
		return;
	     end;

File_header:					/*  Received FILE-HEADER packet  */
						/*  Remote may have lost our previous ACK  */
	call check_lost_packet (infop, ktip, packet_n);
	return;


Eof:						/*  Received EOF packet  */
	if kti.sequence_n ^= packet_n then goto Retry_packet;


/*  Well, we got an eof.  Doesn't matter whether the remote
	   understood the file abort or not, because it's finished sending.  */
	call kermit_pad_$send (infop, Ack_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	abort_sent = False;
	kermit_stats.end_time = clock_ ();
	call update_log (infop, ktip, discard_sw);
	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Rec_file_header;
	return;



Error:						/*  Received ERROR packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Rec_abort;
	return;

Other:						/*  Received unexpected packet  */
Retry_packet:
	call kermit_pad_$send (infop, Nak_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;

     end receive_file_abort;

update_log:
     proc (infop, ktip, discard_sw);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$update_log		internal	*/
/*i 	Input:	infop, ktip, discard_sw			*/
/*f	Function:	Calls the log_mgr_ to updates the log-file and	*/
/*f		statistics database.  Re-initializes all file 	*/
/*f		associated variables.			*/
/*o	Output:	none					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     discard_sw		 bit (1);
	dcl     infop		 ptr;
	dcl     ktip		 ptr;

/*  automatic  */

	dcl     abnormal_termination	 bit (1);

/*  based  */

	dcl     01 path		 aligned based (kti.filenamesp),
		02 dir_name	 char (168) unal,
		02 entry_name	 char (32) unal;
	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);


	kermit_stats.file_len = kermit_stats.char_count;
	kermit_stats.filename = pathname_ (rtrim (path.dir_name), rtrim (path.entry_name));
	call kermit_log_mgr_$log_message (infop, kti.statisticsp);

	if kermit_stats.status = 0 then kti.file_count = kti.file_count + 1;
	abnormal_termination = (kermit_stats.status ^= 0);
	call terminate_file (ktip, discard_sw, abnormal_termination);

	kti.buffp = null ();

	path.dir_name, path.entry_name = " ";

	call init_file_stats (ktip);

	return;
     end update_log;

find_file:
     proc (filename, file_warning_sw, source_dir, source_ename, file_ptr, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$find_file		internal	*/
/*i 	Input:	filename, file_warning_sw			*/
/*f 	Function: Gets a pointer to the file to be received, 	*/
/*f	renaming if necessary.				*/
/*o 	Output:	source_dir, source_ename, file_ptr, ec		*/
/*l       Modified: 89-01-02 by S Huen - Handle links to multisegment */
/*l                 files correctly. (pc_24)                          */
/*							*/
/**********************************************************************/

/*  parameters   */
	dcl     ec		 fixed bin (35);
	dcl     file_ptr		 ptr;
	dcl     file_warning_sw	 bit (1);
	dcl     filename		 char (*);
	dcl     source_dir		 char (168);
	dcl     source_ename	 char (32);

/*  automatic  */

	dcl     abs_max_suffix	 fixed bin;
	dcl     bit_count		 fixed bin (24);
	dcl     file_suffix		 fixed bin;
	dcl     max_suffix_lth	 fixed bin;
	dcl     max_suffix		 fixed bin;
	dcl     name_dup		 bit (1);
	dcl     suffixed_filename	 char (32);

/*  Constants  */

	dcl     Max_entry_lth	 fixed bin internal static options (constant) init (32);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

	ec = 0;
	source_dir = " ";
	source_ename = " ";
	file_ptr = null ();
	name_dup = True;

	call expand_pathname_ (filename, source_dir, source_ename, ec);
	if ec ^= 0 then return;

	suffixed_filename = source_ename;

/*  Calculate the maximum suffix, where suffix = "1" to "9..."  */

	abs_max_suffix = 2 ** 17;
	max_suffix_lth = (Max_entry_lth - length (rtrim (suffixed_filename))) - 1;
						/*  allow for '.' */
	max_suffix = min (10 ** max_suffix_lth - 1, abs_max_suffix);

	do file_suffix = 1 to max_suffix while (name_dup);

	     call hcs_$status_minf (rtrim (source_dir), rtrim (suffixed_filename), (1), (0), bit_count, ec);
	     if ec = 0 
		then do;		/*  The file is already there, so either...  */
		     if ^file_warning_sw then /*  delete it (file warning is off)  */
			call delete_$path (
			rtrim (source_dir), rtrim (suffixed_filename),
			"000111"b, "kermit", ec);
		     else do;			/*  find a new name for the segment  */
			call suffixed_name_$make (source_ename, ltrim (char (file_suffix)), suffixed_filename, ec);
			     if ec ^= 0 then do;
				     ec = kermit_et_$no_rename;
				     return;
				end;
			end;
		end;
	     else name_dup = False;			/*  Successfully created new file  */


	end;					/* while  */

	if name_dup then do;
		ec = kermit_et_$no_rename;
		return;
	     end;


/*  If we get this far we have a file for receiving  */

	source_ename = suffixed_filename;
	call iox_$attach_name ("kermit." || unique_chars_ (False),
	     file_ptr, "vfile_ " || pathname_ (source_dir, source_ename),
	     null(), ec);
	call iox_$open (file_ptr, Stream_output, "0"b, ec);
	
	return;
     end find_file;

terminate_file:
     proc (ktip, discard_sw, abnormal_termination);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$terminate_file		internal	*/
/*i 	Input:	ktip, discard_sw, abnormal_termination		*/
/*f 	Function: Terminates a file, deleting if discard_sw is true	*/
/*f		and the file could not be received normally.	*/
/*o 	Output:	none                          		*/
/*							*/
/**********************************************************************/

/* parameters */

	dcl     abnormal_termination	 bit (1);
	dcl     discard_sw		 bit (1);
	dcl     ktip		 ptr;

	dcl     01 kti		 like kermit_transfer_info based (ktip);
						/* automatic */

	if kti.iocb_ptr ^= null () then do;
	     call iox_$close (kti.iocb_ptr, ec);
	     call iox_$detach_iocb (kti.iocb_ptr, ec);
	     if discard_sw & abnormal_termination then
		call delete_$path (
	kti.filenamesp -> kermit_filenames(kti.filenames_idx).directory,
	kti.filenamesp -> kermit_filenames(kti.filenames_idx).entry_name,
		"000111"b, "kermit", ec);
	     kti.iocb_ptr = null ();
	     end;
	return;
     end terminate_file;

check_lost_packet:
     proc (infop, ktip, packet_n);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$check_lost_packet	internal	*/
/*i 	Input:	infop, ktip, packet_n                             */
/*f 	Function: If we have a previous packet (previous ack was    */
/*f                 lost), retransmits the lost ack.  Otherwise naks  */
/*f                 the packet.                                       */
/*o 	Output:	none                                              */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     packet_n		 fixed bin;
/* static  */

          dcl     last_lost_packet	 fixed bin static internal init (-1);
/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

          
	if mod (packet_n + 1, 64) = kti.sequence_n then do;
	     if mod (last_lost_packet + 1, 64) ^= packet_n then
		call kermit_pad_$send (infop, Ack_packet, null (), 0, packet_n, 0, 0, ec);
	     last_lost_packet = packet_n;
	     end;		         /*  No  */
	else do;
	     call kermit_pad_$send (infop, Nak_packet, null (), 0, kti.sequence_n, 0, 0, ec);
	     last_lost_packet = -1;
	     end;
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end check_lost_packet;

store_data: proc (ktip, eol_split, data, data_lth, packet_size, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$store_data      	internal	*/
/*i 	Input:	ktip, eol_split, data, data_lth, packet_size      */
/*f 	Function: Writes the data to the file.                      */
/*o 	Output:	ec                                                */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     data		 char (*);
	dcl     data_lth		 fixed bin (21);
	dcl     eol_split		 bit (1);
	dcl     ec		 fixed bin (35);
	dcl     ktip		 ptr;
	dcl     packet_size		 fixed bin (21);


/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

	ec = 0;

/*  Account for CR-LF being split across two packets  */
	if eol_split & kti.owe_a_cr then
	     kti.owe_a_cr = False;

/*  All okay, so write it out  */

	if kti.owe_a_cr
	     then do;
	     call iox_$put_chars (kti.iocb_ptr, addr (CR), 1, ec);
	     kermit_stats.char_count = kermit_stats.char_count + 1;
	     kti.owe_a_cr = False;
	     end;

	if substr (data, data_lth, 1) = CR
	     then do;
	     kti.owe_a_cr = True;
	     data_lth = data_lth - 1;
	     end;
	call iox_$put_chars (kti.iocb_ptr, addr (data), data_lth, ec);
	kermit_stats.char_count = kermit_stats.char_count + data_lth;
	kermit_stats.packet_count = kermit_stats.packet_count + 1;
	kermit_stats.packet_chars = kermit_stats.packet_chars + packet_size;
	return;
     end store_data;

init_file_stats:
     proc (ktip);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$init_file_stats      	internal	*/
/*i 	Input:	ktip                                              */
/*f 	Function: Initializes file statistics.                      */
/*o 	Output:	none                                              */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     ktip		 ptr;

/*  based  */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);



	kermit_stats.filename = " ";
	kermit_stats.file_len = 0;
	kermit_stats.char_count = 0;
	kermit_stats.packet_chars = 0;
	kermit_stats.packet_count = 0;
	kermit_stats.packet_retries = 0;
	kermit_stats.start_time = 0;
	kermit_stats.end_time = 0;
	kermit_stats.error_message = " ";

	return;
     end init_file_stats;

verify_receipt:
     proc (infop, ktip);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_receive_$verify_receipt      	internal	*/
/*i 	Input:	infop, ktip                                       */
/*f 	Function: This routine tries to ensure that the remote      */
/*f 	          system received the ack to its EOT packet.        */
/*o 	Output:	none                                              */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     ktip		 ptr;
	dcl     infop		 ptr;

/*  automatic  */

	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     packet_timeout	 fixed bin (8) unal;
	dcl     r_packet_size	 fixed bin (21);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     timeout_select	 (1) fixed bin;

/*  based  */

	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  constants  */

	dcl     Five_seconds	 fixed bin (8) unal internal static options (constant) init (5);


/*  Make sure the remote got the ack, because if it didn't it will hang  */

/*  Make the timeout interval reasonable for this state  */
	timeout_select (1) = I_timeout;
	packet_timeout = Five_seconds;

	call kermit_mode_mgr_$store (infop, Temporary, timeout_select, addr (packet_timeout), ec);

	packet_type = "";
	remote_datap = addr (remote_data);

	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
	     r_packet_size, eol_split, ec);

	do while (packet_type = Eot_packet);
	     call kermit_pad_$send (infop, Ack_packet, null (), 0, kti.sequence_n, chars_sent, packet_size, ec);
	     packet_type = "";
	     call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received,
		packet_size, eol_split, ec);
	end;
	return;
     end verify_receipt;

     end kermit_receive_;




		    kermit_receive_request_.pl1     07/05/88  1407.3r w 07/05/88  1400.0       55827



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
kermit_receive_request_: proc (kermit_scip, infop);

/**********************************************************************/
/*							*/
/*n	Name:	kermit_receive_request_		external	*/
/*i 	Input:	kermit_scip, infop				*/
/*f 	Function: Extracts the filename from the		*/
/*f		request line. Sets up the communications 	*/
/*f		environment for file transfer. 		*/
/*f 		Calls receive_from_remote_ to receive the files.	*/
/*o 	Output:	none					*/
/*							*/
/*l	Written:	84-10-27	by Maureen Mallmes			*/
/*l	Modified:	85-01-17	by Maureen Mallmes to detect invalid	*/
/*l			control arguments.  See problem number	*/
/*l			3 in the kermit error list.		*/
/*l	     		Modified to disallow starnames and	*/
/*l			archive components for the local file.	*/
/*							*/
/**********************************************************************/



/*  automatic  */

	dcl     arg_idx		 fixed binary;
	dcl     arg_lth		 fixed binary (21);
	dcl     arg_ptr		 ptr;
	dcl     argument		 character (arg_lth) based (arg_ptr);
	dcl     argument_count	 fixed bin;
	dcl     01 cl_info_struc	 aligned,
		02 resetread	 bit (1) unal,
		02 mbz		 bit (35) unal;
	dcl     code		 fixed bin (35);
	dcl     dname		 char (168);
	dcl     ename		 char (32);
	dcl     file_sw		 bit (1);
	dcl     first_filename	 char (168);
	dcl     files_received	 fixed bin;
	dcl     infop		 ptr;
	dcl     initial_seq_n	 fixed bin;
	dcl     initial_state	 fixed bin;
	dcl     kermit_scip		 ptr;
	dcl     transfer_modes_set	 bit (1);

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Rec_init		 fixed bin internal static options (constant) init (0);
	dcl     Five_seconds	 fixed bin (71) internal static options (constant) init (5);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

/*  external  */

	dcl     error_table_$badopt	 fixed bin (35) ext static;
	dcl     error_table_$nostars	 fixed bin (35) ext static;
	dcl     error_table_$pathlong	 fixed bin (35) ext static;
	dcl     error_table_$too_many_args fixed bin (35) ext static;

/*  builtin  */

	dcl     index		 builtin;

/*  procedures  */

	dcl     check_star_name_$entry entry (char (*), fixed bin (35));
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     cu_$cl		 entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal);
	dcl     expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	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_$get_request_name	 entry (ptr) returns (char (32));
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));

/*  Conditions  */

	dcl     cleanup		 condition;
	dcl     quit		 condition;

/*  Include files  */

%include kermit_dcls;

%include kermit_info;


/*  initialize receive_request_data  */
	code = 0;
	first_filename = " ";
	file_sw = False;
	transfer_modes_set = False;
	cl_info_struc.resetread = True;
	cl_info_struc.mbz = False;
	initial_state = Rec_init;
	initial_seq_n = 0;


/*  Handlers  */
	on quit begin;
		if transfer_modes_set then do;
						/*  Reset the modes for user input and output  */
			call kermit_comm_mgr_$reset_line_modes (infop, code);
			transfer_modes_set = False;
						/*  Pass control  */
			call cu_$cl (cl_info_struc);
						/*  Back (restart) so set the modes for file transfer  */
			call kermit_comm_mgr_$set_line_modes (infop, code);
			transfer_modes_set = True;
		     end;
		else call continue_to_signal_ (0);	/* do nothing  */
	     end;


	on cleanup call receive_request_cleanup;

	call ssu_$arg_count (kermit_scip, argument_count);

/*  get the first and only user-supplied filename, if given  */
	do arg_idx = 1 to argument_count;
	     call ssu_$arg_ptr (kermit_scip, arg_idx, arg_ptr, arg_lth);

	     if index (argument, "-") ^= 1 then do;
		     if ^file_sw then do;
			     call expand_pathname_ (argument, dname, ename, code);
			     if code = 0 then do;
				     call check_star_name_$entry (ename, code);
				     if code ^= 0 & code < 3 then code = error_table_$nostars;
				end;

			     if code ^= 0 then call ssu_$abort_line (kermit_scip, code, "^a", argument);

			     first_filename = argument;
			     file_sw = True;
			end;

		     else call ssu_$abort_line (kermit_scip, error_table_$too_many_args, "^/Usage: ^a {path}", ssu_$get_request_name (kermit_scip));
		end;

	     else call ssu_$abort_line (kermit_scip, error_table_$badopt, "^a", argument);
	end;

/*  ...greet the user  */
	call ioa_ ("^/Receiving...");


/*  Get ready to receive the segment(s)  */
/*  Give the user some time get back to remote  */
	call timer_manager_$sleep (Five_seconds, "11"b);

/*  Initialize the temporary modes data base  */
	call kermit_xfer_modes_$init (infop, code);
						/*  this should never happen  */
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code);

/*  Set the tty_ modes  */
	call kermit_comm_mgr_$set_line_modes (infop, code);
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code, "^/^a", "Unable to set line modes for file transfer");
	transfer_modes_set = True;

	call kermit_receive_$receive_from_remote (infop, initial_state, initial_seq_n, first_filename, file_sw, files_received, code);

	call kermit_comm_mgr_$reset_line_modes (infop, (0));
	transfer_modes_set = False;

	if code ^= 0 then
	     call ssu_$abort_line (kermit_scip, code, "^/^d files received.", files_received);


	call ioa_ ("^/Transaction completed: ^d file(s) received.", files_received);
	return;


/*  Reset the line modes and free filenames storage */
receive_request_cleanup:
     proc;

	if transfer_modes_set then call kermit_comm_mgr_$reset_line_modes (infop, code);
	transfer_modes_set = False;
	return;
     end receive_request_cleanup;

     end kermit_receive_request_;




		    kermit_remote_requests_.pl1     03/01/89  1437.6rew 03/01/89  1433.5      150705



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(87-11-24,Huen), approve(87-11-24,MCR7803), audit(87-12-07,RWaters),
     install(88-09-16,MR12.2-1113):
     Fix kermit error 12.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8027), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bugs: PC_File_Transfer 18, 20, and 23.
                                                   END HISTORY COMMENTS */


kermit_remote_requests_: proc;

/********************************************************************/
/*							*/
/*n	Name:	kermit_remote_requests_			*/
/*							*/
/*d	This module contains the kermit requests that are used to	*/
/*d	request operations from a remote kermit server.		*/
/*							*/
/*l	Written:	84-11-11	by Dean Elhard			*/
/*l	Modified:	84-01-21	by Maureen Mallmes			*/
/*l	     		Added a quit handler, handle_quit.  See	*/
/*l	     		error #5 in the Kermit error list.	*/
/*l	     		Added a cleanup handler, cleanup_modes	*/
/*l	Modified: 86-10-14  by Don Kozlowski - Use rtrim to remove	*/
/*l			trailing blanks of remote_filename      */
/*l			(kermit12)			*/
/*							*/
/**********************************************************************/

/* constants */

	dcl     true		 bit (1) static options (constant) init ("1"b);
	dcl     false		 bit (1) static options (constant) init ("0"b);

	dcl     Ack_reqd		 bit (1) static options (constant) init ("1"b);
	dcl     No_ack		 bit (1) static options (constant) init ("0"b);

	dcl     Ack_packet_type	 char (1) static options (constant) init ("Y");
	dcl     Nak_packet_type	 char (1) static options (constant) init ("N");
	dcl     Error_packet_type	 char (1) static options (constant) init ("E");
	dcl     Generic_packet_type	 char (1) static options (constant) init ("G");
	dcl     Receive_init_packet_type
				 char (1) static options (constant) init ("R");

	dcl     Logout_command	 char (1) static options (constant) init ("L");
	dcl     Finish_command	 char (1) static options (constant) init ("F");

/* parameters */

	dcl     A_sci_ptr		 ptr parameter;
	dcl     A_infop		 ptr parameter;

/* procedures */

	dcl     check_star_name_$entry entry (char (*), fixed bin (35));
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     cu_$cl		 entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal);
	dcl     expand_pathname_	 entry (char (*), char (*), char (*),
				 fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     pathname_		 entry (char (*), char (*)) returns (char (168));
	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_$get_request_name	 entry (ptr) returns (char (32));

/* external */

	dcl     error_table_$action_not_performed
				 external fixed bin (35);
	dcl     error_table_$badopt
				 external fixed bin (35);
	dcl     error_table_$nostars
				 external fixed bin (35);
	dcl     error_table_$too_many_args
				 external fixed bin (35);

/* based */

	dcl     arg		 char (argl) based (argp);

/* automatic */

	dcl     arg_idx		 fixed bin;
	dcl     argl		 fixed bin (21);
	dcl     argp		 ptr;
	dcl     dname		 char (168);
	dcl     ec		 fixed bin (35);
	dcl     ename		 char (32);
	dcl     file_count		 fixed bin;
	dcl     file_sw		 bit (1);
	dcl     first_filename	 char (168);
	dcl     initial_state	 fixed bin;
	dcl     nargs		 fixed bin;
	dcl     reason		 char (94);
	dcl     remote_file_sw	 bit (1);
	dcl     remote_filename	 char (94);
	dcl     transfer_modes_set	 bit (1);
	dcl     sequence_no		 fixed bin;

/* conditions */

	dcl     cleanup		 condition;
	dcl     quit		 condition;

/* builtin */

	dcl     addr		  builtin;
	dcl     index		  builtin;
	dcl     length		  builtin;
	dcl     rtrim		  builtin;

/* include files */

%include kermit_dcls;

%include kermit_info;

%include kermit_transfer_info;

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


get: entry (A_sci_ptr,				/* subsystem control info ptr		*/
	A_infop);					/* subsystem info ptr		*/

/********************************************************************/
/*							*/
/*n	Name:	kermit_remote_requests_$get		external	*/
/*i	Input:	sci_ptr, info_ptr				*/
/*f	Function:	implements the kermit get remote request.  The	*/
/*f		get request sends a Receive-init packet to the	*/
/*f		remote server indicating the file that the server	*/
/*f		is to send and then call kermit_receive_ to	*/
/*f		receive the file.				*/
/*o	Output:	none					*/
/*							*/
/*l	Written:	84-11-12	by Dean Elhard			*/
/*l	Modified:	85-01-18	by Maureen Mallmes to detect invalid	*/
/*l			control arguments.  See problem number	*/
/*l			3 in the kermit error list.		*/
/*l	     		Modified to disallow starnames and	*/
/*l			archive components for the local file.	*/
/*l			Added quit and cleanup handlers to	*/
/*l			reset tty_ modes.			*/
/*l       Modified: 89-01-02  by S. Huen - The inital state of "get"  */
/*l	                    should start with "Rec_init" instead of */
/*l	                    "Rec_File". (pc_20)                     */
/*							*/
/********************************************************************/

	file_sw = false;
	remote_file_sw = false;
	transfer_modes_set = false;
	remote_filename = "";
	first_filename = "";

/*  Set up quit and cleanup handlers  */

	on quit call handle_quit (A_infop, transfer_modes_set);
	on cleanup call cleanup_modes (A_infop, transfer_modes_set);

	call ssu_$arg_count (A_sci_ptr, nargs);

/* print a usage line if no args were specified			*/

	if nargs = 0
	then call ssu_$abort_line (A_sci_ptr, 0, "Usage: ^a remote_source_path {local_destination_path}", ssu_$get_request_name (A_sci_ptr));

/*  get the arguments  */
	do arg_idx = 1 to nargs;
	     call ssu_$arg_ptr (A_sci_ptr, arg_idx, argp, argl);

	     if index (arg, "-") ^= 1 then do;
						/* get the remote system filename/pathname/filespec/whatever	*/
		     if ^remote_file_sw then do;
			     remote_filename = arg;
			     remote_file_sw = true;
			end;

		     else if ^file_sw then do;
			     call expand_pathname_ (arg, dname, ename, ec);
			     if ec = 0 then do;
				     call check_star_name_$entry (ename, ec);
				     if ec ^= 0 & ec < 3 then ec = error_table_$nostars;
				end;

			     if ec ^= 0
			     then call ssu_$abort_line (A_sci_ptr, ec, "^a", arg);
			     first_filename = pathname_ (dname, ename);
			     file_sw = true;
			end;

		     else call ssu_$abort_line (A_sci_ptr, error_table_$too_many_args, "^/Usage: ^a remote_source_path {local_destination_path}", ssu_$get_request_name (A_sci_ptr));
		end;

	     else call ssu_$abort_line (A_sci_ptr, error_table_$badopt, "^a", arg);
	end;


/* inform the user what is going on				*/

	call ioa_ ("^/Receiving. . .");

/* send the receive-init packet				*/

	call send_packet (A_infop, Receive_init_packet_type, rtrim(remote_filename),
	     No_ack, reason, ec);
/* Fix bug 20 - the initial state should start with Rec_init instead of Rec_File */
	initial_state = Rec_init;
	sequence_no = 0;

/* perform a receive if the packet got there and was acknowledged	*/

	if ec = 0
	then do;
		call kermit_xfer_modes_$init (A_infop, (0));
		call kermit_comm_mgr_$set_line_modes (A_infop, (0));
		transfer_modes_set = true;
		call kermit_receive_$receive_from_remote (A_infop, initial_state,
		     sequence_no, first_filename, file_sw, file_count, ec);
		call kermit_comm_mgr_$reset_line_modes (A_infop, (0));
		transfer_modes_set = false;
		if ec = 0
		then call ioa_ ("^/Successfully received ^d file(s).", file_count);
	     end;

/* reset the line modes					*/

	call kermit_comm_mgr_$reset_line_modes (A_infop, 0);
	transfer_modes_set = false;

	if ec ^= 0
	then call ssu_$abort_line (A_sci_ptr, ec, arg);

	return;

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


finish: entry (A_sci_ptr,				/* subsystem control info ptr		*/
	A_infop);					/* subsystem info ptr		*/

/********************************************************************/
/*							*/
/*n	Name:	kermit_remote_requests_$finish	external	*/
/*i	Input:	sci_ptr, info_ptr				*/
/*f	Function:	This routine implements the kermit finish remote	*/
/*f		request.  The finish remote request sends the	*/
/*f		remote server a generic command packet which will	*/
/*f		cause the server to terminate server operation	*/
/*f		and return to the kermit request loop.		*/
/*o	Output:	none					*/
/*							*/
/*l	Written:	84-11-12	by Dean Elhard			*/
/*							*/
/********************************************************************/

/* send the generic-finish packet to the remote server		*/

	call send_packet (A_infop, Generic_packet_type, Finish_command,
	     Ack_reqd, reason, ec);
	if ec ^= 0
	then call ssu_$abort_line (A_sci_ptr, ec, reason);

	return;

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


logout: entry (A_sci_ptr,				/* subsystem control info ptr		*/
	A_infop);					/* subsystem info ptr		*/

/********************************************************************/
/*							*/
/*n	Name:	kermit_remote_requests_$logout	external	*/
/*i	Input:	sci_ptr, info_ptr				*/
/*f	Function:	This routine implements the kermit logout remote	*/
/*f		request.  The logout remote request sends the	*/
/*f		remote server a generic command packet which will	*/
/*f		cause the server to terminate server operation	*/
/*f		and log the user out from the remote system.	*/
/*o	Output:	none					*/
/*							*/
/*l	Written:	84-11-12	by Dean Elhard			*/
/*							*/
/********************************************************************/

/* send the generic-logout command packet			*/

	call send_packet (A_infop, Generic_packet_type, Logout_command,
	     Ack_reqd, reason, ec);
	if ec ^= 0
	then call ssu_$abort_line (A_sci_ptr, ec, reason);

	return;

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


send_packet: proc (infop,				/* subsystem info ptr		*/
	type,					/* type of packet to send		*/
	data,					/* data to send in packet		*/
	ack,					/* acknowledge required switch	*/
	reason,					/* error message returned from remote	*/
	ec);					/* error code			*/

/********************************************************************/
/*							*/
/*n	Name:	send_packet			internal	*/
/*i	Input:	info_ptr, type, data, ack_sw			*/
/*f	Function:	sends a packet to the remote server and waits for	*/
/*f		a reply if necessary.  If the packet is Nak'ed,	*/
/*f		the packet will be retransmitted.  If an error	*/
/*f		packet is returned send-packet will return with	*/
/*f		a nonzero error code and the error message in the	*/
/*f		reason field.  The returned code will only be	*/
/*f		zero if the packet was Ack'ed or no Ack was	*/
/*f		required					*/
/*o	Output:	reason, error_code				*/
/*							*/
/*l	Written:	84-11-12	by Dean Elhard			*/
/*l	Modified:	85-01-18	by Maureen Mallmes 			*/
/*l			Added quit and cleanup handlers to	*/
/*l			reset tty_ modes.			*/
/*							*/
/********************************************************************/

/* parameters */

	dcl     infop		 ptr;
	dcl     type		 char (1);
	dcl     data		 char (*);
	dcl     ack		 bit (1);
	dcl     reason		 char (*);
	dcl     ec		 fixed bin (35);

/* based */

	dcl     message		 char (rcvd) based (addr (buffer));

/* automatic */

	dcl     buffer		 char (3000);
	dcl     rcvd		 fixed bin (21);
	dcl     remote_type		 char (1);
	dcl     retry_count		 fixed bin;
	dcl     transfer_modes_set	 bit (1);
	dcl     seq_no		 fixed bin;


	reason = "";
	transfer_modes_set = false;

/*  Set up quit and cleanup handlers  */

	on quit call handle_quit (infop, transfer_modes_set);
	on cleanup call cleanup_modes (infop, transfer_modes_set);

/* set up the temporary modes database			*/

	call kermit_xfer_modes_$init (infop, ec);
	if ec ^= 0
	then return;

/* clear out any pending nacks from the server			*/

	call kermit_comm_mgr_$flush_input (infop, ec);

/* set up the modes on the transfer channel			*/

	call kermit_comm_mgr_$set_line_modes (infop, ec);
	if ec ^= 0
	then do;
		reason = "^/Unable to set line modes for command.";
		return;
	     end;

	transfer_modes_set = true;
						/* handle sending packets that require no ack			*/

	if ^ack
	then do;
		call kermit_pad_$send (infop, type, addr (data),
		     length (data), 0, (0), (0), ec);
		if ec ^= 0
		then do;
			call kermit_comm_mgr_$reset_line_modes (infop, (0));
			transfer_modes_set = false;
			reason = "^/Unable to send command.";
		     end;
		return;
	     end;

	remote_type = Nak_packet_type;
	retry_count = 0;

/* send the packet until we get a non-ack/non-timeout		*/

	do while (((ec ^= 0) | (seq_no ^= 0) |
	     (remote_type = Nak_packet_type)) & (retry_count < 5));
	     retry_count = retry_count + 1;
	     call kermit_pad_$send (infop, type, addr (data),
		length (data), 0, (0), (0), ec);
	     if ec ^= 0
	     then do;
		     call kermit_comm_mgr_$reset_line_modes (infop, (0));
		     transfer_modes_set = false;
		     reason = "^/Unable to send command.";
		     return;
		end;

	     call kermit_pad_$receive (infop, remote_type, addr (buffer),
		length (buffer), seq_no, rcvd, (0), (""b), ec);
	end;

/* put the line_modes back					*/

	call kermit_comm_mgr_$reset_line_modes (infop, ec);
	transfer_modes_set = false;

/* if we received an error packet back, set the code and reason	*/

	if remote_type = Error_packet_type
	then do;
		reason = message;
		ec = error_table_$action_not_performed;
	     end;
	else if remote_type ^= Ack_packet_type
	then do;
		reason = "Unknown response from host.";
		ec = error_table_$action_not_performed;
	     end;
	else ec = 0;

     end send_packet;

handle_quit:
     proc (infop,					/* subsystem info ptr		*/
	transfer_modes_sw);				/* = "1"b if transfer modes set	*/

/********************************************************************/
/*							*/
/*n	Name:	handle_quit			internal	*/
/*i	Input:	infop, transfer_modes_sw			*/
/*f	Function:	Resets the line modes for standard user i/o, if	*/
/*f		the line modes have been changed for 'remote 	*/
/*f		communication'.  If restarted 'remote	 	*/
/*f		communication' modes are reestablished before	*/
/*f		returning.				*/
/*o	Output:	none					*/
/*							*/
/*l	Written:	85-01-21	by Maureen Mallmes			*/
/*							*/
/********************************************************************/


/*  parameters  */

	dcl     infop		 ptr;
	dcl     transfer_modes_sw	 bit (1);

/*  automatic  */

	dcl     01 cl_info_struc	 aligned,
		02 resetread	 bit (1) unal,
		02 mbz		 bit (35) unal;


	cl_info_struc.resetread = true;
	cl_info_struc.mbz = false;

	if transfer_modes_sw then do;
						/*  Reset the modes for user input and output  */
		call kermit_comm_mgr_$reset_line_modes (infop, (0));
		transfer_modes_sw = false;
						/*  Pass control  */
		call cu_$cl (cl_info_struc);
						/*  Back (restart) so set the modes for file transfer  */
		call kermit_comm_mgr_$set_line_modes (infop, (0));
		transfer_modes_sw = true;
	     end;
	else call continue_to_signal_ (0);		/* do nothing  */

	return;
     end handle_quit;


cleanup_modes:
     proc (infop,					/* subsystem info ptr		*/
	transfer_modes_sw);				/* = "1"b if transfer modes set	*/

/********************************************************************/
/*							*/
/*n	Name:	cleanup_modes			internal	*/
/*i	Input:	infop, transfer_modes_sw			*/
/*f	Function:	Resets the line modes for standard user i/o, if	*/
/*f		the line modes have been changed for 'remote 	*/
/*f		communication'.                	 	*/
/*o	Output:	none					*/
/*							*/
/*l	Written:	85-01-21	by Maureen Mallmes			*/
/*							*/
/********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     transfer_modes_sw	 bit (1);


	if transfer_modes_sw then call kermit_comm_mgr_$reset_line_modes (infop, (0));
	transfer_modes_sw = false;
	return;

     end cleanup_modes;

     end kermit_remote_requests_;




		    kermit_requests_.alm            11/05/86  1232.6r w 11/04/86  1038.4       17874



" ******************************************
" *                                        *
" * Copyright, (C) Honeywell Limited, 1984 *
" *                                        *
" ******************************************
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
"							"
"	kermit_requests_					"
"	This is the request table for the kermit ssu_ environment	"
"							"
"	Written: 	84-10-14	by Dean Elhard			"
"							"
"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

	name	kermit_requests_

	include	ssu_request_macros

	begin_table	requests

	request	finish,kermit_remote_requests_$finish,(),
		(request that the remote server exit server mode.),
		flags.allow_command
	request	get,kermit_remote_requests_$get,(),
		(request that the remote server send the named file(s).),
		flags.allow_command
	request	log,kermit_log_mgr_$start_log,(),
		(open the named log file and begin logging.),
		flags.allow_command
	request	logout,kermit_remote_requests_$logout,(),
		(request that the remote server log out.),
		flags.allow_command
	request	quit_log,kermit_log_mgr_$end_log,(),
		(stop logging file transfers and close the log file.),
		flags.allow_command
	request	receive,
		kermit_receive_request_$kermit_receive_request_,(r),
		(receive a file or file group from the remote system.),
		flags.allow_command
	request	send,kermit_send_request_$kermit_send_request_,(s),
		(send the specified file(s) to the remote system.),
		flags.allow_command
	request	set,kermit_mode_mgr_$set,(),
		(set the specified kermit mode.),
		flags.allow_command
	request	server,kermit_server_request_$kermit_server_request_,(),
		(enter server mode.),
		flags.allow_command
	request	show,kermit_mode_mgr_$get,(),
		(display the specified kermit mode(s).),
		flags.allow_command
	request	statistics,kermit_log_mgr_$display_statistics,(st),
		(display the statistics for the last file transfer.),
		flags.allow_command
	
	end_table		requests

	end

	




		    kermit_send_.pl1                10/14/90  0933.2rew 10/14/90  0915.0      271359



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1990   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8036), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bug: PC_File_Transfer 24 - kermit is being changed to correctly
     handle links to multisegment files.
  3) change(90-09-20,Huen), approve(90-09-20,MCR8203), audit(90-09-25,Gray),
     install(90-10-14,MR12.4-1039):
     phx21339 (pc_25): kermit is changed to ignore redundant ACKs.
                                                   END HISTORY COMMENTS */


kermit_send_: proc;

/**********************************************************************/
/*							*/
/*n	kermit_send_					*/
/*							*/
/*d	This routine is responsible for sending files to a	*/
/*d	remote kermit.					*/
/*							*/
/*l	Written:	84-10-23	by Maureen Mallmes			*/
/*l	Modified:	84-11-05	by Dean Elhard to add archive support	*/
/*l	Modified:	87-07-22	by Don Kozlowski - Support msf file	*/
/*l		(kermit 17)                			*/
/*							*/
/**********************************************************************/

/*  Not an entry  */
	return;



/* parameters  */

	dcl     ec		 fixed bin (35);
	dcl     file_sw		 bit (1);
	dcl     filenames_areap	 ptr;
	dcl     files_sent		 fixed bin;
	dcl     first_filename	 char (*);
	dcl     infop		 ptr;

/*  automatic  */

	dcl     ktip		 ptr;
	dcl     retry_max		 fixed bin (8) unal;
	dcl     retry_select	 (1) fixed bin;
	dcl     state		 fixed bin;

/*  based */

	dcl     01 filenames	 like kermit_filenames based (filenames_areap);
	dcl     01 kermit_stats	 aligned like kermit_stats_info;
	dcl     01 kti		 like kermit_transfer_info;

/*  labels  */

	dcl     send_state		 (0:6) label init (Send_Init, Send_File, Send_Data, Send_Eof, Send_Break, Send_Abort, Send_Complete);

/*  constants  */

	dcl     Byte_length		 fixed bin internal static options (constant) init (9);
	dcl     Max_packet_size	 fixed bin (21) internal static options (constant) init (94);
	dcl     Max_remote_packet_size fixed bin (21) internal static options (constant) init (3000);
	dcl     Mod_64		 fixed bin internal static options (constant) init (64);
	dcl     Whoami		 char (4) internal static options (constant) init ("send");

/*  builtin  */

	dcl     (addr, char, index, length, ltrim) 	builtin;
	dcl     (mod, rtrim, substr, null) 		builtin;

/*  conditions */

	dcl     cleanup		 condition;


/* constants */
	
	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

/*  external  */

	dcl     error_table_$empty_file fixed bin (35) ext static;
	dcl     error_table_$dirseg fixed bin(35) ext static;
	dcl     kermit_et_$fatal_error fixed bin (35) ext static;
	dcl     kermit_et_$no_initialization fixed bin (35) ext static;
	dcl     kermit_et_$remote_file_abort fixed bin (35) ext static;
	dcl     kermit_et_$remote_group_abort fixed bin (35) ext static;
	dcl     kermit_et_$too_many_retries fixed bin (35) ext static;

/*  procedures  */

	dcl     add_char_offset_	 entry (ptr, fixed bin (21)) returns (ptr) reducible;
	dcl     clock_		 entry () returns (fixed bin (71));
	dcl     hcs_$status_minf       entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
	dcl     iox_$close	 	 entry (ptr, fixed bin (35));
	dcl     iox_$detach_iocb       entry (ptr, fixed bin (35));
	dcl     pathname_$component	 entry (char (*), char (*), char (*)) returns (char (194));
	dcl     pathname_		 entry (char(*), char(*)) returns(char(168));
	dcl     terminate_file_	 entry (ptr, fixed bin (24), bit (*), fixed bin (35));
	

/* include files  */
%include access_mode_values;

%include kermit_dcls;

%include kermit_info;

%include kermit_mode_info;

%include kermit_transfer_info;

%include iox_modes;

%include terminate_file;

send_to_remote:
     entry (infop, filenames_areap, first_filename, file_sw, files_sent, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_to_remote		external	*/
/*i	Input:	infop, filenames_areap, first_filename, file_sw	*/
/*f 	Function: Sends the file or files specified to the	*/
/*f		microcomputer.				*/
/*f		Provides a state-switching mechanism and data 	*/
/*f		interface via calls to send_init, send_filename,	*/
/*f		send_data, send_eof, send_eot and abort.	*/
/*f		Uses transfer_info to update log.		*/
/*o 	Output:	files_sent, ec				*/
/*							*/
/**********************************************************************/

	retry_select = Retry_threshold;
	call kermit_mode_mgr_$retrieve (infop, Permanent, retry_select, addr (retry_max), ec);

	ktip = addr (kti);
	kti.retry_threshold = retry_max;
	kti.retry_count = 0;
	kti.sequence_n = 0;
	kti.filenamesp = filenames_areap;
	kti.filenames_idx = 0;
	kti.filep = null;
	kti.iocb_ptr = null;
	kti.msf = False;
	kti.buffp = null;
	kti.file_count = 0;
	kti.statisticsp = addr (kermit_stats);

	kermit_stats.caller = Whoami;
	kermit_stats.status = 0;
	kermit_stats.filename = "";
	kermit_stats.file_len = 0;
	kermit_stats.char_count = 0;
	kermit_stats.packet_chars = 0;
	kermit_stats.packet_count = 0;
	kermit_stats.packet_retries = 0;
	kermit_stats.start_time = 0;
	kermit_stats.end_time = 0;
	kermit_stats.error_message = "";

	on cleanup begin;
		if kti.filep ^= null then
		     call terminate_file_ (kti.filep, 0, TERM_FILE_TERM, (0));
		kti.filep = null;
		if kti.iocb_ptr ^= null then do;
		     call iox_$close (kti.iocb_ptr, ec);
		     call iox_$detach_iocb (kti.iocb_ptr, ec);
		     kti.iocb_ptr = null;
		     kti.msf = False;
		     end;
	     end;

	state = Send_init;



/*  State switcher  */

	do while ("1"b);

	     goto send_state (state);

Send_Init:
	     call send_init (infop, ktip, state);
	     goto exit_state;

Send_File:
	     call send_filename (infop, ktip, first_filename, file_sw, state);
	     if kermit_stats.status ^= 0 then call update_log (infop, ktip);
	     goto exit_state;
Send_Data:
	     call send_data (infop, ktip, state);
	     goto exit_state;

Send_Eof:
	     call send_eof (infop, ktip, state);
	     if state ^= Send_eof then call update_log (infop, ktip);
	     goto exit_state;

Send_Break:
	     call send_break (infop, ktip, state);
	     goto exit_state;

Send_Abort:
	     call abort_group (infop, ktip);
	     ec = kermit_stats.status;

Send_Complete:
	     files_sent = kti.file_count;
	     return;

exit_state: end;

	return;

send_break: proc (infop, ktip, state);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_break		internal	*/
/*i 	Input:	infop, ktip				*/
/*f	Function:	Transmits an End-of-Transmission (EOT) packet.	*/
/*f		Sets state according to acknowledgement from 	*/
/*f		remote. 	                              	*/
/*o	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;

/*  based */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:3) label init (Other, Nak, Ack, Error);

/*  constants  */

	dcl     Packet_string	 char (3) internal static options (constant) init ("NYE");


	ec = 0;
	packet_type = "";
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		kermit_stats.status = kermit_et_$too_many_retries;
		call kermit_pad_$send (infop, Error_packet, null, (0), kti.sequence_n, (0), (0), ec);
		state = Send_abort;
		return;
	     end;

	call kermit_pad_$send (infop, Eot_packet, null, (0), kti.sequence_n, chars_sent, packet_size, ec);
	if ec ^= 0 then goto Retry_packet;

Ignore_packet:
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received, packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);


Ack:						/*  Received an ACK packet  */
	if mod (packet_n + 1, Mod_64) = kti.sequence_n 
	     then goto Ignore_packet;                     /*  Ignore redundant ACK */
	if kti.sequence_n ^= packet_n then goto Retry_packet;
	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Send_complete;
	return;

Error:						/*  Received an Error packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Send_abort;
	return;

Nak:						/*  Received a Nak packet  */
Other:						/*  Got something other than the above  */
Retry_packet:
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end send_break;


send_data: proc (infop, ktip, state);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_data		internal	*/
/*i 	Input:	infop, ktip				*/
/*f	Function:	Transmits a Data (D) packet, which		*/
/*f		contains file data in the data field.		*/
/*f		Sets state according to acknowledgement from 	*/
/*f		remote. 	                               	*/
/*o	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     bit_count		 fixed bin (24);
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     r_packet_size	 fixed bin (21);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;


/*  based */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:3) label init (Other, Nak, Ack, Error);

/*  constants  */

	dcl     Packet_string	 char (3) internal static options (constant) init ("NYE");

	dcl     initiate_file_$component
				 entry (char (*), char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));


	ec = 0;
	remote_datap = addr (remote_data);

	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		kermit_stats.status = kermit_et_$too_many_retries;
		call kermit_pad_$send (infop, Error_packet, null, (0), kti.sequence_n, (0), (0), ec);
		state = Send_abort;
		return;
	     end;

	call kermit_pad_$send (infop, Data_packet, kti.buffp, kermit_stats.file_len - kermit_stats.char_count, kti.sequence_n, chars_sent, packet_size, ec);
	if ec ^= 0 then goto Retry_packet;

Ignore_packet:
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received, r_packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);

Ack:						/*  Received an ACK packet  */
	if mod (packet_n + 1, Mod_64) = kti.sequence_n 
	     then goto Ignore_packet;                     /*  Ignore redundant ACK */
	else if kti.sequence_n ^= packet_n then goto Retry_packet;

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	kermit_stats.char_count = kermit_stats.char_count + chars_sent;
	kti.buffp = add_char_offset_ (kti.buffp, chars_sent);
	kermit_stats.packet_count = kermit_stats.packet_count + 1;
	kermit_stats.packet_chars = kermit_stats.packet_chars + packet_size;

/*  Check for remote file/group abort  */
	if chars_received ^= 0 then do;
		if substr (remote_data, 1, chars_received) = "X" then
		     kermit_stats.status = kermit_et_$remote_file_abort;
		else if substr (remote_data, 1, chars_received) = "Z" then
		     kermit_stats.status = kermit_et_$remote_group_abort;
	     end;


	if kermit_stats.char_count = kermit_stats.file_len
	     & kti.msf
	     & kti.msf_count > kti.msf_current
	     then do;
	     kti.msf_current = kti.msf_current + 1;
	     call terminate_file_ (kti.filep, 0, TERM_FILE_TERM, (0));
	     call initiate_file_$component ( pathname_ (
		filenames.directory (kti.filenames_idx),
		filenames.entry_name (kti.filenames_idx)),
		ltrim (char (kti.msf_current)),
		"",R_ACCESS, kti.filep, bit_count, ec);
	     kti.buffp = kti.filep;
	     kermit_stats.file_len = bit_count / Byte_length + kermit_stats.char_count;
	     end;
	
	     
	if kermit_stats.char_count = kermit_stats.file_len | kermit_stats.status ^= 0 then state = Send_eof;
	return;

Error:						/*  Received an Error packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Send_abort;
	return;

Nak:						/*  Received a Nak packet  */
Other:						/*  Got something other than the above  */
Retry_packet:
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;

     end send_data;

send_eof: proc (infop, ktip, state);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_eof		internal	*/
/*i 	Input:	infop, ktip				*/
/*f 	Function:	Sends an End-Of-File (Z) packet.		*/
/*f		If the eof packet is in response to an abort	*/
/*f		request received earlier from the remote then	*/
/*f		a "D" is placed in the data part of the packet.	*/
/*f		Sets state according to acknowledgement from      */
/*f		remote. 	                              	*/
/*o 	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     abort_char		 char (1);
	dcl     abort_char_lth	 fixed bin (21);
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;

/*  based */

	dcl     01 filenames	 like kermit_filenames based (kti.filenamesp);
	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:3) label init (Other, Nak, Ack, Error);

/*  constants  */

	dcl     Packet_string	 char (3) internal static options (constant) init ("NYE");

	ec = 0;
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		kermit_stats.status = kermit_et_$too_many_retries;
		call kermit_pad_$send (infop, Error_packet, null, (0), kti.sequence_n, (0), (0), ec);
		state = Send_abort;
		return;
	     end;

	if kermit_stats.status ^= 0 then do;		/* responding to abort request  */
		abort_char = "D";
		abort_char_lth = 1;
	     end;

	else abort_char_lth = 0;			/*  no previous abort request  */

	call kermit_pad_$send (infop, Eof_packet, addr (abort_char), abort_char_lth, kti.sequence_n, chars_sent, packet_size, ec);
	if ec ^= 0 then goto Retry_packet;

Ignore_packet:
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received, packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);

Ack:						/*  Received an ACK packet  */
	if mod (packet_n + 1, Mod_64) = kti.sequence_n 
	     then goto Ignore_packet;                     /*  Ignore redundant ACK */
	if kti.sequence_n ^= packet_n then goto Retry_packet;

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	kermit_stats.end_time = clock_ ();
	if kermit_stats.status = 0 then kti.file_count = kti.file_count + 1;
	if kermit_stats.status = kermit_et_$remote_group_abort then state = Send_abort;
	else if kti.filenames_idx = filenames.n_paths then state = Send_break;
	else state = Send_file_header;
	return;

Error:						/*  Received an Error packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Send_abort;
	return;

Nak:						/*  Received a Nak packet  */
Other:						/*  Got something other than the above  */
Retry_packet:
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end send_eof;

send_filename: proc (infop, ktip, first_filename, file_sw, state);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_filename		internal	*/
/*i 	Input:	infop, ktip				*/
/*f	Function:	Transmits a File-Header (F) packet, which	*/
/*f		contains the file's name in the data field.	*/
/*f		Sets state according to acknowledgement from 	*/
/*f		remote. 	                                	*/
/*o	Output:	state					*/
/*l	Modified: 89-01-02 by S Huen - Handle links to Multisegment */
/*l	          files correctly. (pc_24)                          */
/*							*/
/**********************************************************************/




/* parameters  */

	dcl     file_sw		 bit (1);
	dcl     first_filename	 char (*);
	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     bit_count		 fixed bin (24);
	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     source_file		 char (32);
	dcl     source_filep	 ptr;
	dcl     source_file_lth	 fixed bin (21);

/*  based */

	dcl     01 filenames	 like kermit_filenames based (kti.filenamesp);
	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:3) label init (Other, Nak, Ack, Error);

/*  constants  */

	dcl     Packet_string	 char (3) internal static options (constant) init ("NYE");


/*  procedures  */

	dcl     initiate_file_$component
				 entry (char (*), char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));

	ec = 0;
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		kermit_stats.status = kermit_et_$too_many_retries;
		call kermit_pad_$send (infop, Error_packet, null, (0), kti.sequence_n, (0), (0), ec);
		state = Send_abort;
		return;
	     end;

/*  Have we already set up the file  */
	if (kti.filep = null) & (kti.iocb_ptr = null) then do;
		kermit_stats.status = 0;
		bit_count = 0;
		kti.filenames_idx = kti.filenames_idx + 1;

/* make sure there's really another file  */
		if kti.filenames_idx > filenames.n_paths then do;
			state = Send_break;
			return;
		     end;

		call initiate_file_$component (filenames.directory (kti.filenames_idx), filenames.entry_name (kti.filenames_idx), filenames.component (kti.filenames_idx), R_ACCESS, kti.filep, bit_count, ec);
		if ec = error_table_$dirseg
		     & (filenames.component (kti.filenames_idx) = "")
		     then do;
		     call hcs_$status_minf (
			filenames.directory (kti.filenames_idx),
			filenames.entry_name (kti.filenames_idx),
			(1), (0), bit_count , ec);
		     if bit_count > 0 then do;
			kti.msf = True;
			kti.msf_count = bit_count;
			kti.msf_current = 0;
			call initiate_file_$component ( pathname_ (
			     filenames.directory (kti.filenames_idx),
			     filenames.entry_name (kti.filenames_idx)),
			     "0", "",R_ACCESS, kti.filep, bit_count, ec);
			end;
		     else ec = error_table_$dirseg;
		     end;
		kermit_stats.filename = pathname_$component (filenames.directory (kti.filenames_idx), filenames.entry_name (kti.filenames_idx), filenames.component (kti.filenames_idx));
		kermit_stats.start_time = clock_ ();
		kermit_stats.file_len = bit_count / Byte_length;
		if ec ^= 0 | bit_count = 0 then do;
			if ec ^= 0 then kermit_stats.status = ec;
			else kermit_stats.status = error_table_$empty_file;
			kti.filep = null;
			kermit_stats.end_time = kermit_stats.start_time;
			if kti.msf then do;
			     call iox_$close (kti.iocb_ptr, ec);
			     call iox_$detach_iocb (kti.iocb_ptr, ec);
			     kti.msf = False;
			     kti.iocb_ptr = null;
			     end;
			return;
		     end;
		else kti.buffp = kti.filep;
	     end;

/*  we have a user-specified destination path for the first file  */
	if file_sw then do;
		source_file = first_filename;
		file_sw = False;
	     end;

	else do;
		if filenames.component (kti.filenames_idx) = "" then
		     source_file = filenames.entry_name (kti.filenames_idx);
		else source_file = filenames.component (kti.filenames_idx);
	     end;


	source_filep = addr (source_file);
	source_file_lth = length (rtrim (source_file));

	call kermit_pad_$send (infop, File_header_packet, source_filep, source_file_lth, kti.sequence_n, chars_sent, packet_size, ec);
	if ec ^= 0 then goto Retry_packet;

Ignore_packet:
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received, packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);

Ack:						/*  Received an ACK packet  */
	if mod (packet_n + 1, Mod_64) = kti.sequence_n 
	     then goto Ignore_packet;                     /*  Ignore redundant ACK */
	if kti.sequence_n ^= packet_n then goto Retry_packet;

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Send_data;
	return;

Error:						/*  Received an Error packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Send_abort;
	return;

Nak:						/*  Received a Nak packet  */
Other:						/*  Got something other than the above  */
Retry_packet:
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end send_filename;


send_init: proc (infop, ktip, state);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$send_init		internal	*/
/*i 	Input:	infop, ktip				*/
/*f 	Function: Transmits a Send-Initiate (S) packet to specify 	*/
/*f		local parameters (packet length, timeout, etc.)	*/
/*f		Waits for the remote's parameters via an ACK (Y)	*/
/*f		packet with the remote parameters in the data  	*/
/*f		field.  The results of this negotiation are	*/
/*f		recorded in New-Modes.                       	*/
/*o 	Output:	state					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;
	dcl     state		 fixed bin;

/*  automatic  */

	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     idx		 fixed bin;
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     send_init_data	 char (Max_packet_size);
	dcl     send_init_packet	 char (Max_packet_size);
	dcl     send_init_data_lth	 fixed bin (21);
	dcl     send_init_packet_lth	 fixed bin (21);
	dcl     send_init_datap	 ptr;
	dcl     send_init_packetp	 ptr;

/*  based */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

/*  labels  */

	dcl     packet		 (0:3) label init (Other, Nak, Ack, Error);

/*  constants  */

	dcl     Packet_string	 char (3) internal static options (constant) init ("NYE");

	ec = 0;
	send_init_datap = addr (send_init_data);
	send_init_packetp = addr (send_init_packet);
	remote_datap = addr (remote_data);
	kti.retry_count = kti.retry_count + 1;

/*  Should we give up?  */
	if kti.retry_count > kti.retry_threshold then do;
		kermit_stats.status = kermit_et_$no_initialization;
		call kermit_pad_$send (infop, Error_packet, null, (0), kti.sequence_n, (0), (0), ec);
		state = Send_abort;
		return;
	     end;

/*  Clear the tty_ line (first time only)  */
	if kti.retry_count = 1 then call kermit_comm_mgr_$flush_input (infop, ec);

/*  Get local send-init data  */
	call kermit_xfer_modes_$get_local_params (infop, send_init_datap, send_init_data_lth, send_init_packetp, send_init_packet_lth, ec);
	if ec ^= 0 then goto Retry_packet;

	call kermit_pad_$send (infop, Send_init_packet, send_init_packetp, send_init_packet_lth, kti.sequence_n, chars_sent, packet_size, ec);
	if ec ^= 0 then goto Retry_packet;

Ignore_packet:
	call kermit_pad_$receive (infop, packet_type, remote_datap, Max_remote_packet_size, packet_n, chars_received, packet_size, eol_split, ec);
	if ec ^= 0 then goto Retry_packet;

	idx = index (Packet_string, packet_type);
	goto packet (idx);


Ack:						/*  Received an ACK packet  */
	if mod (packet_n + 1, Mod_64) = kti.sequence_n 
	     then goto Ignore_packet;                     /*  Ignore redundant ACK */
	if packet_n ^= kti.sequence_n then goto Retry_packet;
						/* Have the remote init data, so set the transfer modes  */
	call kermit_xfer_modes_$process_params (infop, remote_datap, chars_received, send_init_datap, ec);
	if ec ^= 0 then
	     goto Retry_packet;

/* And reset the tty_ line  */
	call kermit_comm_mgr_$reset_line_modes (infop, ec);
	call kermit_comm_mgr_$set_line_modes (infop, ec);

	kti.retry_count = 0;
	kti.sequence_n = mod (kti.sequence_n + 1, Mod_64);
	state = Send_file_header;
	return;

Error:						/*  Received an Error packet  */
	kermit_stats.status = kermit_et_$fatal_error;
	kermit_stats.error_message = substr (remote_data, 1, chars_received);
	state = Send_abort;
	return;

Nak:						/*  Received a Nak packet  */
Other:						/*  Got something other than the above  */
Retry_packet:
	kermit_stats.packet_retries = kermit_stats.packet_retries + 1;
	return;
     end send_init;

update_log:
     proc (infop, ktip);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$update_log		internal	*/
/*i 	Input:	infop, ktip				*/
/*f	Function:	Calls the log_mgr_ to updates the log-file and	*/
/*f		statistics database.  Re-initializes all file 	*/
/*f		associated variables.			*/
/*o	Output:	none					*/
/*							*/
/**********************************************************************/

/* parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;


/*  based */

	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);

	call kermit_log_mgr_$log_message (infop, kti.statisticsp);

	if kti.filep ^= null
	     then call terminate_file_ (kti.filep, 0, TERM_FILE_TERM, (0));
	if kti.iocb_ptr ^= null
	     then do;
	     call iox_$close (kti.iocb_ptr, ec);
	     call iox_$detach_iocb (kti.iocb_ptr, ec);
	     end;
	kti.iocb_ptr = null;
	kti.filep = null;
	kti.buffp = null;

	kermit_stats.filename, kermit_stats.error_message = "";
	if kermit_stats.status = kermit_et_$remote_file_abort then kermit_stats.status = 0;

	kermit_stats.file_len, kermit_stats.char_count,
	     kermit_stats.packet_chars, kermit_stats.packet_count,
	     kermit_stats.packet_retries, kermit_stats.start_time,
	     kermit_stats.end_time = 0;

	return;
     end update_log;

abort_group:
     proc (infop, ktip);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_send_$abort			internal	*/
/*i 	Input:	infop, ktip				*/
/*f 	Function: Aborts transaction. Records aborted file and   	*/
/*f		files that could not be sent.			*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     ktip		 ptr;

/* automatic  */

	dcl     idx		 fixed bin;

/*  based  */

	dcl     01 filenames	 like kermit_filenames based (kti.filenamesp);
	dcl     01 kermit_stats	 aligned like kermit_stats_info based (kti.statisticsp);
	dcl     01 kti		 like kermit_transfer_info based (ktip);


/*  Were we in the middle of a file transfer?  */
	if (kti.filep ^= null) | (kti.iocb_ptr ^= null) then
	     call update_log (infop, ktip);

/*  Log all files that could not be sent in this transaction  */
	do idx = kti.filenames_idx + 1 to filenames.n_paths;
	     kermit_stats.filename = pathname_$component (filenames.directory (idx), filenames.entry_name (idx), filenames.component (idx));
	     call kermit_log_mgr_$log_message (infop, kti.statisticsp);
	end;

	return;
     end abort_group;

     end kermit_send_;




		    kermit_send_request_.pl1        07/05/88  1407.3r w 07/05/88  1400.0       57555



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */

kermit_send_request_: proc (kermit_scip, infop);

/**********************************************************************/
/*							*/
/*n	Name:	 kermit_send_request_		external	*/
/*i	Input:	 kermit_scip, infop				*/
/*f	Function:  checks the request line.			*/
/*f		 calls kermit_get_filenames to extract the	*/
/*f		 filenames from the request_line. Sets up the	*/
/*f		 communications environment for file transfer. 	*/
/*f		 Informs the user of the success of the  	*/
/*f		 transaction.				*/
/*o	Output:	 none					*/
/*							*/
/*l	Written:	84-10-23	by Maureen Mallmes			*/
/*l	Modified:	85-01-17	by Maureen Mallmes to detect invalid	*/
/*l			control arguments.  See problem number	*/
/*l			3 in the kermit error list.		*/
/*							*/
/**********************************************************************/


/*  automatic  */

	dcl     arg_idx		 fixed binary;
	dcl     arg_lth		 fixed binary (21);
	dcl     arg_ptr		 ptr;
	dcl     argument		 character (arg_lth) based (arg_ptr);
	dcl     argument_count	 fixed bin;
	dcl     01 cl_info_struc	 aligned,
		02 resetread	 bit (1) unal,
		02 mbz		 bit (35) unal;
	dcl     code		 fixed bin (35);
	dcl     infop		 ptr;
	dcl     filenames_areap	 ptr;
	dcl     file_sw		 bit (1);
	dcl     files_sent		 fixed bin;
	dcl     first_filename	 char (168);
	dcl     kermit_scip		 ptr;
	dcl     reason		 char (256);
	dcl     source_file_sw	 bit (1);
	dcl     source_files	 char (168);
	dcl     transfer_modes_set	 bit (1);

/*  based  */

	dcl     01 filenames	 like kermit_filenames based (filenames_areap);

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Five_seconds	 fixed bin (71) internal static options (constant) init (5);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

/*  builtin  */

	dcl     (addr, index, null)	 builtin;


/*  externals  */

	dcl     error_table_$badopt	 fixed bin (35) ext static;
	dcl     error_table_$too_many_args fixed bin (35) ext static;


/*  procedures  */

	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     cu_$cl		 entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal);
	dcl     ioa_		 entry () options (variable);
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2));
	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_$get_request_name	 entry (ptr) returns (char (32));
	dcl     ssu_$get_temp_segment	 entry (ptr, char (*), ptr);
	dcl     ssu_$release_temp_segment entry (ptr, ptr);

/*  Conditions  */

	dcl     cleanup		 condition;
	dcl     quit		 condition;

/*  Include files  */

%include kermit_dcls;

%include kermit_transfer_info;


/*  Initialize variables  */

	code = 0;
	source_file_sw = False;
	file_sw = False;
	transfer_modes_set = False;
	cl_info_struc.resetread = True;
	cl_info_struc.mbz = False;

	on quit begin;
		if transfer_modes_set then do;
						/*  Reset the modes for user input and output  */
			call kermit_comm_mgr_$reset_line_modes (infop, code);
			transfer_modes_set = False;
						/*  Pass control  */
			call cu_$cl (cl_info_struc);
						/*  Back (restart) so set the modes for file transfer  */
			call kermit_comm_mgr_$set_line_modes (infop, code);
			transfer_modes_set = True;
		     end;
		else call continue_to_signal_ (0);	/* do nothing  */
	     end;


/* get storage for filenames  */

	filenames_areap = null;

	on cleanup call send_request_cleanup;

	call ssu_$get_temp_segment (kermit_scip, "filenames", filenames_areap);

/*  Usage  */
	call ssu_$arg_count (kermit_scip, argument_count);
	if argument_count = 0 then
	     call ssu_$abort_line (kermit_scip, 0, "Usage: ^a local_source_path {remote_destination_path}", ssu_$get_request_name (kermit_scip));

/*  get the arguments  */
	do arg_idx = 1 to argument_count;
	     call ssu_$arg_ptr (kermit_scip, arg_idx, arg_ptr, arg_lth);

	     if index (argument, "-") ^= 1 then do;
		     if ^source_file_sw then do;
			     source_files = argument;
			     source_file_sw = True;
			end;

		     else if ^file_sw then do;
			     first_filename = argument;
			     file_sw = True;
			end;

		     else call ssu_$abort_line (kermit_scip, error_table_$too_many_args, "^/Usage: ^a local_source_path {remote_destination_path}", ssu_$get_request_name (kermit_scip));
		end;

	     else call ssu_$abort_line (kermit_scip, error_table_$badopt, "^a", argument);
	end;

	call kermit_get_filenames_ (infop, source_files, filenames_areap,
	     reason, code);
	if code ^= 0
	then call ssu_$abort_line (kermit_scip, code, "^a", reason);



/*  ...greet the user  */
	call ioa_ ("^/Sending ^d file(s)...", filenames.n_paths);
						/*  ...and send the files  */
						/*  Give the user some time get back to remote  */
	call kermit_xfer_modes_$init (infop, code);
						/*  this should never happen  */
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code);
						/*  Set the tty_ modes  */
	call kermit_comm_mgr_$set_line_modes (infop, code);
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code, "^/^a", "Unable to set line modes for file transfer");
	transfer_modes_set = True;

/*  Send the files  */
	call timer_manager_$sleep (Five_seconds, "11"b);
	call kermit_send_$send_to_remote (infop, filenames_areap, first_filename, file_sw, files_sent, code);
						/*  Done sending  */
	call kermit_comm_mgr_$reset_line_modes (infop, (0));
	transfer_modes_set = False;

	if code ^= 0 then
	     call ssu_$abort_line (kermit_scip, code, "^/^d files sent.", files_sent);

	call ioa_ ("^/Transaction completed: ^d file(s) sent.", files_sent);
	call send_request_cleanup;
	return;


/*  Cleanup the area for the filenames  */
send_request_cleanup:
     proc;

	if filenames_areap ^= null then call ssu_$release_temp_segment (kermit_scip, filenames_areap);
	filenames_areap = null;
	if transfer_modes_set then call kermit_comm_mgr_$reset_line_modes (infop, code);
	transfer_modes_set = False;
	return;
     end send_request_cleanup;

     end kermit_send_request_;




		    kermit_server_.pl1              09/16/88  1334.2rew 09/16/88  1315.0      159516



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(87-11-24,Huen), approve(87-11-24,MCR7803), audit(87-12-07,RWaters),
     install(88-09-16,MR12.2-1113):
     Fix kermit error 13.
                                                   END HISTORY COMMENTS */


kermit_server_:
     proc (infop, filenames_areap);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$kermit_server_		external	*/
/*i 	Input:	infop, filenames_areap			*/
/*f 	Function: Provides a state-switching mechanism and data 	*/
/*f		interface for the server.			*/
/*f		Implemented states are:			*/
/*f		rec_init, send_init, init, generic_logout,	*/
/*f		generic_finish.				*/
/*f		An error packet is returned if the remote issues	*/
/*f		an unimplemented command to the Multics server	*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/


/*  parameters  */

	dcl     infop		 ptr;
	dcl     filenames_areap	 ptr;

/*  automatic */

	dcl     ec		 fixed bin (35);
	dcl     generic_sw		 bit (1);
	dcl     packet_n		 fixed bin;
	dcl     packet_type		 char (1);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_data_lth	 fixed bin (21);
	dcl     generic_state	 fixed bin;
	dcl     state		 fixed bin;

/*  based  */

	dcl     generic_type	 char (1) based (addr (remote_data));
	dcl     remote_datap	 ptr;

/*  labels  */

	dcl     server_state	 (0:4) label init (Other, Server_Rec_Init, Server_Send_Init, Server_Init, Server_Generic);
	dcl     generic_command	 (0:2) label init (Generic_Other, Generic_Logout, Generic_Finish);

/*  constant  */

	dcl     Error_msg		 char (15) internal static options (constant) init ("Not Implemented");
	dcl     Generic_packet	 char (1) unal internal static options (constant) init ("G");
	dcl     Generic_packets	 char (2) internal static options (constant) init ("LF");
	dcl     GF_packet		 char (1) unal internal static options (constant) init ("F");
	dcl     GL_packet		 char (1) unal internal static options (constant) init ("L");
	dcl     Max_remote_packet_size fixed bin internal static options (constant) init (3000);
	dcl     Max_packet_size	 fixed bin internal static options (constant) init (94);
	dcl     Server_packets	 char (4) internal static options (constant) init ("RSIG");
	dcl     True		 bit (1) internal static options (constant) init ("1"b);


/*  builtin  */

	dcl     (addr, before, index, length, ltrim, null, rtrim, size, unspec) builtin;

/*  procedures  */

	dcl     convert_status_code_	 entry (fixed bin (35), char (8) aligned, char (100) aligned);

/*  include  */

%include kermit_dcls;

%include kermit_mode_info;

%include kermit_transfer_info;


/*  clear any garbage on the line  */
	call kermit_comm_mgr_$flush_input (infop, ec);

	remote_datap = addr (remote_data);

	do while ("1"b);

	     packet_n = 0;
	     call rec_server_idle (infop, packet_n, packet_type, remote_datap, remote_data_lth);

	     state = index (Server_packets, packet_type);
	     goto server_state (state);


Server_Rec_Init:
	     call svr_send_file (infop, packet_n, remote_datap, remote_data_lth, filenames_areap);
	     goto exit_state;

Server_Send_Init:
	     call svr_receive_file (infop, packet_n, remote_datap, remote_data_lth);
	     goto exit_state;

Server_Init:
	     call svr_init (infop, packet_n, remote_datap, remote_data_lth);
	     goto exit_state;

Server_Generic:
	     generic_state = index (Generic_packets, generic_type);
	     goto generic_command (generic_state);

Generic_Finish:
	     call kermit_pad_$send (infop, Ack_packet, null (), (0), packet_n, (0), (0), (0));
	     generic_sw = True;
	     call verify_termination (infop, Generic_packet, generic_sw, GF_packet);
	     goto shutdown_server;

Generic_Logout:
	     call kermit_pad_$send (infop, Ack_packet, null (), (0), packet_n, (0), (0), (0));
	     generic_sw = True;
	     call verify_termination (infop, Generic_packet, generic_sw, GL_packet);
	     call logout_user;
	     goto exit_state;			/*  should never come back here  */

Generic_Other:
Other:
	     call kermit_pad_$send (infop, Error_packet, addr (Error_msg), length (Error_msg), packet_n, (0), (0), ec);

exit_state:
	end;
shutdown_server:
	return;

rec_server_idle:
     proc (infop, sequence_n, packet_type, packet_datap, packet_data_lth);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$rec_server_idle	internal	*/
/*i 	Input:	infop, sequence_n,				*/
/*f 	Function: Waits for messages from remote.		*/
/*o 	Output:	packet_type, packet_datap, packet_data_lth	*/
/*l       Modified: 86-01-24  by Don Kozlowski - Idle until a packet  */
/*l			is received regardless of the packet    */
/*l			number.  Remove all reset_line_modes    */
/*l			except before logout. (kermit 13)	*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     packet_datap	 ptr;
	dcl     packet_data_lth	 fixed bin (21);
	dcl     packet_type		 char (1);
	dcl     sequence_n		 fixed bin;

/*  automatic  */

	dcl     ec		 fixed bin (35);
	dcl     old_timeout		 fixed bin (8) unal;
	dcl     old_timeout_select	 (1) fixed bin;
	dcl     server_timeout	 fixed bin (8) unal;
	dcl     timeout_select	 (1) fixed bin;

/*  based  */

	dcl     packet_data		 char (Max_remote_packet_size) based (packet_datap);

/*  constants  */

	dcl     Thirty_seconds	 fixed bin (8) unal internal static options (constant) init (30);


/*  Make the timeout interval reasonable for this state  */
	timeout_select (1) = I_timeout;
	server_timeout = Thirty_seconds;
	sequence_n = 0;
	ec = 0;

	call kermit_mode_mgr_$store (infop, Temporary, timeout_select, addr (server_timeout), ec);

/*  Loop until we get a packet  */

	call kermit_pad_$receive (infop, packet_type, packet_datap, length (packet_data), packet_n, packet_data_lth, (0), ("0"b), ec);

	do while (ec ^= 0);
	     call kermit_pad_$send (infop, Nak_packet, null (), (0), sequence_n, (0), (0), ec);
	     call kermit_pad_$receive (infop, packet_type, packet_datap, length (packet_data), packet_n, packet_data_lth, (0), ("0"b), ec);
	end;

/*  Have a packet.  Let's reset the timeout interval  */
	old_timeout_select (1) = Timeout;
	call kermit_mode_mgr_$retrieve (infop, Permanent, old_timeout_select, addr (old_timeout), ec);
	call kermit_mode_mgr_$store (infop, Temporary, timeout_select, addr (old_timeout), ec);

	return;
     end rec_server_idle;

svr_init:
     proc (infop, sequence_n, packet_datap, packet_data_lth);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$svr_init		internal	*/
/*i 	Input:	infop, sequence_n, packet_datap, packet_data_lth	*/
/*f	Function:	Negotiates parameters with remote		*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     packet_datap	 ptr;
	dcl     packet_data_lth	 fixed bin (21);
	dcl     sequence_n		 fixed bin;

/*  automatic  */

	dcl     ack_init_data	 char (Max_packet_size);
	dcl     ack_init_data_lth	 fixed bin (21);
	dcl     ack_init_datap	 ptr;
	dcl     ack_init_packet	 char (Max_packet_size);
	dcl     ack_init_packet_lth	 fixed bin (21);
	dcl     ack_init_packetp	 ptr;
	dcl     ec		 fixed bin (35);
	dcl     short_message	 char (8) aligned;
	dcl     long_message	 char (100) aligned;


	ec = 0;
	ack_init_datap = addr (ack_init_data);
	ack_init_packetp = addr (ack_init_packet);

/*  Get the local modes   */
	call kermit_xfer_modes_$get_local_params (infop, ack_init_datap, ack_init_data_lth, ack_init_packetp, ack_init_packet_lth, ec);
	if ec ^= 0 then goto init_error;

	call kermit_xfer_modes_$check_params (infop, packet_datap, packet_data_lth, ack_init_datap, ec);
	if ec ^= 0 then
	     goto init_error;

/* else all is fine, so give the remote kermit the local modes  */
	call kermit_pad_$send (infop, Ack_packet, ack_init_packetp, ack_init_packet_lth, sequence_n, (0), (0), ec);
	if ec ^= 0 then
	     goto init_error;

/* All okay, so set the tty_ line to the new modes  */
	call kermit_xfer_modes_$process_params (infop, packet_datap, packet_data_lth, ack_init_datap, ec);

	call kermit_comm_mgr_$set_line_modes (infop, ec);
	return;

init_error:
	call convert_status_code_ (ec, short_message, long_message);
	call kermit_pad_$send (infop, Error_packet, addr (long_message), length (rtrim (long_message)), packet_n, (0), (0), ec);
	return;
     end svr_init;

svr_send_file:
     proc (infop, sequence_n, packet_datap, packet_data_lth, filenames_areap);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$svr_send_files		internal	*/
/*i 	Input:	infop, sequence_n, packet_datap, packet_data_lth,	*/
/*f		filenames_areap				*/
/*f 	Function:	Gets the names of the files to be sent.		*/
/*f		Calls kermit_send_$send_to_remote to send a file.	*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/

/*  parameters */

	dcl     infop		 ptr;
	dcl     filenames_areap	 ptr;
	dcl     packet_datap	 ptr;
	dcl     packet_data_lth	 fixed bin (21);
	dcl     sequence_n		 fixed bin;

/*  automatic  */

	dcl     error_msg		 char (256);
	dcl     filename		 char (packet_data_lth);
	dcl     long_message	 char (100) aligned;
	dcl     short_message	 char (8) aligned;


/*  based  */

	dcl     01 filenames	 like kermit_filenames based (filenames_areap);
	dcl     packet_data		 char (packet_data_lth) based (packet_datap);


/*  external  */

	dcl     error_table_$noarg	 fixed bin (35) ext static;

	ec = 0;

	if packet_data_lth = 0 then do;
		ec = error_table_$noarg;
		goto send_error;
	     end;

	filenames.n_paths = 0;
	filename = before (ltrim (packet_data), " ");

	call kermit_get_filenames_ (infop, rtrim (filename), filenames_areap, error_msg, ec);

	if ec ^= 0 then goto send_error;

	call kermit_send_$send_to_remote (infop, filenames_areap, "", "0"b, (0), ec);
	if ec ^= 0 then goto send_error;
	return;

send_error:
	call convert_status_code_ (ec, short_message, long_message);
	call kermit_pad_$send (infop, Error_packet, addr (long_message), length (rtrim (long_message)), packet_n, (0), (0), ec);
	return;
     end svr_send_file;

svr_receive_file:
     proc (infop, sequence_n, packet_datap, packet_data_lth);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$svr_receive_file	internal	*/
/*i 	Input:	infop, sequence_n, packet_datap, packet_data_lth	*/
/*f 	Function:	Receives a file or file group from the remote.	*/
/*f		Negotiates parameters.  Calls			*/
/*f		kermit_receive_$receive_from_remote to receive	*/
/*f		a file or file group			*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     packet_datap	 ptr;
	dcl     packet_data_lth	 fixed bin (21);
	dcl     sequence_n		 fixed bin;

/*  automatic  */
	dcl     ack_init_data	 char (Max_packet_size);
	dcl     ack_init_data_lth	 fixed bin (21);
	dcl     ack_init_datap	 ptr;
	dcl     ack_init_packet	 char (Max_packet_size);
	dcl     ack_init_packet_lth	 fixed bin (21);
	dcl     ack_init_packetp	 ptr;
	dcl     ec		 fixed bin (35);
	dcl     file_sw		 bit (1);
	dcl     first_filename	 char (packet_data_lth);
	dcl     initial_state	 fixed bin;
	dcl     long_message	 char (100) aligned;
	dcl     short_message	 char (8) aligned;

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);

	ec = 0;
	ack_init_datap = addr (ack_init_data);
	ack_init_packetp = addr (ack_init_packet);

	call kermit_xfer_modes_$get_local_params (infop, ack_init_datap, ack_init_data_lth, ack_init_packetp, ack_init_packet_lth, ec);
	if ec ^= 0 then goto modes_error;

	call kermit_xfer_modes_$check_params (infop, packet_datap, packet_data_lth, ack_init_datap, ec);
	if ec ^= 0 then
	     goto modes_error;

/* else all is fine, so give the remote kermit the local modes  */
	call kermit_pad_$send (infop, Ack_packet, ack_init_packetp, ack_init_packet_lth, sequence_n, (0),
	     (0), ec);
	if ec ^= 0 then
	     goto modes_error;

/* All okay, so set the tty_ line to the new modes  */
	call kermit_xfer_modes_$process_params (infop, packet_datap, packet_data_lth, ack_init_datap, ec);

	call kermit_comm_mgr_$set_line_modes (infop, ec);

	initial_state = Rec_file_header;
	first_filename = "";
	file_sw = False;
	sequence_n = sequence_n + 1;

	call kermit_receive_$receive_from_remote (infop, initial_state, sequence_n, first_filename, file_sw, (0), ec);
	return;

modes_error:
	call convert_status_code_ (ec, short_message, long_message);
	call kermit_pad_$send (infop, Error_packet, addr (long_message), length (rtrim (long_message)), packet_n, (0), (0), ec);
	return;
     end svr_receive_file;

logout_user: proc;

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$logout_user		internal	*/
/*i 	Input:	none					*/
/*f 	Function: Logs out the user in response to a Generic Logout	*/
/*f		packet.					*/
/*o 	Output:	state					*/
/*							*/
/**********************************************************************/

/*  automatic  */

	dcl     action		 char (7);
	dcl     01 local_finish_info	 aligned like finish_info;
	dcl     1 logout_string	 aligned,		/* information about logouts */
		02 version	 fixed bin,	/* this is version 0 */
		02 hold		 bit (1) unaligned, /* don't hangup line */
		02 brief		 bit (1) unaligned, /* don't print logout message */
		02 pad		 bit (34) unaligned;/* must be zero */
	dcl     term_structure_ptr	 ptr;


/*  procedures  */

	dcl     signal_		 entry (char (*), ptr, ptr);
	dcl     execute_epilogue_	 entry (bit (1) aligned);
	dcl     terminate_process_	 entry (char (*), ptr);


/*  include  */

%include finish_info;
%include condition_info_header;


	call kermit_comm_mgr_$reset_line_modes (infop, (0));

	action = "logout";
	logout_string.version = 0;
	logout_string.hold = "0"b;			/* set default values for arguments */
	logout_string.brief = "1"b;			/* .. */
	logout_string.pad = "0"b;
	term_structure_ptr = addr (logout_string);

	finish_info_ptr = addr (local_finish_info);
	finish_info.type = "logout";

no_more_arguments:
	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);
	call terminate_process_ (action, term_structure_ptr);
	go to no_more_arguments;			/* and don't come back */
     end logout_user;

verify_termination:
     proc (infop, packet_type, generic_sw, generic_packet_type);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_server_$verify_termination	internal	*/
/*i 	Input:    infop, packet_type, generic_sw,		*/
/*i 	          generic_packet_type				*/
/*f 	Function: Verifies receipt of the transmitted ack before	*/
/*f		exiting the server.				*/
/*o 	Output:	none					*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     generic_sw		 bit (1);
	dcl     generic_packet_type	 char (1);
	dcl     packet_type		 char (1);

/*  automatic  */

	dcl     chars_received	 fixed bin (21);
	dcl     chars_sent		 fixed bin (21);
	dcl     done		 bit (1);
	dcl     ec		 fixed bin (35);
	dcl     eol_split		 bit (1);
	dcl     packet_n		 fixed bin;
	dcl     packet_size		 fixed bin (21);
	dcl     packet_timeout	 fixed bin (8) unal;
	dcl     r_packet_size	 fixed bin (21);
	dcl     remote_data		 char (Max_remote_packet_size);
	dcl     remote_datap	 ptr;
	dcl     remote_packet_type	 char (1);
	dcl     timeout_select	 (1) fixed bin;

/*   based  */
	dcl     remote_generic_type	 char (1) based (addr (remote_data));

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     Five_seconds	 fixed bin (8) unal internal static options (constant) init (5);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);


	timeout_select (1) = I_timeout;
	packet_timeout = Five_seconds;

	call kermit_mode_mgr_$store (infop, Temporary, timeout_select, addr (packet_timeout), ec);

	done = False;
	remote_packet_type = "";
	remote_data = "";
	remote_datap = addr (remote_data);

	call kermit_pad_$receive (infop, remote_packet_type, remote_datap, length (remote_data), packet_n, chars_received,
	     r_packet_size, eol_split, ec);


	do while (remote_packet_type = packet_type & ^done);
	     if generic_sw & remote_generic_type ^= generic_packet_type then done = True;
	     else call kermit_pad_$send (infop, Ack_packet, null (), 0, packet_n, chars_sent, packet_size, ec);

	     remote_packet_type = "";
	     remote_data = "";
	     if ^done then call kermit_pad_$receive (infop, remote_packet_type, remote_datap, length (remote_data), packet_n, chars_received,
		     packet_size, eol_split, ec);
	end;
	return;
     end verify_termination;

     end kermit_server_;




		    kermit_server_request_.pl1      09/16/88  1334.2rew 09/16/88  1316.4       39303



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(87-11-24,Huen), approve(87-11-24,MCR7803), audit(87-12-07,RWaters),
     install(88-09-16,MR12.2-1113):
     Fix kermit error 13.
                                                   END HISTORY COMMENTS */


kermit_server_request_:
     proc (kermit_scip, infop);

/**********************************************************************/
/*							*/
/*n	Name:	kermit_server_request_		external	*/
/*i	Input:	kermit_scip, infop				*/
/*f 	Function: Sets up a Kermit environment that does not have a */
/*f		user interface. i.e. all further commands to	*/
/*f		multics-kermit come in the form of packets from	*/
/*f		the remote.				*/
/*o 	Output:	none					*/
/*l	Modified: 86-01-31  by Don Kozlowski - Delete the 5 second  */
/*l			waiting before setting the file transfer*/
/*l			mode. (kermit 13)			*/
/*l	Modified: 86-10-09  by Don Kozlowski - Set the server flag  */
/*l			properly. (kermit 13)                   */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     infop		 ptr;
	dcl     kermit_scip		 ptr;

/*  automatic  */

	dcl     01 cl_info_struc	 aligned,
		02 resetread	 bit (1) unal,
		02 mbz		 bit (35) unal;
	dcl     code		 fixed bin (35);
	dcl     filenames_areap	 ptr;
	dcl     transfer_modes_set	 bit (1);

/*  constants  */

	dcl     False		 bit (1) internal static options (constant) init ("0"b);
	dcl     True		 bit (1) internal static options (constant) init ("1"b);

/*  builtin  */

	dcl     null		 builtin;


/*  procedures  */
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     cu_$cl		 entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal);
	dcl     ssu_$abort_line	 entry () options (variable);
	dcl     ssu_$get_temp_segment	 entry (ptr, char (*), ptr);
	dcl     ssu_$release_temp_segment entry (ptr, ptr);

  /* based */
  
  dcl 01 info		aligned like kermit_info based (infop);
  dcl 01 comm_info		aligned like kermit_comm_info
			     based (info.comm_infop);
  
/*  Conditions  */

	dcl     cleanup		 condition;
	dcl     quit		 condition;


/*  include files  */

%include kermit_dcls;

%include kermit_info;

	transfer_modes_set = False;
	cl_info_struc.resetread = True;
	cl_info_struc.mbz = False;
	comm_info.server = "1"b;		/* We are now a server */

	on quit begin;
		if transfer_modes_set then do;
						/*  Reset the modes for user input and output  */
			call kermit_comm_mgr_$reset_line_modes (infop, code);
			transfer_modes_set = False;
						/*  Pass control  */
			call cu_$cl (cl_info_struc);
						/*  Back (restart) so set the modes for file transfer  */
			call kermit_comm_mgr_$set_line_modes (infop, code);
			transfer_modes_set = True;
		     end;
		else call continue_to_signal_ (0);	/* do nothing  */
	     end;

	filenames_areap = null;

	on cleanup call server_request_cleanup;

	call ssu_$get_temp_segment (kermit_scip, "filenames", filenames_areap);
	call kermit_xfer_modes_$init (infop, code);
						/*  this should never happen  */
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code);
						/*  Set the tty_ modes  */

	call kermit_comm_mgr_$set_line_modes (infop, code);
	if code ^= 0 then call ssu_$abort_line (kermit_scip, code, "^/^a", "Unable to set line modes for file transfer");
	transfer_modes_set = True;

/*  Invoke the server  */

	call kermit_server_ (infop, filenames_areap);
						/*  Server done  */
	call server_request_cleanup;
	return;

server_request_cleanup:
     proc;

	comm_info.server = "0"b;		/* We are NOT a server */
	if filenames_areap ^= null then call ssu_$release_temp_segment (kermit_scip, filenames_areap);
	filenames_areap = null;
	if transfer_modes_set then call kermit_comm_mgr_$reset_line_modes (infop, code);
	transfer_modes_set = False;
	comm_info.server = "0"b;		/* We are NOT a server */
	return;
     end server_request_cleanup;

     end kermit_server_request_;




		    kermit_xfer_modes_.pl1          03/01/89  1437.6rew 03/01/89  1433.3      156411



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-05-16,Huen), approve(88-05-16,MCR7841), audit(88-05-25,RWaters),
     install(88-07-05,MR12.2-1054):
     Fix kermit 15, 16, 17, and 18.
  2) change(89-01-02,Huen), approve(89-01-02,MCR8027), audit(89-01-25,Lee),
     install(89-03-01,MR12.3-1020):
     Fix kermit bugs: PC_File_Transfer 18, 20, and 23.
                                                   END HISTORY COMMENTS */


kermit_xfer_modes_:
     proc;

/********************************************************************/
/*							*/
/*n	kermit_xfer_modes_					*/
/*							*/
/*d	This routine is responsible for setting the modes		*/
/*d	required for file transfer.				*/
/*							*/
/*l	Written:	84-10-23	by Maureen Mallmes			*/
/*l       Modified: 87-06-15  by S. Huen - Add extended packet length */
/*l                 based on D. Kozlowski's version (kermit 16)  .    */
/*							*/
/********************************************************************/


/*  Not an entry  */
	return;

/*  parameters  */
	dcl     encoded_params_lth	 fixed bin (21);
	dcl     encoded_paramsp	 ptr;
	dcl     ec		 fixed bin (35);
	dcl     infop		 ptr;
	dcl     local_paramsp	 ptr;
	dcl     local_params_lth	 fixed bin (21);
	dcl     remote_paramsp	 ptr;
	dcl     remote_params_lth	 fixed bin (21);
	dcl     temp_defaultsp	 ptr;

/* automatic  */

	dcl     reset_sw		 bit (1);
	dcl     send_init_select	 (N_params) fixed bin;

/*  constants  */

	dcl     Init_field		 (13) fixed bin static options (constant) init
				 (1,		/* MAXL is char  */
				 1,		/* TIME is char  */
				 1,		/* NPAD is char  */
				 2,		/* PADC is ctl   */
				 1,		/* EOL  is char  */
				 0,		/* QCTL is none  */
				 0,		/* QBIN is none  */
				 3,		/* CHKT is binary*/
				 0,		/* REPT is none  */
				 1,		/* CAPAS is char */
				 1,		/* WINDO  ischar */
				 1,		/* MAXLX1 is char*/
				 1);		/* MAXLX2 is char*/



	dcl     Char_coded		 fixed bin static options (constant) init (1);
	dcl     Ctl_coded		 fixed bin static options (constant) init (2);
	dcl     Binary_coded	 fixed bin static options (constant) init (3);
	dcl     False		 bit (1) static options (constant) init ("0"b);
	dcl     N_params		 fixed bin static options (constant) init (13);
	dcl     True		 bit (1) static options (constant) init ("1"b);

/* builtin  */

	dcl     (addr, bool, byte, fixed)  builtin;
	dcl     (min, mod, rank, unspec)   builtin;

/*  include  */

%include kermit_mode_info;

%include kermit_dcls;

init:
     entry (infop, ec);

/**********************************************************************/
/*							*/
/*n	Name:	kermit_xfer_modes_$init		external	*/
/*i	Input:	infop					*/
/*f	Function: Calls modes_manager to initialize new-modes to 	*/
/*f		defaults.	 Sets modes to get first packet through.*/
/*o	Output:	ec					*/
/*							*/
/**********************************************************************/


	ec = 0;

/*  Set temporary modes to defaults  */
	temp_defaultsp = addr (Temp_defaults);
	call kermit_mode_mgr_$store (infop, Temporary, Store_all, temp_defaultsp, ec);
	if ec ^= 0 then return;

/*  SET user-specified modes  */
	call set_initial_modes (ec);
	return;


get_local_params:
     entry (infop, local_paramsp, local_params_lth, encoded_paramsp, encoded_params_lth, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	transfer_modes_$get_local_params		*/
/*i 	Input:	infop					*/
/*f 	Function: Gets the local modes from the modes_info database	*/
/*f		and puts them in a character string using the	*/
/*f		format of the data field to the send_init packet.	*/
/*o 	Output:	local_paramsp, local_params_lth,encoded_paramsp,  */
/*o                 encoded_params_lth, ec                           	*/
/*							*/
/**********************************************************************/

	ec = 0;
	local_params_lth = N_params;

/* Select send-init values  */

	send_init_select (1) = I_maxl;
	send_init_select (2) = O_timeout;
	send_init_select (3) = I_n_pads;
	send_init_select (4) = I_pad_char;
	send_init_select (5) = I_eol_char;
	send_init_select (6) = O_quote_char;
	send_init_select (7) = G_eight_bit_char;
	send_init_select (8) = G_check_type;
	send_init_select (9) = G_repeat_char;
	send_init_select (10) = G_capabilities;
	send_init_select (11) = G_window;
	send_init_select (12) = I_max_lenx1;
	send_init_select (13) = I_max_lenx2;

	call kermit_mode_mgr_$retrieve (infop, Temporary, send_init_select, local_paramsp, ec);
	if ec ^= 0 then return;
	call get_encoded_params (local_paramsp, local_params_lth, encoded_paramsp, encoded_params_lth);
	return;

process_params: entry (infop, remote_paramsp, remote_params_lth, local_paramsp, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_xfer_modes_$process_params	external	*/
/*i 	Input:	infop, remote_paramsp, remote_params_lth	*/
/*i		local_paramsp				*/
/*f 	Function: Sets the modes for file transfer.		*/
/*f 		Calls set_transfer_modes.			*/
/*o 	Output:	ec					*/
/*							*/
/**********************************************************************/

	ec = 0;
	reset_sw = False;
	call set_transfer_modes (infop, remote_paramsp, remote_params_lth, local_paramsp, reset_sw, ec);
	return;



check_params: entry (infop, remote_paramsp, remote_params_lth, local_paramsp, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_xfer_modes_$check_params	external	*/
/*i 	Input:	infop, remote_paramsp, remote_params_lth	*/
/*i		local_paramsp				*/
/*f 	Function: Checks the modes for file transfer.		*/
/*f 		Calls set_transfer_modes.			*/
/*o 	Output:	ec					*/
/*							*/
/**********************************************************************/

	ec = 0;
	reset_sw = True;
	call set_transfer_modes (infop, remote_paramsp, remote_params_lth, local_paramsp, reset_sw, ec);
	return;

get_encoded_params: proc (local_paramsp, local_params_lth, encoded_paramsp, encoded_params_lth);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_xfer_modes_$get_encoded_params	internal	*/
/*i 	Input:	local_paramsp, local_params_lth                   */
/*f 	Function: Encodes data for Send-Init packet		*/
/*o 	Output:	encoded_paramsp, encoded_params_lth               */
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     encoded_params_lth	 fixed bin (21);
	dcl     encoded_paramsp	 ptr;
	dcl     local_params_lth	 fixed bin (21);
	dcl     local_paramsp	 ptr;


/*  automatic  */

	dcl     idx		 fixed bin;

/*  based  */


	dcl     e_params		 (1:1) fixed bin (8) unal based (encoded_paramsp);
	dcl     l_params		 (1:1) fixed bin (8) unal based (local_paramsp);


/*  encode the send-init data  */

	do idx = 1 to local_params_lth;
	     if Init_field (idx) = Char_coded then e_params (idx) = l_params (idx) + 32;
	     else if Init_field (idx) = Ctl_coded then unspec (e_params (idx)) =
		     bool (unspec (l_params (idx)), "100"b3, "0110"b);
	     else if Init_field (idx) = Binary_coded then
		e_params (idx) = l_params (idx) + 48;
	     else e_params (idx) = l_params (idx);
	end;
	encoded_params_lth = local_params_lth;

	return;
     end get_encoded_params;

set_initial_modes: proc (ec);

/**********************************************************************/
/*							*/
/*n	Name:	kermit_xfer_modes_$set_initial_modes	internal	*/
/*i	Input:	none					*/
/*f	Function:	Sets modes to get first packet through.		*/
/*o	Output:	ec					*/
/*							*/
/**********************************************************************/

/*  parameters  */

	dcl     ec		 fixed bin (35);

/*  automatic  */

	dcl     perm_modes		 (17) fixed bin (8) unal;
	dcl     perm_modesp		 ptr;
	dcl     perm_modes_select	 (17) fixed bin;
	dcl     temp_modes_select	 (16) fixed bin;

/*  constants  */

	dcl     Ebp_select		 fixed bin internal static options (constant) init (11);
	dcl     Line_byte_size_select	 fixed bin internal static options (constant) init (17);
	dcl     Eight_bit		 fixed bin (8) unal internal static options (constant) init (8);
	dcl     No		 char (1) unal internal static options (constant) init ("N");

	ec = 0;
	perm_modesp = addr (perm_modes);


	perm_modes_select (1) = Maxl;
	perm_modes_select (2) = Timeout;
	perm_modes_select (3) = N_pads;
	perm_modes_select (4) = Pad_char;
	perm_modes_select (5) = Eol_char;
	perm_modes_select (6) = Quote_char;
	perm_modes_select (7) = Check_type;
	perm_modes_select (8) = Start_char;
	perm_modes_select (9) = Parity;
	perm_modes_select (10) = Eol_char;		/*  again for output  */
	perm_modes_select (Ebp_select) = Eight_bit_char;
	perm_modes_select (12) = Repeat_char;
	perm_modes_select (13) = Capabilities;
	perm_modes_select (14) = Window_size;
	perm_modes_select (15) = Max_len_ext_1;
	perm_modes_select (16) = Max_len_ext_2;
	perm_modes_select (Line_byte_size_select) = Line_byte_size;

	temp_modes_select (1) = I_maxl;
	temp_modes_select (2) = O_timeout;
	temp_modes_select (3) = I_n_pads;
	temp_modes_select (4) = I_pad_char;
	temp_modes_select (5) = I_eol_char;
	temp_modes_select (6) = O_quote_char;
	temp_modes_select (7) = G_check_type;
	temp_modes_select (8) = G_start_char;
	temp_modes_select (9) = G_parity;
	temp_modes_select (10) = O_eol_char;
	temp_modes_select (11) = G_eight_bit_char;
	temp_modes_select (12) = G_repeat_char;
	temp_modes_select (13) = G_capabilities;
	temp_modes_select (14) = G_window;
	temp_modes_select (15) = I_max_lenx1;
	temp_modes_select (16) = I_max_lenx2;

	call kermit_mode_mgr_$retrieve (infop, Permanent, perm_modes_select, perm_modesp, ec);
	if ec ^= 0 then return;

/*  No eight_bit_prefixing if binary mode is set  */
	if perm_modes (Line_byte_size_select) = Eight_bit then perm_modes (Ebp_select) = rank (No);

	call kermit_mode_mgr_$store (infop, Temporary, temp_modes_select, perm_modesp, ec);


	return;
     end set_initial_modes;

set_transfer_modes: proc (infop, remote_paramsp, remote_lth, local_paramsp, reset_sw, ec);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_xfer_modes_$set_transfer_modes	internal	*/
/*i 	Input:	infop, remote_paramsp, remote_lth, local_paramsp	*/
/*i		reset_sw					*/
/*f 	Function: Sets the applicable values for the remote and 	*/
/*f 		local in new_modes.				*/
/*o 	Output:	ec					*/
/*l       Modified: 89-01-02  by S. Huen - Ignore invalid value and   */
/*l	          assume default value for the "maxl" field when    */
/*l	          using extended packet length. (pc_23) .           */
/*							*/
/**********************************************************************/


/*  parameters  */

	dcl     ec		 fixed bin (35);
	dcl     infop		 ptr;
	dcl     remote_paramsp	 ptr;
	dcl     local_paramsp	 ptr;
	dcl     remote_lth		 fixed bin (21);
	dcl     reset_sw		 bit (1);


/*  automatic  */
          dcl     tmp		 fixed bin (9);		
	dcl     (remote_len, local_len) fixed bin;		
	dcl     global_modes	 (7) char (1) unal;
	dcl     global_modesp	 ptr;
	dcl     01 modes_select	 aligned,
		02 remote		 (6) fixed bin,
		02 global		 (7) fixed bin;
	dcl     old_modes		 (N_params) char (1);
	dcl     old_modesp		 ptr;
	dcl     r_paramsp		 ptr;
	dcl     remote_params	 (remote_lth) char (1) unal;

/*  based  */

	dcl     local_params	 (N_params) char (1) based (local_paramsp) unal;
	dcl     old_modes_select	 (N_params) fixed bin based (addr (modes_select)) aligned;

/*  constants  */

	dcl     Chkt		 fixed bin (8) internal static options (constant) init (8);
	dcl     Default_8bit_prefix	 char (1) internal static options (constant) init ("&");
	dcl     Qbin		 fixed bin (8) internal static options (constant) init (7);
	dcl     Rept		 fixed bin (8) internal static options (constant) init (9);
	dcl     Capas		 fixed bin (8) internal static options (constant) init (10);
	dcl     Max_len_ext		 fixed bin (8) internal static options (constant) init (13);
	dcl     Yes		 char (1) internal static options (constant) init ("Y");



	ec = 0;
	r_paramsp = addr (remote_params);

/*  Specify modes to be set by initialization packet  */

	modes_select.remote (1) = O_maxl;
	modes_select.remote (2) = I_timeout;
	modes_select.remote (3) = O_n_pads;
	modes_select.remote (4) = O_pad_char;
	modes_select.remote (5) = O_eol_char;
	modes_select.remote (6) = I_quote_char;

	modes_select.global (1) = G_eight_bit_char;
	modes_select.global (2) = G_check_type;
	modes_select.global (3) = G_repeat_char;
	modes_select.global (4) = G_capabilities;
	modes_select.global (5) = G_window;
	modes_select.global (6) = O_max_lenx1;
	modes_select.global (7) = O_max_lenx2;

/*  Get the old modes  */
	old_modesp = addr (old_modes);
	call kermit_mode_mgr_$retrieve (infop, Temporary, old_modes_select, old_modesp, ec);

/*  Decode the remote initialization parameters  */
	call decode_params (infop, remote_paramsp, r_paramsp, remote_lth);


/*  set global modes (same for input and output), but dependent on both systems  */
/*  8-bit quoting prefix  */
	if remote_lth < Qbin then unspec (global_modes (1)) = unspec (Temp_defaults.qbin);
	else do;
		if remote_params (Qbin) = Yes & local_params (Qbin) = Yes then global_modes (1)
			= Default_8bit_prefix;
		else if remote_params (Qbin) = Yes then global_modes (1) = local_params (Qbin);
		else if local_params (Qbin) = Yes then global_modes (1) = remote_params (Qbin);
		else if local_params (Qbin) ^= remote_params (Qbin) then unspec (global_modes (1)) = unspec (Temp_defaults.qbin);
		else if local_params (Qbin) = remote_params (Qbin) then global_modes (1) = local_params (Qbin);
	     end;

/*  Error detecting code  */
	if remote_lth < Chkt | local_params (Chkt) ^= remote_params (Chkt)
	then unspec (global_modes (2)) = unspec (Temp_defaults.chkt);
	else global_modes (2) = local_params (Chkt);

/*  Repeat prefix  */
	if remote_lth < Rept | local_params (Rept) ^= remote_params (Rept)
	then unspec (global_modes (3)) = unspec (Temp_defaults.rept);
	else global_modes (3) = local_params (Rept);

/* Capabilities */
	if remote_lth < Capas
	     then unspec (global_modes (4)) = "0"b;
	else unspec (global_modes (4))
	     = unspec (local_params (Capas)) & unspec (remote_params (Capas));
/* Window */
	global_modes (5) = " ";

/* Max extended packet length */
	if unspec (global_modes (4)) & Ext_Headers
	     then do;
	     /* some kermits leave invalid values for maxl, we don't use
	        maxl with ext_packets,  so ignore invalid value */
	     remote_params(1) = "^"; /* assume maxl is 94 when ext_packet */
	     
	     if remote_lth < Max_len_ext
	     then do;
	     global_modes (6) = "%"; /* the default is 500 for ext_packet */
	     global_modes (7) = "9";
	     end;
	     else do;
	     remote_len = rank (remote_params (12)) * 95
		+ rank (remote_params (13));
	     local_len = rank (local_params (12)) * 95
		+ rank (local_params (13));
	     remote_len = min (local_len, remote_len);
	     tmp = fixed (remote_len / 95);
	     global_modes (6) = byte (tmp);
	     global_modes (7) = byte (mod (remote_len, 95));
	     end;
	end;

/*  Store remote parameters  */
	call kermit_mode_mgr_$store (infop, Temporary, modes_select.remote, r_paramsp, ec);
	if ec ^= 0 then goto reset_modes;

/*  Store global parameters  */
	global_modesp = addr (global_modes);
	call kermit_mode_mgr_$store (infop, Temporary, modes_select.global, global_modesp, ec);

reset_modes:
	if reset_sw then
	     if ec=0 then call kermit_mode_mgr_$store (infop, Temporary, old_modes_select, old_modesp, ec);
	     else call kermit_mode_mgr_$store (infop, Temporary, old_modes_select, old_modesp, 0);
	return;
     end set_transfer_modes;

decode_params: proc (infop, datap, decoded_datap, n_params);

/**********************************************************************/
/*							*/
/*n 	Name:	kermit_xfer_modes_$decode_params	internal	*/
/*i 	Input:	infop, datap, decoded_datap        		*/
/*f 	Function: Decodes Send-Init data.			*/
/*o 	Output:	n_params					*/
/*							*/
/**********************************************************************/


/*  parameters  */

	dcl     datap		 ptr;
	dcl     decoded_datap	 ptr;
	dcl     infop		 ptr;
	dcl     n_params		 fixed bin (21);

/*  automatic  */

	dcl     idx		 fixed bin;

/*  based  */
	dcl     decoded_data	 (n_params) fixed bin (8) unal based (decoded_datap);
	dcl     packet_data		 (n_params) fixed bin (8) unal based (datap);


	do idx = 1 to n_params;
	     if Init_field (idx) = Char_coded then decoded_data (idx) = packet_data (idx) - 32;
	     else if Init_field (idx) = Ctl_coded then unspec (decoded_data (idx)) =
		     bool (unspec (packet_data (idx)), "100"b3, "0110"b);
	     else if Init_field (idx) = Binary_coded then
		decoded_data (idx) = packet_data (idx) - 48;
	     else decoded_data (idx) = packet_data (idx);
	end;

	return;
     end decode_params;

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