net_convert_ascii_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 149481 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ net_convert_ascii_: procedure (); /* "net_convert_ascii_" -- a collection of procedures used in */ /* converting from Network characters (9 bits) to Multics characters (9 */ /* bits). The most common subsets of conversions are here so that, if */ /* necessary, this module can be converted to assembly language for */ /* efficiency. */ /* The interfaces to all entries in this module are identical: */ /* The info_ptr is ignored (but is here because it makes the calling */ /* sequence of this entries similar to others having to do with code */ /* conversion (and someday, it just might be useful). */ /* The input_ptr and output_ptr parameters point to an I/O workspace */ /* (i.e., word aligned). The next_XXX argument indicates the next */ /* available (from the beginning) byte to be read from/stored into. */ /* The last_XXX argument indicates the last available byte. Notice */ /* that the next_XXX argument is thus both an input and an output arg. */ /* Originally written by D. M. Wells 30 April, 1974. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_first_in fixed binary (24), /* first byte in workspace to process */ P_num_in fixed binary (24), /* num bytes in workspace to process */ P_num_in_proc fixed binary (24), /* num bytes in workspace actually processed */ P_first_out fixed binary (24), /* first available byte in output workspace */ P_num_out fixed binary (24), /* num available bytes in output workspace */ P_num_out_proc fixed binary (24), /* num bytes actually placed in output workspace */ P_error_code fixed binary (35), /* always returned as zero */ P_info_ptr pointer, /* unused, makes arg list similar to other procs */ P_input_ptr pointer, /* points to input I/O workspace */ P_output_ptr pointer) /* points to output I/O workspace */ parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (byte_num_in fixed binary (3), /* byte offset (within element) of next input */ byte_num_out fixed binary (3), /* byte offset (within element) of next output */ next_in fixed binary (24), /* always indicates next input byte */ next_out fixed binary (24), /* always indicates next output byte */ last_in fixed binary (24), /* indicates last input byte */ last_out fixed binary (24), /* indicates last output byte */ string_offset fixed binary (18), current_byte bit (9), temp_byte bit (9), /* used to remember last byte during lookahead */ in_string_ptr pointer, /* points to current input element */ out_string_ptr pointer, /* points to current output element */ input_ptr pointer, /* automatic copy of P_input_ptr */ output_ptr pointer) /* automatic copy of P_output_ptr */ automatic; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare (NUL initial ("000000000"b), NL initial ("000001010"b), CR initial ("000001101"b), SP initial ("000100000"b), PAD initial ("001111111"b), Max_Byte initial ("011111111"b)) bit (9) internal static options (constant); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare (based_bit36_algn bit (36) aligned, based_bit36_array (0 : 1) bit (36) aligned) based; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$chars_after_delim fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare (addr, divide, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_special_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ in_middle_of_input_sequence: call copy_back_parameters (); P_error_code = error_table_$chars_after_delim; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ out_of_input_bytes: out_of_output_space: call copy_back_parameters (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ /* This entry point does a particular translation of Network */ /* ASCII to Multics ASCII. In particular, it only implements the */ /* CR-LF -> NL, CR-NUL -> CR, and NUL -> /0 conversions. In general, */ /* programs will have to do separate translations for conversions */ /* not performed here. These other translations can generally be */ /* performed by a PL/1 translate statement. */ net_to_multics: entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc, P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code); call copy_in_parameters (); do next_in = next_in by 1 to last_in; call fetch_9_bits (); if current_byte >= SP /* All controls are less than space */ then if current_byte <= Max_Byte then call store_9_bits (); /* bigger than space, and still in 8-bit space */ else; /* bigger than 8-bit data space, ignore this */ else if current_byte = CR then do; /* this is a CR, look at next char for info */ if next_in + 1 > last_in then goto in_middle_of_input_sequence; /* see if we can look at one more char */ next_in = next_in + 1; /* update to next character */ call fetch_9_bits (); /* fetch the next input byte */ if current_byte = NL then call store_9_bits (); /* store this NL character */ else if current_byte = NUL then do; current_byte = CR; /* this was CR-NUL, store a CR */ call store_9_bits (); end; else do; /* PROTOCOL VIOLATION -- but attempt to recover */ current_byte = CR; /* pick up a CR again */ call store_9_bits (); /* and store it */ next_in = next_in - 1; /* back down on the input byte num */ byte_num_in = -1; /* and cause recomputation of byte num */ end; end; else if current_byte ^= NUL /* pass through all but NULs */ then call store_9_bits (); end; call copy_back_parameters (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ /* This entry point translates from Multics ASCII to Network */ /* ASCII. This includes: NL -> CR-LF, CR -> CR-NUL, and PAD -> /0 */ multics_to_net: entry (P_info_ptr, P_input_ptr, P_first_in, P_num_in, P_num_in_proc, P_output_ptr, P_first_out, P_num_out, P_num_out_proc, P_error_code); call copy_in_parameters (); do next_in = next_in by 1 to last_in; call fetch_9_bits (); if current_byte >= SP then do; /* if above SP */ if current_byte > Max_Byte then; /* ignore characters out of 8-bit data space */ else if current_byte ^= PAD then call store_9_bits (); /* then store, if not a PAD */ end; else do; /* else this is a control character */ if current_byte = NL then do; /* this is a NL character, handle specially */ if next_out + 1 > last_out then goto out_of_output_space; /* we dont have enough room left, give up */ current_byte = CR; /* NL gets replaced by CR-LF */ call store_9_bits (); current_byte = NL; call store_9_bits (); end; else if current_byte = CR then do; /* this is a CR character, handler specially */ if next_out + 1 > last_out then goto out_of_output_space; /* not enough room left, give up */ call store_9_bits (); /* store the CR and then follow it by a NUL */ current_byte = NUL; call store_9_bits (); end; else call store_9_bits (); /* otherwise, just store the random character */ end; end; call copy_back_parameters (); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ copy_in_parameters: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ P_error_code = 0; byte_num_in = -1; byte_num_out = -1; input_ptr = P_input_ptr; next_in = P_first_in; last_in = P_first_in + P_num_in - 1; next_out = P_first_out; last_out = P_first_out + P_num_out - 1; output_ptr = P_output_ptr; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ copy_back_parameters: entry (); P_num_out_proc = next_out - P_first_out; P_num_in_proc = next_in - P_first_in; return; end; /* end copy_in_parameters */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ fetch_9_bits: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ goto fetch_nine (byte_num_in); /* * * * * * * * * * * * * * * * * * * */ fetch_nine (-1): string_offset = divide (next_in, 4, 18, 0); /* which 36-bit element are we referencing */ byte_num_in = next_in - 4 * string_offset; /* which byte in that 36-bit element */ in_string_ptr = addr (input_ptr -> based_bit36_array (string_offset)); /* addr of element */ goto fetch_nine (byte_num_in); /* * * * * * * * * * * * * * * * * * * */ fetch_nine (0): current_byte = substr (in_string_ptr -> based_bit36_algn, 1, 9); byte_num_in = byte_num_in + 1; /* will be 1, but use "aos" instruction */ return; /* * * * * * * * * * * * * * * * * * * */ fetch_nine (1): current_byte = substr (in_string_ptr -> based_bit36_algn, 10, 9); byte_num_in = byte_num_in + 1; /* will be 2, but use "aos" instruction */ return; /* * * * * * * * * * * * * * * * * * * */ fetch_nine (2): current_byte = substr (in_string_ptr -> based_bit36_algn, 19, 9); byte_num_in = byte_num_in + 1; /* will be 3 */ return; /* * * * * * * * * * * * * * * * * * * */ fetch_nine (3): current_byte = substr (in_string_ptr -> based_bit36_algn, 28, 9); byte_num_in = 0; in_string_ptr = addr (in_string_ptr -> based_bit36_array (1)); /* move to next element */ return; end; /* end fetch_9_bits */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ store_9_bits: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ if next_out > last_out then goto out_of_output_space; next_out = next_out + 1; goto store_nine (byte_num_out); /* * * * * * * * * * * * * * * * * * * */ store_nine (-1): string_offset = divide ((next_out - 1), 4, 18, 0); /* which 36-bit element is referenced */ byte_num_out = (next_out - 1) - 4 * string_offset; /* which byte in that 36-bit element */ out_string_ptr = addr (output_ptr -> based_bit36_array (string_offset)); /* addr of element */ goto store_nine (byte_num_out); /* * * * * * * * * * * * * * * * * * * */ store_nine (0): substr (out_string_ptr -> based_bit36_algn, 1, 9) = current_byte; byte_num_out = byte_num_out + 1; /* will be 1, but use "aos" instruction */ return; /* * * * * * * * * * * * * * * * * * * */ store_nine (1): substr (out_string_ptr -> based_bit36_algn, 10, 9) = current_byte; byte_num_out = byte_num_out + 1; /* will be 2, but use "aos" instruction */ return; /* * * * * * * * * * * * * * * * * * * */ store_nine (2): substr (out_string_ptr -> based_bit36_algn, 19, 9) = current_byte; byte_num_out = byte_num_out + 1; /* will be 3 */ return; /* * * * * * * * * * * * * * * * * * * */ store_nine (3): substr (out_string_ptr -> based_bit36_algn, 28, 9) = current_byte; byte_num_out = 0; out_string_ptr = addr (out_string_ptr -> based_bit36_array (1)); /* move to next element */ return; end; /* end store_9_bits */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end net_convert_ascii_ */ end;  telnet_cmd_processor_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 48438 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_cmd_processor_: procedure (); /* This procedure is the request processor for the telnet_user and */ /* user_ftp requests. Requests are looked up in the appropriate request */ /* table (telnet_command_table_ or telnet_command_table_) by calling */ /* the find command routine. As a special case, any request whose first */ /* character is a question mask (?) actually causes a list of requests */ /* to be printed out together with a short explanation of what the */ /* request does. */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_num_chars fixed binary (24), P_error_code fixed binary (35), (P_line_ptr, P_IB_ptr) pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_command_line character (P_num_chars) based; declare 1 input_buffer aligned based, 2 byte (0 : P_num_chars - 1) bit (9) unaligned; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare telnet_command_table_$telnet_command_table_ external static; declare (error_table_$badcall, error_table_$id_not_found, error_table_$unbalanced_quotes) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), ioa_ constant entry options (variable), execute_command_line_ constant entry (char (*), entry (char (*), ptr, fixed bin (35)), fixed bin (35)), telnet_find_command_ constant entry (char (*), ptr, entry (ptr, ptr), bit (36) aligned, fixed bin (35)), telnet_find_command_$list_command_summary constant entry (ptr, fixed bin (35)); declare (addr, null, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ process_command_line: entry (P_IB_ptr, P_line_ptr, P_num_chars, P_error_code); P_error_code = 0; if substr (P_line_ptr -> based_command_line, 1, 1) = "?" then do; /* special case any line that starts with "?" */ call ioa_ ("Commands are:^/"); call telnet_find_command_$list_command_summary (addr (telnet_command_table_$telnet_command_table_), P_error_code); return; end; call execute_command_line_ (P_line_ptr -> based_command_line, call_routine, P_error_code); /* go have the request line interpreted */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ call_routine: procedure (P_command_name, P_arg_list_ptr, P_error_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_command_name character (*), P_error_code fixed binary (35), P_arg_list_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (command_info bit (36) aligned, command_entry variable entry (ptr, ptr)) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ call telnet_find_command_ (P_command_name, addr (telnet_command_table_$telnet_command_table_), command_entry, command_info, P_error_code); if P_error_code ^= 0 then do; if P_error_code = error_table_$id_not_found then call com_err_ ((36)"0"b, IB.error_identifier, "Unrecognized request: ^a; Type the request ""?"" for request list", P_command_name); else call com_err_ (P_error_code, IB.error_identifier, ""); return; end; call command_entry (P_IB_ptr, P_arg_list_ptr); /* go call the request handler */ return; end; /* end call_routine */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_cmd_processor_ */ end;  telnet_command_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 45936 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_command_: procedure (); /* This module contains the command entry points for the */ /* user_telnet command. It allocates space for the command instance */ /* block and then calls a subroutine to initialize it. It then calls */ /* the listener which performs all futher work. */ /* Originally written by D. M. Wells. */ /* Last modified by D. M. Wells, July, 1975 to use telnet IOSIM. */ /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (err_code fixed binary (35), unique_identifier bit (70), IB_ptr pointer) automatic; declare 1 IB aligned automatic like telnet_option_template; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare (error_table_$bad_index, /* used to mean internal error detected */ error_table_$no_message) /* means a message has already been printed */ fixed binary (35) external static; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare PROG character (32) initial ("user_telnet") internal static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), cu_$arg_list_ptr constant entry () returns (ptr), hcs_$make_ptr constant entry (entry, char (*), char (*), ptr, fixed bin (35)), net_data_transfer_$net_data_transfer_attach constant entry options (variable), telnet_control_args_$process_arguments constant entry (ptr, ptr, fixed bin (35)), telnet_instance_$create_instance constant entry (ptr, char (*), fixed bin (35)), telnet_instance_$declare_ftp_instance constant entry (ptr, fixed bin (35)), telnet_instance_$declare_telnet_instance constant entry (ptr, fixed bin (35)), telnet_instance_$declare_tip_talk_instance constant entry (ptr, fixed bin (35)), telnet_instance_$destroy_instance constant entry (ptr, fixed bin (35)), telnet_listener_ constant entry (ptr, fixed bin (35)), unique_bits_ constant entry () returns (bit (70)); declare null builtin; /* * * * * STACK REFERENCES * * * * * * * * * * */ declare (cleanup, telnet_abort_) condition; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller: return; /* * * * * * * * * * * * * * * * * * * * * * * * */ user_telnet: telnet: entry (); IB_ptr = addr (IB); IB.unique_identifier = ""b; /* setup so that no problems with cleanup */ on cleanup call cleanup_connections (); on telnet_abort_ goto cleanup_and_leave; unique_identifier = unique_bits_ (); /* get a unique identifier for debugging */ call telnet_instance_$create_instance (IB_ptr, (PROG), err_code); if err_code ^= 0 then goto report_error_to_user; call telnet_instance_$declare_telnet_instance (IB_ptr, err_code); if err_code ^= 0 then goto report_error_to_user; call telnet_control_args_$process_arguments (IB_ptr, cu_$arg_list_ptr (), err_code); if err_code ^= 0 then goto report_error_to_user; call telnet_listener_ (IB_ptr, err_code); if err_code ^= 0 then goto report_error_to_user; call cleanup_connections (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ report_error_to_user: if err_code ^= error_table_$no_message then call com_err_ (err_code, (PROG), ""); cleanup_and_leave: call cleanup_connections (); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ cleanup_connections: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ if IB.unique_identifier ^= ""b then call telnet_instance_$destroy_instance (IB_ptr, err_code); return; end cleanup_connections; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_command_ */ end;  telnet_command_table_.mexp 09/23/77 1038.1rew 09/23/77 0809.2 37296 name telnet_command_table_ " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Segment containing correspondence table between a request name and " the procedure which implements that request for the telnet command. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Originally created by D. M. Wells on 10 April, 1974. " Last modified by D. M. Wells, October, 1975 for removing connect " type commands. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Macro definitions: " &include telnet_command_macros " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Requests for the user_telnet command: table_start telnet_command_table_ command abort_output,telnet_misc_commands_,process_abort_output,OK,(send TELNET 'Abort Output' command.) command abort_request,telnet_misc_commands_,process_abort,OK,(return to top listening level of telnet command.) command ao,telnet_misc_commands_,process_abort_output,OK,NOLIST command ar,telnet_misc_commands_,process_abort,OK,NOLIST command are_you_there,telnet_misc_commands_,process_are_you_there,OK,(send TELNET 'Are You There?' command.) command ascii,telnet_misc_commands_,process_ascii,OK,(Send a named ASCII character.) command ayt,telnet_misc_commands_,process_are_you_there,OK,NOLIST command break,telnet_misc_commands_,process_break,OK,(send a TELNET 'Break' Command.) command brk,telnet_misc_commands_,process_break,OK,NOLIST " command close,telnet_misc_commands_,process_disconnect,OK,NOLIST " command connect,telnet_misc_commands_,process_connect,OK,(create a connection to foreign host.) command control,telnet_misc_commands_,process_control,OK,(send a TTY 'control' character.) command ctl,telnet_misc_commands_,process_control,OK,NOLIST " command disconnect,telnet_misc_commands_,process_disconnect,OK,(close connections to foreign host.) command e,telnet_misc_commands_,process_execute,OK,NOLIST command E,telnet_misc_commands_,process_execute,OK,NOLIST command ec,telnet_misc_commands_,process_erase,OK,NOLIST command el,telnet_misc_commands_,process_kill,OK,NOLIST command erase,telnet_misc_commands_,process_erase,OK,(send a TELNET 'Erase Character' command.) command escape,telnet_misc_commands_,process_escape,OK,(change request escape character) command execute,telnet_misc_commands_,process_execute,OK,(execute a Multics command.) command exit,telnet_misc_commands_,process_exit,OK,(return from telnet command.) command ga,telnet_misc_commands_,process_go_ahead,OK,NOLIST command go_ahead,telnet_misc_commands_,process_go_ahead,OK,(send a TELNET 'Go Ahead' command.) command help,telnet_misc_commands_,process_help,OK,NOLIST command interrupt,telnet_misc_commands_,process_interrupt,OK,(send a TELNET 'Interrupt Process' command.) command ip,telnet_misc_commands_,process_interrupt,OK,NOLIST command kill,telnet_misc_commands_,process_kill,OK,(send a TELNET 'Erase Line' command.) command nop,telnet_misc_commands_,process_nop,OK,(send a TELNET 'NOP' command.) command option,telnet_misc_commands_,process_option,OK,NOLIST command quit,telnet_misc_commands_,process_exit,OK,NOLIST command st,telnet_status_,process_telnet_status,OK,NOLIST command status,telnet_status_,process_telnet_status,OK,(print a summary of status of connections.) command timeout,telnet_misc_commands_,process_timeout,OK,(change length of timeout period.) table_finish telnet_command_table_ " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " join /text/table_area,string_area,comment_area end  telnet_connection_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 73800 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_connection_: procedure (); /* This collection of procedures is the basic handler for the */ /* TELNET connection that is set up between this host and the foreign */ /* host. There is a routine which will read from the connection and a */ /* routine which will write to the connection. (There is also a routine */ /* to send uninterpreted bytes to the network for use by TELNET protocol */ /* routines outside of this set of routines.) */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_num_bytes fixed binary (24), P_error_code fixed binary (35), (P_line_ptr, P_IB_ptr) pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((first_to_write, num_to_write, num_written) fixed binary (24), err_code fixed binary (35)) automatic; declare 1 wait_list aligned automatic, 2 num_chans fixed binary (17), 2 channel (1) fixed binary (71); declare 1 event_message aligned automatic like event_message_template; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ /* * * * * DEFINED REFERENCES * * * * * * * ** */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * DEFINED REFERENCES * * * * * * * * * */ /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_char_string character (1048576) based; declare 1 based_workspace aligned based, 2 byte (0 : 1) bit (9) unaligned; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare (error_table_$device_active, error_table_$net_invalid_state, error_table_$no_message) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), ipc_$block constant entry (ptr, ptr, fixed bin (35)), user_telnet_io_$ut_async_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_io_$ut_async_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)); declare (addr, dimension, null, substr, translate) builtin; /* * * * * STACK REFERENCES * * * * * * * * * * */ declare telnet_instance_error_ condition; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include net_event_template; % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* Routine to read from the TELNET connection and process any */ /* protocol information that it may find. The caller is assumed to */ /* have setup a 256 character buffer for these characters. */ receive_buffer: entry (P_IB_ptr, P_line_ptr, P_num_bytes, P_error_code); P_error_code = 0; P_num_bytes = 0; if IB.icp_in_progress then return; call user_telnet_io_$ut_async_get_chars (IB.telnet_cdb, P_line_ptr, 256, P_num_bytes, IB.read_event_channel, P_error_code); if P_error_code = error_table_$device_active then P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ /* Routine to send data characters to the other system via the */ /* TELNET connection. If the protocol is the new TELNET, a data */ /* space of 8 bits is allowed, while if the old protocol is in effect */ /* a data space of only 7 bits is allowed. */ transmit_buffer: entry (P_IB_ptr, P_line_ptr, P_num_bytes, P_error_code); if IB.upper_case then do; substr (P_line_ptr -> based_char_string, 1, P_num_bytes) = translate (substr (P_line_ptr -> based_char_string, 1, P_num_bytes), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz"); end; wait_list.num_chans = 1; wait_list.channel (1) = IB.write_event_channel; first_to_write = 0; num_to_write = P_num_bytes; P_error_code = 0; do while ((num_to_write > 0) | (P_error_code ^= 0)); call user_telnet_io_$ut_async_put_chars (IB.telnet_cdb, addr (P_line_ptr -> based_workspace.byte (first_to_write)), num_to_write, num_written, IB.write_event_channel, P_error_code); num_to_write = num_to_write - num_written; first_to_write = first_to_write + num_written; if P_error_code ^= 0 then if P_error_code ^= error_table_$device_active then call interpret_ncp_status (P_error_code); if (num_to_write > 0) | (P_error_code ^= 0) then do; call ipc_$block (addr (wait_list), addr (event_message), P_error_code); if P_error_code ^= 0 then call report_error_to_user (P_error_code); end; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_ncp_status: procedure (P_ncp_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_ncp_err_code fixed binary (35) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ if P_ncp_err_code ^= error_table_$net_invalid_state then call report_error_to_user (P_ncp_err_code); call com_err_ (P_ncp_err_code, IB.error_identifier, "Socket has gone into unexpected state"); call report_error_to_user (error_table_$no_message); end; /* end interpret_ncp_status */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ report_error_to_user: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ IB.nonlocal_error_code = P_err_code; signal telnet_instance_error_; end; /* end report_error_to_user */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_connection_ */ end;  telnet_control_args_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 114354 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_control_args_: procedure (); /* This procedure interprets control arguments for the user_telnet */ /* and user_ftp commands. See the parsing of control args to see what */ /* current control args are. */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_error_code fixed binary (35), (P_arg_list_ptr, P_IB_ptr) pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (arg_indx fixed binary (17), arg_length fixed binary (24), err_code fixed binary (35), arg_ptr pointer) automatic; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare (based_argument character (arg_length), based_command_line character (command_line_length), based_command_char_array (1 : command_line_length) character (1)) based; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$no_message fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), convert_binary_integer_$decimal_string constant entry (fixed bin (35)) returns (char (12) varying), cu_$arg_ptr_rel constant entry (fixed bin (17), ptr, fixed bin (24), fixed bin (35), ptr), cv_dec_check_ constant entry (char (*), fixed bin (35)) returns (fixed bin (35)), host_id_$check_id constant entry (char (*), bit (1), fixed bin (16), bit (1), fixed bin (35)), host_id_$symbol constant entry (fixed bin (16), char (*), fixed bin (35)); declare (substr, unspec) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ process_arguments: entry (P_IB_ptr, P_arg_list_ptr, P_error_code); P_error_code = 0; arg_indx = 0; do while (got_next_arg ()); if substr (arg_ptr -> based_argument, 1, 1) ^= "-" /* assume this is host name */ then call interpret_host_name (arg_ptr -> based_argument); else call interpret_control_argument (substr (arg_ptr -> based_argument, 2)); if P_error_code ^= 0 then return; end; if IB.foreign_host = -1 then do; call com_err_ (0, IB.error_identifier, "No foreign host name specified in command line."); P_error_code = error_table_$no_message; return; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ got_next_arg: procedure () returns (bit (1)); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ arg_indx = arg_indx + 1; call cu_$arg_ptr_rel (arg_indx, arg_ptr, arg_length, err_code, P_arg_list_ptr); return (err_code = 0); end; /* end got_next_arg */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_host_name: procedure (P_host_name); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_host_name character (*) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * */ if IB.foreign_host ^= -1 then do; call com_err_ (0, IB.error_identifier, "More than one host name specified."); P_error_code = error_table_$no_message; return; end; call host_id_$check_id (P_host_name, "0"b, IB.foreign_host, ("0"b), err_code); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, """^a"" is not a recognized host identifier.", P_host_name); P_error_code = error_table_$no_message; return; end; call host_id_$symbol (IB.foreign_host, IB.host_name, err_code); if err_code ^= 0 then IB.host_name = "HOST-" || convert_binary_integer_$decimal_string ((IB.foreign_host)); return; end; /* end interpret_host_name */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_control_argument: procedure (P_control_argument); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_control_argument character (*) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * */ if (P_control_argument = "uppercase") | (P_control_argument = "uc") then do; IB.upper_case = "1"b; return; end; if (P_control_argument = "socket") | (P_control_argument = "sc") then do; if ^ got_next_arg () then do; call com_err_ (0, IB.error_identifier, "No socket number supplied."); P_error_code = error_table_$no_message; return; end; IB.foreign_icp_socket = cv_dec_check_ (arg_ptr -> based_argument, err_code); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "Socket specified ""^a"" is not a decimal number.", arg_ptr -> based_argument); P_error_code = error_table_$no_message; return; end; IB.telnet_connection_compatibility = "0"b; return; end; if IB.icp_info.attach_type = "connect" /* if in tip_talk and not telnet */ then do; if P_control_argument = "port" then do; if ^ got_next_arg () then do; call com_err_ (0, IB.error_identifier, "No port number supplied."); P_error_code = error_table_$no_message; return; end; IB.foreign_icp_socket = cv_dec_check_ (arg_ptr -> based_argument, err_code) * 65536 + 2; if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "Port specified ""^a"" is not a decimal number.", arg_ptr -> based_argument); P_error_code = error_table_$no_message; return; end; return; end; end; if (P_control_argument = "escape_char") | (P_control_argument = "ec") then do; if ^ got_next_arg () then do; call com_err_ (0, IB.error_identifier, "No escape character provided."); P_error_code = error_table_$no_message; return; end; if arg_length ^= 1 then do; call com_err_ (0, IB.error_identifier, "The escape sequence is not exactly one character in length."); P_error_code = error_table_$no_message; return; end; IB.escape_char = arg_ptr -> based_argument; IB.escape_byte = unspec (IB.escape_char); return; end; if (P_control_argument = "timeout") then do; if ^ got_next_arg () then do; call com_err_ (0, IB.error_identifier, "No timeout value specified."); P_error_code = error_table_$no_message; return; end; IB.icp_timeout = cv_dec_check_ (arg_ptr -> based_argument, err_code); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "Timeout value ""^a"" is not a decimal integer.", arg_ptr -> based_argument); P_error_code = error_table_$no_message; return; end; return; end; if (P_control_argument = "protocol") then do; if ^ got_next_arg () then do; call com_err_ (0, IB.error_identifier, "The protocol control argument requires an argument: 18639, 9348, new, none"); P_error_code = error_table_$no_message; return; end; call interpret_protocol_identifier (arg_ptr -> based_argument); return; end; if (P_control_argument = "help") then do; call com_err_ (0, IB.error_identifier, "No help yet, sorry"); P_error_code = error_table_$no_message; return; end; if (P_control_argument = "no_quit_handler") then do; IB.ignore_quits = "1"b; return; end; if (P_control_argument = "debug") then do; IB.in_debug_mode = "1"b; return; end; call com_err_ (0, IB.error_identifier, """^a"" is not a recognized argument.", P_control_argument); P_error_code = error_table_$no_message; return; end; /* end interpret_control_argument */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_protocol_identifier: procedure (P_protocol); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_protocol character (*) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ if arg_ptr -> based_argument = "18639" then do; IB.protocol_18639 = "1"b; return; end; if arg_ptr -> based_argument = "new" then do; IB.protocol_18639 = "1"b; return; end; if arg_ptr -> based_argument = "none" then do; IB.protocol_18639, IB.protocol_9348, IB.report_protocol_violations = "0"b; return; end; if arg_ptr -> based_argument = "9348" then do; IB.protocol_9348 = "1"b; return; end; call com_err_ (0, IB.error_identifier, "The protocol control argument requires a value of: 18639, 9348, new, or none."); P_error_code = error_table_$no_message; return; end; /* end interpret_protocol_identifier */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_control_args_ */ end;  telnet_find_command_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 63756 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_find_command_: procedure (P_command_name, P_table_ptr, P_processor, P_command_info, P_error_code); /* This is the procedure that looks up requests for the user_telnet */ /* and user_ftp commands. The declarations for the command entries in */ /* this module must correspond to the assembly language declarations of */ /* the same things as declared in the command tables. */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_command_name character (*), P_error_code fixed binary (35), P_command_info bit (36) aligned, P_table_ptr pointer, P_processor variable entry (ptr, ptr)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (command_indx fixed binary (17), entry_ptr pointer) automatic; /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare 1 based_table aligned based, 2 num_commands fixed binary (17), 2 entry (1 : 1 refer (based_table.num_commands)) like command_entry; declare 1 acc_string aligned based, 2 count fixed binary (8) unaligned, 2 char_string character (0 refer (acc_string.count)) unaligned; declare 1 command_entry aligned based, 2 name_ptr_rel bit (18) aligned, 2 space bit (36) aligned, 2 getlp bit (36) aligned, 2 tra_to_command bit (36) aligned, 2 explanation_rel bit (18) aligned; declare 1 entry_variable_struc aligned based, 2 text_pointer pointer, 2 stack_pointer pointer; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$id_not_found fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare ioa_ constant entry options (variable); declare (addr, index, length, null, pointer) builtin; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ entry_ptr = lookup_command (P_table_ptr, P_command_name); /* lookup this request in telnet table */ if entry_ptr = null () then do; P_error_code = error_table_$id_not_found; return; end; /* we have found the right command, generate an */ /* entry variable to point to the executable code */ /* that is in the command entry. */ addr (P_processor) -> entry_variable_struc.text_pointer = addr (entry_ptr -> command_entry.getlp); addr (P_processor) -> entry_variable_struc.stack_pointer = null (); P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ list_command_summary: entry (P_table_ptr, P_error_code); call list_explanations (P_table_ptr); P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ lookup_command: procedure (P_command_table_ptr, P_command) returns (ptr); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_command character (*), P_command_table_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (table_indx fixed binary (17), command_length fixed binary (24), (entry_ptr, name_ptr) pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ command_length = index (P_command, " ") - 1; if command_length = -1 then command_length = length (P_command); do command_indx = 1 by 1 to P_command_table_ptr -> based_table.num_commands; entry_ptr = addr (P_command_table_ptr -> based_table.entry (command_indx)); name_ptr = pointer (entry_ptr, entry_ptr -> command_entry.name_ptr_rel); if name_ptr -> acc_string.count = command_length then if name_ptr -> acc_string.char_string = P_command then return (entry_ptr); end; return (null ()); end; /* end lookup_command */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ list_explanations: procedure (P_command_table_ptr); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_command_table_ptr pointer parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (table_indx fixed binary (17), entry_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ do table_indx = 1 by 1 to P_command_table_ptr -> based_table.num_commands; entry_ptr = addr (P_command_table_ptr -> based_table.entry (table_indx)); if entry_ptr -> command_entry.explanation_rel ^= ""b then do; call ioa_ ("^20a^a", pointer (entry_ptr, entry_ptr -> command_entry.name_ptr_rel) -> acc_string.char_string, pointer (entry_ptr, entry_ptr -> command_entry.explanation_rel) -> acc_string.char_string); end; end; call ioa_ (""); return; end; /* end list_explanations */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_find_command_ */ end;  telnet_instance_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 129348 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_instance_: procedure (); /* This set of routines maintains the various "instances" of the */ /* user_telnet and user_ftp commands that may exist. (Notice that these */ /* commands may be used reentrantly, and even simultaneously). The */ /* entry points here generally do such things as initialize the TELNET */ /* Instance Blocks (IB's), and release resources when terminating, etc.*/ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_error_identifier character (*), P_error_code fixed binary (35), P_IB_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (err_code fixed binary (35), attach_description (5) character (64) varying) automatic; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare (default_timeout fixed binary (17) initial (15), default_escape_byte bit (9) initial ("000100001"b)) /* default escape is "!" -- 041 octal */ internal static; /* * * * * DEFINED DECLARATIONS * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare (iox_$user_output pointer, user_telnet_orders_$send_NOP character (32)) external static; declare (error_table_$badcall, error_table_$device_active, error_table_$net_fhost_down, error_table_$net_fimp_down, error_table_$net_invalid_state) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare convert_binary_integer_$decimal_string constant entry (fixed bin (35)) returns (char (12) varying), ioa_$rsnnl constant entry options (variable), ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)), ipc_$delete_ev_chn constant entry (fixed bin (71), fixed bin (35)), net_pin_manager_$allocate_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)), net_pin_manager_$free_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)), unique_bits_ constant entry () returns (bit (70)), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)), user_telnet_xtach_$user_telnet_ constant entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)), user_telnet_xtach_$ut_async_close constant entry (ptr, ptr, fixed bin (71), fixed bin (35)), user_telnet_xtach_$ut_async_open constant entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)), user_telnet_xtach_$ut_detach constant entry (ptr, ptr, fixed bin (35)); declare (addr, null, string, unspec) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ perform_icp: entry (P_IB_ptr, P_error_code); if (IB.foreign_host = -1) | (IB.foreign_icp_socket = -1) then do; P_error_code = error_table_$badcall; return; end; IB.local_icp_pin = -1; try_a_new_set_of_pins: call close_any_connections (); call net_pin_manager_$allocate_pins (8, IB.local_icp_pin, P_error_code); if P_error_code ^= 0 then return; call ioa_$rsnnl ("^d,^d", attach_description (1), (0), IB.foreign_host, IB.foreign_icp_socket); attach_description (2) = "-connect"; attach_description (3) = IB.attach_type; attach_description (4) = "-local_pin"; attach_description (5) = convert_binary_integer_$decimal_string ((IB.local_icp_pin)); IB.icp_in_progress = "1"b; call user_telnet_xtach_$user_telnet_ (IB.telnet_cdb, attach_description, "1"b, IB.attach_descr_ptr, P_error_code); if P_error_code ^= 0 then return; if IB.in_debug_mode then call user_telnet_state_$ut_control (IB.telnet_cdb, "trace", iox_$user_output, (0)); call user_telnet_state_$ut_control (IB.telnet_cdb, "timeout", addr (IB.icp_timeout), P_error_code); if P_error_code ^= 0 then return; call user_telnet_xtach_$ut_async_open (IB.telnet_cdb, 3, attach_description, IB.open_descr_ptr, IB.icp_event_channel, P_error_code); if P_error_code ^= error_table_$device_active then do; if (P_error_code = error_table_$net_invalid_state) then goto try_a_new_set_of_pins; /* NCP doesnt like these pins, try some new ones */ IB.icp_in_progress = "0"b; return; end; call user_telnet_state_$ut_control (IB.telnet_cdb, "set_users_output_iocb", iox_$user_output, P_error_code); if P_error_code ^= 0 then return; P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ check_for_icp_conclusion: entry (P_IB_ptr, P_error_code); P_error_code = 0; if ^ IB.icp_in_progress then return; call test_icp_conclusion (P_error_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* This subroutine completes a connection (including noting */ /* that the connection didn't complete). This procedure also */ /* configures each connection by doing such things as sending NO-OPs */ /* ove the connection if that is desired, and attaching the extra */ /* pins for an FTP. One other thing done is to implement the telnet */ /* connection compatibility feature which may be simply described as */ /* follows: Because Multics wants to run new TELNET and the other */ /* systems are not ready, we will initially connect to socket 23 of */ /* the foreign host. If we are in this compatibility mode, and if */ /* the connection to socket 23 fails, we will attempt to connect to */ /* socket 1 of the foreign host if there is any reason to believe */ /* that such a connection might work. */ test_icp_conclusion: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * */ attach_description (1) = ""; attach_description (2) = ""; call user_telnet_xtach_$ut_async_open (IB.telnet_cdb, 3, attach_description, IB.open_descr_ptr, IB.icp_event_channel, P_err_code); if P_err_code = error_table_$device_active then do; P_err_code = 0; return; end; if P_err_code ^= 0 then do; if IB.telnet_connection_compatibility then do; if (P_err_code ^= error_table_$net_fhost_down) & (P_err_code ^= error_table_$net_fimp_down) then do; IB.telnet_connection_compatibility = "0"b; IB.foreign_icp_socket = 1; call perform_icp (P_IB_ptr, P_err_code); return; end; end; end; IB.icp_in_progress = "0"b; call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_NOP, null, (0)); return; end; /* end test_icp_conclusion */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ declare_telnet_instance: entry (P_IB_ptr, P_error_code); P_error_code = 0; IB.icp_info.attach_type = "icp"; if IB.foreign_icp_socket = -1 then do; IB.telnet_connection_compatibility = "1"b; IB.foreign_icp_socket = 23; end; call ipc_$create_ev_chn (IB.write_event_channel, P_error_code); if P_error_code ^= 0 then return; call ipc_$create_ev_chn (IB.read_event_channel, P_error_code); if P_error_code ^= 0 then return; call ipc_$create_ev_chn (IB.icp_event_channel, P_error_code); if P_error_code ^= 0 then return; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ create_instance: entry (P_IB_ptr, P_error_identifier, P_error_code); IB.error_identifier = P_error_identifier; IB.host_name = ""; IB.foreign_host = -1; IB.foreign_icp_socket = -1; IB.local_icp_pin = -1; IB.telnet_connection_compatibility = "0"b; IB.telnet_cdb = null (); IB.attach_descr_ptr = null (); IB.open_descr_ptr = null (); IB.write_event_channel = -1; IB.read_event_channel = -1; IB.icp_event_channel = -1; /* compiler gets fault on string(...) if thingie is defined */ string (P_IB_ptr -> telnet_option_template.instance_parms.current_modes) = ""b; IB.current_modes.continue_in_telnet = "1"b; IB.report_protocol_violations = "0"b; string (P_IB_ptr -> telnet_option_template.icp_info.flags) = ""b; IB.escape_byte = default_escape_byte; unspec (IB.escape_char) = default_escape_byte; /* for use by ioa_ */ IB.icp_timeout = default_timeout; /* IB.transmit_connection.option_status (3).option_supported = "1"b; /* allow Go-Ahead suppression */ /* IB.receive_connection.option_status (3).option_supported = "1"b; /* allow Go-Ahead suppression */ IB.unique_identifier = unique_bits_ (); P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ destroy_instance: entry (P_IB_ptr, P_error_code); P_error_code = 0; call close_any_connections (); if IB.icp_event_channel ^= -1 then call delete_event_channel (IB.icp_event_channel); if IB.read_event_channel ^= -1 then call delete_event_channel (IB.read_event_channel); if IB.write_event_channel ^= -1 then call delete_event_channel (IB.write_event_channel); IB.unique_identifier = ""b; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ close_connections: entry (P_IB_ptr, P_error_code); P_error_code = 0; call close_any_connections (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ any_connections: entry (P_IB_ptr) returns (bit (1) aligned); if IB.icp_in_progress then return ("0"b); if IB.telnet_cdb = null () then return ("0"b); if IB.open_descr_ptr = null () then return ("0"b); /* should go get socket states */ return ("1"b); /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ delete_event_channel: procedure (P_event_channel); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_event_channel fixed binary (71) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ call ipc_$delete_ev_chn (P_event_channel, (0)); P_event_channel = -1; return; end; /* end delete_event_channel */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ close_any_connections: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ if IB.telnet_cdb ^= null () then do; call user_telnet_xtach_$ut_async_close (IB.telnet_cdb, IB.open_descr_ptr, 0, (0)); call user_telnet_xtach_$ut_detach (IB.telnet_cdb, IB.attach_descr_ptr, (0)); IB.telnet_cdb = null (); end; if IB.local_icp_pin ^= -1 then do; call net_pin_manager_$free_pins (8, IB.local_icp_pin, (0)); IB.local_icp_pin = -1; end; return; end; /* end close_any_connections */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_instance_ */ end;  telnet_listener_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 222210 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_listener_: procedure (P_IB_ptr, P_error_code); /* This is the request listener for the user_telnet command */ /* environment. After the telnet_command_ routine allocates space */ /* for the IB, it calls this guy who sets up condition handlers, sets */ /* himself up as the handler for wakeups from the telnet connection */ /* sockets, and then listens to the stream user_input (usually the */ /* user's terminal). If any characters come in from the network, this */ /* program causes them to be printed out. The internal procedure */ /* "process_input_line" is the routine that implements the "escape" */ /* process of the user_telnet command. */ /* Originally written by D. M. Wells. */ /* Last modified by D. M. Wells, Spring 1975, while converting to */ /* use the new user_telnet_ IOSIM. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_error_code fixed binary (35), P_IB_ptr pointer, P_abort_label label) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; declare 1 wait_list aligned automatic, 2 count fixed binary (17), 2 padding bit (36) aligned, 2 channel (2) fixed binary (71); declare 1 event_message aligned automatic like event_message_template; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_char_string character (1048576) based; declare 1 based_workspace aligned based, 2 byte (0 : 1) bit (9) unaligned; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare (iox_$user_input, iox_$user_output) pointer external static; declare (error_table_$badcall, error_table_$device_active, error_table_$end_of_info, error_table_$io_no_permission, error_table_$no_message) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), command_query_ constant entry options (variable), continue_to_signal_ constant entry (fixed bin (35)), debug constant entry (), ioa_ constant entry options (variable), ioa_$nnl constant entry options (variable), ios_$read_ptr constant entry (ptr, fixed bin (24), fixed bin (24)), ios_$write_ptr constant entry (ptr, fixed bin (24), fixed bin (24)), iox_$control constant entry (ptr, char (*), ptr, fixed bin (35)), ipc_$block constant entry (ptr, ptr, fixed bin (35)), telnet_cmd_processor_$process_command_line constant entry (ptr, ptr, fixed bin (24), fixed bin (35)), telnet_instance_$any_connections constant entry (ptr) returns (bit (1) aligned), telnet_instance_$check_for_icp_conclusion constant entry (ptr, fixed bin (35)), telnet_instance_$perform_icp constant entry (ptr, fixed bin (35)), user_telnet_io_$ut_async_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_io_$ut_async_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)); declare (addr, binary, dimension, null, substr) builtin; /* * * * * STACK REFERENCES * * * * * * * * * * */ declare (cleanup, program_interrupt, quit, telnet_instance_error_) condition; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include net_event_template; % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ P_error_code = 0; call telnet_instance_$perform_icp (P_IB_ptr, P_error_code); if P_error_code ^= 0 then do; return; end; IB.continue_in_telnet = "1"b; IB.at_interrupt_level = "0"b; wait_list.count = 2; if ^ IB.ignore_quits then on quit begin; IB.silence_receive = "1"b; if IB.in_debug_mode then do; call com_err_ (0, IB.error_identifier, """quit"" occurred; debug entered -- IB_ptr = ^p.", P_IB_ptr); call debug (); end; if IB.at_interrupt_level then call continue_to_signal_ ((0)); else call quit_handler (P_IB_ptr, reenter_interaction_loop, (0)); end; on telnet_instance_error_ begin; if IB.in_debug_mode then do; call com_err_ (IB.nonlocal_error_code, IB.error_identifier, """telnet_instance_error_"" occurred; debug entered -- IB_ptr = ^p.", P_IB_ptr); call debug (); end; call iox_$control (iox_$user_input, "resetread", null (), (0)); P_error_code = IB.nonlocal_error_code; goto return_to_caller; end; on program_interrupt goto reenter_at_top_level; reenter_at_top_level: call ioa_ ("^1a", IB.escape_char); reenter_interaction_loop: IB.at_interrupt_level = "0"b; /* this is where we come when we leave int level */ IB.abort_current_command = "0"b; IB.silence_receive = "0"b; on cleanup call cleanup_connections (); do while (IB.continue_in_telnet); wait_list.channel (2) = check_network_stream (); wait_list.channel (1) = check_terminal_stream (); if (wait_list.channel (1) ^= 0) & (wait_list.channel (2) ^= 0) then do; call ipc_$block (addr (wait_list), addr (event_message), P_error_code); if P_error_code ^= 0 then return; end; IB.silence_receive = "0"b; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ quit_handler: entry (P_IB_ptr, P_abort_label, P_error_code); P_error_code = 0; IB.at_interrupt_level = "1"b; /* this quit handler is the interrupt level */ IB.silence_receive = "1"b; IB.abort_current_command = "0"b; call iox_$control (iox_$user_input, "resetread", null (), (0)); call iox_$control (iox_$user_output, "resetwrite", null (), (0)); if IB.telnet_cdb = null () then do; call com_err_ (0, IB.error_identifier, "No connection open, type ""^1aexit"" to leave command.", IB.escape_char); end; call ioa_$nnl ("^1aInput: ", IB.escape_char); call process_terminal_input (); if (^ IB.continue_in_telnet) | (IB.abort_current_command) | (IB.silence_receive) then goto P_abort_label; IB.silence_receive = "0"b; call user_telnet_state_$ut_control (IB.telnet_cdb, "start", null (), (0)); call iox_$control (iox_$user_output, "start", null (), (0)); IB.at_interrupt_level = "0"b; /* we are now leaving the interrupt level */ return; /* * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller: return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ process_terminal_input: procedure (); /* state = F (0) -- send to foreign system */ /* F' (1) -- found escape when sending to foreign system */ /* L (2) -- send to local command processor */ /* L' (3) -- found escape when sending to local system */ /* */ /* next state table is: */ /* cur state | F | F' | L | L' | */ /* ----------|------|------|------|------| */ /* char not escape ^ | F | L | L | F | */ /* char is escape = | F' | F | L' | L | */ /* ----------|------|------|------|------| */ /* */ /* action table is: */ /* cur state | F | F' | L | L' | */ /* ----------|------|------|------|------| */ /* char not escape ^ | 1 | 2 | 3 | 4 | */ /* char is escape = | 0 | 1 | 0 | 3 | */ /* ----------|------|------|------|------| */ /* where actions are as follows: */ /* 0 -- do nothing */ /* 1 -- store in string (will eventually go to foreign site) */ /* 2 -- send current string to foreign site -- then make this */ /* char first in new string (for local site) */ /* 3 -- store in string (eventually for local processor) */ /* 4 -- send current string to local processor, -- then place */ /* this char first in new string (for foreign) */ /* */ /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (byte_type fixed binary (1), (cur_state, next_state) fixed binary (3), (cur_begin, cur_length, indx) fixed binary (24), num_bytes_read fixed binary (24), using_copy bit (1)) automatic; declare 1 input_buffer aligned automatic, /* notice relationship with xmit_buffer in */ 2 byte (0 : 255) bit (9) unaligned; /* send_line_to_network routine */ /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare 1 next_state_table aligned internal static, 2 byte_type (0 : 1), 3 cur_state (0 : 3) fixed binary (2) initial (0, 2, 2, 0, 1, 0, 3, 2); declare 1 action_table aligned internal static, 2 byte_type (0 : 1), 3 cur_state (0 : 3) fixed binary (3) initial (1, 2, 3, 4, 0, 1, 0, 3); /* * * * * * * * * * * * * * * * * * * * * * * * */ call ios_$read_ptr (addr (input_buffer.byte), dimension (input_buffer.byte, 1), num_bytes_read); next_state = 0; using_copy = "0"b; cur_begin = 0; cur_length = 0; do indx = 0 by 1 to num_bytes_read - 1; cur_state = next_state; byte_type = binary (input_buffer.byte (indx) = IB.escape_byte, 1); next_state = next_state_table.byte_type (byte_type).cur_state (cur_state); goto action (action_table.byte_type (byte_type).cur_state (cur_state)); /* * * * * * * * * * * * * * */ action (0): /* do nothing with this character */ using_copy = "1"b; /* must make copy because we have extra char */ goto end_processing_action; /* * * * * * * * * * * * * * */ action (1): /* place this character in string for foreign host */ if using_copy then input_buffer.byte (cur_length) = input_buffer.byte (indx); cur_length = cur_length + 1; goto end_processing_action; /* * * * * * * * * * * * * * */ action (2): /* send current string to foreign site -- then empty */ /* the current string, then append current char to it */ if cur_length ^= 0 then call transmit_buffer (addr (input_buffer.byte), cur_length); cur_begin = indx; input_buffer.byte (0) = input_buffer.byte (indx); cur_length = 1; goto end_processing_action; /* * * * * * * * * * * * * * */ action (3): /* Place this character in string for local processor */ if using_copy then input_buffer.byte (cur_length) = input_buffer.byte (indx); cur_length = cur_length + 1; goto end_processing_action; /* * * * * * * * * * * * * * */ action (4): /* send current string to local processor -- then empty */ /* the current string -- then append current char to it */ if cur_length ^= 0 then call telnet_cmd_processor_$process_command_line (P_IB_ptr, addr (input_buffer.byte), cur_length, err_code); cur_begin = indx; input_buffer.byte (0) = input_buffer.byte (indx); cur_length = 1; goto end_processing_action; /* * * * * * * * * * * * * * */ end_processing_action: end; if next_state = 0 then call transmit_buffer (addr (input_buffer.byte), cur_length); else if next_state = 2 then call telnet_cmd_processor_$process_command_line (P_IB_ptr, addr (input_buffer.byte), cur_length, err_code); else call report_error_to_user (error_table_$badcall); return; end; /* end process_terminal_input */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ transmit_buffer: procedure (p_buff_ptr, p_buff_len); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (p_buff_len fixed binary (24), p_buff_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((first_to_write, num_to_write, num_written) fixed binary (24), err_code fixed binary (35)) automatic; declare 1 output_wait aligned automatic, 2 num_chans fixed binary (17), 2 channel (1) fixed binary (71); /* * * * * * * * * * * * * * * * * * * * * * * * */ if IB.upper_case then do; substr (p_buff_ptr -> based_char_string, 1, p_buff_len) = translate (substr (p_buff_ptr -> based_char_string, 1, p_buff_len), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz"); end; first_to_write = 0; num_to_write = p_buff_len; err_code = 0; output_wait.num_chans = 1; output_wait.channel (1) = IB.write_event_channel; do while ((num_to_write > 0) | (err_code ^= 0)); call user_telnet_io_$ut_async_put_chars (IB.telnet_cdb, addr (p_buff_ptr -> based_workspace.byte (first_to_write)), num_to_write, num_written, IB.write_event_channel, err_code); num_to_write = num_to_write - num_written; first_to_write = first_to_write + num_written; if err_code ^= 0 then if err_code ^= error_table_$device_active then call interpret_ncp_status (err_code); else call ipc_$block (addr (output_wait), addr (event_message), (0)); end; return; end; /* end transmit_buffer */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_ncp_status: procedure (P_ncp_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_ncp_err_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; declare 1 socket_info_struc (0 : 1) aligned automatic, 2 socket_state fixed binary (6), 2 local_socket fixed binary (32), 2 foreign_host fixed binary (16), 2 foreign_socket fixed binary (32); /* * * * * * * * * * * * * * * * * * * * * * * * */ if P_ncp_err_code ^= error_table_$end_of_info then call report_error_to_user (P_ncp_err_code); call user_telnet_state_$ut_control (IB.telnet_cdb, "get_socket_states", addr (socket_info_struc), err_code); if err_code ^= 0 then call report_error_to_user (err_code); if (socket_info_struc (0).socket_state = 1) | (socket_info_struc (1).socket_state = 1) then do; call com_err_ (0, IB.error_identifier, "Connection has been closed by ^a.", IB.host_name); call report_error_to_user (error_table_$no_message); end; call com_err_ (P_ncp_err_code, IB.error_identifier, "The sockets have gone into states ^d and ^d.", socket_info_struc (0).socket_state, socket_info_struc (1).socket_state); call report_error_to_user (error_table_$no_message); end; /* end interpret_ncp_status */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_network_stream: procedure () returns (fixed binary (71)); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (num_received fixed binary (24), total_processed_this_call fixed binary (24), err_code fixed binary (35)) automatic; declare 1 output_buffer aligned automatic, /* this is the same size as recv_buffer so we */ 2 byte (0 : 1012) bit (9) unaligned; /* dont have to check for buffer overflow when */ /* converting to 9 bit code */ /* * * * * * * * * * * * * * * * * * * * * * * * */ if IB.icp_in_progress then do; call telnet_instance_$check_for_icp_conclusion (addr (IB), err_code); if err_code = 0 then do; if IB.icp_in_progress then return (IB.icp_event_channel); else return (0); end; call report_error_to_user (err_code); end; total_processed_this_call = 0; do while ("1"b); call user_telnet_io_$ut_async_get_chars (IB.telnet_cdb, addr (output_buffer.byte), dimension (output_buffer.byte, 1), num_received, IB.read_event_channel, err_code); if err_code = error_table_$device_active then err_code = 0; total_processed_this_call = total_processed_this_call + num_received; if err_code ^= 0 then call interpret_ncp_status (err_code); if num_received = 0 then do; if total_processed_this_call = 0 then return (IB.read_event_channel); else return (0); end; call ios_$write_ptr (addr (output_buffer.byte), 0, num_received); end; call report_error_to_user (error_table_$badcall); /* this is not a valid way out of this routine */ end; /* end check_network_stream */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_terminal_stream: procedure () returns (fixed binary (71)); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; declare 1 read_status_struc aligned automatic, 2 event_channel fixed binary (71), 2 input_available bit (1) unaligned, 2 padding bit (35) unaligned; /* * * * * * * * * * * * * * * * * * * * * * * * */ call iox_$control (iox_$user_input, "read_status", addr (read_status_struc), err_code); if err_code = 0 then if ^ read_status_struc.input_available then return (read_status_struc.event_channel); call process_terminal_input (); return (0); end; /* end check_terminal_stream */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ report_error_to_user: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ IB.nonlocal_error_code = P_err_code; signal telnet_instance_error_; end; /* end report_error_to_user */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ cleanup_connections: procedure (); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare reply character (16) varying automatic; declare 1 query_struc aligned automatic, 2 version fixed binary (17) initial (2), 2 want_yes_or_no bit (1) unaligned initial ("1"b), 2 suppress_name bit (1) unaligned initial ("0"b), 2 status_code fixed binary (35) initial (0), 2 query_code fixed binary (35) initial (0); /* * * * * * * * * * * * * * * * * * * * * * * * */ if telnet_instance_$any_connections (P_IB_ptr) then do; call command_query_ (addr (query_struc), reply, IB.error_identifier, "Do you wish to terminate the Network connection to ^a ? ", IB.host_name); if reply = "no" then goto reenter_interaction_loop; end; return; end; /* end cleanup_connections */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_listener_ */ end;  telnet_misc_commands_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 147348 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_misc_commands_: procedure (); /* This collection of miscellaneous routines is a set of programs */ /* which implement the various requests of the user_telnet and user_ftp */ /* commands (generally only commands of user_ftp that manipulate the */ /* telnet connection). For a description of them, see the documentation */ /* of the user_telnet command. */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_arg_list_ptr, P_IB_ptr) pointer parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((arg_indx, temp_integer) fixed binary (17), (arg_length, character_count) fixed binary (24), err_code fixed binary (35), one_char character (1) aligned, temp_string character (32), (arg_ptr, value_ptr) pointer) automatic; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_argument character (arg_length) based; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare iox_$user_output pointer external static; declare ascii_value_$byte (0 : 127) bit (9) aligned external static; declare (user_telnet_orders_$send_AO, user_telnet_orders_$send_AYT, user_telnet_orders_$send_BRK, user_telnet_orders_$send_EC, user_telnet_orders_$send_EL, user_telnet_orders_$send_GA, user_telnet_orders_$send_IP, user_telnet_orders_$send_NOP) character (32) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), cu_$arg_ptr_rel constant entry (fixed bin (17), ptr, fixed bin (24), fixed bin (35), ptr), cu_$cp constant entry (ptr, fixed bin (24), fixed bin (35)), cv_dec_check_ constant entry (char (*), fixed bin (35)) returns (fixed bin (35)), hcs_$make_ptr constant entry (ptr, char (*), char (*), ptr, fixed bin (35)), iox_$control constant entry (ptr, char (*), ptr, fixed bin (35)), telnet_connection_$transmit_buffer constant entry (ptr, ptr, fixed bin (24), fixed bin (35)), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)); declare (addr, length, null, rel, substr, translate, unspec) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller_on_error: return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_interrupt: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_IP, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send IP"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_nop: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_NOP, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send NOP"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_break: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_BRK, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send BRK"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_go_ahead: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_GA, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send GA"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_are_you_there: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_AYT, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send AYT"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_erase: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code ^= 0 then character_count = 1; else do; character_count = cv_dec_check_ (arg_ptr -> based_argument, err_code); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "The argument to the erase request must be a decimal integer."); return; end; end; do temp_integer = 1 by 1 to character_count; call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_EC, null, err_code); if err_code ^= 0 then do; call com_err_ (err_code, IB.error_identifier, "Attemping to send EC"); return; end; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_kill: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_EL, null, err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send EL"); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_abort: entry (P_IB_ptr, P_arg_list_ptr); IB.abort_current_command = "1"b; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_control: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code ^= 0 then do; call com_err_ (err_code, IB.error_identifier, "The ""control"" request requires an argument of one character."); return; end; one_char = arg_ptr -> based_argument; unspec (one_char) = unspec (one_char) & "000011111"b; call telnet_connection_$transmit_buffer (P_IB_ptr, addr (one_char), 1, err_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_ascii: entry (P_IB_ptr, P_arg_list_ptr); call verify_write_connection (); call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code ^= 0 then do; call com_err_ (err_code, IB.error_identifier, "The ""ascii"" request requires the name of an ASCII character, e.g., NL."); return; end; if arg_length = 1 then do; one_char = arg_ptr -> based_argument; value_ptr = addr (one_char); end; else do; value_ptr = addr (ascii_value_$byte (0)); /* touch ascii_value_ to see that its there */ temp_string = arg_ptr -> based_argument; temp_string = translate (temp_string, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz"); /* "ascii_value_" only has upper case versions */ call hcs_$make_ptr (null (), "ascii_value_", temp_string, value_ptr, err_code); if err_code = 0 then if rel (value_ptr) < rel (addr (ascii_value_$byte (0))) then err_code = -1; /* not in proper range -- too low */ else if rel (value_ptr) > rel (addr (ascii_value_$byte (127))) then err_code = -1; /* not in proper range -- too high */ if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, """^a"" is not a recognized name for an ASCII character.", temp_string); return; end; end; call telnet_connection_$transmit_buffer (P_IB_ptr, value_ptr, 1, err_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_timeout: entry (P_IB_ptr, P_arg_list_ptr); call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "The ""timeout"" request requires a decimal integer argument."); return; end; temp_integer = cv_dec_check_ (arg_ptr -> based_argument, err_code); if (err_code ^= 0) | (temp_integer <= 0) then do; call com_err_ (0, IB.error_identifier, "Improper argument given to timeout request."); return; end; call user_telnet_state_$ut_control (IB.telnet_cdb, "timeout", addr (temp_integer), err_code); if err_code ^= 0 then do; call com_err_ (err_code, IB.error_identifier, "Setting timeout value in telnet stream."); return; end; IB.icp_timeout = temp_integer; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_abort_output: entry (P_IB_ptr, P_arg_list_ptr); call user_telnet_state_$ut_control (IB.telnet_cdb, "abort_input", null (), (0)); call user_telnet_state_$ut_control (IB.telnet_cdb, user_telnet_orders_$send_AO, null (), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Attempting to send AO"); IB.silence_receive = "1"b; call iox_$control (iox_$user_output, "resetwrite", null, (0)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_escape: entry (P_IB_ptr, P_arg_list_ptr); call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code ^= 0 then do; call com_err_ (0, IB.error_identifier, "Exactly one single character argument must be given to the escape request."); return; end; if arg_length ^= 1 then do; call com_err_ (0, IB.error_identifier, "The argument specified for the ""escape"" request must be exactly one character in length."); return; end; IB.escape_char = arg_ptr -> based_argument; IB.escape_byte = unspec (arg_ptr -> based_argument); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_option: entry (P_IB_ptr, P_arg_list_ptr); call com_err_ (0, IB.error_identifier, "The ""option"" request is currently unimplemented."); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_exit: entry (P_IB_ptr, P_arg_list_ptr); IB.continue_in_telnet = "0"b; IB.abort_current_command = "1"b; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_help: entry (P_IB_ptr, P_arg_list_ptr); call com_err_ (0, IB.error_identifier, "The ""help"" request is not yet implemented."); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_execute: entry (P_IB_ptr, P_arg_list_ptr); character_count = 0; err_code = 0; do arg_indx = 1 by 1 while (err_code = 0); call cu_$arg_ptr_rel (arg_indx, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code = 0 then character_count = character_count + arg_length + 1; end; if character_count < 64000 then call call_command_processor (character_count); else call com_err_ (0, IB.error_identifier, "The request line is longer than 64000 characters."); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ verify_write_connection: procedure (); /* * * * * * * * * * * * * * * * * * * * * * * * */ /* also if not open !! */ if IB.telnet_cdb = null () then do; call com_err_ (0, IB.error_identifier, "There is no transmit connection open."); goto return_to_caller_on_error; end; return; end; /* end verify_write_connection */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ call_command_processor: procedure (P_com_line_length); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_com_line_length fixed binary (24) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (indx fixed binary (17), (arg_length, cur_pos) fixed binary (24), command_line character (P_com_line_length) aligned, arg_ptr pointer) automatic; /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_argument character (arg_length) based; /* * * * * * * * * * * * * * * * * * * * * * * * */ command_line = ""; cur_pos = 1; err_code = 0; do indx = 1 by 1 while (err_code = 0); call cu_$arg_ptr_rel (indx, arg_ptr, arg_length, err_code, P_arg_list_ptr); if err_code = 0 then do; substr (command_line, cur_pos, arg_length) = arg_ptr -> based_argument; cur_pos = cur_pos + arg_length + 1; end; end; call cu_$cp (addr (command_line), length (command_line), (0)); return; end; /* end call_command_processor */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_misc_commands_ */ end;  telnet_status_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 64143 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ telnet_status_: procedure (); /* "telnet_status_" -- procedure to handle user's requests to find */ /* out the status of what is going on in the user_telnet command. */ /* Originally created by D. M. Wells. */ /* Last modified by D. M. Wells, Summer, 1975, to get info from IOSIM. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_arg_list_ptr, P_IB_ptr) pointer parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (err_code fixed binary (35), protocol_level fixed binary (35), pin_state_name character (12), foreign_host_name character (32)) automatic; declare 1 socket_info_struc (1 : 2) aligned automatic, 2 socket_state fixed binary (6), 2 local_socket fixed binary (32), 2 foreign_host fixed binary (16), 2 foreign_socket fixed binary (32); /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IB aligned like telnet_option_template defined (P_IB_ptr -> telnet_option_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare 1 socket_states (0 : 14) aligned internal static, 2 name character (12) initial ( "????", "Active", "Listen", "Rfcd-rcvd", "Abort", "Rfc-sent", "Open", "Cls-wait", "Reject-wait", "Data-wait", "Rfnm-wait", "Cls-read", "????", "Broken", "Reset"); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), convert_binary_integer_$decimal_string constant entry (fixed bin (35)) returns (char (12) varying), host_id_$symbol constant entry (fixed bin (16), char (*), fixed bin (35)), ioa_ constant entry options (variable), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)); declare (addr, binary, null) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_command_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ process_telnet_status: entry (P_IB_ptr, P_arg_list_ptr); if IB.icp_in_progress then do; if IB.attach_type = "icp" then call ioa_ ("ICP in progress to socket ^d at host ^a.", IB.foreign_icp_socket, IB.host_name); else call ioa_ ("Attempting to ^a to socket ^d at host ^a.", IB.attach_type, IB.foreign_icp_socket, IB.host_name); return; end; call user_telnet_state_$ut_control (IB.telnet_cdb, "get_protocol", addr (protocol_level), err_code); if err_code ^= 0 then call com_err_ (err_code, IB.error_identifier, "Unable to determine protocol level."); else call ioa_ ("Using TELNET Protocol of NIC #^d.", protocol_level); call user_telnet_state_$ut_control (IB.telnet_cdb, "get_socket_states", addr (socket_info_struc), err_code); if err_code ^= 0 then do; call com_err_ (err_code, IB.error_identifier, "Unable to get socket states."); return; end; call print_pin_state ("Receive Pin", socket_info_struc (1)); call print_pin_state ("Transmit Pin", socket_info_struc (2)); if "0"b then if protocol_level = 18639 then call print_options_in_effect (); call ioa_ (""); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ print_pin_state: procedure (P_pin_name, P_sock_info); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_pin_name character (*) parameter; declare 1 P_sock_info aligned parameter like socket_info_struc; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ if P_sock_info.socket_state = 0 then do; call ioa_ ("The ^a does not exist.", P_pin_name); return; end; pin_state_name = socket_states (P_sock_info.socket_state).name; if (P_sock_info.socket_state < 5) | (P_sock_info.foreign_host = 0) then do; call ioa_ ("The ^a is in the ^a state.", P_pin_name, pin_state_name); end; else do; call host_id_$symbol (P_sock_info.foreign_host, foreign_host_name, err_code); if err_code ^= 0 then foreign_host_name = "HOST-" || convert_binary_integer_$decimal_string ((P_sock_info.foreign_host)); call ioa_ ("The ^a is in the ^a state for socket ^d at ^a.", P_pin_name, pin_state_name, P_sock_info.foreign_socket, foreign_host_name); end; return; end; /* end print_pin_state */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ print_options_in_effect: procedure (); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (indx fixed binary (18), block_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ call ioa_ ("Options in effect on receive connection:"); do indx = 0 by 1 to 255; /* block_ptr = addr (IB.receive_connection.option_status (indx)); */ /* if block_ptr -> option_status_template.option_in_effect */ /* then call ioa_ (" Option ^d.", indx); */ end; call ioa_ ("Options in effect on transmit connection."); do indx = 0 by 1 to 255; /* block_ptr = addr (IB.transmit_connection.option_status (indx)); */ /* if block_ptr -> option_status_template.option_in_effect */ /* then call ioa_ (" Option ^d.", indx); */ end; return; end; /* end print_options_in_effect */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end telnet_status_ */ end;  user_telnet_io_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 308844 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_io_: procedure (P_SDB_ptr); /* "user_telnet_io_" -- portion of the user process TELNET IOSIM */ /* that handles the actual I/O for the IOSIM. */ /* Last modified by: */ /* D. M. Wells (1972, Feb) to fix various bugs in formatting. */ /* D. M. Wells (1975, April) to convert to iox and async. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_nelem fixed binary (24), /* num of elements requested to be transmitted */ P_nelemt fixed binary (24), /* num of elements actually transmitted */ P_error_code fixed binary (35), P_event_channel fixed binary (71), P_delim_set bit (36), /* delimiter set identifier prev gotten by caller */ P_SDB_ptr pointer, /* pointer to the SDB for this attachment */ P_wksp_ptr pointer) /* pointer to input workspace */ parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (state fixed binary (6), (first_input, last_input, next_input) fixed binary (24), (next_output, num_output) fixed binary (24), wksp_offset fixed binary (24), (num_in_proc, xnt) fixed binary (24), delimiter_set_id bit (36), err_code fixed binary (35), buffer2 (0 : 999) character (1) unaligned, (delimiter_buffer_ptr, wksp_ptr) pointer) automatic; declare SDB_ptr pointer initial (P_SDB_ptr) automatic; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 SDB aligned like SDB_template defined (SDB_ptr -> SDB_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare 1 based_workspace aligned based, 2 byte (0 : 1) bit (9) unaligned; declare 1 char_buffer aligned based, 2 header like net_buffer_header, 2 workspace aligned, 3 byte (0 : 0 refer (char_buffer.header.buffer_bound)) bit (9) unaligned; declare 1 byte_buffer aligned based, 2 header like net_buffer_header, 2 workspace aligned, 3 byte (0 : 0 refer (byte_buffer.header.buffer_bound)) bit (9 refer (byte_buffer.header.workspace_byte_size)) unaligned; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare disable_mask bit (36) initial ((10)"1"b) /* all on for debugging only */ internal static; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare net_character_tables_$NL_delim_id bit (36) external static; declare (error_table_$area_too_small, error_table_$chars_after_delim, error_table_$data_improperly_terminated, error_table_$device_active, error_table_$end_of_info, error_table_$invalid_read, error_table_$invalid_write, error_table_$long_record, error_table_$net_invalid_state) /* means we got a bad state from hardcore NCP */ fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare hcs_$set_ips_mask constant entry (bit (36) aligned, bit (36) aligned), ipc_$reset_ev_call_chn constant entry (fixed bin (71), fixed bin (35)), net_$ncp_read constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35)), net_$ncp_write constant entry (bit (36), ptr, fixed bin (24), fixed bin (24), fixed bin (6), fixed bin (35)), net_alm_$copy_chars constant entry (ptr, ptr, fixed bin (24)), net_alm_$decode_char_pointer constant entry (ptr, ptr, fixed bin (24)), net_alm_$scan_from_char_table constant entry (ptr, fixed bin (24), ptr, bit (9) aligned) returns (fixed bin (24)), net_async_support_$insert_in_channel_list constant entry (ptr, fixed bin (71), fixed bin (35)), net_async_support_$notify_all_channels constant entry (ptr, fixed bin (35)), net_async_support_$setup_event_channel constant entry (ptr, fixed bin (71), fixed bin (35)), net_buffer_man_$allocate_buffer constant entry (fixed bin (24), fixed bin (24), fixed bin (35)) returns (ptr), net_buffer_man_$empty_space constant entry (ptr, fixed bin (35)) returns (fixed bin (24)), net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)), net_buffer_man_$make_larger_buffer constant entry (ptr, fixed bin (35)) returns (ptr), net_character_$nc_async_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), net_character_$nc_async_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), net_convert_ascii_$multics_to_net constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24), ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)), net_convert_ascii_$net_to_multics constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24), ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)), net_convert_size_$direct_9_to_8 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24), ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)), net_convert_size_$telnet_8_to_9 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24), ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)), net_convert_size_$telnet_9_to_8 constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (24), ptr, fixed bin (24), fixed bin (24), fixed bin (24), fixed bin (35)), user_telnet_protocol_ constant entry (ptr, ptr, fixed bin (35)); declare (addr, baseptr, dimension, min, null, pointer, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include user_telnet_sdb_dcls; % include net_buffer_header_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* This entry is used internally by the rest of this */ /* IOSIM to write characters to the Network without having */ /* them processed (except for 9 to 8 bit conversion.) This */ /* is useful for other parts of this IOSIM which wish to */ /* handle TELNET negotiation (for example). */ /* To allow a simplification of other procedures, this */ /* entry will accept all bytes that it is given and place */ /* then into the output buffer. It will not, however, */ /* necessarily wait for the NCP to accept them. */ ut_put_chars_raw: entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_error_code); P_error_code = 0; P_nelemt = 0; call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset); call write_to_ncp (P_error_code); /* push anything in buffer to NCP, if possible */ if P_error_code ^= 0 then return; next_output = wksp_offset; num_output = P_nelem; do while (num_output > 0); call move_to_net_buffer (wksp_ptr, next_output, num_output, xnt, err_code); if err_code ^= 0 then do; P_error_code = err_code; return; end; next_output = next_output + xnt; num_output = num_output - xnt; P_nelemt = P_nelem - num_output; call write_to_ncp (P_error_code); if P_error_code ^= 0 then return; end; P_nelemt = P_nelem; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_async_put_chars: /* entry to write on typewriter */ entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_event_channel, P_error_code); P_error_code = 0; P_nelemt = 0; /* init num elems trans to zero */ call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset); if SDB.ncp_cdb = null () then do; P_error_code = error_table_$invalid_write; return; end; call net_character_$nc_async_put_chars (SDB.ncp_cdb, null (), 0, (0), P_event_channel, P_error_code); if P_error_code ^= 0 then return; if SDB.connection_state.aborting_output then do; P_nelemt = P_nelem; /* tell user we took everything */ return; end; /* Now that we know that we are really going to */ /* attempt to send data (incl zero chars), we will not */ /* start processing until the NCP has accepted all chars */ /* that we have previously attempted to write to it. */ call write_to_ncp (P_error_code); if P_error_code ^= 0 then return; if SDB.output_ptr ^= null () then return; /* something is buffered, we wont start just yet */ if SDB.current_modes.rawo then do; call net_character_$nc_async_put_chars (SDB.ncp_cdb, P_wksp_ptr, P_nelem, P_nelemt, P_event_channel, P_error_code); return; end; /* At this point, we are going to process the data by */ /* running the characters through the output converter. */ next_output = wksp_offset; num_output = P_nelem; do while (num_output > 0); /* notice that we should restrict output buffer size here */ call move_to_net_buffer (wksp_ptr, next_output, num_output, xnt, err_code); if err_code ^= 0 then do; P_error_code = err_code; return; end; next_output = next_output + xnt; num_output = num_output - xnt; P_nelemt = P_nelem - wksp_offset; call write_to_ncp (P_error_code); if P_error_code ^= 0 then return; if SDB.output_ptr ^= null () then do; P_error_code = error_table_$device_active; return; end; end; P_nelemt = P_nelem; return; return_from_write: P_error_code = err_code; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_async_get_to_delim: /* entry to read to a delimiter in input stream */ entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_delim_set, P_event_channel, P_error_code); P_error_code = 0; call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset); delimiter_set_id = P_delim_set; if substr (delimiter_set_id, 1, 18) = ""b then delimiter_buffer_ptr = pointer (addr (net_character_tables_$NL_delim_id), substr (delimiter_set_id, 19, 18)); else delimiter_buffer_ptr = pointer (baseptr (substr (delimiter_set_id, 1, 18)), substr (delimiter_set_id, 19, 18)); err_code = 0; SDB.connection_state.aborting_output = "0"b; P_nelemt = 0; /* initialize elements transferred to zero */ if SDB.ncp_cdb = null () then do; err_code = error_table_$invalid_read; goto return_from_read; end; call read_from_network (wksp_ptr, wksp_offset, P_nelem, P_nelemt, err_code); if err_code ^= 0 then goto return_from_read; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_async_get_chars: /* entry to read from typewriter */ entry (P_SDB_ptr, P_wksp_ptr, P_nelem, P_nelemt, P_event_channel, P_error_code); P_error_code = 0; /* initialize status code to zero */ call net_alm_$decode_char_pointer (P_wksp_ptr, wksp_ptr, wksp_offset); delimiter_buffer_ptr = null (); err_code = 0; SDB.connection_state.aborting_output = "0"b; P_nelemt = 0; /* initialize elements transferred to zero */ if SDB.ncp_cdb = null () then do; err_code = error_table_$invalid_read; goto return_from_read; end; call read_from_network (wksp_ptr, wksp_offset, P_nelem, P_nelemt, err_code); if err_code ^= 0 then goto return_from_read; return_from_read: P_error_code = err_code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ move_to_net_buffer: procedure (P_buff_ptr, P_first_offset, P_num_elements, P_num_elements_proc, P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare ((P_first_offset, P_num_elements, P_num_elements_proc) fixed binary (24), P_err_code fixed binary (35), P_buff_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((next_free_loc, num_transmitted) fixed binary (24), (num_in_proc, num_out_proc) fixed binary (24), (first_to_send, last_to_send, next_to_send) fixed binary (24), err_code fixed binary (35), continue_to_process bit (1), previous_mask bit (36) aligned, buffer_ptr pointer, out_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_err_code = 0; P_num_elements_proc = 0; if P_num_elements = 0 then return; err_code = 0; first_to_send = P_first_offset; last_to_send = first_to_send + min (P_num_elements, 1000) - 1; buffer_ptr = P_buff_ptr; call hcs_$set_ips_mask ((disable_mask), previous_mask); if SDB.output_ptr = null () then do; SDB.output_ptr = net_buffer_man_$allocate_buffer (800, 8, P_err_code); if P_err_code ^= 0 then do; call hcs_$set_ips_mask (previous_mask, (""b)); return; end; end; num_transmitted = 0; next_to_send = first_to_send; continue_to_process = "1"b; do while ((next_to_send <= last_to_send) & continue_to_process); out_ptr = SDB.output_ptr; next_free_loc = out_ptr -> char_buffer.byte_offset + out_ptr -> char_buffer.num_bytes; call net_convert_ascii_$multics_to_net (null (), buffer_ptr, next_to_send, last_to_send - next_to_send + 1, num_in_proc, addr (out_ptr -> char_buffer.workspace), next_free_loc, out_ptr -> char_buffer.buffer_bound - next_free_loc + 1, num_out_proc, err_code); next_to_send = next_to_send + num_in_proc; num_transmitted = num_transmitted + num_in_proc; out_ptr -> char_buffer.num_bytes = out_ptr -> char_buffer.num_bytes + num_out_proc; if next_to_send <= last_to_send then do; if (P_num_elements < 1000) then do; SDB.output_ptr = net_buffer_man_$make_larger_buffer (out_ptr, P_err_code); call hcs_$set_ips_mask (previous_mask, (""b)); return; end; else continue_to_process = "0"b; end; end; call hcs_$set_ips_mask (previous_mask, (""b)); P_num_elements_proc = num_transmitted; P_err_code = err_code; return; end; /* end move_to_net_buffer */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ write_to_ncp: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (num_transmitted fixed binary (24), err_code fixed binary (35), previous_mask bit (36) aligned, data_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_err_code = 0; if SDB.output_ptr = null () then return; err_code = 0; call hcs_$set_ips_mask ((disable_mask), previous_mask); data_ptr = addr (SDB.output_ptr -> byte_buffer.byte (SDB.output_ptr -> byte_buffer.byte_offset)); call net_character_$nc_async_put_chars (SDB.ncp_cdb, data_ptr, SDB.output_ptr -> byte_buffer.num_bytes, num_transmitted, P_event_channel, err_code); SDB.output_ptr -> byte_buffer.byte_offset = SDB.output_ptr -> byte_buffer.byte_offset + num_transmitted; SDB.output_ptr -> byte_buffer.num_bytes = SDB.output_ptr -> byte_buffer.num_bytes - num_transmitted; if SDB.output_ptr -> byte_buffer.num_bytes = 0 then do; call net_buffer_man_$free_buffer (SDB.output_ptr, (0)); SDB.output_ptr = null (); end; call hcs_$set_ips_mask (previous_mask, ((36)"0"b)); P_err_code = err_code; return; end; /* end write_to_ncp */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_from_network: procedure (P_buffer_ptr, P_first_offset, P_num_elements, P_num_elements_trans, P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare ((P_first_offset, P_num_elements, P_num_elements_trans) fixed binary (24), P_err_code fixed binary (35), P_buffer_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((first_offset, num_to_read) fixed binary (24), (delim_table_ptr, wksp_ptr) pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_err_code = 0; wksp_ptr = P_buffer_ptr; P_num_elements_trans = 0; do while (P_num_elements_trans = 0); if SDB.transl_ptr ^= null () then do; if move_transl_to_callers (P_num_elements, P_num_elements_trans, P_err_code) then return; end; wksp_ptr = P_buffer_ptr; first_offset = P_first_offset; num_to_read = P_num_elements; if SDB.transl_ptr = null () then do; SDB.transl_ptr = net_buffer_man_$allocate_buffer (256, 9, P_err_code); if P_err_code ^= 0 then return; end; if move_transl_to_callers (P_num_elements, P_num_elements_trans, P_err_code) then return; if ^ moved_into_transl_buffer (P_err_code) then do; if P_err_code = 0 then return; /* everything ok, just no data to read */ if P_err_code ^= error_table_$end_of_info then return; /* somekind of bad error, return this to caller */ delimiter_buffer_ptr = null (); if move_transl_to_callers (P_num_elements, P_num_elements_trans, P_err_code) then; if P_err_code ^= 0 then return; /* probably errortable_$long_record */ P_err_code = error_table_$end_of_info; return; end; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* This string returns true if it has moved all the */ /* characters to the caller's buffer that it can. It */ /* can't move any more if it finds a delimiter, runs out */ /* of caller buffer space, gets a null ptr, etc. */ move_transl_to_callers: procedure (p_num_in, p_num_proc, p_err_code) returns (bit (1)); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare ((p_num_in, p_num_proc) fixed binary (24), p_err_code fixed binary (35)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((n8, num_elements) fixed binary (24), buff_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ p_err_code = 0; buff_ptr = SDB.transl_ptr; if buff_ptr = null () then n8 = 0; else n8 = buff_ptr -> char_buffer.num_bytes; if n8 = 0 then return ("0"b); /* there are no characters to move */ if delimiter_buffer_ptr = null () then delim_table_ptr = null (); else delim_table_ptr = addr (delimiter_buffer_ptr -> char_buffer.workspace); if delim_table_ptr = null () then num_elements = min (p_num_in, buff_ptr -> char_buffer.num_bytes); else do; n8 = net_alm_$scan_from_char_table (addr (buff_ptr -> char_buffer.byte (buff_ptr -> char_buffer.byte_offset)), buff_ptr -> char_buffer.num_bytes, delim_table_ptr, (""b)); if n8 = 0 then return ("0"b); /* there are characters, but none is a delimiter */ if n8 <= p_num_in then num_elements = n8; else do; num_elements = p_num_in; p_err_code = error_table_$long_record; end; end; call net_alm_$copy_chars (addr (buff_ptr -> char_buffer.byte (buff_ptr -> char_buffer.byte_offset)), addr (wksp_ptr -> based_workspace.byte (P_first_offset)), num_elements); buff_ptr -> char_buffer.num_bytes = buff_ptr -> char_buffer.num_bytes - num_elements; buff_ptr -> char_buffer.byte_offset = buff_ptr -> char_buffer.byte_offset + num_elements; if buff_ptr -> char_buffer.num_bytes = 0 then do; call net_buffer_man_$free_buffer (SDB.transl_ptr, (0)); SDB.transl_ptr = null (); end; p_num_proc = num_elements; return ("1"b); /* we moved all we could (even if 0) */ end; /* end move_transl_to_callers */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ end; /* end read_from_network */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ moved_into_transl_buffer: procedure (P_error_code) returns (bit (1)); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_error_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((num_raw_processed, raw_buff_count, next_unused_converted, num_out_proc) fixed binary (24), out_space_avail fixed binary (24), num_moved_this_call fixed binary (24), buff_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ raw_buff_count = locate_break_char (P_error_code); if raw_buff_count = 0 then return ("0"b); /* P_error_code might be end_of_info */ if P_error_code ^= 0 then if P_error_code ^= error_table_$end_of_info then return ("0"b); /* ignore end_of_info if we got any chars */ num_moved_this_call = 0; if SDB.transl_ptr = null () then do; SDB.transl_ptr = net_buffer_man_$allocate_buffer (256, 9, P_error_code); if P_error_code ^= 0 then return ("1"b); end; do while (raw_buff_count ^= 0); buff_ptr = SDB.transl_ptr; next_unused_converted = buff_ptr -> char_buffer.byte_offset + buff_ptr -> char_buffer.num_bytes; out_space_avail = buff_ptr -> char_buffer.buffer_bound - next_unused_converted + 1; call net_convert_ascii_$net_to_multics (null (), addr (SDB.rawbuffer_ptr -> char_buffer.byte), SDB.rawbuffer_ptr -> char_buffer.byte_offset, raw_buff_count, num_raw_processed, addr (buff_ptr -> char_buffer.byte), next_unused_converted, out_space_avail, num_out_proc, P_error_code); SDB.rawbuffer_ptr -> char_buffer.num_bytes = SDB.rawbuffer_ptr -> char_buffer.num_bytes - num_raw_processed; SDB.rawbuffer_ptr -> char_buffer.byte_offset = SDB.rawbuffer_ptr -> char_buffer.byte_offset + num_raw_processed; buff_ptr -> char_buffer.num_bytes = buff_ptr -> char_buffer.num_bytes + num_out_proc; num_moved_this_call = num_moved_this_call + num_out_proc; if P_error_code ^= 0 then do; if P_error_code ^= error_table_$chars_after_delim then return ("1"b); raw_buff_count = 0; /* in middle of input seq, cant continue */ P_error_code = 0; end; else raw_buff_count = raw_buff_count - num_raw_processed; if raw_buff_count ^= 0 then do; SDB.transl_ptr = net_buffer_man_$make_larger_buffer (SDB.transl_ptr, P_error_code); if P_error_code ^= 0 then return ("1"b); end; end; if SDB.rawbuffer_ptr -> char_buffer.num_bytes = 0 then do; call net_buffer_man_$free_buffer (SDB.rawbuffer_ptr, (0)); SDB.rawbuffer_ptr = null (); end; P_error_code = 0; return (num_moved_this_call ^= 0); end; /* end moved_into_transl_buffer */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ locate_break_char: procedure (P_error_code) returns (fixed bin (24)); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_error_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((break_loc, raw_count, raw_lbound) fixed binary (24), raw_buff_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_error_code = 0; do break_loc = 0 repeat (raw_buff_ptr -> char_buffer.num_bytes) while (break_loc = 0); if read_from_ncp ((0)) then; if SDB.rawbuffer_ptr = null () then raw_count = 0; else raw_count = SDB.rawbuffer_ptr -> char_buffer.num_bytes; if raw_count = 0 then if ^ read_from_ncp (P_error_code) then return (0); raw_buff_ptr = SDB.rawbuffer_ptr; raw_lbound = raw_buff_ptr -> char_buffer.byte_offset; end; /* if net_alm_$scanxxx (addr (raw_buff_ptr -> char_buffer.byte (raw_lbound)), break_loc, (OUR_IAC)) ^= 0 */ do; call user_telnet_protocol_ (addr (SDB), SDB.rawbuffer_ptr, P_error_code); if P_error_code ^= 0 then if P_error_code = error_table_$data_improperly_terminated then do; P_error_code = 0; break_loc = 0; end; end; return (break_loc); end; /* end locate_break_char */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_from_ncp: procedure (P_err_code) returns (bit (1)); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((first_offset, num_elements, num_trans) fixed binary (24), (num_in_proc, num_out_proc) fixed binary (24), input_buffer (0 : 1099) bit (8), got_any_data_this_call bit (1), connection_closed bit (1), previous_mask bit (36) aligned, raw_buffer_ptr pointer) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ connection_closed = "0"b; call hcs_$set_ips_mask ((disable_mask), previous_mask); if SDB.rawbuffer_ptr = null () then SDB.rawbuffer_ptr = net_buffer_man_$allocate_buffer (1500, 9, (0)); else if SDB.rawbuffer_ptr -> char_buffer.num_bytes = 0 then SDB.rawbuffer_ptr -> char_buffer.byte_offset = 0; got_any_data_this_call = "0"b; /* we haven't read any data yet in the subr call */ num_trans = 1; /* lie about num read, so next test will work */ do while (num_trans > 0); /* keep reading from NCP until dont get any data */ raw_buffer_ptr = SDB.rawbuffer_ptr; num_elements = raw_buffer_ptr -> char_buffer.buffer_bound - (raw_buffer_ptr -> char_buffer.byte_offset + raw_buffer_ptr -> char_buffer.num_bytes); if num_elements < 200 then do; SDB.rawbuffer_ptr = net_buffer_man_$make_larger_buffer (SDB.rawbuffer_ptr, P_err_code); if P_err_code ^= 0 then do; call hcs_$set_ips_mask (previous_mask, ((36)"0"b)); return ("0"b); end; raw_buffer_ptr = SDB.rawbuffer_ptr; end; first_offset = raw_buffer_ptr -> char_buffer.byte_offset + raw_buffer_ptr -> char_buffer.num_bytes; call net_character_$nc_async_get_chars (SDB.ncp_cdb, addr (raw_buffer_ptr -> char_buffer.byte (first_offset)), raw_buffer_ptr -> char_buffer.buffer_bound - first_offset + 1, num_trans, P_event_channel, P_err_code); if P_err_code ^= 0 then do; if P_err_code = error_table_$end_of_info then do; connection_closed = "1"b; P_err_code = 0; end; end; if num_trans ^= 0 then do; got_any_data_this_call = "1"b; /* we have read some data this call */ raw_buffer_ptr -> char_buffer.num_bytes = raw_buffer_ptr -> char_buffer.num_bytes + num_trans; end; end; call hcs_$set_ips_mask (previous_mask, ((36)"0"b)); if ^ got_any_data_this_call then if connection_closed then if P_err_code = 0 then P_err_code = error_table_$end_of_info; return (got_any_data_this_call); end; /* end read_from_ncp */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_io_ */ end;  user_telnet_iox_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 189531 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_iox_: procedure (P_IOCB_ptr); /* "user_telnet_iox_" -- I/O switch interface to the Network TELNET */ /* IOSIMS for pseudo-TTYs and for random Network character connections. */ /* Originally coded by D. M. Wells March 6, 1975. */ /* notice that there are still varying string to be inited at entry for every call */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_positioning_type fixed binary (1), /* type of positioning to do on stream */ P_open_mode fixed binary (17), /* mode of opening to stream */ P_position_movement fixed binary (24), /* amount to move current position */ P_num_elem fixed binary (24), /* max number of elements to be transmitted */ P_num_elem_trans fixed binary (24), /* actual number of elements transmitted */ P_extend_bit bit (1) aligned, /* on if we are to append to end of previous */ P_report_sw bit (1) aligned, /* on if we should use com_err_ to report errors */ P_error_code fixed binary (35), /* standard Multics error code */ (P_new_modes, P_old_modes) character (*), /* arguments to modes entry point */ P_request character (*), /* request being made of control entry point */ P_attach_args (*) character (*) varying, /* arguments to attach call */ P_buffer_ptr pointer, /* pointer to workspace buffer */ P_info_ptr pointer, /* pointer to data for control entry point */ P_IOCB_ptr pointer) /* pointer to IOCB associated with switch */ parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (num_read fixed binary (24), (num_to_trans, num_trans) fixed binary (24), lines fixed binary (24), data_in_dim_buffer bit (1), temp_buffer character (64), SDB_ptr pointer, temp_iocb_ptr pointer) automatic; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ declare area_ptr pointer initial (null ()) internal static; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare (STREAM_INPUT_MODE initial (1), STREAM_OUTPUT_MODE initial (2), STREAM_INPUT_OUTPUT_MODE initial (3)) fixed binary (17) internal static; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 IOCB aligned like iocb_template defined (P_IOCB_ptr -> iocb_template.actual_iocb_ptr -> iocb_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_area area based; declare 1 iox_info aligned based, 2 CDB_ptr pointer, 2 open_ev_chn fixed binary (71), 2 read_ev_chn fixed binary (71), 2 write_ev_chn fixed binary (71), 2 open_mode fixed binary (17), 2 flags unaligned, 3 asynchronous_open bit (1), 3 padd bit (35); declare 1 workspace unaligned based, 2 byte (0 : 1) character (1) unaligned; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare ascii_value_$NL character (1) external static; declare net_character_tables_$NL_delim_id bit (36) external static; declare (error_table_$device_active, error_table_$ionmat, error_table_$no_operation, error_table_$not_detached, error_table_$undefined_order_request) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare get_system_free_area_ constant entry () returns (ptr), iox_$err_not_attached constant entry options (variable), iox_$err_not_closed constant entry options (variable), iox_$err_not_open constant entry options (variable), iox_$propagate constant entry (ptr), ipc_$block constant entry (ptr, ptr, fixed bin (35)), ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)), user_telnet_io_$ut_async_get_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_io_$ut_async_get_to_delim constant entry (ptr, ptr, fixed bin (24), fixed bin (24), bit (36), fixed bin (71), fixed bin (35)), user_telnet_io_$ut_async_put_chars constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (71), fixed bin (35)), user_telnet_io_util_$ut_reset_readahead constant entry (ptr, fixed bin (35)), user_telnet_io_util_$ut_reset_writebehind constant entry (ptr, fixed bin (35)), user_telnet_state_$ut_control constant entry (ptr, char (*), ptr, fixed bin (35)), user_telnet_state_$ut_modes constant entry (ptr, char (*), char (*), fixed bin (35)), user_telnet_xtach_$user_telnet_ constant entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)), user_telnet_xtach_$ut_async_close constant entry (ptr, ptr, fixed bin (71), fixed bin (35)), user_telnet_xtach_$ut_async_open constant entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)), user_telnet_xtach_$ut_detach constant entry (ptr, ptr, fixed bin (35)); declare (addr, length, null, size, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include net_event_template; % include net_iocb_template_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller: return; /* * * * * * * * * * * * * * * * * * * * * * * * */ user_telnet_attach: entry (P_IOCB_ptr, P_attach_args, P_report_sw, P_error_code); P_error_code = 0; /* setup for a successful return */ call attach (user_telnet_xtach_$user_telnet_, na_iox_open); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_detach: entry (P_IOCB_ptr, P_error_code); P_error_code = 0; call detach (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_open: entry (P_IOCB_ptr, P_open_mode, P_extend_bit, P_error_code); P_error_code = 0; call open (user_telnet_xtach_$ut_async_open, na_iox_close, P_open_mode); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_close: entry (P_IOCB_ptr, P_error_code); P_error_code = 0; call close (user_telnet_xtach_$ut_async_close, na_iox_open); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_get_line: entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, P_error_code); P_num_elem_trans = 0; do while (P_num_elem_trans = 0); call user_telnet_io_$ut_async_get_to_delim (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, net_character_tables_$NL_delim_id, IOCB.attach_data_ptr -> iox_info.read_ev_chn, P_error_code); if P_error_code ^= 0 then return; if P_num_elem_trans = 0 then call block (IOCB.attach_data_ptr -> iox_info.read_ev_chn); end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_get_chars: entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, P_error_code); P_num_elem_trans = 0; do while (P_num_elem_trans = 0); call user_telnet_io_$ut_async_get_chars (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_buffer_ptr, P_num_elem, P_num_elem_trans, IOCB.attach_data_ptr -> iox_info.write_ev_chn, P_error_code); if P_error_code ^= 0 then return; if P_num_elem_trans = 0 then call block (IOCB.attach_data_ptr -> iox_info.write_ev_chn); end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_put_chars: entry (P_IOCB_ptr, P_buffer_ptr, P_num_elem, P_error_code); P_error_code = 0; num_to_trans = P_num_elem; num_trans = 0; data_in_dim_buffer = "0"b; do while (num_to_trans > 0 | data_in_dim_buffer); call user_telnet_io_$ut_async_put_chars (IOCB.attach_data_ptr -> iox_info.CDB_ptr, addr (P_buffer_ptr -> workspace.byte (num_trans)), num_to_trans, num_read, IOCB.attach_data_ptr -> iox_info.write_ev_chn, P_error_code); num_trans = num_trans + num_read; num_to_trans = num_to_trans - num_read; if P_error_code ^= 0 then if P_error_code = error_table_$device_active then data_in_dim_buffer = "1"b; else return; else data_in_dim_buffer = "0"b; if (num_to_trans > 0) | (data_in_dim_buffer) then call block (IOCB.attach_data_ptr -> iox_info.write_ev_chn); end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_control: entry (P_IOCB_ptr, P_request, P_info_ptr, P_error_code); call check_control (P_error_code); if P_error_code ^= error_table_$undefined_order_request then return; call user_telnet_state_$ut_control (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_request, P_info_ptr, P_error_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_position: entry (P_IOCB_ptr, P_positioning_type, P_position_movement, P_error_code); P_error_code = 0; if (P_positioning_type ^= 0) | (P_position_movement < 0) then do; P_error_code = error_table_$no_operation; return; end; lines = 0; do while (lines < P_position_movement); call na_iox_get_line (addr (IOCB), addr (temp_buffer), length (temp_buffer), num_read, P_error_code); if P_error_code ^= 0 then return; if substr (temp_buffer, num_read, 1) = ascii_value_$NL then lines = lines + 1; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ na_iox_modes: entry (P_IOCB_ptr, P_new_modes, P_old_modes, P_error_code); call user_telnet_state_$ut_modes (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_new_modes, P_old_modes, P_error_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ block: procedure (P_event_channel); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_event_channel fixed binary (71) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare err_code fixed binary (35) automatic; declare 1 chn_list aligned automatic, 2 num_chans fixed binary (17), 2 padding bit (36), 2 channel (1) fixed binary (71); declare 1 event_message aligned like event_message_template; /* * * * * * * * * * * * * * * * * * * * * * * * */ chn_list.num_chans = 1; chn_list.channel (1) = P_event_channel; call ipc_$block (addr (chn_list), addr (event_message), err_code); if err_code ^= 0 then do; if P_event_channel = 0 then call ipc_$create_ev_chn (P_event_channel, err_code); /* iosim has switched to */ /* async operation */ if err_code ^= 0 then do; P_error_code = err_code; goto return_to_caller; end; end; return; end; /* end block */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ attach: procedure (P_attach_proc, P_open_entry); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_opening_mode fixed binary (17), P_attach_proc entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)), P_close_proc entry (ptr, ptr, fixed bin (71), fixed bin (35)), P_open_proc entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)), P_close_entry entry (ptr, fixed bin (35)), P_open_entry entry (ptr, fixed bin (17), bit (1), fixed bin (35))) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (should_complete_open bit (1), open_args (1) character (32) varying) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ if area_ptr = null () then area_ptr = get_system_free_area_ (); if IOCB.attach_descrip_ptr ^= null () then do; P_error_code = error_table_$ionmat; return; end; allocate iox_info in (area_ptr -> based_area) set (IOCB.attach_data_ptr); IOCB.attach_data_ptr -> iox_info.CDB_ptr = null (); IOCB.attach_data_ptr -> iox_info.open_ev_chn = 0; IOCB.attach_data_ptr -> iox_info.read_ev_chn = 0; IOCB.attach_data_ptr -> iox_info.write_ev_chn = 0; IOCB.attach_data_ptr -> iox_info.open_mode = 0; IOCB.attach_data_ptr -> iox_info.asynchronous_open = "0"b; call P_attach_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_attach_args, (P_report_sw), IOCB.attach_descrip_ptr, P_error_code); if P_error_code ^= 0 then do; free IOCB.attach_data_ptr -> iox_info in (area_ptr -> based_area); return; end; IOCB.detach_iocb = na_iox_detach; IOCB.open = P_open_entry; call iox_$propagate (addr (IOCB)); IOCB.control = na_iox_control; IOCB.modes = na_iox_modes; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ detach: entry (); SDB_ptr = IOCB.attach_data_ptr -> iox_info.CDB_ptr; call user_telnet_xtach_$ut_detach (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.attach_descrip_ptr, P_error_code); if P_error_code ^= 0 then return; IOCB.attach_descrip_ptr = null (); IOCB.attach_data_ptr -> iox_info.CDB_ptr = null (); IOCB.detach_iocb = iox_$err_not_attached; IOCB.open = iox_$err_not_attached; free IOCB.attach_data_ptr -> iox_info in (area_ptr -> based_area); IOCB.attach_data_ptr = null (); call iox_$propagate (addr (IOCB)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ open: entry (P_open_proc, P_close_entry, P_opening_mode); SDB_ptr = IOCB.attach_data_ptr -> iox_info.CDB_ptr; should_complete_open = ^ IOCB.attach_data_ptr -> iox_info.asynchronous_open; IOCB.attach_data_ptr -> iox_info.asynchronous_open = "0"b; IOCB.attach_data_ptr -> iox_info.open_mode = P_opening_mode; open_args (1) = ""; P_error_code = -1; do while (P_error_code ^= 0); call P_open_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.attach_data_ptr -> iox_info.open_mode, open_args, IOCB.open_descrip_ptr, IOCB.attach_data_ptr -> iox_info.open_ev_chn, P_error_code); if P_error_code ^= 0 then do; if P_error_code = error_table_$device_active then do; if should_complete_open then call block (IOCB.attach_data_ptr -> iox_info.open_ev_chn); else do; P_error_code = 0; return; end; end; else return; end; end; IOCB.close = P_close_entry; IOCB.open = iox_$err_not_open; IOCB.detach_iocb = iox_$err_not_closed; if IOCB.attach_data_ptr -> iox_info.open_mode ^= STREAM_OUTPUT_MODE then do; IOCB.get_line = na_iox_get_line; IOCB.get_chars = na_iox_get_chars; IOCB.position = na_iox_position; end; if IOCB.attach_data_ptr -> iox_info.open_mode ^= STREAM_INPUT_MODE then do; IOCB.put_chars = na_iox_put_chars; end; IOCB.modes = na_iox_modes; IOCB.control = na_iox_control; call iox_$propagate (addr (IOCB)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ close: entry (P_close_proc, P_open_entry); call P_close_proc (IOCB.attach_data_ptr -> iox_info.CDB_ptr, IOCB.open_descrip_ptr, 0, P_error_code); IOCB.detach_iocb = na_iox_detach; IOCB.open = P_open_entry; IOCB.close = iox_$err_not_open; IOCB.get_line = iox_$err_not_open; IOCB.get_chars = iox_$err_not_open; IOCB.put_chars = iox_$err_not_open; IOCB.control = iox_$err_not_open; IOCB.modes = iox_$err_not_open; IOCB.position = iox_$err_not_open; call iox_$propagate (addr (IOCB)); IOCB.control = na_iox_control; IOCB.modes = na_iox_modes; return; end; /* end attach */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_control: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_err_code = 0; /* if (P_request = "resetread") */ /* then do; */ /* call user_telnet_io_util_$ut_reset_readahead (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_err_code); */ /* return; */ /* end; */ /* if (P_request = "resetwrite") */ /* then do; */ /* call user_telnet_io_util_$ut_reset_writebehind (IOCB.attach_data_ptr -> iox_info.CDB_ptr, P_err_code); */ /* return; */ /* end; */ /* if (P_request = "abort") */ /* then do; */ /* call user_telnet_io_util_$ut_reset_readahead (IOCB.attach_data_ptr -> iox_info.CDB_ptr, (0)); */ /* call user_telnet_io_util_$ut_reset_writebehind (IOCB.attach_data_ptr -> iox_info.CDB_ptr, (0)); */ /* return; */ /* end; */ if (P_request = "asynchronous_open") then do; IOCB.attach_data_ptr -> iox_info.asynchronous_open = "1"b; return; end; if (P_request = "complete_open") then do; call block (IOCB.attach_data_ptr -> iox_info.open_ev_chn); call open (user_telnet_xtach_$ut_async_open, na_iox_close, IOCB.attach_data_ptr -> iox_info.open_mode); return; end; P_err_code = error_table_$undefined_order_request; return; end; /* end check_control */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_iox_ */ end;  user_telnet_option_ctl_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 80748 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_option_ctl_: procedure (); /* This module contains various utility functions for the use of */ /* the higher level module "user_telnet_options_". */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option fixed binary (8), P_error_code fixed binary (35), P_direction bit (1), P_block_ptr pointer, P_SDB_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (option_number fixed binary (8), info_ptr pointer, block_ptr pointer) automatic; declare 1 negotiation_buffer aligned automatic, 2 byte (0 : 255) bit (9) unaligned; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ declare area_ptr pointer initial (null ()) internal static; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 SDB aligned like SDB_template defined (P_SDB_ptr -> SDB_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare (RECEIVE_DIRECTION initial ("0"b), TRANSMIT_DIRECTION initial ("1"b)) internal static bit (1); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_area area based; declare 1 options_info aligned based, 2 allocation_info aligned, 3 area_ptr pointer, 3 lock bit (36) aligned, 3 padding bit (36), 2 status (0 : 25), 3 receive aligned like option_status_template, 3 transmit aligned like option_status_template; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$badcall fixed binary (35) external static; declare (telnet_message_$option_already_in_effect, telnet_message_$option_already_requested, telnet_message_$option_not_in_effect, telnet_message_$option_not_supported) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare get_system_free_area_ constant entry () returns (ptr), ioa_$ioa_switch constant entry options (variable), net_character_$nc_control constant entry (ptr, char (*), ptr, fixed bin (35)); declare (addr, bit, binary, null) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include user_telnet_option_dcls; % include user_telnet_sdb_dcls; % include telnet_special_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * */ find_option_block: entry (P_SDB_ptr, P_option, P_direction, P_block_ptr, P_error_code); P_error_code = 0; if SDB.options_info_ptr = null () then do; P_block_ptr = null (); return; end; info_ptr = SDB.options_info_ptr; if (P_option < lbound (info_ptr -> options_info.status, 1)) | (P_option > hbound (info_ptr -> options_info.status, 1)) then do; P_block_ptr = null (); return; end; if P_direction = RECEIVE_DIRECTION then P_block_ptr = addr (info_ptr -> options_info.status (P_option).receive); else P_block_ptr = addr (info_ptr -> options_info.status (P_option).transmit); return; /* * * * * * * * * * * * * * * * * * * * * * * */ initialize_options: entry (P_SDB_ptr, P_error_code); P_error_code = 0; if area_ptr = null () then do; area_ptr = get_system_free_area_ (); end; allocate options_info in (area_ptr -> based_area) set (info_ptr); info_ptr -> options_info.area_ptr = null (); do option_number = lbound (info_ptr -> options_info.status, 1) by 1 to hbound (info_ptr -> options_info.status, 1); do block_ptr = addr (info_ptr -> options_info.status (option_number).receive), addr (info_ptr -> options_info.status (option_number).transmit); block_ptr -> option_status_template.info_data_ptr = null (); string (block_ptr -> option_status_template.cur_state) = ""b; end; end; do block_ptr = addr (info_ptr -> options_info.status (3).receive), addr (info_ptr -> options_info.status (3).transmit); block_ptr -> option_status_template.option_supported = "1"b; block_ptr -> option_status_template.option_allowed = "1"b; end; SDB.options_info_ptr = info_ptr; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ option_invoked: entry (P_SDB_ptr, P_option, P_direction, P_block_ptr, P_error_code); P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ option_revoked: entry (P_SDB_ptr, P_option, P_direction, P_block_ptr, P_error_code); P_error_code = 0; return; error_return: return; cant_reach_here: if find_option_block ("1"b) = null () then; call write_option_command_block (""b); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ find_option_block: procedure (P_direction) returns (ptr); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_direction bit (1) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ option_number = P_option; if ("0"b) then return (null ()); if SDB.options_info_ptr = null () then do; end; /* if P_direction = RECEIVE_DIRECTION then return (addr (SDB.options_info.receive_connection.option_status (option_number))); else return (addr (SDB.options_info.transmit_connection.option_status (option_number))); */ end; /* end find_option_block */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ write_option_command_block: procedure (P_command_char); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_command_char bit (9) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (error_code fixed binary (35), command_name character (4)) automatic; declare 1 command_block aligned automatic, 2 count fixed binary (24), 2 workspace aligned, 3 Interpret_As_Command bit (9) unaligned, 3 TELNET_Command bit (9) unaligned, 3 Option_Number bit (9) unaligned; /* * * * * * * * * * * * * * * * * * * * * * * * */ if SDB.trace_iocb_ptr ^= null () then do; if P_command_char = NET_WILL then command_name = "WILL"; else if P_command_char = NET_DO then command_name = "DO"; else if P_command_char = NET_WONT then command_name = "WONT"; else if P_command_char = NET_DONT then command_name = "DONT"; else command_name = "????"; call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Sending reply ^a for option ^d.", command_name, option_number); end; command_block.Interpret_As_Command = NET_IAC; command_block.TELNET_Command = P_command_char; command_block.Option_Number = bit (binary (option_number, 9)); command_block.count = 3; call net_character_$nc_control (SDB.ncp_cdb, "send_TELNET_control", addr (command_block), error_code); return; end; /* end write_option_command_block */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_option_ctl_ */ end;  user_telnet_options_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 158517 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_options_: procedure (); /* This module contains the various entry points to implement the */ /* TELNET option negotiation for the user side of the protocol. For */ /* each option (in each direction), four (4) bits of information are */ /* kept -- see the declaration of option_status_template for a list of */ /* these. See the TELNET specification for a description of the actions */ /* necessary to implement the negotiation. */ /* Originally written by D. M. Wells. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_buffer_len fixed binary (24), P_error_code fixed binary (35), P_option fixed binary (8), P_buffer_ptr pointer, P_SDB_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 SDB aligned like SDB_template defined (P_SDB_ptr -> SDB_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare (RECEIVE_DIRECTION initial ("0"b), TRANSMIT_DIRECTION initial ("1"b)) internal static bit (1); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$badcall fixed binary (35) external static; declare (telnet_message_$option_already_in_effect, telnet_message_$option_already_requested, telnet_message_$option_not_in_effect, telnet_message_$option_not_supported) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare ioa_$ioa_switch constant entry options (variable), net_character_$nc_control constant entry (ptr, char (*), ptr, fixed bin (35)), user_telnet_option_ctl_$find_option_block constant entry (ptr, fixed bin (8), bit (1), ptr, fixed bin (35)), user_telnet_option_ctl_$initialize_options constant entry (ptr, fixed bin (35)), user_telnet_option_ctl_$option_invoked constant entry (ptr, fixed bin (8), bit (1), ptr, fixed bin (35)), user_telnet_option_ctl_$option_revoked constant entry (ptr, fixed bin (8), bit (1), ptr, fixed bin (35)); declare (addr, bit, binary, null) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include user_telnet_option_dcls; % include user_telnet_sdb_dcls; % include telnet_special_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* This entry is called if it is desired that the */ /* foreign host perform according to the desired option. */ DO_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call request_option (P_option, (RECEIVE_DIRECTION), (NET_DO)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ /* This entry is called if it is desired that we */ /* perform according to some option. */ WILL_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call request_option (P_option, (TRANSMIT_DIRECTION), (NET_WILL)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ DONT_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call revoke_option (P_option, (RECEIVE_DIRECTION), (NET_DONT)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ WONT_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call revoke_option (P_option, (TRANSMIT_DIRECTION), (NET_WONT)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ /* The "process_XX_option" entry points are called */ /* when a particular option negotiation is received from */ /* the network. */ process_DO_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call option_requested (P_option, (TRANSMIT_DIRECTION), (NET_WILL), (NET_WONT)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_WILL_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call option_requested (P_option, (RECEIVE_DIRECTION), (NET_DO), (NET_DONT)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_DONT_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call option_revoked (P_option, (TRANSMIT_DIRECTION), (NET_WONT)); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ process_WONT_option: entry (P_SDB_ptr, P_option, P_error_code); P_error_code = 0; call option_revoked (P_option, (RECEIVE_DIRECTION), (NET_DONT)); return; process_subnegotiation: entry (P_SDB_ptr, P_option, P_buffer_ptr, P_buffer_len, P_error_code); P_error_code = 0; if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received subnegotiation string for option ^d.", P_option); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ release_option_info: entry (P_SDB_ptr, P_error_code); P_error_code = 0; if SDB.options_info_ptr ^= null () then do; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller: return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ find_option_block: procedure (P_option_num, P_direction) returns (ptr); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_direction bit (1)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare block_ptr pointer automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ if SDB.options_info_ptr = null () then do; call user_telnet_option_ctl_$initialize_options (P_SDB_ptr, P_error_code); if P_error_code ^= 0 then goto return_to_caller; end; call user_telnet_option_ctl_$find_option_block (P_SDB_ptr, P_option_num, P_direction, block_ptr, P_error_code); if P_error_code ^= 0 then goto return_to_caller; return (block_ptr); end; /* end find_option_block */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ write_option_command_block: procedure (P_option_num, P_command_char); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_command_char bit (9)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (error_code fixed binary (35), command_name character (4)) automatic; declare 1 command_block aligned automatic, 2 count fixed binary (24), 2 workspace aligned, 3 Interpret_As_Command bit (9) unaligned, 3 TELNET_Command bit (9) unaligned, 3 Option_Number bit (9) unaligned; /* * * * * * * * * * * * * * * * * * * * * * * * */ if SDB.trace_iocb_ptr ^= null () then do; if P_command_char = NET_WILL then command_name = "WILL"; else if P_command_char = NET_DO then command_name = "DO"; else if P_command_char = NET_WONT then command_name = "WONT"; else if P_command_char = NET_DONT then command_name = "DONT"; else command_name = "????"; call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Sending reply ^a for option ^d.", command_name, P_option_num); end; command_block.Interpret_As_Command = NET_IAC; command_block.TELNET_Command = P_command_char; command_block.Option_Number = bit (binary (P_option_num, 9)); command_block.count = 3; call net_character_$nc_control (SDB.ncp_cdb, "send_TELNET_control", addr (command_block), error_code); return; end; /* end write_option_command_block */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ request_option: procedure (P_option_num, P_direction, P_telnet_command); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_direction bit (1), P_telnet_command bit (9)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare block_ptr pointer automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ block_ptr = find_option_block (P_option_num, P_direction); if block_ptr = null () then do; P_error_code = telnet_message_$option_not_supported; return; end; if ^ block_ptr -> option_status_template.option_supported then do; P_error_code = telnet_message_$option_not_supported; return; end; block_ptr -> option_status_template.option_allowed = "1"b; if block_ptr -> option_status_template.option_in_effect then do; P_error_code = telnet_message_$option_already_in_effect; return; end; if block_ptr -> option_status_template.option_invocation_requested then do; P_error_code = telnet_message_$option_already_requested; return; end; call write_option_command_block (P_option_num, P_telnet_command); block_ptr -> option_status_template.option_invocation_requested = "1"b; return; end; /* end request_option */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ revoke_option: procedure (P_option_num, P_direction, P_telnet_command); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_direction bit (1), P_telnet_command bit (9)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare block_ptr pointer automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ block_ptr = find_option_block (P_option_num, P_direction); if block_ptr = null () then do; /* this option is not in effect, can't revoke it */ P_error_code = telnet_message_$option_not_in_effect; return; end; block_ptr -> option_status_template.option_allowed = "0"b; if ^ block_ptr -> option_status_template.option_in_effect then do; P_error_code = telnet_message_$option_not_in_effect; return; end; call write_option_command_block (P_option_num, P_telnet_command); block_ptr -> option_status_template.option_revocation_requested = "1"b; return; end; /* end revoke_option */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ option_requested: procedure (P_option_num, P_direction, P_ack_telnet_command, P_nak_telnet_command); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_direction bit (1), (P_ack_telnet_command, P_nak_telnet_command) bit (9)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare block_ptr pointer automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ block_ptr = find_option_block (P_option_num, P_direction); if block_ptr = null () then do; call write_option_command_block (P_option_num, P_nak_telnet_command); return; end; if (^ block_ptr -> option_status_template.option_supported) | (^ block_ptr -> option_status_template.option_allowed) then do; call write_option_command_block (P_option_num, P_nak_telnet_command); return; end; if block_ptr -> option_status_template.option_invocation_requested then do; block_ptr -> option_status_template.option_in_effect = "1"b; block_ptr -> option_status_template.option_invocation_requested = "0"b; call user_telnet_option_ctl_$option_invoked (P_SDB_ptr, P_option_num, P_direction, block_ptr, P_error_code); return; end; if ^ block_ptr -> option_status_template.option_in_effect then do; call write_option_command_block (P_option_num, P_ack_telnet_command); block_ptr -> option_status_template.option_in_effect = "1"b; call user_telnet_option_ctl_$option_invoked (P_SDB_ptr, P_option_num, P_direction, block_ptr, P_error_code); return; end; if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Protocol violation -- option ^d in effect already.", P_option_num); return; end; /* end option_requested */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ option_revoked: procedure (P_option_num, P_direction, P_telnet_command); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_option_num fixed binary (8), P_direction bit (1), P_telnet_command bit (9)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare block_ptr pointer automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ block_ptr = find_option_block (P_option_num, P_direction); if block_ptr = null () then do; /* this option isn't in effect now, ignore */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received revocation for option not in effect."); return; end; if block_ptr -> option_status_template.option_revocation_requested then do; block_ptr -> option_status_template.option_in_effect = "0"b; block_ptr -> option_status_template.option_revocation_requested = "0"b; return; end; if block_ptr -> option_status_template.option_in_effect then do; call write_option_command_block (P_option_num, P_telnet_command); block_ptr -> option_status_template.option_in_effect = "0"b; call user_telnet_option_ctl_$option_revoked (P_SDB_ptr, P_option_num, P_direction, block_ptr, P_error_code); return; end; if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received revocation for option ^d not if effect.", P_option_num); return; end; /* end option_revoked */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_options_ */ end;  user_telnet_orders_.mexp 09/23/77 1038.1rew 09/23/77 0809.2 5049 name user_telnet_orders_ ¯o define_order " order_name segdef &1 &1: aci "&1",32 &end " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " define_order send_AO define_order send_AYT define_order send_BRK define_order send_EC define_order send_EL define_order send_GA define_order send_IP define_order send_NOP end  user_telnet_protocol_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 164349 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_protocol_: procedure (P_SDB_ptr, P_raw_buffer_ptr, P_error_code); /* "user_telnet_protocol_" -- this procedure interprets the */ /* Network TELNET characters received from the Network. It also */ /* performs any necessary action required by these characters. */ /* Originally created by D. M. Wells 1973, December 17. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_error_code fixed binary (35), (P_raw_buffer_ptr, P_SDB_ptr) pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((buffer_hbound, last_processed, raw_indx) fixed binary (24), byte_element bit (9), buffer_ptr pointer) automatic; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ declare NL initial ("000001010"b) /* New Line character */ bit (9) internal static; /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_area area based; declare 1 based_workspace aligned based, 2 byte (0 : 1) bit (9) unaligned; declare 1 char_buffer aligned based, 2 header like net_buffer_header, 2 workspace aligned, 3 byte (0 : buffer_allocation_size refer (char_buffer.header.buffer_bound)) bit (9) unaligned; /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 SDB aligned like SDB_template defined (P_SDB_ptr -> SDB_template); /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare error_table_$data_improperly_terminated fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare clock_ constant entry () returns (fixed bin (71)), ioa_$ioa_switch constant entry options (variable), iox_$control constant entry (ptr, char (*), ptr, fixed bin (35)), net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)), net_character_$nc_control constant entry (ptr, char (*), ptr, fixed bin (35)), user_telnet_io_util_$ut_reset_writebehind constant entry (ptr, fixed bin (35)), user_telnet_options_$process_DO_option constant entry (ptr, fixed bin (8), fixed bin (35)), user_telnet_options_$process_DONT_option constant entry (ptr, fixed bin (8), fixed bin (35)), user_telnet_options_$process_subnegotiation constant entry (ptr, fixed bin (8), ptr, fixed bin (24), fixed bin (35)), user_telnet_options_$process_WILL_option constant entry (ptr, fixed bin (8), fixed bin (35)), user_telnet_options_$process_WONT_option constant entry (ptr, fixed bin (8), fixed bin (35)); declare (addr, binary, null, substr, unspec) builtin; /* * * * * STACK REFERENCES * * * * * * * * * * */ /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include user_telnet_sdb_dcls; % include net_buffer_header_dcls; % include telnet_special_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ P_error_code = 0; buffer_ptr = P_raw_buffer_ptr; if SDB.protocol_state.nic_9348 then do; /* if dedicated to old protocol, check buffer */ call check_old_protocol (); return; end; restart_buffer_scan: buffer_hbound = buffer_ptr -> char_buffer.byte_offset + buffer_ptr -> char_buffer.num_bytes - 1; last_processed = buffer_ptr -> char_buffer.byte_offset - 1; do raw_indx = buffer_ptr -> char_buffer.byte_offset by 1 to buffer_hbound; byte_element = buffer_ptr -> char_buffer.byte (raw_indx); if byte_element = OUR_IAC /* if this character is our translated IAC */ then call process_protocol (raw_indx); /* then find out what foreign system wants */ last_processed = raw_indx; end; return_from_raw_scan: if SDB.aborting_input then do; if clock_ () > SDB.abort_input_timeout then SDB.aborting_input = "0"b; else call overwrite_protocol (buffer_ptr -> char_buffer.byte_offset, last_processed); end; if ^ SDB.protocol_state.nic_18639 then call check_old_protocol (); /* not new yet, ignore all 200 bytes */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ overwrite_protocol: procedure (P_start_loc, P_end_loc); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_end_loc, P_start_loc) fixed binary (24) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare indx fixed binary (24) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ do indx = P_start_loc by 1 to P_end_loc; buffer_ptr -> char_buffer.byte (indx) = OUR_NOP; end; return; end; /* end overwrite_protocol */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* this procedure is a subroutine which implements the */ /* basic level of the TELNET IAC processing. */ process_protocol: procedure (P_next_indx); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_next_indx fixed binary (24) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (option_number fixed binary (8), iac_indx fixed binary (24), command bit (9)) automatic; declare 1 transmit_buffer aligned automatic, 2 count fixed binary (24), 2 workspace aligned, 3 byte (1 : 2) bit (9) unaligned; /* * * * * * * * * * * * * * * * * * * * * * * * */ if ^ SDB.protocol_state.nic_18639 then do; /* are now just switching into new protocol mode */ SDB.protocol_state.nic_18639 = "1"b; transmit_buffer.byte (1) = NET_IAC; transmit_buffer.byte (2) = NET_NOP; transmit_buffer.count = 2; call net_character_$nc_control (SDB.ncp_cdb, "send_TELNET_control", addr (transmit_buffer), (0)); /* should call options_init */ end; iac_indx = P_next_indx; if iac_indx + 1 > buffer_hbound then goto return_from_raw_scan; /* we dont have another character to interpret */ P_next_indx = P_next_indx + 1; command = buffer_ptr -> char_buffer.byte (P_next_indx); /* pick up the next character */ if command = OUR_IAC then do; call overwrite_protocol (iac_indx, P_next_indx); /* overwrite both bytes */ buffer_ptr -> char_buffer.byte (iac_indx) = NET_IAC; /* now overwrite iac loc with real iac */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received extended character 377"); return; end; if command = NET_DONT then do; option_number = get_option_number (P_next_indx); call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 3 bytes */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received DONT for option ^d.", option_number); call user_telnet_options_$process_DONT_option (addr (SDB), option_number, P_error_code); return; end; if command = NET_DO then do; option_number = get_option_number (P_next_indx); call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 3 bytes of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received DO for option ^d.", option_number); call user_telnet_options_$process_DO_option (addr (SDB), option_number, P_error_code); return; end; if command = NET_WONT then do; option_number = get_option_number (P_next_indx); call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 3 byte of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received WONT for option ^d.", option_number); call user_telnet_options_$process_WONT_option (addr (SDB), option_number, P_error_code); return; end; if command = NET_WILL then do; option_number = get_option_number (P_next_indx); call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 3 bytes of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received WILL for option ^d.", option_number); call user_telnet_options_$process_WILL_option (addr (SDB), option_number, P_error_code); return; end; if command = NET_SB then do; call interpret_subnegotiation_string (P_next_indx); call overwrite_protocol (iac_indx, P_next_indx); /* overwrite all bytes of string */ return; end; if command = NET_GA then do; call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 2 bytes of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received GA"); return; end; if command = NET_NOP then do; call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 2 bytes of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received NOP"); return; end; if command = NET_DM then do; SDB.connection_state.aborting_input = "0"b; /* received data mark resets input aborting */ call overwrite_protocol (iac_indx, P_next_indx); /* overwrite 2 bytes of protocol */ if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received Data Mark from foreign host"); else if SDB.users_output_iocb_ptr ^= null () then call iox_$control (SDB.users_output_iocb_ptr, "resetwrite", null (), (0)); call overwrite_protocol (buffer_ptr -> char_buffer.byte_offset, iac_indx - 1); /* overwrite the first part of the buffer */ return; end; if (command = NET_AO) | (command = NET_AYT) | (command = NET_BRK) | (command = NET_EC) | (command = NET_EL) | (command = NET_IP) | (command = NET_SE) then do; call overwrite_protocol (iac_indx, P_next_indx); if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Received command ^d from foreign host, meaningless to user telnet.", binary (command, 9)); return; end; if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Unknown telnet command ^d", binary (command, 9)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ get_option_number: procedure (P_next_byte_indx) returns (fixed bin (8)); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_next_byte_indx fixed binary (24) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_next_byte_indx = P_next_byte_indx + 1; /* increment to location of the option number */ if P_next_byte_indx > buffer_hbound then goto return_from_raw_scan; return (binary (buffer_ptr -> char_buffer.byte (P_next_byte_indx), 8)); return; end; /* end get_option */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_subnegotiation_string: procedure (P_next_byte_indx); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_next_byte_indx fixed binary (24) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((byte_indx, first_sub, next_out) fixed binary (24), (found_IAC, found_SE) bit (1), this_byte bit (9)) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ option_number = get_option_number (P_next_indx); first_sub = P_next_indx + 1; /* remember loc of first char of string */ P_error_code = error_table_$data_improperly_terminated; /* if we leave here, then let our */ /* caller know that we are in the */ /* of processing something important */ found_IAC = "0"b; found_SE = "0"b; do P_next_byte_indx = P_next_byte_indx + 1 by 1 while (^ found_SE); if P_next_byte_indx > buffer_hbound then goto return_from_raw_scan; this_byte = buffer_ptr -> char_buffer.byte (P_next_byte_indx); if ^ found_IAC then do; if this_byte = NET_IAC then found_IAC = "1"b; end; else do; found_IAC = "0"b; if this_byte = NET_SE then found_SE = "1"b; end; end; P_error_code = 0; /* we have a complete negotiaton string */ /* If we got through the loop, then we found the IAC-SE */ /* sequence, so we should pass the sequence on to the option manager. */ next_out = first_sub; do byte_indx = first_sub by 1 to P_next_byte_indx - 2; this_byte = buffer_ptr -> char_buffer.byte (byte_indx); if ^ found_IAC then do; if this_byte = OUR_IAC then found_IAC = "1"b; else do; buffer_ptr -> char_buffer.byte (next_out) = this_byte; next_out = next_out + 1; end; end; else do; found_IAC = "0"b; if this_byte = OUR_IAC then do; buffer_ptr -> char_buffer.byte (next_out) = this_byte; next_out = next_out + 1; end; else do; if SDB.trace_iocb_ptr ^= null () then call ioa_$ioa_switch (SDB.trace_iocb_ptr, "Got non-matched c(IAC) char ^d in subnegotiation string.", binary (this_byte, 9)); end; end; end; call user_telnet_options_$process_subnegotiation (P_SDB_ptr, binary (option_number, 8), addr (buffer_ptr -> char_buffer.byte (first_sub)), next_out, P_error_code); return; end; /* end interpret_subnegotiation_string */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ end; /* end process_protocol */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_old_protocol: procedure (); /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare buff_indx fixed binary (24) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ do buff_indx = buffer_ptr -> char_buffer.byte_offset by 1 to buffer_ptr -> char_buffer.byte_offset + buffer_ptr -> char_buffer.num_bytes - 1; byte_element = buffer_ptr -> char_buffer.byte (buff_indx); if substr (byte_element, 1, 2) = "01"b /* only check for telnet protocol, not ours */ then buffer_ptr -> char_buffer.byte (buff_indx) = OUR_NOP; end; return; end; /* end check_old_protocol */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_protocol_ */ end;  user_telnet_state_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 219987 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_state_: procedure (P_SDB_ptr); /* "user_telnet_state_" -- this procedure contains the entry */ /* points associated with maintaining the attachment (through the I/O */ /* switch) for a stream using this IOSIM. */ /* Originally created by D. M. Wells 1973, December 17. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_size fixed binary (24), /* element size of this attachment */ P_delim_count fixed binary (24), P_error_code fixed binary (35), /* standard Multics error code */ P_interpretation_modes bit (*), P_delim_id bit (36), (P_new_modes, P_old_modes, P_request) character (*), P_SDB_ptr pointer, P_delim_ptr pointer, P_request_ptr pointer) /* pointer to additional args for order call */ parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (indx fixed binary (24), num_chars fixed binary (24), err_code fixed binary (35), delimiter_set_id bit (36), foreign_socket_for_hc bit (41), foreign_host character (32), (buff_ptr, delim_ptr) pointer) automatic; declare SDB_ptr pointer initial (P_SDB_ptr) automatic; declare 1 special_output_buffer aligned automatic, 2 count fixed binary (24), 2 byte (1 : 20) bit (9) unaligned; declare 1 interpretation_modes automatic, 2 use_hc_modes bit (1), 2 set_initial_modes bit (1), 2 ignore_bad_modes bit (1); /* * * * * DEFINED REFERENCES * * * * * * * * * */ declare 1 SDB aligned like SDB_template defined (SDB_ptr -> SDB_template); /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare (based_fb35 fixed binary (35), based_bit41 bit (41)) based; declare 1 read_status_struc aligned based, 2 ev_chan fixed binary (71), 2 input_available bit (1) unaligned, 2 padd bit (35) unaligned; declare 1 based_break_comm aligned based, 2 buffer_size fixed binary (24), 2 count fixed binary (24), 2 byte (0 : 0 refer (based_break_comm.buffer_size)) bit (9) unaligned; declare 1 based_delim unaligned based, 2 byte (0 : 1) bit (9) unaligned; declare 1 char_buffer aligned based, 2 header like net_buffer_header, 2 workspace aligned, 3 byte (0 : 0 refer (char_buffer.buffer_bound)) bit (9) unaligned; /* * * * * TEXT SECTION REFERENCES * * * * * * * */ /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare net_character_tables_$NL_delim_id bit (36) external static; declare (user_telnet_orders_$send_AO, user_telnet_orders_$send_AYT, user_telnet_orders_$send_BRK, user_telnet_orders_$send_EC, user_telnet_orders_$send_EL, user_telnet_orders_$send_GA, user_telnet_orders_$send_IP, user_telnet_orders_$send_NOP) character (32) external static; declare (error_table_$action_not_performed, error_table_$area_too_small, error_table_$bad_arg, error_table_$bad_mode, /* we didn't understand the mode the guy wanted */ error_table_$invalid_elsize, error_table_$long_record, error_table_$undefined_order_request, /* code indicating ignorance of order call */ error_table_$unimplemented_version) fixed binary (35) external static; declare net_error_table_$no_protocol_support fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare clock_ constant entry () returns (fixed bin (71)), convert_binary_integer_$decimal_string constant entry (fixed bin (35)) returns (char (12) varying), get_process_id_ constant entry () returns (bit (36) aligned), hcs_$wakeup constant entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), host_id_$abbrev constant entry (fixed bin (8), char (*), fixed bin (35)), ioa_$ioa_switch constant entry options (variable), ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)), ncp_$send_interrupt constant entry (bit (36), fixed bin (35)), net_$ncp_state constant entry (bit (36), bit (41), fixed bin (6), fixed bin (35)), net_buffer_man_$allocate_buffer constant entry (fixed bin (24), fixed bin (24), fixed bin (35)) returns (ptr), net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)), net_character_$nc_control constant entry (ptr, char (*), ptr, fixed bin (35)), net_mode_parser_ constant entry (char (*), entry (char (*) varying, bit (*), ptr, fixed bin (35)), fixed bin (35)), user_telnet_io_$ut_async_get_to_delim constant entry (ptr, ptr, fixed bin (24), fixed bin (24), bit (36), fixed bin (71), fixed bin (35)), user_telnet_io_$ut_put_chars_raw constant entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35)); declare (addr, baseno, binary, bit, hbound, length, null, rel, string, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include telnet_special_chars; % include user_telnet_sdb_dcls; % include net_buffer_header_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ ut_control: /* entry to issue typewriter order calls */ entry (P_SDB_ptr, P_request, P_request_ptr, P_error_code); P_error_code = 0; /* initialize status word to zero */ if P_request = "start" then do; call net_character_$nc_control (SDB.ncp_cdb, "start", P_request_ptr, P_error_code); return; end; if P_request = user_telnet_orders_$send_AO then do; if ^ SDB.protocol_state.nic_18639 then do; P_error_code = net_error_table_$no_protocol_support; return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_AO; call send_raw_buffer (2, "1"b); /* we need a sync for this one */ return; end; if P_request = user_telnet_orders_$send_AYT then do; if ^ SDB.protocol_state.nic_18639 then do; P_error_code = net_error_table_$no_protocol_support; return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_AYT; call send_raw_buffer (2, "1"b); /* this command needs a sync sequence */ return; end; if P_request = user_telnet_orders_$send_BRK then do; if ^ SDB.protocol_state.nic_18639 then do; special_output_buffer.byte (1) = "010000001"b; /* old protocol BRK character */ call send_raw_buffer (1, "0"b); return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_BRK; call send_raw_buffer (2, "1"b); /* this command needs a sync sequence */ return; end; if P_request = user_telnet_orders_$send_EC then do; if ^ SDB.protocol_state.nic_18639 then do; P_error_code = net_error_table_$no_protocol_support; return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_EC; call send_raw_buffer (2, "0"b); /* this command doesn't need a sync */ return; end; if P_request = user_telnet_orders_$send_EL then do; if ^ SDB.protocol_state.nic_18639 then do; P_error_code = net_error_table_$no_protocol_support; return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_EL; call send_raw_buffer (2, "0"b); /* this command doesn't need a sync */ return; end; if P_request = user_telnet_orders_$send_GA then do; if ^ SDB.protocol_state.nic_18639 then do; P_error_code = net_error_table_$no_protocol_support; return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_GA; call send_raw_buffer (2, "0"b); /* this command doesn't need a sync */ return; end; if P_request = user_telnet_orders_$send_IP then do; if ^ SDB.protocol_state.nic_18639 then do; call send_raw_buffer (0, "1"b); return; end; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_IP; call send_raw_buffer (2, "1"b); /* this command does need a sync */ return; end; if P_request = user_telnet_orders_$send_NOP then do; special_output_buffer.byte (1) = NET_IAC; special_output_buffer.byte (2) = NET_NOP; call send_raw_buffer (2, "0"b); /* this command doesn't need a sync */ return; end; if P_request = "abort_input" then do; SDB.connection_state.abort_input_timeout = clock_ () + SDB.timeout_value * 1000000; /* set timeout so that even if other system */ /* doesn't follow protocol, this will clear */ /* up after a while */ SDB.connection_state.aborting_input = "1"b; return; end; if P_request = "abort_output" then do; SDB.connection_state.aborting_output = "1"b; return; end; if P_request = "get_socket_states" then do; call net_character_$nc_control (SDB.ncp_cdb, "get_socket_states", P_request_ptr, P_error_code); return; end; if P_request = "set_protocol" then do; if string (SDB.protocol_state) ^= ""b then do; P_error_code = error_table_$action_not_performed; return; end; if P_request_ptr -> based_fb35 = 9348 then SDB.protocol_state.nic_9348 = "1"b; else if P_request_ptr -> based_fb35 = 18639 then SDB.protocol_state.nic_18639 = "1"b; else P_error_code = error_table_$unimplemented_version; return; end; if P_request = "get_protocol" then do; if SDB.protocol_state.nic_18639 then P_request_ptr -> based_fb35 = 18639; else P_request_ptr -> based_fb35 = 9348; return; end; if P_request = "read_status" then do; if SDB.connection_state.read_status_channel = 0 then call ipc_$create_ev_chn (SDB.connection_state.read_status_channel, (0)); call user_telnet_io_$ut_async_get_to_delim (addr (SDB), null (), 0, (0), net_character_tables_$NL_delim_id, SDB.connection_state.read_status_channel, P_error_code); if P_error_code = 0 then do; P_request_ptr -> read_status_struc.ev_chan = SDB.connection_state.read_status_channel; P_request_ptr -> read_status_struc.input_available = "0"b; end; else if P_error_code = error_table_$long_record then do; P_request_ptr -> read_status_struc.ev_chan = 0; P_request_ptr -> read_status_struc.input_available = "1"b; P_error_code = 0; end; return; end; if P_request = "set_users_output_iocb" then do; SDB.users_output_iocb_ptr = P_request_ptr; return; end; if P_request = "timeout" then do; SDB.timeout_value = P_request_ptr -> based_fb35; call net_character_$nc_control (SDB.ncp_cdb, "timeout", addr (SDB.timeout_value), P_error_code); return; end; if P_request = "trace" then do; if P_request_ptr ^= null then call ioa_$ioa_switch (P_request_ptr, "Tracing to iocb at ^p", P_request_ptr); SDB.trace_iocb_ptr = P_request_ptr; return; end; P_error_code = error_table_$undefined_order_request; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_setsize: entry (P_SDB_ptr, P_size, P_error_code); P_error_code = 0; if P_size ^= 9 then P_error_code = error_table_$invalid_elsize; return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_getsize: /* entry to return current element size */ entry (P_SDB_ptr, P_size, P_error_code); P_error_code = 0; P_size = 9; /* element size for terminals is always 9 */ return; /* so return the constant 9 to the caller */ /* * * * * * * * * * * * * * * * * * * * * * * * */ initialize_device_modes: /* internal interface to set initial modes */ entry (P_SDB_ptr, P_new_modes, P_interpretation_modes, P_error_code); P_error_code = 0; string (interpretation_modes) = P_interpretation_modes; if interpretation_modes.set_initial_modes then call setup_initial_modes (P_new_modes, P_error_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_modes: entry (P_SDB_ptr, P_new_modes, P_old_modes, P_error_code); P_error_code = 0; /* initialize status code to zero */ call change_modes (P_new_modes, P_old_modes, P_error_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_create_delim_set: entry (P_SDB_ptr, P_delim_ptr, P_delim_count, P_delim_id, P_error_code); P_error_code = 0; delim_ptr = P_delim_ptr; if (P_delim_count < 0) then do; P_error_code = error_table_$bad_arg; return; end; if P_delim_count > 0 then delimiter_set_id = delim_ptr -> based_delim.byte (0); /* feel the first char to check access */ buff_ptr = net_buffer_man_$allocate_buffer (512, 9, P_error_code); if P_error_code ^= 0 then return; buff_ptr -> char_buffer.header.num_bytes = 512; string (buff_ptr -> char_buffer.workspace) = ""b; do indx = 0 by 1 to P_delim_count - 1; buff_ptr -> char_buffer.workspace.byte (binary (delim_ptr -> based_delim.byte (indx), 9)) = (9)"1"b; end; delimiter_set_id = baseno (buff_ptr) || rel (buff_ptr); buff_ptr -> char_buffer.user_data = delimiter_set_id; buff_ptr -> char_buffer.user_info_ptr = SDB.delim_list_ptr; SDB.delim_list_ptr = buff_ptr; P_delim_id = delimiter_set_id; P_error_code = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ send_raw_buffer: procedure (P_count, P_need_sync); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_count fixed binary (24), P_need_sync bit (1)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * */ special_output_buffer.count = P_count; if P_need_sync then do; if SDB.protocol_state.nic_18639 then do; special_output_buffer.byte (special_output_buffer.count + 1) = NET_IAC; special_output_buffer.byte (special_output_buffer.count + 2) = NET_DM; special_output_buffer.count = special_output_buffer.count + 2; end; else do; special_output_buffer.byte (special_output_buffer.count + 1) = "010000000"b; /* old protocol Data Mark */ special_output_buffer.count = special_output_buffer.count + 1; end; end; call net_character_$nc_control (SDB.ncp_cdb, "send_TELNET_control", addr (special_output_buffer), P_error_code); if P_error_code ^= 0 then return; if P_need_sync then call net_character_$nc_control (SDB.ncp_cdb, "send_INS", null (), P_error_code); return; end; /* end send_raw_buffer */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ change_modes: procedure (P_new_modes, P_old_modes, P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_err_code fixed binary (35), P_new_modes character (*), P_old_modes character (*)) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare ((indx, jdex) fixed binary (24), setting_initial_modes bit (1), (newm, oldm) bit (2), old_modes character (128) varying) automatic; /* * * * * CONSTANT DECLARATIONS * * * * * * * * */ declare modestr (2) character (12) varying initial ( "rawi", "rawo") internal static; declare (modes_by_default_on initial ("00"b), /* (none on by default) */ modes_by_default_off initial ("11"b)) /* rawi, rawo */ bit (2) internal static; /* * * * * * * * * * * * * * * * * * * * * * * * */ setting_initial_modes = "0"b; /* the status code has been zeroed already */ newm, oldm = string (P_SDB_ptr -> SDB_template.current_modes.mode_switches); /* get cur modes */ /* figure out the mode string for current modes */ indx = 1; old_modes = ""; /* blank out the entire temporary string */ do jdex = 1 to hbound (modestr, 1); if ^ substr (oldm, jdex, 1) /* if "^" needed */ then old_modes = old_modes || "^"; /* insert "^" to denote that this option is off */ old_modes = old_modes || modestr (jdex); /* insert mode name for this mode */ old_modes = old_modes || ","; /* insert the "," that goes between modes */ end; goto common_new_mode_setting; /* * * * * * * * * * * * * * * * * * * */ setup_initial_modes: entry (P_new_modes, P_err_code); setting_initial_modes = "1"b; newm = ""b; newm = (newm & ^ modes_by_default_off) | (modes_by_default_on); goto common_new_mode_setting; /* * * * * * * * * * * * * * * * * * * */ common_new_mode_setting: /* now weve got the old modes, figure out the new */ call net_mode_parser_ (P_new_modes, interpret_key, P_err_code); if P_err_code ^= 0 then goto error; SDB.modes_inconsistent = "1"b; string (P_SDB_ptr -> SDB_template.current_modes.mode_switches) = newm; SDB.modes_inconsistent = "0"b; if ^ setting_initial_modes then P_old_modes = old_modes; /* now return original mode string */ return; /* * * * * * * * * * * * * * * * * * * * * * * * */ error: P_err_code = error_table_$bad_mode; if ^ setting_initial_modes then P_old_modes = old_modes; /* remember to return old modes anyway */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ interpret_key: procedure (P_key, P_info_bits, P_data_ptr, P_error_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_error_code fixed binary (35), P_info_bits bit (*), P_key character (*) varying, P_data_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (mode_desired_on bit (1), integer_value_exists bit (1)) automatic; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_error_code = 0; mode_desired_on = "1"b; /* default is to make the mode go on */ integer_value_exists = "0"b; /* default is that no integer was decoded */ if length (P_info_bits) >= 1 then mode_desired_on = substr (P_info_bits, 1, 1); if length (P_info_bits) >= 2 then integer_value_exists = substr (P_info_bits, 2, 1); do jdex = 1 by 1 to hbound (modestr, 1) while (P_key ^= modestr (jdex)); /* search for P_key */ end; if jdex <= hbound (modestr, 1) /* if found */ then do; substr (newm, jdex, 1) = mode_desired_on; return; end; found_error_in_key: P_error_code = error_table_$bad_mode; return; end; /* end interpret_key */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ end; /* end change_modes */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_state_ */ end;  user_telnet_xtach_.pl1 09/23/77 1038.1rew 09/22/77 1715.0 156960 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ user_telnet_xtach_: procedure (P_CDB_ptr); /* "user_telnet_xtach_" -- this procedure contains the entry */ /* points associated with maintaining the attachment (through the I/O */ /* switch) for a stream using this IOSIM. */ /* Originally created by D. M. Wells 1973, December 17. */ /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare (P_report_sw bit (1), /* on if we should use com_err_ to report errors */ P_open_mode fixed binary (17), P_event_channel fixed binary (71), P_error_code fixed binary (35), P_descrip_args (*) character (*) varying, P_attach_descrip_ptr pointer, /* points to a varying string with attach descrip */ P_open_descrip_ptr pointer, /* points to a varying string with open descrip */ P_CDB_ptr pointer) parameter; /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (pin_number fixed binary (8), arg_indx fixed binary (17), connection_type fixed binary (17), err_code fixed binary (35), myname character (32) varying, attach_device character (64) varying, SDB_ptr pointer, error variable entry options (variable)) automatic; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ /* * * * * TEXT SECTION REFERENCES * * * * * * * */ declare stream_input_output_mode initial (3) fixed binary (17) internal static; declare (ICP_CONNECTION initial (11), LISTEN_CONNECTION initial (12), CONNECT_CONNECTION initial (13)) fixed binary (17) internal static; /* * * * * DEFINED DECLARATIONS * * * * * * * * */ /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ declare based_area area based; declare 1 SDB aligned based, /* Stream Data Block as allocated from storage */ 2 template aligned like SDB_template, /* template as other programs might know it */ 2 attachment_info aligned, 3 ncp_attach_desc pointer, /* description of attachment of lower stream */ 3 ncp_open_desc pointer, /* description of opening of lower stream */ 3 foreign_host fixed binary (16), 3 contact_socket fixed binary (32), 3 attachment_modes unaligned, 4 icp bit (1), /* whether it is desired to connect via ICP */ 4 listen bit (1), /* whether is is desired to only listen for RFC's */ 4 connect bit (1), /* wherher is is desired to initiate RFC's */ 3 attachment_modes_pad bit (33) unaligned, 3 first_allocated_pin fixed binary (8), /* -1 if nonr reserved, else we have 4 pins */ 3 num_allocated_pins fixed binary (8), /* how many pins we have allocated */ 2 opening_info aligned, 3 open_mode fixed binary (17), /* iox type opening mode */ 2 device_name character (64) unaligned, 2 attach_description character (96) unaligned varying, 2 open_description character (28) unaligned varying; /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ declare (net_character_tables_$nontype6_link_verification fixed binary (35), net_character_tables_$NL_break_table) external static; declare (error_table_$bad_mode, /* we didn't understand the mode the guy wanted */ error_table_$device_active, error_table_$invalid_device, error_table_$ionmat, /* code indicating stream already attached */ error_table_$net_icp_not_concluded, error_table_$no_linkage, error_table_$wrong_no_of_args) fixed binary (35) external static; /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ declare com_err_ constant entry options (variable), cu_$arg_list_ptr constant entry () returns (ptr), cu_$gen_call constant entry (entry, ptr), get_system_free_area_ constant entry () returns (ptr), interpret_socket_spec_ constant entry (char (*), fixed bin (16), fixed bin (32), fixed bin (8), fixed bin (35)), ipc_$create_ev_chn constant entry (fixed bin (71), fixed bin (35)), ipc_$delete_ev_chn constant entry (fixed bin (71), fixed bin (35)), ipc_$reset_ev_call_chn constant entry (fixed bin (71), fixed bin (35)), net_$ncp_deactivate constant entry (bit (36), fixed bin (35)), net_character_ constant entry (ptr, (*) char (*) varying, bit (1), ptr, fixed bin (35)), net_character_$nc_async_close constant entry (ptr, ptr, fixed bin (71), fixed bin (35)), net_character_$nc_async_open constant entry (ptr, fixed bin (17), (*) char (*) varying, ptr, fixed bin (71), fixed bin (35)), net_character_$nc_detach constant entry (ptr, ptr, fixed bin (35)), net_character_$nc_modes constant entry (ptr, char (*), char (*), fixed bin (35)), user_telnet_state_$initialize_device_modes constant entry (ptr, char (*), bit (*), fixed bin (35)), net_async_support_$insert_in_channel_list constant entry (ptr, fixed bin (71), fixed bin (35)), net_async_support_$notify_all_channels constant entry (ptr, fixed bin (35)), net_async_support_$setup_event_channel constant entry (ptr, fixed bin (71), fixed bin (35)), net_buffer_man_$free_buffer constant entry (ptr, fixed bin (35)), net_connect_$abort_connection constant entry (fixed bin (8), fixed bin (35)), net_connect_$conclude_connection constant entry (fixed bin (8), fixed bin (71), fixed bin (71), bit (41), bit (36), bit (36), fixed bin (35)), net_connect_$initiate_connection constant entry (fixed bin (8), fixed bin (17), bit (41), bit (2), fixed bin (17), fixed bin (71), fixed bin (35)), net_pin_manager_$allocate_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)), net_pin_manager_$free_pins constant entry (fixed bin (8), fixed bin (8), fixed bin (35)), user_telnet_options_$release_option_info constant entry (ptr, fixed bin (35)); declare (addr, binary, hbound, mod, null, string, stac, substr) builtin; /* * * * * INCLUDE FILES * * * * * * * * * * * * */ % include user_telnet_sdb_dcls; % include net_buffer_header_dcls; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ return_to_caller: return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* "report_and_abort_attachment" -- internal procedure to handle */ /* all attach errors. It will call com_err_ with its arguments iff */ /* the "P_report_sw" switch is set. In any case, it will return */ /* to the caller of the attach entry point after setting the */ /* status code to indicate no attachment was done. */ report_and_abort_attachment: procedure (P_err_code); /* * * * * PARAMETER DECLARATIONS * * * * * * * * */ declare P_err_code fixed binary (35) parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ if P_report_sw then call cu_$gen_call (com_err_, (cu_$arg_list_ptr ())); P_error_code = P_err_code; if SDB_ptr ^= null () then call release_SDB (); goto return_to_caller; end; /* end report_and_abort_attachment */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ user_telnet_: /* entry to attach non-user_i/o typewriter */ entry (P_CDB_ptr, P_descrip_args, P_report_sw, P_attach_descrip_ptr, P_error_code); P_error_code = 0; SDB_ptr = null (); myname = "user_telnet_"; error = report_and_abort_attachment; /* setup abort procedure for the attach call */ if substr (P_descrip_args (lbound (P_descrip_args, 1)), 1,1) = "-" then attach_device = "-1,-1"; else attach_device = P_descrip_args (lbound (P_descrip_args, 1)); call acquire_SDB (); call net_character_ (SDB_ptr -> SDB.ncp_cdb, P_descrip_args, P_report_sw, SDB_ptr -> SDB.ncp_attach_desc, P_error_code); if P_error_code ^= 0 then call error (P_error_code, myname, "Error detected by lower level"); call net_character_$nc_modes (SDB_ptr -> SDB.ncp_cdb, "telnet", (""), P_error_code); if P_error_code ^= 0 then call error (P_error_code, myname, "Changing lower-level routines to telnet mode."); call user_telnet_state_$initialize_device_modes (SDB_ptr, "", "010"b, P_error_code); /* Now we are going to parse the device name that was */ /* given to us. The general form of the device name is: */ /* foreign_host,foreign_socket/local_pin */ /* The local_pin portion of the name is optional. */ call interpret_socket_spec_ ((attach_device), SDB_ptr -> SDB.foreign_host, SDB_ptr -> SDB.contact_socket, pin_number, err_code); if err_code ^= 0 then call error (err_code, myname, "Unable to interpret socket name ^a", attach_device); call user_telnet_state_$initialize_device_modes (SDB_ptr, "", "001"b, (0)); SDB_ptr -> SDB.attach_description = myname; do arg_indx = lbound (P_descrip_args, 1) by 1 to hbound (P_descrip_args, 1); SDB_ptr -> SDB.attach_description = SDB_ptr -> SDB.attach_description || " "; SDB_ptr -> SDB.attach_description = SDB_ptr -> SDB.attach_description || P_descrip_args (arg_indx); end; P_CDB_ptr = SDB_ptr; P_attach_descrip_ptr = addr (SDB_ptr -> SDB.attach_description); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_async_open: entry (P_CDB_ptr, P_open_mode, P_descrip_args, P_open_descrip_ptr, P_event_channel, P_error_code); P_error_code = 0; SDB_ptr = P_CDB_ptr; if P_open_mode ^= stream_input_output_mode then do; P_error_code = error_table_$bad_mode; return; end; SDB_ptr -> SDB.open_description = "stream_input_output"; call net_character_$nc_async_open (SDB_ptr -> SDB.ncp_cdb, 3, P_descrip_args, SDB_ptr -> SDB.ncp_open_desc, P_event_channel, P_error_code); if P_error_code ^= 0 then if P_error_code ^= error_table_$device_active then do; call ut_async_close (SDB_ptr, P_open_descrip_ptr, 0, (0)); return; end; P_open_descrip_ptr = addr (SDB_ptr -> SDB.open_description); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_async_close: entry (P_CDB_ptr, P_open_descrip_ptr, P_event_channel, P_error_code); P_error_code = 0; SDB_ptr = P_CDB_ptr; call net_character_$nc_async_close (SDB_ptr -> SDB.ncp_cdb, SDB_ptr -> SDB.ncp_open_desc, P_event_channel, P_error_code); call user_telnet_options_$release_option_info (P_CDB_ptr, (0)); if SDB_ptr -> SDB.connection_state.read_status_channel ^= 0 then do; call ipc_$delete_ev_chn (SDB_ptr -> SDB.connection_state.read_status_channel, (0)); SDB_ptr -> SDB.connection_state.read_status_channel = 0; end; call free_buffer (SDB_ptr -> SDB.transl_ptr); call free_buffer (SDB_ptr -> SDB.rawbuffer_ptr); call free_buffer (SDB_ptr -> SDB.output_ptr); P_open_descrip_ptr = null (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ ut_detach: /* entry to detach a given instance of attachment */ entry (P_CDB_ptr, P_attach_descrip_ptr, P_error_code); P_error_code = 0; SDB_ptr = P_CDB_ptr; /* get pointer to block for this device */ P_CDB_ptr = null (); call ut_async_close (SDB_ptr, (null ()), 0, (0)); call release_SDB (); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ initialize_buffer: procedure (P_buffer_ptr); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ declare P_buffer_ptr pointer parameter; /* * * * * * * * * * * * * * * * * * * * * * * * */ P_buffer_ptr = null (); return; /* * * * * * * * * * * * * * * * * * * * * * * * */ free_buffer: entry (P_buffer_ptr); if P_buffer_ptr ^= null () then do; call net_buffer_man_$free_buffer (P_buffer_ptr, (0)); P_buffer_ptr = null (); end; return; end; /* end initialize_buffer */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ acquire_SDB: procedure (); /* * * * * PARAMETER DECLARATIONS * * * * * * * */ /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ declare (area_ptr, temp_ptr) pointer automatic; /* * * * * INTERNAL STATIC DECLARATIONS * * * * */ declare static_SDB_lock bit (36) initial ((36)""b) internal static; declare 1 static_SDB aligned internal static like SDB; /* * * * * * * * * * * * * * * * * * * * * * * * */ if P_CDB_ptr ^= null () then call error (error_table_$ionmat, myname, "Attempt to create a multiple attachment."); if stac (addr (static_SDB_lock), "1"b) then do; temp_ptr = addr (static_SDB); temp_ptr -> SDB.allocation_ptr = null (); end; else do; area_ptr = get_system_free_area_ (); allocate SDB in (area_ptr -> based_area) set (temp_ptr); temp_ptr -> SDB.allocation_ptr = area_ptr; end; if net_character_tables_$nontype6_link_verification = 0 then call error (error_table_$no_linkage, myname, "net_character_tables_ was created and not found."); temp_ptr -> SDB.break_delim_id = (18)"0"b || rel (addr (net_character_tables_$NL_break_table)); temp_ptr -> SDB.delim_list_ptr = null (); temp_ptr -> SDB.trace_iocb_ptr = null (); temp_ptr -> SDB.users_output_iocb_ptr = null (); temp_ptr -> SDB.options_info_ptr = null (); string (temp_ptr -> SDB.attachment_modes) = ""b; temp_ptr -> SDB.ncp_cdb = null (); temp_ptr -> SDB.device_name = attach_device; temp_ptr -> SDB.transl_ptr = null (); temp_ptr -> SDB.output_ptr = null (); temp_ptr -> SDB.rawbuffer_ptr = null (); string (temp_ptr -> SDB.current_modes) = ""b; string (temp_ptr -> SDB.connection_state.flags) = ""b; temp_ptr -> SDB.connection_state.read_status_channel = 0; string (temp_ptr -> SDB.protocol_state) = "0"b; temp_ptr -> SDB.timeout_value = 15; /* default timeout period is 15 seconds */ SDB_ptr = temp_ptr; return; /* * * * * * * * * * * * * * * * * * * * * * * */ release_SDB: entry (); temp_ptr = SDB_ptr; SDB_ptr = null (); if temp_ptr = null () then return; call net_character_$nc_detach (temp_ptr -> SDB.ncp_cdb, (null ()), (0)); if temp_ptr -> SDB.allocation_ptr = null () then static_SDB_lock = ""b; else free temp_ptr -> SDB in (temp_ptr -> SDB.allocation_ptr -> based_area); temp_ptr = null (); return; end; /* end acquire_SDB */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* end user_telnet_xtach_ */ end;  telnet_message_.alm 05/16/80 1808.3rew 05/16/80 1806.6 16281 " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** include et_macros et telnet_message_ ec bracket_encountered,bracseen,(A bracket was encountered.) ec exhausted_iteration_set,nomoreit,(An iteration set has been exhausted.) ec foreign_error,frgn_err,(Error at foreign server:) ec implementation_restriction,implrstr,(The requested action is not currently implemented.) ec improper_allocation,bad_ALLO,(Allocation for file write could not be performed.) ec improper_bytesize,bad_BYTE,(Byte size must be greater than 0 and less than 256.) ec null_command_line,nullcomm,(No commands were executed.) ec option_already_in_effect,optalrdy,(The specified option is already in effect.) ec option_already_requested,optrqstd,(The specified option is already in negotiation with the foreign host.) ec option_not_in_effect,optnotef,(The specified option is not in effect currently.) ec option_not_supported,optunimp,(The specified option is not supported by this system.) ec parens_on_quote_tail,quotepar,(Parentheses were encountered at the end of a quoted string.) ec recursive_parentheses,recparen,(Recursive parentheses have been encountered.) ec unable_to_complete_transfer,xferbad,(Transfer was not completed properly.) ec unable_to_prepare_transfer,no_trans,(Unable to negotiate file transfer.) ec unimplemented_request,unimpl,(The requested action is not yet implemented.) end 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