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