%Title := "KERMIT"; %Listing_Character_Set := "tn"; %Unref := False; /*box,centre KERMIT *//* *//* Author: Bruce Jolliffe *//* *//* The KERMIT protocol is designed for character-oriented transmission over serial telecommunication lines. The design allows it to be operating system independent. It can be used to move files between micros and mainframes and between pairs of mainframes over standard telecommunications lines. *//* *//* This version is designed to run under the MTS operating system. Besides being able to talk to microcomputers this version can also talk to other host versions of Kermit. Several MTS dependant enhancements have been added to the protocol so that MTS files can be sent complete with their internal line structure. The program can send an exact image of an MTS file from one MTS system to another. *//* *//* The progam may be called as a main program and as a subroutine. If it is called as a main program it it starts in server mode ready to talk to another Kermit. It may be started in user mode by specifying 'PAR=u' on the run command. If it is called as a subroutine it takes three parameters: *//*as_is Kermit_Control_Block_Ptr (full word pointer) Switches (full word bit string) Fdname (character string terminated by blank) *//* If bit 31 of Switches is set then Kermit assumes you are talking to a remote site that has another Kermit in the file NET:Kermit. The progam will attempt to establish communication with the remote Kermit by starting it. The Fdname is that of where the commands are coming from. The local Kermit will be started in User mode when the subroutine entry is made. The subroutine Kermit assumes Unit 0 is connected to a mounted remote device. *//* *//* The Kermit return codes are: *//*as_is 0 - all okay 8 - error */ %Eject(); %Include(Boolean, Numeric_Types, String_Types, Guser_Varying, Sprint_Varying, Mts_Io_Types, Mts_Io_Extended_Modifiers, Mts_File_Type, Sercom_String, Chkfile, Mts_File_Access_Codes, Initialize_File_With_Name, Initialize_File, Chkfile, Read_Varying, Write_Varying, Write_String, S370_Opcodes, More_String_Types, Read, Twait, Sercom, Integer_To_Varying, Control, Integer_To_Varying, Line_Number_To_Varying, String_To_Hex_Varying, Message_Initialize, Message_Terminate, Message, Fnametrt, Empty, Create, Mts_File_Organizations, Gdinfo, Gdinfo_Result_Type, Return_From, Setup_Return_From, Cnfginfo, Bits_To_Hex_Varying, String_To_Integer, Hex_String_To_Bits, Set_First_Line, Set_Next_Line, Guinfo, Cuinfo, Initialize_File_With_Unit#, Gfinfo, B255, Case_Conversion, Time, Write_Record, Lock, Unlk, Set_Last_Line, Freefd); %Include(Semantic_Procedure_Type, Parse_String_Type, Parse, Parse_Initialize, Parse_Terminate, Parse_Set, Parse_Get, Production_Text, Last_Terminal_Text, Parse_Item_Type, Cmdnoe); /* Attn's includes */ %Include(Exit_Definitions, Set_Exit, Attntrp, Getspace, Mts, Freespac); %Include(Kermit_Command_Definitions); %Unref := True; %Merge_Unref := False; %Eject(); global Main_Global /* Constants for packets */ constant Kermit_Help_File is "NET.:Kermit_Help ", Kermit_Program_File is "NET.:Kermit ", Kermit_Log_Filename is "NET.:Kermit#log ", Kermit_Log_File_Modifiers is Mts_Io_Errrtn, Version is "1.00", Error_Rc is 4, Max_Integer_In_Byte is 255, Bits_76 is 'C0', Bits_543210 is '3F', Checksum_Modulo is 64, Max_Packet_Char_Count is 94, Min_Packet_Char_Count is 40, Uncounted_Packet_Char is 2, Max_Packet_Length is Max_Packet_Char_Count + Uncounted_Packet_Char, Min_Packet_Length is Min_Packet_Char_Count + Uncounted_Packet_Char, Max_Padding_Count is 20, Ascii_Null is '00', Ascii_Soh is '01', Ascii_Etx is '03', Ascii_Cr is '0D', Ascii_Lf is '0A', Ascii_Crlf is '0D0A', Ascii_Space is '20', Ascii_# is '23', Ascii_Ampersand is '26', Ascii_Minus is '2D', Ascii_Period is '2E', Ascii_0 is '30', Ascii_1 is '31', Ascii_2 is '32', Ascii_3 is '33', Ascii_Greater_Than is '3E', Ascii_A is '41', Ascii_B is '42', Ascii_C is '43', Ascii_D is '44', Ascii_E is '45', Ascii_F is '46', Ascii_G is '47', Ascii_H is '48', Ascii_I is '49', Ascii_J is '4A', Ascii_L is '4C', Ascii_N is '4E', Ascii_S is '53', Ascii_Grave is '60', Ascii_Tilde is '7E', Ascii_Del is '7F', Connect_Escape is "#", Max_Retries is 5, Max_Timeout_Retries is 10, /* give it plenty of time */ Min_Timeout is 10, Max_Timeout is 30, My_Default_Packet_Length is 75, /* Make it smaller for the NIM */ Default_Packet_Length is Max_Packet_Length, Default_Timeout is 10, /* timeout after 10 seconds */ Default_Padding_Count is 0, Default_Padding_Character is Ascii_Null, Default_End_Of_Line_Character is Ascii_Cr, Default_Quote_Character is Ascii_#, Default_8_Bit_Quote_Character is Ascii_N, /* no 8 bit quoting */ Default_Repeat_Character is Ascii_Space, /* no repeat quoting */ Max_Encoding_Count is 5, /* repeat char, repeat count, 8 bit mark, quote, character */ Sequence_Number_Modulo is 64, /* The following are the codes used to specify the various types of packets */ Bad_Code is '00', Abort_Code is '01', Data_Packet_Code is '44', /* ascii D */ Acknowledge_Code is '59', /* ascii Y */ Negative_Acknowledge_Code is '4E', /* ascii N */ Send_Init_Code is '53', /* ascii S */ Break_Transmission_Code is '42', /* ascii B */ File_Header_Code is '46', /* ascii F */ File_Attribute_Code is '41', /* ascii A */ End_Of_File_Code is '5A', /* ascii Z */ Error_Code is '45', /* ascii E */ Receive_Init_Code is '52', /* ascii R */ Generic_Command_Code is '47', /* ascii G */ Host_Command_Code is '43', /* ascii C */ Text_Code is '58', /* ascii X */ /* file attribute codes */ Length_File_Attribute is '21', /* ascii ] */ Type_File_Attribute is '22', /* ascii " */ Mts_File_Attribute is '4D', /* ascii M */ /* I/O constants */ Input_Unit_Name is "SCARDS ", Output_Unit_Name is "SPRINT ", Debug_Unit is "SERCOM ", Sercom_Unit is "SERCOM ", Default_In_File is "-KERMIT", Debug_Filename is "KERMIT.LOG", Backup_Debug_Filename is "-KER.LOG", Debug_File_Io_Modifiers is 0, Max_Remote_Unit_Name_Length is 20, Default_Send_Delay is 10, /* delays for send init */ Max_Send_Delay is 100, Min_Send_Delay is 0, Microseconds_Per_Sec is 1000000, Write_Remote_Timeout is "2 minutes", Max_Blocksize is Long_String_Length, Min_Binary_Blocksize is 1, /* ridiculous but there */ Max_Binary_Blocksize is Max_Blocksize, Default_Binary_Blocksize is 256, /* same as mcp */ Min_Text_Blocksize is 1, /* no null stuff */ Max_Text_Blocksize is Max_Blocksize, Default_Text_Blocksize is Max_Blocksize, Max_Line_Number_String_Length is 20, /* constants used in the mts file header */ Mts_File_Indicator is ",", Max_Mts_Total_Filename_Length is 17, Mts_Line_File is "L", Mts_Sequential_File is "S", Mts_Save is "S", Mts_Nosave is "N", Mts_File_Size_Len is 5, Default_Pkey is "*EXEC", Expected_Binary_Packets_Per_Page is 82, Expected_Text_Packets_Per_Page is 54, Log_Numeric_Field_Width is 6, Millisecond_Field_Width is 10; type Packet_Char_Count_Type is (0 to Max_Packet_Char_Count), Printable_Range_Type is Packet_Char_Count_Type, Packet_Length_Type is (0 to Max_Packet_Length), Sequence_Number_Type is (0 to Sequence_Number_Modulo - 1), Retry_Count_Type is (0 to Max_Retries), Padding_Count_Type is (0 to Max_Padding_Count), Byte_Integer_Type is (0 to Max_Integer_In_Byte), State_Type is (Send_Init_State, Send_File_Header_State, Send_File_Attribute_State, Send_File_Data_State, Send_Eof_State, Send_Eot_State, Receive_State, Receive_File_Header_State, Receive_File_Attribute_State, Receive_Send_Init_State, Receive_File_Data_State, Complete_State, Abort_State, User_Start_State, Server_Start_State), Packet_Type_Type is bit(8), Packet_Header_Type is record Ph_Mark is bit(8), Ph_Count is bit(8), Ph_Sequence_Number is bit(8), Ph_Type is Packet_Type_Type end, Packet_Header_Character_Type is character(Byte_Size(Packet_Header_Type)), Checksum_Kind_Type is (Single_Character_Checksum_Kind, Two_Character_Checksum_Kind, Crc_Checksum_Kind), Checksum_Type is record variant Checksum_Kind_Type from case Single_Character_Checksum_Kind: Single_Character_Checksum is character(1) case Two_Character_Checksum_Kind: Two_Character_Checksum is character(2) case Crc_Checksum_Kind: Crc_Checksum is character(3) end, Checksum_Size_Type is (1 to Byte_Size(Checksum_Type)), Checksum_Lengths_Type is array Checksum_Kind_Type of Checksum_Size_Type, Checksum_To_External_Type is array Checksum_Kind_Type of bit(8), Mode_Type is (User_Mode, Server_Mode), Side_Type is (Sending_Side, Receiving_Side), /* this is used to determine what to do on a timeout: NAK or resend */ File_Kind_Type is (Text_File_Kind, Binary_File_Kind, Mts_Binary_File_Kind), File_Kind_Text_Type is array File_Kind_Type of character(0 to 16), Packet_Count_Type is record For_File is Integer, For_Session is Integer, Side is Side_Type end, Mts_Binary_State_Type is (Start_Mts_Binary_Linenumber_State, Build_Mts_Binary_Linenumber_State, First_Mts_Binary_Byte_Length_State, Second_Mts_Binary_Byte_Length_State, Mts_Binary_Bytes_State), Line_Number_String_Type is character(0 to Max_Line_Number_String_Length), Mts_File_Attribute_Type is record Mfa_Maxsize_String is character(5), Mfa_Nosave is bit(8), Mfa_Pkey is character(16) end, Mts_File_Info_Type is record Mf_File_Organization is Integer, Mf_Copied_Size is Short_Integer, Mf_Maxsize is Short_Integer, Mf_Nosave is Boolean, Mf_Pkey is character(16) end, /* storage allocated status */ Storage_Allocated_Info_Type is record Sa_Old_Attn_Saved, Sa_Old_Prefix_Saved, Sa_Mask_Attn_Stack, Sa_Normal_Attn_Stack, Sa_Global_Area, Sa_File_Buffer, Sa_Pcb, Sa_File_Transfer_Attn are Boolean end, Date_Type is character(12), Time_Type is character(8), Fill_Type is character(2), Log_Numeric_Field_Type is character(Log_Numeric_Field_Width), Millisecond_Field_Type is character(Millisecond_Field_Width), Log_Record_Type is record Lr_Date is Date_Type, Lr_Fill1 is Fill_Type, Lr_Start_Time is Time_Type, Lr_Fill2 is Fill_Type, Lr_Finish_Time is Time_Type, Lr_Fill3 is Fill_Type, Lr_Elapsed_Time is Millisecond_Field_Type, Lr_Fill4 is Fill_Type, Lr_Cpu_Time is Millisecond_Field_Type, Lr_Fill5 is Fill_Type, Lr_Ccid is character(4), Lr_Fill6 is Fill_Type, Lr_Send_Command_Count is Log_Numeric_Field_Type, Lr_Fill7 is Fill_Type, Lr_Get_Command_Count is Log_Numeric_Field_Type, Lr_Fill8 is Fill_Type, Lr_Total_Command_Count is Log_Numeric_Field_Type, Lr_Fill9 is Fill_Type, Lr_Out_Packet_Count is Log_Numeric_Field_Type, Lr_Fill10 is Fill_Type, Lr_In_Packet_Count is Log_Numeric_Field_Type, Lr_Fill11 is Fill_Type, Lr_Total_Retries is Log_Numeric_Field_Type end; constant Checksum_Lengths is Checksum_Lengths_Type(Byte_Size(Checksum_Type, Single_Character_Checksum_Kind), Byte_Size(Checksum_Type, Two_Character_Checksum_Kind), Byte_Size(Checksum_Type, Crc_Checksum_Kind)), Checksum_To_External is Checksum_To_External_Type(Ascii_1, Ascii_2, Ascii_3), Default_Checksum_Kind is Single_Character_Checksum_Kind, Max_Non_Data_Count is Byte_Size(Packet_Header_Type) + Byte_Size(Checksum_Type), Max_Data_Length is Max_Packet_Length - Max_Non_Data_Count, File_Kind_Text is File_Kind_Text_Type("TEXT", "BINARY", "MTS-BINARY"), Default_Mts_File_Info is Mts_File_Info_Type(Line_File, 1 /* one page */ , Maximum_Short_Integer, False, Default_Pkey !! Substring(B255, 0, 16 - Length(Default_Pkey))), Initial_Storage_Allocated_Info is Storage_Allocated_Info_Type(False, False, False, False, False, False, False, False); type Packet_Data_Type is character(0 to Max_Data_Length), Packet_Data_Length_Type is (0 to Max_Data_Length), Packet_Int_Data_Type is array (1 to Max_Data_Length) of bit(8), Non_Data_Count_Type is (0 to Max_Non_Data_Count), Packet_Buffer_Type is Varying_String, Capability_Byte_1_Type is record Cb1_Nul_Bit7, Cb1_Nul_Bit6, Cb1_Can_Time_Out, Cb1_Server, Cb1_Accept_File_Attributes, Cb1_Nul_Bit2, Cb1_Nul_Bit1, Cb1_Continue_Bit are packed Boolean end, Packet_Parameters_Type is record Pp_Buffer_Size is bit(8), Pp_Timeout is bit(8), Pp_Padding_Count is bit(8), Pp_Padding_Character is bit(8), Pp_End_Of_Line_Character is bit(8), Pp_Quote_Character is bit(8), Pp_8_Bit_Quote_Character is bit(8), Pp_Checksum_Type is bit(8), Pp_Repeat_Character is bit(8), Pp_Capability_Byte_1 is Capability_Byte_1_Type end, Packet_Parameters_Character_Type is character(Byte_Size(Packet_Parameters_Type)), /* types used in subroutine call */ Guinfo_Pfxstr_Type is record Gp_Region_Length is Integer, Gp_Actual_Length is Integer, Gp_Prefix is character(120) end, Guinfo_Attntrp_Type is array (1 to 2) of Integer, Current_Attn_Kind_Type is (Normal_Attn_Kind, File_Transfer_Attn_Kind); constant Capability_Byte_1 is Capability_Byte_1_Type(False, False, True, True, True, False, False, False); type Global_Area_Type is record Current_Data_Size is Packet_Char_Count_Type, Last_Sequence_Number is Sequence_Number_Type, Current_Sequence_Number is Sequence_Number_Type, Next_Sequence_Number is Sequence_Number_Type, My_Packet_Length is Packet_Length_Type, Your_Packet_Length is Packet_Length_Type, My_Timeout is Printable_Range_Type, Your_Timeout is Printable_Range_Type, Your_Timeout_Char is character(0 to 11), My_Padding_Count is Padding_Count_Type, Your_Padding_Count is Padding_Count_Type, My_Padding_Character is bit(8), Your_Padding_Character is bit(8), My_End_Of_Line_Character is bit(8), Your_End_Of_Line_Character is bit(8), My_Quote_Character is bit(8), Your_Quote_Character is bit(8), Eight_Bit_Quote_Character is bit(8), Checksum_Kind is Checksum_Kind_Type, Checksum_Size is Checksum_Size_Type, My_Repeat_Character is bit(8), Your_Repeat_Character is bit(8), Times_This_Packet_Retried is Retry_Count_Type, Times_Last_Packet_Retried is Retry_Count_Type, State is State_Type, My_Start_Of_Packet_Character is bit(8), Your_Start_Of_Packet_Character is bit(8), Non_Data_Count is Non_Data_Count_Type, Clear_High_Bit_Pattern is character(256), Mode is Mode_Type, /* user or server */ Remote_Mts is Boolean, /* set when run by other Mts Kermit */ Side is Side_Type, /* sending or receiving */ Remote_Kermit is Boolean, /* local or remote */ Can_Talk_To_Remote_Kermit is Boolean, Kill_Remote_Kermit is Boolean, Simple_Receive is Boolean, /* Buffers for building packets */ Send_Buffer is Packet_Buffer_Type, Receive_Buffer is Packet_Buffer_Type, Readable_Receive_Buffer is Varying_String, Send_Packet_Data is Packet_Data_Type, /* some parser variables */ Pcb is pointer to Parser_Control_Block_Type, All_Done is Boolean, /* flag set when kermit is to exit */ Error_Message is Varying_String, Rcb is Return_Control_Block_Type, /* file variables */ Saved_Filename is Packet_Data_Type, Out_Filename is Packet_Data_Type, Out_Ascii_Filename is Packet_Data_Type, Out_File is Mts_File_Type, Out_File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type, Is_First_Out_File_Record is Boolean, Out_File_End_Of_File is Boolean, Next_Out_File_Character_Position is Integer, In_Filename is Packet_Data_Type, Received_Filename is Packet_Data_Type, In_Ascii_Filename is Packet_Data_Type, In_File is Mts_File_Type, Remote_Filename is Packet_Data_Type, Pending_Cr is Boolean, In_File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type, /* source and sink file blocks */ Input_Unit is Mts_File_Type, Input_Unit_Device_Type is character(4), Output_Unit is Mts_File_Type, Output_Unit_Device_Type is character(4), Command_Unit is Mts_File_Type, /* unit for reading commands */ Remote_Unit is Mts_File_Type, Remote_Unit_Name is character(0 to Max_Remote_Unit_Name_Length), Remote_Unit_Modifiers is Mts_Io_Extended_Modifiers_Type, File_Is_Line is Boolean, File_Kind is File_Kind_Type, Clear_Parity_Bit is Boolean, Debug is Boolean, Debug_File is Mts_File_Type, /* Some site specific features for echoing and timeouts */ Can_Set_Read_Timer is Boolean, Can_Set_X25_Timer is Boolean, Can_Set_Local_Echo is Boolean, Can_Set_Network_Echo is Boolean, Can_Set_8_Bit_Datapac_Transparancy is Boolean, X25_Timer_Set is Boolean, Set_Um_Binary_On is Boolean, Telenet_Width_Set is Boolean, Send_Delay is Integer, /* this is the amount of time kermit waits before sending the first packet */ Out_Packet_Count is Packet_Count_Type, In_Packet_Count is Packet_Count_Type, Next_Packet_Count_Threshold is Integer, Packet_Count_Interval is Integer, Expected_Packets is Integer, Display_Packet_Count is Boolean, Binary_Blocksize is Integer, Text_Blocksize is Integer, In_Buffer_End is Integer, Mts_Binary_State is Mts_Binary_State_Type, Mts_Binary_Length is Short_Integer, Current_Line_Number is Integer, Last_Line_Number is Integer, Line_Number_String is Line_Number_String_Type, Line_Number_String_Length is Short_Integer, Line_Number_String_Pos is String_Length_Type, Is_Line_Number_Fraction is Boolean, /* old info for subroutine call etc */ Subroutine_Entry is Boolean, Site is character(0 to 10), Par_String is character(0 to 256), Calling_Mts_Kermit is Boolean, Mts_File_Info is Mts_File_Info_Type, File_Attribute_Data is Packet_Data_Type, Send_File_Attributes is Boolean, Read_Attn_Return is Boolean, File_Transfer_Attn_Stack_Ptr is pointer to Stack_Type, File_Transfer_Attn_Area is Exit_Area_Type, /* Logging info */ Logging_Started is Boolean, Log_Record is Log_Record_Type, Kermit_Log_File is Mts_File_Type, Get_Command_Count is Short_Integer, Send_Command_Count is Short_Integer, Total_Command_Count is Short_Integer, Total_Retries is Short_Integer end; end Main_Global; %Eject(); global Kermit_Global external "KERGLB" /*box This global holds a few pointers to the data structures used globally by the program. */ variable Global_Area_Ptr is pointer to Global_Area_Type, /* buffer to hold maximum file record */ File_Buffer_Ptr is pointer to Long_Varying_String, Old_Prefix is Guinfo_Pfxstr_Type, Old_Attntrp is Guinfo_Attntrp_Type, Entry_Rcb is Return_Control_Block_Type, Storage_Allocated_Info is Storage_Allocated_Info_Type; end Kermit_Global; %Eject(); /*box Attn global variables, and macros. Note getspace must be called to get a small stack for the attn routines (half page). */ global Attn_Global constant Attn_Stack_Length is 2048; /* half page */ variable Mask_Attn_Stack_Ptr is pointer to Stack_Type, Normal_Attn_Stack_Ptr is pointer to Stack_Type, Mask_Attn_Area is Exit_Area_Type, Normal_Attn_Area is Exit_Area_Type, Current_Attn_Kind is Current_Attn_Kind_Type, Attn_Flag is Boolean, Null_Exit_Area is pointer to unknown; end Attn_Global; macro Mask_Attn; Attn_Flag := False; Set_Exit(Attntrp, Mask_Attn_Routine, Mask_Attn_Area, Mask_Attn_Stack_Ptr@, False); end macro; macro Reenable_Attn; if Attn_Flag then Check_Attn(); end if; if Current_Attn_Kind = Normal_Attn_Kind then Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area, Normal_Attn_Stack_Ptr@, False); else /* File transfer attn */ Set_Exit(Attntrp, File_Transfer_Attn, File_Transfer_Attn_Area, File_Transfer_Attn_Stack_Ptr@, False); end if; Attn_Flag := False; end macro; macro Set_Normal_Attn; Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area, Normal_Attn_Stack_Ptr@, False); Current_Attn_Kind := Normal_Attn_Kind; end macro; macro Set_File_Transfer_Attn; Set_Exit(Attntrp, File_Transfer_Attn, File_Transfer_Attn_Area, File_Transfer_Attn_Stack_Ptr@, False); Current_Attn_Kind := File_Transfer_Attn_Kind; end macro; %Eject(); /*box This section includes the encoding macros: *//* *//*as_is char(x) = x + Ascii_Space (x'20') unchar(x) = x - Ascii_Space ctl(x) = x xor '40' */ macro Char parameter is X; X +:= Ascii_Space; end macro; macro Unchar parameter is X; (X - Ascii_Space) end macro; macro Ctl parameter is X; X xor:= '40'; end macro; /*Box Macros to cycle sequence number. Note three global variables last_sequence_number, current_sequence_number, and next_sequence_number are used to by these macros to keep track of the packet sequence. */ macro Increment_Sequence_Numbers; Last_Sequence_Number := (Last_Sequence_Number + 1) mod Sequence_Number_Modulo; Current_Sequence_Number := (Current_Sequence_Number + 1) mod Sequence_Number_Modulo; Next_Sequence_Number := (Next_Sequence_Number + 1) mod Sequence_Number_Modulo; end macro; macro Initialize_Sequence_Numbers; Last_Sequence_Number := Sequence_Number_Modulo - 1; Current_Sequence_Number := 0; Next_Sequence_Number := 1; end macro; macro Read_Long_Varying parameters are Mts_File, Long_Var_String; equate Buffer to Long_Var_String as Long_Varying_String_Structure_Type; open Buffer, Mts_File; /* set maxlen even though in this case it matters little */ File_Length.Maximum_Length := Long_String_Length; File_Simple_Length := 0; /* for EOF */ Last_Result := Read(Long_Varying_String_Text, File_Length, File_Modifiers, File_Line_Number, File_Unit return code Last_Return_Code); Long_Varying_String_Length := File_Simple_Length; end macro; macro Ascii_To_Mts_Ebcdic parameters are String, Len; /* This macro converts a string from ASCII to MTS EBCDIC. Note the string must be <= 255 bytes long. */ variable Tr_Inst is aligned 16 left bit(48), Lenm1 is Integer in register 15; variable Convert_Table is value character(256) external "ASCEBC"; Lenm1 := Len - 1; if Lenm1 >= 0 then variable String_Addr is pointer to unknown in register 2, Convert_Addr is pointer to value character(256) in register 3; Tr_Inst := 'DC 00 2000 3000'; String_Addr := Address(String); Convert_Addr := Address(Convert_Table); Inline(Ex, Lenm1, 0, Tr_Inst, String_Addr, Convert_Addr); end if; end macro; macro Mts_Ebcdic_To_Ascii parameters are String, Len; /* This macro converts a string from MTS EBCDIC to ASCII. Note the string must be <= 255 bytes long. */ /* The macro also clears the parity bit */ variable Tr_Inst is aligned 16 left bit(48), Nc_Inst is aligned 16 left bit(48), Lenm1 is Integer in register 15; variable Convert_Table is value character(256) external "EBCASC"; Lenm1 := Len - 1; if Lenm1 >= 0 then variable String_Addr is pointer to unknown in register 2, Convert_Addr is pointer to value character(256) in register 3; Tr_Inst := 'DC 00 2000 3000'; String_Addr := Address(String); Convert_Addr := Address(Convert_Table); Inline(Ex, Lenm1, 0, Tr_Inst, String_Addr, Convert_Addr); Nc_Inst := 'D4 00 2000 3000'; Convert_Addr := Address(Clear_High_Bit_Pattern); Inline(Ex, Lenm1, 0, Nc_Inst, String_Addr, Convert_Addr); end if; end macro; macro Read_From_User parameters are Mts_Unit, Varying_String; open Mts_Unit; File_Modifiers := 0; Read_Varying(Mts_Unit, Varying_String); end macro; macro Read_Packet parameters are Mts_Unit, Varying_String; open Mts_Unit; File_Modifiers := Mts_Io_Binary ! Mts_Io_Errrtn ! Mts_Io_Not_Trim; Read_Varying(Mts_Unit, Varying_String); end macro; macro Write_Packet parameters are Mts_Unit, Varying_String; open Mts_Unit; File_Modifiers := Mts_Io_Binary ! Mts_Io_Errrtn ! Mts_Io_Not_Trim; Write_Varying(Mts_Unit, Varying_String); end macro; macro Debug_String parameter is String; variable Line is Varying_String; Line := String; Write_Varying(Debug_File, Line); end macro; macro Increment_Packet_Count parameter is Packet_Count; open Packet_Count; For_File +:= 1; For_Session +:= 1; end macro; macro Initialize_Packet_Count parameter is Packet_Count; Packet_Count.For_File := 0; Next_Packet_Count_Threshold := Packet_Count_Interval; Display_Packet_Count := True; Expected_Packets := 0; end macro; macro Set_Filetype_Text; Clear_Parity_Bit := True; File_Kind := Text_File_Kind; In_Buffer_End := Text_Blocksize; end macro; macro Set_Filetype_Binary; Clear_Parity_Bit := False; File_Kind := Binary_File_Kind; In_Buffer_End := Binary_Blocksize; end macro; macro Set_Filetype_Mts_Binary; Clear_Parity_Bit := False; File_Kind := Mts_Binary_File_Kind; In_Buffer_End := Max_Blocksize; end macro; macro Check_For_Retries parameter is Retry_Kind; if Retry_Kind > 0 then Total_Retries +:= 1; end if; end macro; %Eject(); /*box This sections lists all the procedures defined in the program */ procedure Main is procedure reference optional parameter Par is character(0 to 256) in register 0 result Rc is Integer in register 15 end external "MAIN" linkage "PLUSENTR"; %Library := True; procedure Kermit_Subroutine is procedure reference parameter Kermitcb is pointer to unknown, reference parameter Kermit_Switches is bit(32), reference parameter Commands_Fdname is character(20), result Rc is Integer in register 15 end external "KERMIT" linkage system; procedure Kermit_Main is procedure result Rc is Integer end external "MAINKER"; procedure Setup_Kermit_Environment is procedure reference parameter Success is Boolean end external "SETUPKEN"; procedure Cleanup is procedure end external "CLEANUP"; procedure Mask_Attn_Routine is Exit_Routine_Type external "MASKATTN"; procedure Normal_Attn_Routine is Exit_Routine_Type external "NORMATTN"; procedure File_Transfer_Attn is Exit_Routine_Type external "FILEATTN"; procedure Check_Attn is procedure end external "CHKATTN"; procedure Main_Semantics is Semantic_Procedure_Type; procedure Set_Semantics is Semantic_Procedure_Type; procedure Show_Semantics is Semantic_Procedure_Type; procedure Par_String_Semantics is Semantic_Procedure_Type; procedure Filename_Semantics is Semantic_Procedure_Type; procedure Initialize is procedure end external "INITLIZE"; procedure Send_File is procedure reference parameter Success is Boolean end; procedure Send_Init_Action is procedure result Next_State is State_Type end external "SND_INTA"; procedure Send_File_Header_Action is procedure result Next_State is State_Type end external "SND_FHA"; procedure Send_File_Attribute_Action is procedure result Next_State is State_Type end external "SND_FAA"; procedure Send_File_Data_Action is procedure result Next_State is State_Type end external "SND_FDA"; procedure Send_Eof_Action is procedure result Next_State is State_Type end external "SND_EOFA"; procedure Send_Eot_Action is procedure result Next_State is State_Type end external "SND_EOTA"; procedure Receive_File is procedure reference parameter Success is Boolean end; procedure Receive_File_Header_Action is procedure result Next_State is State_Type end external "REC_FHA"; procedure Receive_File_Attribute_Action is procedure result Next_State is State_Type end external "REC_FAA"; procedure Receive_File_Data_Action is procedure result Next_State is State_Type end external "REC_FDA"; procedure Receive_Send_Init_Action is procedure result Next_State is State_Type end external "REC_SINA"; procedure Server_Node is procedure reference parameter Success is Boolean end external "SERVNODE"; procedure Server_Receive_File is procedure reference parameter Success is Boolean end external "SERVRCVF"; procedure Receive_File_From_Server is procedure parameter Receive_Filename is Packet_Data_Type, reference parameter Success is Boolean end external "RECFSERV"; procedure Send_Packet is procedure parameter Packet_Type is Packet_Type_Type parameter Sequence_Number is Sequence_Number_Type, parameter Packet_Data is Packet_Data_Type end external "SENDPACK"; procedure Send_Remote_Packet is procedure end external "SENDRPKT"; procedure Receive_Packet is procedure reference parameter Packet_Type is Packet_Type_Type, reference parameter Sequence_Number is Sequence_Number_Type, reference parameter Packet_Data is Packet_Data_Type end; procedure Get_Local_Packet is procedure reference parameter Success is Boolean end external "GETLPCKT"; procedure Get_Remote_Packet is procedure reference parameter Success is Boolean end external "GETRPCKT"; procedure Dump_Receive_Buffer is procedure end external "DUMPRCBF"; procedure Get_My_Packet_Parameters is procedure reference parameter Send_Init_Data is Packet_Data_Type end external "GTMYPARM"; procedure Get_Your_Packet_Parameters is procedure reference parameter Packet_Data is Packet_Data_Type end external "GTYRPARM"; procedure Get_Out_File_Data is procedure reference parameter Packet_Data is Packet_Data_Type, reference parameter End_Of_File is Boolean end; procedure Get_Next_Out_File_Character is procedure reference parameter Next_Character is bit(8), reference parameter Success is Boolean end external "GETNOFCH"; procedure Put_In_File_Data is procedure reference parameter Packet_Data is Packet_Data_Type, reference parameter Put_Success is Boolean end; procedure Decode_File_Attributes is procedure parameter File_Attribute_Packet is Packet_Data_Type end external "DECODEFA"; procedure Open_In_File is procedure reference parameter Success is Boolean end external "OPENINF"; procedure Open_Out_File is procedure reference parameter Success is Boolean end external "OPENOUTF"; procedure Flush_Input_Unit is procedure end; procedure Write_In_File_Buffer is procedure reference parameter Success is Boolean end; procedure Get_Next_Out_File is procedure reference parameter Success is Boolean end external "GETNOUTF"; procedure Send_Error_Message is procedure parameter Error_Message is Varying_String end external "SNDERRMG"; procedure Handle_Received_Error is procedure parameter Error_Packet_Data is Packet_Data_Type end external "HNDLRERR"; procedure Handle_Error is procedure end external "HANDLERR"; procedure Do_Generic_Command is procedure parameter Receive_Data is Packet_Data_Type, reference parameter Quit is Boolean, reference parameter Success is Boolean end external "DOGENCMD"; procedure Get_Valid_Ascii_Control_Char is procedure reference parameter Ascii_Code is bit(8), reference parameter Success is Boolean end external "GETVACC"; procedure Get_Remote_Unit is procedure result Success is Boolean end external "GETRUNIT"; procedure Configure_Remote_Unit is procedure end external "CNFGREMU"; procedure Get_Inout_Unit_Types is procedure end external "TYPE_IOU"; procedure Open_Debug_File is procedure reference parameter Success is Boolean end external "OPENDBGF"; procedure Send_Generic_Command is procedure parameter Generic_Command is Packet_Data_Type, reference parameter Success is Boolean end external "SENDGCMD"; procedure Display_Packet_Action is procedure parameter Packet_Count is Packet_Count_Type end external "DISPCKAC"; procedure Write_To_User is procedure parameter Message is Varying_String end external "PUTMSG"; procedure Put_Mts_Binary_Data is procedure parameter Next_Character is bit(8), reference parameter Put_Success is Boolean end external "PUTMTSBD"; procedure Get_Mts_Binary_Data is procedure reference parameter Next_Character is bit(8), reference parameter Success is Boolean end external "GETMTSBD"; procedure Encode_Mts_Linenumber is procedure parameter Line_Number_Difference is Integer, reference parameter Encoded_Line_Number is Line_Number_String_Type end external "ENCODEL#"; procedure Decode_Mts_Linenumber is procedure parameter Line_Number_String is Line_Number_String_Type, reference parameter Line_Number_Difference is Integer, reference parameter Success is Boolean end external "DECODEL#"; procedure Save_And_Set_Prefix_String is procedure end external "SASETPFX"; procedure Send_Kermit_Run_Command is procedure result Success is Boolean end external "SENDKERR"; procedure Stop_Remote_Kermit is procedure end external "STOPRKER"; procedure Initialize_Logging is procedure end external "INITLOG"; procedure Terminate_Logging is procedure end external "TERMLOG"; procedure Set_Echo_Off is procedure end external "SETEOFF"; procedure Set_Echo_On is procedure end external "SETEON"; %Eject(); definition Main /*box Entry point used when KERMIT is called as a main program. */ Rc := 0; variable Good_Environment is Boolean; /* get an environment */ Setup_Kermit_Environment(Good_Environment); return when not Good_Environment with Error_Rc; open Global_Area_Ptr@; Par_String := Par; Subroutine_Entry := False; Calling_Mts_Kermit := False; Initialize_File(Command_Unit, "GUSER ", 0); /* check to see if logical unit 0 is attached to a mounted device */ variable Temp_Unit is Mts_File_Type; Initialize_File_With_Unit#(Temp_Unit, 0, Remote_Unit_Modifiers); Remote_Kermit := True; Mode := User_Mode; Set_Filetype_Text(); variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type, Gdinfo_Rc is Integer; Gdinfo_Result_Ptr := Gdinfo(Temp_Unit.File_Unit return code Gdinfo_Rc); if Gdinfo_Rc = 0 then /* have something attached to unit */ open Gdinfo_Result_Ptr@; if Gd_Use_Code = Gd_Mounted_Device then /* have attached mounted unit */ Remote_Unit := Temp_Unit; Configure_Remote_Unit(); Remote_Kermit := False; end if; end if; Rc := Kermit_Main(); if Kill_Remote_Kermit then Stop_Remote_Kermit(); end if; Terminate_Logging(); Cleanup(); end Main; %Eject(); definition Kermit_Subroutine /*box This is the entry point used when KERMIT is called as a subroutine. It takes three parameters, a control block (Kermitcb), some switches (kermit_switches), and an fdname for the commands input. Unit 0 is used to connect to the remote kermit. The return codes are: *//* *//* 0 - all okay. If kermit called again this parameter is zero. *//* 4 - okay but returned kermitcb is retained and passed again. *//* 8 - error. Kermitcb will be zero if called again. */ constant Mts_Switch is '00 00 00 01'; variable Get_Fdub_Rc is Integer, Good_Environment is Boolean; Rc := 0; /* allocate global area */ Setup_Kermit_Environment(Good_Environment); return when not Good_Environment with Error_Rc; open Global_Area_Ptr@; Subroutine_Entry := True; Remote_Kermit := False; Mode := User_Mode; if Kermit_Switches & Mts_Switch = Mts_Switch then Calling_Mts_Kermit := True; Set_Filetype_Mts_Binary(); else /* default to text */ Calling_Mts_Kermit := False; Set_Filetype_Text(); end if; Initialize_File_With_Name(Command_Unit, Commands_Fdname, 0, Get_Fdub_Rc); return when Get_Fdub_Rc > 0 with 8; Initialize_File_With_Unit#(Remote_Unit, 0, Remote_Unit_Modifiers); Configure_Remote_Unit(); if Calling_Mts_Kermit then if not Send_Kermit_Run_Command() then Rc := Error_Rc; return; end if; end if; Rc := Kermit_Main(); if Kill_Remote_Kermit then Stop_Remote_Kermit(); end if; Terminate_Logging(); Cleanup(); end Kermit_Subroutine; %Eject(); definition Kermit_Main /*box This procedure initializes the variables used to build packets, parses commands, and calls the tasks needed to carryout the commands. */ variable Command_Line is Varying_String, Getspace_Rc is Integer; open Global_Area_Ptr@; /* set up exit for attn etc */ Setup_Return_From(Entry_Rcb, Rc); Rc := 0; /* set up the input and output units scards and sprint */ /* These unit are used when Kermit is talking to a microcomputer Kermit */ Initialize_Logging(); Initialize_File(Input_Unit, Input_Unit_Name, 0); Initialize_File(Output_Unit, Output_Unit_Name, 0); Get_Inout_Unit_Types(); /* Set up the Help file */ Parse_Set(Pcb, Help_File_Name, Parse_String_Type(Kermit_Help_File)); if Calling_Mts_Kermit then variable Success is Boolean; /*box We have a call to a remote Mts Kermit. By now the remote Kermit should be running. We'll try to see if we can establish contact using a generic command. If we don't succeed tell the user there maybe nobody at the other end. If we can talk the generic command routine sets Can_Talk_To_Remote_Mts to True. When you shut down the local Mts Kermit if it can talk to another kermit it will shut it down. */ Send_Delay := 0; Send_Generic_Command("T" !! File_Kind_Text(File_Kind), Success); if not Success then Write_To_User(" Unable to set remote filetype to " !! File_Kind_Text(File_Kind) !! "."); Write_To_User(" Remote Kermit probably not successfully " !! "started."); end if; else /* Program entry point: check Par string */ if Length(Par_String) > 0 then Parse(Pcb, Par_String_List, Address(Substring(Par_String, 0)), Length(Par_String)); end if; end if; if not Remote_Mts then /* Display Banner */ Write_To_User(" MTS KERMIT (" !! Site !! ") V" !! Version !! "(" !! Substring(%Time, 0, 5) !! Substring(%Date, 4, 3) !! Substring(%Date, 8, 5) !! ")"); end if; if Mode = Server_Mode then if not Remote_Mts then open Cnfginfo; if (Ci_Installation_Code = Ci_Ubc) & Calling_Mts_Kermit then Write_To_User(" Kermit in Server mode. Enter /KERMIT."); else Write_To_User( " Kermit in Server mode. Escape to Local Kermit."); end if; end if; variable Success is Boolean; Set_Echo_Off(); Server_Node(Success); Set_Echo_On(); All_Done := True; else /* user mode */ cycle /*box When Kermit is in user mode this loop is used to read user commands. The only other place user commands are read is in the Normal_Attn_Routine and the File_Transfer_Attn. In those routines the user is asked whether he wants to continue or not. The procedure that perform all the action are called by the semantic routines. The STOP (EXIT, FINISH) commands or End_Of_File will terminate the program. */ Read_Attn_Return := False; Read_From_User(Command_Unit, Command_Line); open Command_Unit; if Last_Return_Code > 0 then exit; end if; repeat when Read_Attn_Return; if Debug then Debug_String(" User input: " !! Command_Line); end if; Total_Command_Count +:= 1; Parse(Pcb, Kermit_Command, Address(Substring(Command_Line, 0)), Length(Command_Line)); exit when All_Done; end cycle; end if; end Kermit_Main; %Eject(); definition Mask_Attn_Routine /*box This procedure is used to temporarily disable attention interrupts in critical processing sections of the program. It sets the global "Attn_flag" to true if an attention interrupt has occured. The macros mask_attn and reenable_attn should surround the critical section. */ open Global_Area_Ptr@; Attn_Flag := True; /* disable attn's - return to program */ Set_Exit(Attntrp, Mask_Attn_Routine, Mask_Attn_Area, Mask_Attn_Stack_Ptr@, True); end Mask_Attn_Routine; %Eject(); definition Normal_Attn_Routine /*box This is the attentions handler for the bulk of the program. A separate attention handler is setup for the region of the program where the timers are set to make sure no outstanding timers are left enabled. If the attention is received by a remote Kermit any allocated space is freed and the program stops. If it is a local Kermit the user is asked if he wants to continue. If he does the program continues, if not space is freed and the program is terminated. */ open Global_Area_Ptr@; /* stop multiple attn's for a while */ Mask_Attn(); Set_Echo_On(); if Mode = User_Mode then begin /* check to see if user wants to continue */ variable User_Response is Varying_String; Write_To_User(" Attn] Do you wish to continue (Y/N)?"); cycle Read_From_User(Command_Unit, User_Response); exit when Attn_Flag; open Command_Unit; exit when Last_Return_Code > 0 or Length(User_Response) = 0; /* Check response */ Case_Conversion(Substring(User_Response, 0), Length(User_Response)); if Substring(User_Response, 0, 1) = "Y" then /* Have user who wants to resume so do so */ Read_Attn_Return := True; Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area, Normal_Attn_Stack_Ptr@, True); elseif Substring(User_Response, 0, 1) = "N" then exit ; else /* Bad response, ask for correct one */ Write_To_User(" Enter Y or N."); end if; end cycle; end end if; /* okay person doesn't want to continue, kill program */ Kill_Remote_Kermit := True; Return_From(Entry_Rcb, Integer(Error_Rc)); end Normal_Attn_Routine; %Eject(); definition File_Transfer_Attn /*box This procedure is called when an attention occurs during a file tranfer. If it does occur the user is asked if he wants to continue. If not the user is returned to user command mode. */ open Global_Area_Ptr@; /* Stop Multiple Attn's */ Mask_Attn(); Set_Echo_On(); if Mode = User_Mode then begin /* check to see if we should continue */ variable User_Response is Varying_String; Write_To_User(" Attn] Do you wish to continue the file " !! "transfer (Y/N)?"); cycle Read_From_User(Command_Unit, User_Response); exit when Attn_Flag; open Command_Unit; exit when Last_Return_Code > 0 or Length(User_Response) = 0; /* Check response */ Case_Conversion(Substring(User_Response, 0, 1), Length(User_Response)); if Substring(User_Response, 0, 1) = "Y" then /* Have user that wishes to continue */ Read_Attn_Return := True; Set_Echo_Off(); Set_Exit(Attntrp, File_Transfer_Attn, File_Transfer_Attn_Area, File_Transfer_Attn_Stack_Ptr@, True); elseif Substring(User_Response, 0, 1) = "N" then exit ; else Write_To_User(" Enter Y or N."); end if; end cycle; end end if; /* okay person wants to stop transfer */ Error_Message := "File transfer aborted."; /* Restore exit to normal Attn */ Read_Attn_Return := True; Current_Attn_Kind := Normal_Attn_Kind; Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area, Normal_Attn_Stack_Ptr@, False); Return_From(Rcb, Boolean(False)); end File_Transfer_Attn; %Eject(); definition Check_Attn /*box This routine is called if after a critical region it is discovered that an attention has been given. It asks the user whether it should continue or quit. If the user wants to quit the environment is cleaned up and we return to the caller. */ open Global_Area_Ptr@; /* stop multiple attn's for a while */ Mask_Attn(); Set_Echo_On(); if Mode = User_Mode then begin /* check to see if user wants to continue */ variable User_Response is Varying_String; if Current_Attn_Kind = Normal_Attn_Kind then Write_To_User( " Attn] Do you wish to continue the program (Y/N)?"); else /* File Transfer Attn */ Write_To_User(" Attn] Do you wish to continue with the " !! "file transfer (Y/N)?"); end if; cycle Read_From_User(Command_Unit, User_Response); exit when Attn_Flag; open Command_Unit; exit when Last_Return_Code > 0 or Length(User_Response) = 0; /* Check response */ Case_Conversion(Substring(User_Response, 0), Length(User_Response)); if Substring(User_Response, 0, 1) = "Y" then /* Have user who wants to resume so do so */ if Current_Attn_Kind = File_Transfer_Attn_Kind then Set_Echo_Off(); end; return elseif Substring(User_Response, 0, 1) = "N" then exit else /* Improper Response */ Write_To_User(" Enter Y or N."); end if; end cycle; end end if; if Current_Attn_Kind = Normal_Attn_Kind then /* okay person doesn't want to continue, kill program */ Stop_Remote_Kermit(); Return_From(Entry_Rcb, Integer(Error_Rc)); else /* File transfer attn */ Return_From(Rcb, Boolean(False)); end if; end Check_Attn; %Eject(); definition Main_Semantics /*box This is the main semantics routine. The semantic routines Set_Semantics and Show_Semantics also analyze user commands. These routines should be consulted along with the grammar. */ open Global_Area_Ptr@; Success := True; select Semantic_Action from case Ks_Exit_Command: All_Done := True; Stop_Remote_Kermit(); case Ks_Finish_Command: variable Finish_Success is Boolean; Send_Generic_Command("F", Finish_Success); /* send finish command */ if Finish_Success then Write_To_User(" Server shut down but not logged off."); Can_Talk_To_Remote_Kermit := False; else Write_To_User(" Unable to shut remote server down."); end if; case Ks_Bye_Command: variable Bye_Success is Boolean; Send_Generic_Command("L", Bye_Success); /* send bye (logoff) command */ if Bye_Success then Write_To_User(" Server shut down and logged off."); else Write_To_User(" Unable to logoff remote server."); end if; case Ks_Save_Filename: variable Temp_Filename is Varying_String; Temp_Filename := Last_Terminal_Text(Pcb, True); Saved_Filename := Substring(Temp_Filename, 0, Min(Length(Temp_Filename), Max_Data_Length)); case Ks_Send_Simple_Filename: variable Open_Success, Send_Success are Boolean; Out_Filename := Saved_Filename; Remote_Filename := ""; Initialize_Packet_Count(Out_Packet_Count); Open_Out_File(Open_Success); if Open_Success then Write_To_User(" Preparing to send file '" !! Out_Filename !! "'."); if Send_Delay ^= 0 then variable Wait_Time is array (1 to 2) of Integer; Wait_Time(1) := 0; Wait_Time(2) := Send_Delay; Twait(Microsec_From_Call, Wait_Time); end if; Send_Command_Count +:= 1; Set_File_Transfer_Attn(); Set_Echo_Off(); Send_File(Send_Success); Set_Echo_On(); Set_Normal_Attn(); if not Send_Success then Handle_Error(); else Write_To_User(" File sent successfully."); end if; else Handle_Error(); end if; Display_Packet_Count := False; case Ks_Send_Local_Filename: variable Local_Filename is Varying_String; Local_Filename := Production_Text(Pcb, True); Out_Filename := Substring(Local_Filename, 0, Min(Length(Local_Filename), Max_Data_Length)); case Ks_Send_Remote_Filename: variable Open_Success, Send_Success are Boolean; Remote_Filename := Saved_Filename; Initialize_Packet_Count(Out_Packet_Count); /* Check we can get the file to send */ Open_Out_File(Open_Success); if Open_Success then Write_To_User(" Preparing to send MTS file '" !! Out_Filename !! "' to remote file '" !! Remote_Filename !! "'."); if Send_Delay ^= 0 then variable Wait_Time is array (1 to 2) of Integer; Wait_Time(1) := 0; Wait_Time(2) := Send_Delay; Twait(Microsec_From_Call, Wait_Time); end if; Send_Command_Count +:= 1; Set_File_Transfer_Attn(); Set_Echo_Off(); Send_File(Send_Success); Set_Echo_On(); Set_Normal_Attn(); if not Send_Success then Handle_Error(); else Write_To_User(" File sent successfully."); end if; else Handle_Error(); end if; Display_Packet_Count := False; case Ks_Receive: if Can_Talk_To_Remote_Kermit then Write_To_User(" Use 'Get' for remote Server Kermit"); return; end if; variable Receive_Success is Boolean; Get_Command_Count +:= 1; Initialize_Packet_Count(In_Packet_Count); Simple_Receive := True; In_Filename := ""; Write_To_User(" Preparing to receive file."); Set_File_Transfer_Attn(); Set_Echo_Off(); Receive_File(Receive_Success); Set_Echo_On(); Set_Normal_Attn(); if not Receive_Success then Handle_Error(); else Write_To_User(" File received successfully."); end if; Display_Packet_Count := False; case Ks_Receive_Local_Filename: if Can_Talk_To_Remote_Kermit then Write_To_User(" Use 'Get' for remote Server Kermit"); return; end if; variable Receive_Success is Boolean; Get_Command_Count +:= 1; Initialize_Packet_Count(In_Packet_Count); /* use given name for file */ In_Filename := Saved_Filename; Write_To_User(" File being received will be placed into " !! "MTS file '" !! In_Filename !! "'"); Set_File_Transfer_Attn(); Set_Echo_Off(); Receive_File(Receive_Success); Set_Echo_On(); Set_Normal_Attn(); if not Receive_Success then Handle_Error(); else Write_To_User(" File received successfully."); end if; Display_Packet_Count := False; case Ks_Get_Simple_Filename: /* Get a remote file */ variable Simple_Name is Varying_String, Receive_Success is Boolean; Simple_Name := Saved_Filename; Get_Command_Count +:= 1; Initialize_Packet_Count(In_Packet_Count); In_Filename := ""; Write_To_User(" Getting remote file '" !! Simple_Name !! "'"); Set_File_Transfer_Attn(); Receive_File_From_Server(Simple_Name, Receive_Success); Set_Normal_Attn(); if not Receive_Success then Handle_Error(); else Write_To_User(" File received successfully."); end if; Display_Packet_Count := False; case Ks_Get_Remote_Filename: variable Temp_Filename is Varying_String; Temp_Filename := Production_Text(Pcb, True); Remote_Filename := Substring(Temp_Filename, 0, Min(Length(Temp_Filename), Max_Data_Length)); case Ks_Get_Local_Filename: variable Receive_Success is Boolean; In_Filename := Saved_Filename; Get_Command_Count +:= 1; Initialize_Packet_Count(In_Packet_Count); Write_To_User(" Getting remote file '" !! Remote_Filename !! "'"); Set_File_Transfer_Attn(); Receive_File_From_Server(Remote_Filename, Receive_Success); Set_Normal_Attn(); if Receive_Success then Write_To_User(" Remote file '" !! Remote_Filename !! "' successfully received. Put in MTS file '" !! In_Filename !! "'"); else Handle_Error(); end if; Display_Packet_Count := False; Remote_Filename := ""; case Ks_Set_Debug_On: variable Debug_Open_Success is Boolean; Open_Debug_File(Debug_Open_Success); if Debug_Open_Success then Debug_String(":"); Debug_String("1 Packet Trace and Debug Log"); Debug_String(" "); Debug := True; else Write_To_User(" Unable to find a file to log debugging"); end if; if Calling_Mts_Kermit then variable Remote_Debug_Success is Boolean; Send_Generic_Command("DO", Remote_Debug_Success); if not Remote_Debug_Success then Write_To_User(" Unable to set remote debugging on."); end if; end if; case Ks_Set_Delay: /* this is called for resetting the send-init delay */ Parse_Get(Pcb, Parsed_Integer, Send_Delay, Byte_Size(Send_Delay)); if Send_Delay > Max_Send_Delay then Send_Delay := Max_Send_Delay; elseif Send_Delay < Min_Send_Delay then Send_Delay := Min_Send_Delay; end if; Write_To_User(" Send delay set to " !! Integer_To_Varying(Send_Delay, 0) !! " seconds."); Send_Delay := Send_Delay * Microseconds_Per_Sec; case Ks_Set_Filetype_Text: variable Success is Boolean; Set_Filetype_Text(); Write_To_User(" Text filetype set."); if not Remote_Kermit then Send_Generic_Command("TTEXT", Success); if not Success then Write_To_User(" Unable to set remote filetype to TEXT.") ; end if; end if; case Ks_Set_Filetype_Binary: variable Success is Boolean; Set_Filetype_Binary(); Write_To_User(" Binary filetype set."); if not Remote_Kermit then Send_Generic_Command("TBINARY", Success); if not Success then Write_To_User( " Unable to set remote filetype to BINARY."); end if; end if; case Ks_Set_Filetype_Mts_Binary: variable Success is Boolean; Set_Filetype_Mts_Binary(); Write_To_User(" MTS binary filetype set."); if not Remote_Kermit then Send_Generic_Command("TMTS-BINARY", Success); if not Success then Write_To_User( " Unable to set remote filetype to MTS-BINARY."); end if; end if; case Ks_Set_Binary_Blocksize: variable Temp is Integer; Parse_Get(Pcb, Parsed_Integer, Temp, Byte_Size(Temp)); if Temp > Max_Binary_Blocksize then Binary_Blocksize := Max_Binary_Blocksize; elseif Temp < Min_Binary_Blocksize then Binary_Blocksize := Min_Binary_Blocksize; else Binary_Blocksize := Temp; end if; Write_To_User(" Binary blocksize set to " !! Integer_To_Varying(Binary_Blocksize, 0) !! "."); if File_Kind = Binary_File_Kind then In_Buffer_End := Binary_Blocksize; end if; case Ks_Set_Text_Blocksize: variable Temp is Integer; Parse_Get(Pcb, Parsed_Integer, Temp, Byte_Size(Temp)); if Temp > Max_Text_Blocksize then Text_Blocksize := Max_Text_Blocksize; elseif Temp < Min_Text_Blocksize then Text_Blocksize := Min_Text_Blocksize; else Text_Blocksize := Temp; end if; Write_To_User(" Text blocksize set to " !! Integer_To_Varying(Text_Blocksize, 0) !! "."); if File_Kind = Text_File_Kind then In_Buffer_End := Text_Blocksize; end if; case Ks_Set_Line: variable Temp_Unit is Varying_String; Temp_Unit := Production_Text(Pcb, False); Remote_Unit_Name := Substring(Temp_Unit, 0, Min(Length(Temp_Unit), Max_Remote_Unit_Name_Length)); if not Get_Remote_Unit() then /* couldn't open mounted device */ Write_To_User(" Unable to open network connection " !! Remote_Unit_Name); else Configure_Remote_Unit(); Write_To_User(" Line to remote KERMIT connected."); Remote_Kermit := False; end if; case Ks_Mcmd: variable Command_Text is Varying_String, Command_Length is Integer; Command_Text := Production_Text(Pcb, False); Command_Length := Length(Command_Text); Cmdnoe(Substring(Command_Text, 0, Length(Command_Text)), Command_Length); case Ks_Server_Command: variable Server_Success is Boolean; Write_To_User( " Kermit in server mode. Escape to local KERMIT."); Set_Echo_Off(); Server_Node(Server_Success); Set_Echo_On(); All_Done := True; case Ks_Invalid_Command: variable Invalid_Command is Varying_String; Invalid_Command := Production_Text(Pcb, False); if Invalid_Command ^= "" then Write_To_User(" Invalid command: '" !! Invalid_Command !! "'"); Write_To_User( " Enter HELP COMMANDS for a list of commands."); end if; case Ks_Error_Bad_Get_Parm: variable Bad_Get_Parm is Varying_String; Bad_Get_Parm := Production_Text(Pcb, False); Write_To_User(" Invalid GET parameters: '" !! Bad_Get_Parm !! "'"); Write_To_User(" Enter HELP GET for valid syntax."); case Ks_Error_Bad_Receive_Parm: variable Bad_Receive_Parm is Varying_String; Bad_Receive_Parm := Production_Text(Pcb, False); Write_To_User(" Invalid RECEIVE parameters: '" !! Bad_Receive_Parm !! "'"); Write_To_User(" Enter HELP RECEIVE for valid syntax."); case Ks_Error_Bad_Send_Parm: variable Bad_Send_Parm is Varying_String; Bad_Send_Parm := Production_Text(Pcb, False); Write_To_User(" Invalid SEND parameters: '" !! Bad_Send_Parm !! "'"); Write_To_User(" Enter HELP SEND for valid syntax."); case Ks_Error_On_Off: Write_To_User( " This SET command accepts only nothing, ON, or OFF " !! "as an option."); case Ks_Set_Failure: variable Failing_Set_Option is Varying_String; Failing_Set_Option := Production_Text(Pcb, True); Write_To_User(" Invalid SET option: '" !! Failing_Set_Option !! "'"); Write_To_User(" Enter 'HELP SET' for a list of options."); else Write_To_User(" Semantic action not implemented yet"); end select; end Main_Semantics; %Eject(); definition Set_Semantics /*box This procedure is called by the semantic actions that allow the user to set the receive and send parameters for the packets. */ variable Ascii_Char is bit(8), Byte_Int is bit(8), Char_Ok is Boolean; open Global_Area_Ptr@; Success := True; select Semantic_Action from case Ks_My_End_Of_Line: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then My_End_Of_Line_Character := Ascii_Char; end if; case Ks_My_Packet_Length: variable New_Packet_Length is Integer; Parse_Get(Pcb, Parsed_Integer, New_Packet_Length, Byte_Size(New_Packet_Length)); if New_Packet_Length < Min_Packet_Length then My_Packet_Length := Min_Packet_Length; elseif New_Packet_Length > Max_Packet_Length then My_Packet_Length := Max_Packet_Length; else My_Packet_Length := New_Packet_Length; end if; case Ks_My_Padding: variable New_Padding_Count is Integer; Parse_Get(Pcb, Parsed_Integer, New_Padding_Count, Byte_Size(New_Padding_Count)); if New_Padding_Count < 0 then My_Padding_Count := 0; elseif New_Padding_Count > Max_Padding_Count then My_Padding_Count := Max_Padding_Count; else My_Padding_Count := New_Padding_Count; end if; case Ks_My_Padchar: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then My_Padding_Character := Ascii_Char; end if; case Ks_My_Quote: variable New_Quote is Integer; Parse_Get(Pcb, Parsed_Integer, New_Quote, Byte_Size(New_Quote)); /* check lies within ascii range permitable */ if (New_Quote > Ascii_Space and New_Quote <= Ascii_Greater_Than) or (New_Quote >= Ascii_Grave and New_Quote <= Ascii_Tilde) then Byte_Int := New_Quote; My_Quote_Character := Byte_Int; else Write_To_User( " New quote out of range. Must lie within the " !! "range " !! Integer_To_Varying(Ascii_Space + 1, 0) !! " to " !! Integer_To_Varying(Ascii_Greater_Than, 0) !! " or " !! Integer_To_Varying(Ascii_Grave, 0) !! " to " !! Integer_To_Varying(Ascii_Tilde, 0) !! "."); end if; case Ks_My_Start_Of_Packet: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then My_Start_Of_Packet_Character := Ascii_Char; end if; case Ks_My_Timeout: variable New_Timeout is Integer; Parse_Get(Pcb, Parsed_Integer, New_Timeout, Byte_Size(New_Timeout)); if New_Timeout < Min_Timeout then My_Timeout := Min_Timeout; elseif New_Timeout > Max_Timeout then My_Timeout := Max_Timeout; else My_Timeout := New_Timeout; end if; case Ks_Your_End_Of_Line: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then Your_End_Of_Line_Character := Ascii_Char; end if; case Ks_Your_Packet_Length: variable New_Packet_Length is Integer; Parse_Get(Pcb, Parsed_Integer, New_Packet_Length, Byte_Size(New_Packet_Length)); if New_Packet_Length < Min_Packet_Length then Your_Packet_Length := Min_Packet_Length; elseif New_Packet_Length > Max_Packet_Length then Your_Packet_Length := Max_Packet_Length; else Your_Packet_Length := New_Packet_Length; end if; case Ks_Your_Padding: variable New_Padding_Count is Integer; Parse_Get(Pcb, Parsed_Integer, New_Padding_Count, Byte_Size(New_Padding_Count)); if New_Padding_Count < 0 then Your_Padding_Count := 0; elseif New_Padding_Count > Max_Padding_Count then Your_Padding_Count := Max_Padding_Count; else Your_Padding_Count := New_Padding_Count; end if; case Ks_Your_Padchar: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then Your_Padding_Character := Ascii_Char; end if; case Ks_Your_Quote: variable New_Quote is Integer; Parse_Get(Pcb, Parsed_Integer, New_Quote, Byte_Size(New_Quote)); /* check lies within ascii range permitable */ if (New_Quote > Ascii_Space and New_Quote <= Ascii_Greater_Than) or (New_Quote >= Ascii_Grave and New_Quote <= Ascii_Tilde) then Byte_Int := New_Quote; Your_Quote_Character := Byte_Int; else Write_To_User( " New quote out of range. Must lie within the " !! "range " !! Integer_To_Varying(Ascii_Space + 1, 0) !! " to " !! Integer_To_Varying(Ascii_Greater_Than, 0) !! " or " !! Integer_To_Varying(Ascii_Grave, 0) !! " to " !! Integer_To_Varying(Ascii_Tilde, 0) !! "."); end if; case Ks_Your_Start_Of_Packet: Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok); if Char_Ok then Your_Start_Of_Packet_Character := Ascii_Char; end if; case Ks_Your_Timeout: variable New_Timeout is Integer; Parse_Get(Pcb, Parsed_Integer, New_Timeout, Byte_Size(New_Timeout)); if New_Timeout < Min_Timeout then Your_Timeout := Min_Timeout; elseif New_Timeout > Max_Timeout then Your_Timeout := Max_Timeout; else Your_Timeout := New_Timeout; end if; Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0); case Ks_Set_Packet_Count_Interval: /* set the frequency the packet count is displayed */ variable New_Interval_Count is Integer; Parse_Get(Pcb, Parsed_Integer, New_Interval_Count, Byte_Size(New_Interval_Count)); if New_Interval_Count <= 0 then Write_To_User(" Notify turned off."); Packet_Count_Interval := Maximum_Integer; else Packet_Count_Interval := New_Interval_Count; end if; case Ks_Set_Packet_Count_Interval_Off: Packet_Count_Interval := Maximum_Integer; else /* dummy nothing */ end select; end Set_Semantics; %Eject(); definition Show_Semantics /*box This procedure handles the semantics for the SHOW command. The show command allows the user to display the current settings of the parameters that may be set using the SET command. */ open Global_Area_Ptr@; Success := True; select Semantic_Action from case Kssh_Binary_Blocksize: Write_To_User(" Binary Blocksize is " !! Integer_To_Varying(Binary_Blocksize, 0)); case Kssh_Debug: if Debug then Write_To_User(" Debug is on"); else Write_To_User(" Debug is off"); end if; case Kssh_Delay: Write_To_User(" Delay is " !! Integer_To_Varying(Send_Delay / 1000000, 0) !! " seconds"); case Kssh_Filetype: Write_To_User(" Filetype is " !! File_Kind_Text(File_Kind)); case Kssh_Notify: Write_To_User(" Notify frequency is " !! Integer_To_Varying(Packet_Count_Interval, 0)); case Kssh_My_End_Of_Line: Write_To_User(" My End of Line Character in decimal is " !! Integer_To_Varying(My_End_Of_Line_Character, 0)); case Kssh_My_Packet_Length: Write_To_User(" My Packet Length is " !! Integer_To_Varying(My_Packet_Length, 0)); case Kssh_My_Padding: Write_To_User(" My padding count is " !! Integer_To_Varying(My_Padding_Count, 0)); case Kssh_My_Padchar: Write_To_User(" My padding character in decimal is " !! Integer_To_Varying(My_Padding_Character, 0)); case Kssh_My_Quote: Write_To_User(" My quote character in decimal is " !! Integer_To_Varying(My_Quote_Character, 0)); case Kssh_My_Start_Of_Packet: Write_To_User(" My start of packet character is " !! Integer_To_Varying(My_Start_Of_Packet_Character, 0)); case Kssh_My_Timeout: Write_To_User(" My timeout is " !! Integer_To_Varying(My_Timeout, 0) !! " seconds"); case Kssh_Your_End_Of_Line: Write_To_User(" Your End of Line Character in decimal is " !! Integer_To_Varying(Your_End_Of_Line_Character, 0)); case Kssh_Your_Packet_Length: Write_To_User(" Your Packet Length is " !! Integer_To_Varying(Your_Packet_Length, 0)); case Kssh_Your_Padding: Write_To_User(" Your padding count is " !! Integer_To_Varying(Your_Padding_Count, 0)); case Kssh_Your_Padchar: Write_To_User(" Your padding character in decimal is " !! Integer_To_Varying(Your_Padding_Character, 0)); case Kssh_Your_Quote: Write_To_User(" Your quote character in decimal is " !! Integer_To_Varying(Your_Quote_Character, 0)); case Kssh_Your_Start_Of_Packet: Write_To_User(" Your start of packet character is " !! Integer_To_Varying(Your_Start_Of_Packet_Character, 0)); case Kssh_Your_Timeout: Write_To_User(" Your timeout is " !! Integer_To_Varying(Your_Timeout, 0) !! " seconds"); else /* Should never occur */ end select; end Show_Semantics; %Eject(); definition Par_String_Semantics /*box This procedure is called during the analysis of the PAR string. Several options may be set. These include *//*as_is User - run kermit in user rather than default server mode FileType Binary - set initial filetype to Binary FileType MTS-Binary - set initial filetype to MTS-Binary */ open Global_Area_Ptr@; Success := True; select Semantic_Action from case Ps_Set_Mode_User: Mode := User_Mode; case Ps_Set_Mode_Server: Mode := Server_Mode; case Ps_Remote_Mts: Remote_Mts := True; Mode := Server_Mode; /* Other Kermit expects an "Execution begins" or such line when it starts this Kermit. If the user has shut this feature off issue a dummy line to keep the Kermits in synch */ variable Ebm_Result is character(8), Print_Message is Boolean, Chr_Pos is String_Length_Type; Guinfo("EBM ", Ebm_Result); Case_Conversion(Ebm_Result, Byte_Size(Ebm_Result)); Print_Message := False; Chr_Pos := 0; cycle if Substring(Ebm_Result, Chr_Pos, 1) = "W" or Substring(Ebm_Result, Chr_Pos, 1) = "H" then Print_Message := True; exit; end if; exit when Chr_Pos >= 7; Chr_Pos +:= 1; exit when Substring(Ebm_Result, Chr_Pos, 1) = "*"; end cycle; if not Print_Message then /* Issue a Dummy Line */ Write_To_User(" Execution begins"); end if; case Ps_Set_Debug: Debug := True; case Ps_Set_Filetype_Binary: variable Success is Boolean; Set_Filetype_Binary(); if not Remote_Kermit then Send_Generic_Command("TBINARY", Success); if Success then Write_To_User(" Filetype set to binary."); else Write_To_User( " Unable to set remote filetype to binary."); end if; end if; case Ps_Set_Filetype_Text: variable Success is Boolean; Set_Filetype_Text(); if not Remote_Kermit then Send_Generic_Command("TTEXT", Success); if Success then Write_To_User(" Filetype set to text."); else Write_To_User(" Unable to set remote filetype to text.") ; end if; end if; case Ps_Set_Filetype_Mts_Binary: variable Success is Boolean; Set_Filetype_Mts_Binary(); if not Remote_Kermit then Send_Generic_Command("TMTS-BINARY", Success); if Success then Write_To_User(" Filetype set to MTS-binary."); else Write_To_User( " Unable to set remote filetype to MTS-binary."); end if; end if; else /* just in case */ end select; end Par_String_Semantics; %Eject(); definition Filename_Semantics /*box This procedure is called when to check an mts filename is valid. */ constant Max_Mts_Filename_Length is 12; variable I is Short_Integer, /* index for name scan */ Filename_Char is character(1), Filename is Varying_String; open Global_Area_Ptr@; Success := True; select Semantic_Action from case Ks_Mts_Simple_Filename: Filename := Production_Text(Pcb, True); if Length(Filename) > Max_Mts_Filename_Length or Length(Filename) <= 0 then Success := False; return; end if; /* check name contains valid characters */ do I := 0 to Length(Filename) - 1 Filename_Char := Substring(Filename, I, 1); select Fnametrt(Filename_Char) from case Fnametrt_Valid: else Success := False; return; end select; end do; else end select; end Filename_Semantics; %Eject(); definition Initialize /*box This procedure sets the initial data packet parameters and other default values. */ open Global_Area_Ptr@; Remote_Mts := False; Logging_Started := False; Can_Talk_To_Remote_Kermit := False; /* initialize clear high bit pattern */ Substring(Clear_High_Bit_Pattern, 0, 1) := '7F'; Substring(Clear_High_Bit_Pattern, 1, Length(Clear_High_Bit_Pattern) - 1) := Substring(Clear_High_Bit_Pattern, 0, Length(Clear_High_Bit_Pattern) - 1); Text_Blocksize := Default_Text_Blocksize; Binary_Blocksize := Default_Binary_Blocksize; Send_File_Attributes := False; Simple_Receive := False; Remote_Filename := ""; Send_Delay := Default_Send_Delay * Microseconds_Per_Sec; Out_Packet_Count.For_File := 0; Out_Packet_Count.For_Session := 0; Out_Packet_Count.Side := Sending_Side; In_Packet_Count.For_File := 0; In_Packet_Count.For_Session := 0; Send_Command_Count := 0; Get_Command_Count := 0; Total_Command_Count := 0; Total_Retries := 0; In_Packet_Count.Side := Receiving_Side; Packet_Count_Interval := 20; Display_Packet_Count := False; Debug := False; Error_Message := ""; My_Packet_Length := My_Default_Packet_Length; My_Timeout := Default_Timeout; My_Padding_Count := Default_Padding_Count; My_Padding_Character := Default_Padding_Character; My_End_Of_Line_Character := Default_End_Of_Line_Character; Your_End_Of_Line_Character := Ascii_Cr; /* assume CR to start */ My_Quote_Character := Default_Quote_Character; Eight_Bit_Quote_Character := Default_8_Bit_Quote_Character; Checksum_Kind := Default_Checksum_Kind; Checksum_Size := Checksum_Lengths(Checksum_Kind); My_Repeat_Character := Default_Repeat_Character; Your_Repeat_Character := Default_Repeat_Character; /* set sum defaults for the initial packet; rest will come in ACK */ Your_Timeout := Default_Timeout; Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0); Your_Padding_Count := Default_Padding_Count; Your_Padding_Character := Default_Padding_Character; Your_End_Of_Line_Character := Default_End_Of_Line_Character; Your_Start_Of_Packet_Character := Ascii_Soh; My_Start_Of_Packet_Character := Ascii_Soh; All_Done := False; Non_Data_Count := Byte_Size(Packet_Header_Type) + Checksum_Size - Uncounted_Packet_Char; /* some file initialization parameters */ Out_File_Io_Modifiers := Mts_Io_Not_Trim ! Mts_Io_Not_Ic ! Mts_Io_Not_Endfile; In_File_Io_Modifiers := Mts_Io_Not_Trim ! Mts_Io_Errrtn; Remote_Unit_Modifiers := Mts_Io_Errrtn; open Cnfginfo; select Ci_Installation_Code from case Ci_Um: Set_Um_Binary_On := True; Can_Set_Read_Timer := False; Can_Set_X25_Timer := False; Can_Set_Local_Echo := True; Can_Set_Network_Echo := True; Can_Set_8_Bit_Datapac_Transparancy := False; case Ci_Ubc: Set_Um_Binary_On := False; Can_Set_Read_Timer := True; Can_Set_X25_Timer := True; Can_Set_Local_Echo := True; Can_Set_Network_Echo := True; Can_Set_8_Bit_Datapac_Transparancy := True; case Ci_Uqv: Set_Um_Binary_On := False; Can_Set_Read_Timer := False; Can_Set_X25_Timer := False; Can_Set_Local_Echo := False; Can_Set_Network_Echo := False; Can_Set_8_Bit_Datapac_Transparancy := False; case Ci_Sfu: Set_Um_Binary_On := False; Can_Set_Read_Timer := True; Can_Set_X25_Timer := True; Can_Set_Local_Echo := True; Can_Set_Network_Echo := True; Can_Set_8_Bit_Datapac_Transparancy := True; else Set_Um_Binary_On := False; Can_Set_Read_Timer := False; Can_Set_X25_Timer := False; Can_Set_Local_Echo := True; Can_Set_Network_Echo := True; Can_Set_8_Bit_Datapac_Transparancy := False; end select; Telenet_Width_Set := False; end Initialize; %Eject(); definition Send_File /*box This procedure is used to send a file to another host. The name of the file to be sent should be in the global variable "out_filename". If the procedure is unable to send the file it returns false in the parameter "success" and puts an error message in the global variable "error_message". */ /* set up a long return for the a timed out write when talking to a remote kermit */ open Global_Area_Ptr@; Setup_Return_From(Rcb, Success); Success := True; Initialize_Sequence_Numbers(); Times_This_Packet_Retried := 0; Side := Sending_Side; State := Send_Init_State; cycle select State from case Send_Init_State: State := Send_Init_Action(); case Send_File_Header_State: State := Send_File_Header_Action(); case Send_File_Attribute_State: State := Send_File_Attribute_Action(); case Send_File_Data_State: State := Send_File_Data_Action(); case Send_Eof_State: State := Send_Eof_Action(); case Send_Eot_State: State := Send_Eot_Action(); case Complete_State: return; case Abort_State: /* error sensed at a lower level procedure */ Success := False; return; else /* Something has gone wrong: Abort */ Success := False; Error_Message := "Program error: Unexpected state in " !! "proc " !! %Current_Procedure !! "."; return; end select; end cycle; end Send_File; %Eject(); definition Send_Init_Action /*box This procedure initiates file transfer: it sends this kermits paramters and gets back the other Kermits parameters. */ variable Send_Init_Data is Packet_Data_Type, Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Success is Boolean; open Global_Area_Ptr@; /* Flush the input buffer to get rid of NAK's */ Flush_Input_Unit(); Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send Init: unable to get ACK for init packet."; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Get_My_Packet_Parameters(Send_Init_Data); Send_Packet(Send_Init_Code, Current_Sequence_Number, Send_Init_Data); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: Next_State := Send_Init_State; return; case Acknowledge_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* wrong ACK stay in initialize state */ Next_State := Send_Init_State; return; end if; Get_Your_Packet_Parameters(Receive_Data); /* Here is where final agreement is made as what checksum, 8 bit quoting and repeat characters to use */ /* File is ready and open */ Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Send_File_Header_State; return; case Bad_Code: /* bad packet */ Next_State := Send_Init_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* assume either abort_code or unknown */ Next_State := Abort_State; return; end select; end; %Eject(); definition Send_File_Header_Action /*box This procedure sends the name of the file that the data is to be placed into. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, End_Of_File is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send file header: unable to get ACK for " !! "packet."; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; if Remote_Filename = "" then Out_Ascii_Filename := Out_Filename; else Out_Ascii_Filename := Remote_Filename; end if; Mts_Ebcdic_To_Ascii(Substring(Out_Ascii_Filename, 0, 0), Length(Out_Ascii_Filename)); Send_Packet(File_Header_Code, Current_Sequence_Number, Out_Ascii_Filename); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: /* check to see if NAK for following packet */ if Receive_Sequence_Number = Next_Sequence_Number then /* assume file header accepted, so process */ else /* try again for an ACK */ Next_State := Send_File_Header_State; return; end if; case Acknowledge_Code: /* check sequence numbers match */ if Receive_Sequence_Number = Current_Sequence_Number then /* process file header */ else Next_State := Send_File_Header_State; return; end if; case Bad_Code: Next_State := Send_File_Header_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* something really bad */ Error_Message := "Send File Header: inconsistent state."; Next_State := Abort_State; return; end select; /* File header has been received properly */ Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); if Send_File_Attributes then Next_State := Send_File_Attribute_State; else /* Grab the first record from the file */ Get_Out_File_Data(Send_Packet_Data, End_Of_File); if End_Of_File then Next_State := Send_Eof_State; return; else Next_State := Send_File_Data_State; end if; end if; end Send_File_Header_Action; %Eject(); definition Send_File_Attribute_Action /*box This procedure is used to send the file attributes to an MTS Kermit. Three attributes are sent; Length (size of file in Kbytes), Type, and Mts atributes. The first attribute is standard, the second includes as data the standard types A (Ascii), B (Binary), D (varying length binary, MTS sequential), and the non-standard type L (MTS line file). */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send file attribute: unable to get ACK for " !! "packet."; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; if Debug then variable Text is Varying_String; Text := File_Attribute_Data; Ascii_To_Mts_Ebcdic(Substring(Text, 0), Length(Text)); Debug_String(" File attributes: " !! Text); end if; Send_Packet(File_Attribute_Code, Current_Sequence_Number, File_Attribute_Data); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: /* check to see if NAK for following packet */ if Receive_Sequence_Number = Next_Sequence_Number then /* assume file attribute accepted, so process */ else /* try again for an ACK */ Next_State := Send_File_Attribute_State; return; end if; case Acknowledge_Code: /* check sequence numbers match */ if Receive_Sequence_Number = Current_Sequence_Number then /* process file attribute */ else Next_State := Send_File_Attribute_State; return; end if; case Bad_Code: Next_State := Send_File_Attribute_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* something really bad */ Error_Message := "Send File Header: inconsistent state."; Next_State := Abort_State; return; end select; /* File attribute has been sent properly */ variable End_Of_File is Boolean; /* Grab the first record from the file */ Get_Out_File_Data(Send_Packet_Data, End_Of_File); Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); if End_Of_File then Next_State := Send_Eof_State; return; else Next_State := Send_File_Data_State; end if; end Send_File_Attribute_State; %Eject(); definition Send_File_Data_Action /*box This is the state used send the file data */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, No_More_Data is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send data: Unable to get ACK for data packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Send_Packet(Data_Packet_Code, Current_Sequence_Number, Send_Packet_Data); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: /* check to see if NAK for next packet */ if Receive_Sequence_Number = Next_Sequence_Number then /* assume data packet and process */ else /* try again to get an ACK */ Next_State := Send_File_Data_State; return; end if; case Acknowledge_Code: /* check sequence numbers match */ if Receive_Sequence_Number = Current_Sequence_Number then /* looks okay so process */ else /* reject and try again */ Next_State := Send_File_Data_State; return; end if; case Bad_Code: /* lower procedure is asking for retry */ Next_State := Send_File_Data_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* (abort_code) things are more serious: quit */ Next_State := Abort_State; return; end select; Display_Packet_Action(Out_Packet_Count); /* okay folks data sent okay: get next packet */ Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Get_Out_File_Data(Send_Packet_Data, No_More_Data); if No_More_Data then Next_State := Send_Eof_State; return else Next_State := Send_File_Data_State; return end if; end Send_File_Data_Action; %Eject(); definition Send_Eof_Action /*box KERMIT enters this state after a file has been sent and an EOF is detected */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Success is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send EOF: Unable to get ACK for EOF packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Send_Packet_Data := ""; Send_Packet(End_Of_File_Code, Current_Sequence_Number, Send_Packet_Data); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: /* check to see if NAK for next packet */ if Receive_Sequence_Number = Next_Sequence_Number then /* assume data packet and process */ else /* try again to get an ACK */ Next_State := Send_Eof_State; return; end if; case Acknowledge_Code: /* check sequence numbers match */ if Receive_Sequence_Number = Current_Sequence_Number then /* looks okay so process */ else /* reject and try again */ Next_State := Send_Eof_State; return; end if; case Bad_Code: /* lower procedure is asking for retry */ Next_State := Send_Eof_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* (abort_code) things are more serious: quit */ Next_State := Abort_State; return; end select; /* EOF has been acknowleged */ Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); /* for multiple files we will want to return to send file header if there are more files to send */ Get_Next_Out_File(Success); if Success then Next_State := Send_File_Header_State; return; else Next_State := Send_Eot_State; return; end if; end Send_Eof_Action; %Eject(); definition Send_Eot_Action /*box KERMIT enters this state when we have to break transmission */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Send EOT: Unable to get ACK for EOT packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Send_Packet_Data := ""; Send_Packet(Break_Transmission_Code, Current_Sequence_Number, Send_Packet_Data); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Negative_Acknowledge_Code: /* check to see if NAK for next packet */ if Receive_Sequence_Number = Next_Sequence_Number then /* assume data packet and process */ else /* try again to get an ACK */ Next_State := Send_Eot_State; return; end if; case Acknowledge_Code: /* check sequence numbers match */ if Receive_Sequence_Number = Current_Sequence_Number then /* looks okay so process */ else /* reject and try again */ Next_State := Send_Eot_State; return; end if; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; case Bad_Code: /* lower procedure is asking for retry */ Next_State := Send_Eot_State; return; else /* (abort_code) things are more serious: quit */ Next_State := Abort_State; return; end select; /* EOT has been acknowleged */ Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Complete_State; end Send_Eot_Action; %Eject(); definition Receive_File /*box This procedure is used to get a file from another host or micro. If the global "in_filename" is the empty string then the name in the file header packet is used for the recieved file. If the value of the global is not empty then that name will be used for the file and the name in the file header packet will be used. If the procedure is unable to get the file it returns false in the second parameter "success" and puts into the global variable "Error_message" a string describing the error. */ /* set up a return for the case of a timed out write on a remote call */ open Global_Area_Ptr@; Setup_Return_From(Rcb, Success); Success := True; Initialize_Sequence_Numbers(); Times_This_Packet_Retried := 0; Side := Receiving_Side; State := Receive_Send_Init_State; cycle select State from case Receive_Send_Init_State: State := Receive_Send_Init_Action(); case Receive_File_Header_State: State := Receive_File_Header_Action(); case Receive_File_Attribute_State: State := Receive_File_Attribute_Action(); case Receive_File_Data_State: State := Receive_File_Data_Action(); case Complete_State: return; case Abort_State: /* error sensed at a lower level procedure */ Success := False; return; else /* Something has gone wrong: Abort */ Success := False; Error_Message := "Program error: Unexpected state in " !! "proc " !! %Current_Procedure !! "."; return; end select; end cycle; end Send_File; %Eject(); definition Receive_Send_Init_Action /*box KERMIT enters this state when it is waiting for a "send init" from another KERMIT. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Init_Data is Packet_Data_Type; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Receive Send Init: Unable to get " !! "packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Send_Init_Code: /* get his parameters and send our parameters */ Get_Your_Packet_Parameters(Receive_Data); Get_My_Packet_Parameters(Init_Data); /* here is where the final adjusment for 8 bit, repeat, and checksum type takes place */ Send_Packet(Acknowledge_Code, Current_Sequence_Number, Init_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Header_State; return; case Bad_Code: /* garbled packet */ Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, ""); Next_State := Receive_Send_Init_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else /* (abort_code) things are more serious: quit */ Next_State := Abort_State; return; end select; end Receive_Send_Init_Action; %Eject(); definition Receive_File_Header_Action /*box KERMIT enters this state when it is waiting for a "file header" from another KERMIT. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Send_Data is Packet_Data_Type, Success is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Receive File Header: Unable to get " !! "packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Send_Init_Code: Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File Header : Unable to get" !! " packet (send init instead)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* lost our ACK so send ACK again with our parameters */ Get_My_Packet_Parameters(Send_Data); Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Header_State; return; else Error_Message := "Receive File Header: Unable to get " !! "packet (send init instead)"; Next_State := Abort_State; return; end if; case End_Of_File_Code: Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File Header : Unable to get" !! " packet (EOF instead)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* lost our ACK so send ACK again */ Send_Data := ""; Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Header_State; return; else Error_Message := "Receive File Header: Unable to get " !! "packet (EOF instead)."; Next_State := Abort_State; return; end if; case File_Header_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* have to abort */ Error_Message := "Receive file header: bad sequence number."; Next_State := Abort_State; return; end if; if In_Filename = "" then /* use the filename received for the file */ /* convert it to ebcdic */ Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0), Length(Receive_Data)); In_Filename := Receive_Data; if Debug then Debug_String(" Incoming filename !" !! In_Filename !! "!"); end if; if not Remote_Kermit and Simple_Receive then Write_To_User(" Incoming filename '" !! In_Filename !! "'"); end if; Simple_Receive := False; end if; /* set default mts file info junk */ Mts_File_Info := Default_Mts_File_Info; /* acknowledge file header */ Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Attribute_State; return; case Break_Transmission_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* abort */ Error_Message := "Receive File Header: Bad sequence number for " !! "EOT"; Next_State := Abort_State; return; end if; /* acknowledge Break of transmission */ Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Next_State := Complete_State; return; case Bad_Code: /* packet garbled */ Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, ""); Next_State := Receive_File_Header_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else Error_Message := "Receive File Header: unexpected packet type"; Next_State := Abort_State; return; end select; end Receive_File_Header_Action; %Eject(); definition Receive_File_Attribute_Action /*box KERMIT enters this state when it is receiving file attributes. Only a few file attributes are checked. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Send_Data is Packet_Data_Type, Success is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Receive File attribute: Unable to get " !! "packet."; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case File_Attribute_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* wrong packet */ Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File Attribute : Unable to get" !! " Attributes (too many retries)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* acknowledge last packet */ Send_Data := ""; Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Attribute_State; return; else Error_Message := "Receive File Attribute: Bad sequence number" !! " for packet."; Next_State := Abort_State; return; end if; end if; /* decipher file attributes */ if Debug then variable Text is Varying_String; Text := Receive_Data; Ascii_To_Mts_Ebcdic(Substring(Text, 0), Length(Text)); Debug_String(" Received Attributes: " !! Text); end if; Decode_File_Attributes(Receive_Data); Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Attribute_State; case Data_Packet_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* have to abort */ Error_Message := "Receive File Attribute: 1st data packet: " !! "bad sequence number."; Next_State := Abort_State; return; end if; /* open file */ Open_In_File(Success); if not Success then Next_State := Abort_State; return; else /* if have terminal notify packet is being received */ end if; Display_Packet_Action(In_Packet_Count); /* write the data to the file */ variable Put_Success is Boolean; Put_In_File_Data(Receive_Data, Put_Success); if not Put_Success then if Debug then Debug_String(" Put_in_file_data error in " !! %Current_Procedure); end if; Next_State := Abort_State; return; end if; Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Data_State; case File_Header_Code: Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File Attribute : Unable to get" !! " data or attribute packet (file header instead)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* lost our ACK so send ACK again */ Send_Data := ""; Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Attribute_State; return; else Error_Message := "Receive File Attribute: Unable to get " !! "data or attribute packet (file header instead)."; Next_State := Abort_State; return; end if; case End_Of_File_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* have to abort */ Error_Message := "Receive file Attribute: bad sequence number " !! "(EOF)"; Next_State := Abort_State; return; end if; Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); /* no file sent return to header state */ Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Header_State; return; case Bad_Code: /* packet garbled */ Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, ""); Next_State := Receive_File_Attribute_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else Error_Message := "Receive File Attribute: unexpected packet type."; Next_State := Abort_State; return; end select; end Receive_File_Attribute_Action; %Eject(); definition Receive_File_Data_Action /*box KERMIT enters this state when it is putting data from another KERMIT into a file. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Send_Data is Packet_Data_Type, Success is Boolean; open Global_Area_Ptr@; Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := "Receive File Data: Unable to get " !! "packet"; Next_State := Abort_State; return; else Times_This_Packet_Retried +:= 1; end if; Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Data_Packet_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* wrong packet */ Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File Data : Unable to get" !! " packet (too many retries)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* acknowledge last packet */ Send_Data := ""; Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Data_State; return; else Error_Message := "Receive File data: Bad sequence number" !! " for packet"; Next_State := Abort_State; return; end if; end if; Display_Packet_Action(In_Packet_Count); /* write the data to the file */ variable Put_Success is Boolean; Put_In_File_Data(Receive_Data, Put_Success); if not Put_Success then if Debug then Debug_String(" Bad put data in " !! %Current_Procedure); end if; Next_State := Abort_State; return; end if; Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Data_State; case File_Header_Code: Check_For_Retries(Times_Last_Packet_Retried); if Times_Last_Packet_Retried >= Max_Retries then Error_Message := "Receive File data : Unable to get" !! " packet (file header instead)"; Next_State := Abort_State; return; else Times_Last_Packet_Retried +:= 1; end if; if Receive_Sequence_Number = Last_Sequence_Number then /* lost our ACK so send ACK again */ Send_Data := ""; Send_Packet(Acknowledge_Code, Last_Sequence_Number, Send_Data); Times_This_Packet_Retried := 0; Next_State := Receive_File_Data_State; return; else Error_Message := "Receive File data: Unable to get " !! "packet (file header instead)."; Next_State := Abort_State; return; end if; case End_Of_File_Code: if Receive_Sequence_Number ^= Current_Sequence_Number then /* have to abort */ Error_Message := "Receive file data: bad sequence number " !! "(EOF)"; Next_State := Abort_State; return; end if; Send_Data := ""; Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); /* close file */ if Length(File_Buffer_Ptr@) > 0 then Write_In_File_Buffer(Success); File_Buffer_Ptr@ := ""; if not Success then /* Unable to complete writing file - abort */ Next_State := Abort_State; return; end if; end if; /* apply final attributes to file */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; open Mts_File_Info; if Mf_Nosave then Control_Command := "nosave"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, In_File.File_Unit, Control_Return_Info return code Control_Rc); end if; /* put the pkey on the file */ Control_Command := "pkey=" !! Mf_Pkey; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, In_File.File_Unit, Control_Return_Info return code Control_Rc); /* Clean up, get rid of Fdub */ Freefd(In_File.File_Unit.Fdub); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Next_State := Receive_File_Header_State; return; case Bad_Code: /* packet got garbled */ Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, ""); Next_State := Receive_File_Data_State; return; case Error_Code: Handle_Received_Error(Receive_Data); Next_State := Abort_State; return; else Error_Message := "Receive File Data Action : unexpected packet type."; Next_State := Abort_State; return; end select; end Receive_File_Data_Action; %Eject(); definition Send_Packet /*box This procedure takes a packet type and its data as input, builds a packet and ships it off to the other KERMIT. The procedure does the checksum computation. */ variable I is Integer, Checksum is Integer, Packet_Header is Packet_Header_Type, Data_Length is Packet_Data_Length_Type, Packet_Char_Count is bit(8); open Global_Area_Ptr@; /* initialize buffer and insert padding */ Send_Buffer := ""; do I := 1 to Your_Padding_Count Send_Buffer !!:= Your_Padding_Character; end do; open Packet_Header; Ph_Mark := Your_Start_Of_Packet_Character; Data_Length := Length(Packet_Data); Packet_Char_Count := Data_Length + Non_Data_Count; /* accumulate checksum for package */ Char(Packet_Char_Count); /* make printable */ Ph_Count := Packet_Char_Count; Checksum := Ph_Count; Ph_Sequence_Number := Sequence_Number; Char(Ph_Sequence_Number); Checksum +:= Ph_Sequence_Number; Ph_Type := Packet_Type; Checksum +:= Ph_Type; /* put header into packet */ equate Packet_Header_Char to Packet_Header as Packet_Header_Character_Type; Send_Buffer !!:= Packet_Header_Char; /* put in the data */ Send_Buffer !!:= Packet_Data; equate Int_Data to Substring(Packet_Data, 0) as Packet_Int_Data_Type; do I := 1 to Data_Length Checksum +:= Int_Data(I); end do; Checksum := (Checksum + (Checksum & Bits_76) / Checksum_Modulo) & Bits_543210; variable Checksum_Char is bit(8); Checksum_Char := Checksum; Char(Checksum_Char); Send_Buffer !!:= Checksum_Char; Send_Buffer !!:= Your_End_Of_Line_Character; /* send buffer */ if Debug then variable Readable_Packet_Type is bit(8); Readable_Packet_Type := Packet_Type; Ascii_To_Mts_Ebcdic(Readable_Packet_Type, 1); Debug_String(" Packet sent: data length " !! Integer_To_Varying(Length(Packet_Data), 2) !! " number " !! Integer_To_Varying(Sequence_Number, 2) !! " type " !! Readable_Packet_Type); end if; if Remote_Kermit then if Output_Unit_Device_Type = "3270" then Write_To_User(" KERMIT won't treat a 3270 like a micro]"); if Debug then Debug_String(" KERMIT won't treat a 3270 like a micro]") ; end if; Return_From(Entry_Rcb, Integer(99)); end if; Write_Packet(Output_Unit, Send_Buffer); Increment_Packet_Count(Out_Packet_Count); else Send_Remote_Packet(); end if; end Send_Packet; %Eject(); definition Send_Remote_Packet /*box This procedure sends the next packet to a mounted unit. The X25_timer is used to prevent deadlocks. */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; /*box If possible the X25_timer is set so as to avoid write deadlocks. If the timer goes off a rc of 20 is given for the write. A rc of 12 will be returned if the network dies. */ open Global_Area_Ptr@; Write_Packet(Remote_Unit, Send_Buffer); open Remote_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 12 then /* have a call cleared situation, abort */ Error_Message := "Line unexpectedly disconnected - " !! "(write) transmission ceases"; /* have to abort. Do a long jump */ Return_From(Rcb, Boolean(False)); end if; if Last_Return_Code = 20 then /* have a timeout on write, quit. */ Error_Message := "Timed out on remote write."; /* Have to abort. Do a long jump */ Return_From(Rcb, Boolean(False)); end if; end if; Increment_Packet_Count(Out_Packet_Count); end Send_Remote_Packet; %Eject(); definition Receive_Packet /*box This procedure gets the next packet from the input buffer. It returns the type of packet found, the packets sequence number, and the data in the packet. */ constant Zero_Parity_Bit is '7F'; variable Success is Boolean, /* true if there is a "next character" in buffer */ Next_Character is bit(8), /* next character in buffer */ Got_Packet is Boolean; open Global_Area_Ptr@; /*box This macro gets the next character from the input buffer. It keeps a private variable next_character_position that should be set to 0 before the first call is made. Beware of this if you modify this macro. */ variable Next_Character_Position is Short_Integer; macro Get_Character parameters are String, Next_Character, Success; if Next_Character_Position >= Length(String) /* one beyond last position */ then Success := False; else Next_Character := Substring(String, Next_Character_Position, 1); Success := True; Next_Character_Position +:= 1; end if; end macro Get_Character; /* initialize return values so they don't have to be set on an unexpected return */ Packet_Type := Bad_Code; Sequence_Number := Current_Sequence_Number; Packet_Data := ""; /*box We'll assume that a Kermit packet will contain a valid start of packet character. If such a packet does no arrive we'll ignore it at this point and get a new line. This should help the situation where we have remote garbage generated during start up etc. Should reduce the chances of mis synchronization. */ cycle /* get the buffer */ if Remote_Kermit then Get_Local_Packet(Got_Packet); else Get_Remote_Packet(Got_Packet); end if; if not Got_Packet then Packet_Type := Abort_Code; return; end if; if Debug then Debug_String(" Packet received:"); Readable_Receive_Buffer := " text: "; end if; /* initialize string buffer position */ Next_Character_Position := 0; /* scan for the start of the packet */ cycle Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* call it an error */ if Debug then Debug_String( " Unable to find start of packet character " !! "in line. Going back for more."); Dump_Receive_Buffer(); end if; repeat ; end if; if Next_Character = My_Start_Of_Packet_Character then /* header found */ exit ; end if; end cycle; end cycle ; /* build packet and check the checksum */ variable Checksum is Integer, Data_Length is Packet_Data_Length_Type, Temp is Integer, Temp_Length is Integer; /* used to check length before assigning */ cycle /* get packet character count */ Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* have an error */ if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; /* clear parity bit */ Next_Character &:= Zero_Parity_Bit; if Next_Character = My_Start_Of_Packet_Character then /* resychronize */ repeat; end if; Checksum := Next_Character; Temp_Length := Unchar(Next_Character); /* packet character count */ Temp_Length := Temp_Length - Non_Data_Count; if Temp_Length < 0 or Temp_Length > Max_Data_Length then if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; Data_Length := Temp_Length; if Debug then Readable_Receive_Buffer !!:= "data length " !! Integer_To_Varying(Data_Length, 2); end if; /* get sequence number */ Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* bad packet: try again */ if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; /* clear parity bit */ Next_Character &:= Zero_Parity_Bit; if Next_Character = My_Start_Of_Packet_Character then /* resychronize packet */ repeat; end if; Checksum +:= Next_Character; Temp := Unchar(Next_Character); if Temp < 0 or Temp > Sequence_Number_Modulo - 1 then Packet_Type := Bad_Code; return; end if; Sequence_Number := Temp; if Debug then Readable_Receive_Buffer !!:= " number " !! Integer_To_Varying(Sequence_Number, 2); end if; /* Get the packet type */ Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* bad packet: try again */ if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; /* clear parity bit */ Next_Character &:= Zero_Parity_Bit; if Next_Character = My_Start_Of_Packet_Character then /* resychronize packet */ repeat; end if; Checksum +:= Next_Character; Packet_Type := Next_Character; if Debug then variable Readable_Packet_Type is bit(8); Readable_Packet_Type := Packet_Type; Ascii_To_Mts_Ebcdic(Readable_Packet_Type, 1); Readable_Receive_Buffer !!:= " type " !! Readable_Packet_Type; end if; /* Now get the data portion of the packet */ Packet_Data := ""; variable I is Short_Integer, Temp_Character is bit(8); do I := 1 to Data_Length; Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* unexpected end: try again */ if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; Temp_Character := Next_Character & Zero_Parity_Bit; if Temp_Character = My_Start_Of_Packet_Character then /* resychronize packet */ repeat ; end if; if Clear_Parity_Bit then Next_Character := Temp_Character; end if; Checksum +:= Next_Character; Packet_Data !!:= Next_Character; end do; /* get the checksum */ Get_Character(Receive_Buffer, Next_Character, Success); if not Success then /* unexpected end: try again */ if Debug then Debug_String(" Bad return from " !! %Current_Procedure !! " line " !! Line_Number_To_Varying(%Source_Line, 0) !! " co-ord " !! Integer_To_Varying(%Coordinate, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; /* clear parity bit */ Next_Character &:= Zero_Parity_Bit; if Next_Character = My_Start_Of_Packet_Character then /* resychronize packet */ repeat; end if; exit; end cycle ; /* check that the checksums match */ Temp := Unchar(Next_Character); Checksum := (Checksum + (Checksum & Bits_76) / Checksum_Modulo) & Bits_543210; if Debug then Debug_String(Readable_Receive_Buffer); end if; if Temp = Checksum then /* we have a good packet */ return; else if Debug then Debug_String(" Bad checksum in received packet."); Debug_String(" Received checksum: " !! Integer_To_Varying(Next_Character, 0) !! " Calculated checksum: " !! Integer_To_Varying(Checksum, 0)); Dump_Receive_Buffer(); end if; Packet_Type := Bad_Code; return; end if; end Receive_Packet; %Eject(); definition Get_Local_Packet /*box This procedure reads the next packet from the normal input unit. If the input is a network terminal it also does a timeout. */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type, Nak_Data is Packet_Data_Type, Timeout_Retry_Count is Short_Integer; /*box Set Timeout: this is a kluge that will work on UBCnet. In standard MTS there is no way to timeout an I/O operation but on UBCnet there is a control command that allows you set a timer (Read_timer n). If there is no response within in that time the Read subroutine will respond with a return code of 20. */ open Global_Area_Ptr@; if Input_Unit_Device_Type = "3270" then Write_To_User(" KERMIT won't treat a 3270 like a micro]"); if Debug then Debug_String(" KERMIT won't treat a 3270 like a micro]"); end if; Return_From(Entry_Rcb, Integer(99)); end if; Timeout_Retry_Count := 0; cycle if Mode = User_Mode or Side = Sending_Side then /* timeout retries only when not a waiting server */ if Timeout_Retry_Count > Max_Timeout_Retries then Success := False; Error_Message := "Timeout retry count exceeded"; return; else Timeout_Retry_Count +:= 1; end if; end if; /* try the read_timer command */ if Can_Set_Read_Timer then /* Initially we assume we can set read_timer: once we fail we don't bother again. */ Mask_Attn(); Control_Command := "read_timer " !! Your_Timeout_Char; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then /* can't set timer interval */ Can_Set_Read_Timer := False; Reenable_Attn(); if Debug then open Control_Return_Info; Debug_String( " Unable to set timer interval (won't try any more]): " ); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Set_Um_Binary_On then /* @bin has to be implemented using control command at um */ Control_Command := "binary=on"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to turn on ASCII input: "); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; /* DO THIS ONCE :: Telenet WIDTH parameter must be cleared */ if not Telenet_Width_Set then Control_Command := "set 10:0"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to SET 10:0 for Telenet: "); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; Telenet_Width_Set := True; end if; end if; Read_Packet(Input_Unit, Receive_Buffer); if Set_Um_Binary_On then /* @bin has to be implemented using control command at um */ Control_Command := "binary=off"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to turn off ASCII input: "); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Can_Set_Read_Timer then /* clear the read timer and re-enable attn's */ Control_Command := "read_timer off"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then /* Should never happen but just in case */ open Control_Return_Info; Debug_String(" Unable to set timer interval: "); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; Reenable_Attn(); end if; Increment_Packet_Count(In_Packet_Count); open Input_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 20 then /* have a timeout send NAK if receiving or resend the last packet if sending */ if Side = Receiving_Side then Total_Retries +:= 1; Nak_Data := ""; Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, Nak_Data); else /* sending side */ if Debug then Debug_String(" Sending a timeout repeat"); end if; Total_Retries +:= 1; Write_Packet(Output_Unit, Send_Buffer); Increment_Packet_Count(Out_Packet_Count); end if; repeat; else /* something is drastically wrong: abort */ Success := False; Error_Message := "Unexpected end of packets found."; return; end if; end if; exit; end cycle; Success := True; end Get_Local_Packet; %Eject(); definition Get_Remote_Packet /*box This procedure reads the next packet from a mounted unit. The X25_timer is used to prevent deadlocks. */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type, Nak_Data is Packet_Data_Type, Timeout_Retry_Count is Short_Integer; /*box Set Timeout: this is a way to prevent deadlocks on the remote unit. The X25_timer is set to go off if there is no response within a specified period. If the call is clears it resonds with a rc of 12. If there is no response within in that time the Read subroutine will respond with a return code of 20. */ open Global_Area_Ptr@; Timeout_Retry_Count := 0; cycle if Mode = User_Mode or Side = Sending_Side then /* timeout retries only when not a waiting server */ if Timeout_Retry_Count > Max_Timeout_Retries then Success := False; Error_Message := "Timeout retry count exceeded"; return; else Timeout_Retry_Count +:= 1; end if; end if; if Set_Um_Binary_On then /* @bin has to be implemented using control command at um */ Control_Command := "binary=on"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Remote_Unit.File_Unit, Control_Return_Info return code Control_Rc); end if; Read_Packet(Remote_Unit, Receive_Buffer); if Set_Um_Binary_On then /* @bin has to be implemented using control command at um */ Control_Command := "binary=off"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Remote_Unit.File_Unit, Control_Return_Info return code Control_Rc); end if; Increment_Packet_Count(In_Packet_Count); open Remote_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 12 then /* have a call cleared situation, abort */ Error_Message := " Line unexpectedly disconnected - " !! "transmission ceases"; Success := False; return; end if; if Last_Return_Code = 20 then /* have a timeout send NAK if receiving or resend the last packet if sending */ if Side = Receiving_Side then Total_Retries +:= 1; Nak_Data := ""; Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, Nak_Data); else /* sending side */ /* resend the buffer */ Total_Retries +:= 1; Send_Remote_Packet(); if Debug then Debug_String(" Sending a timeout repeat"); end if; /* Its possible to abort at this point */ end if; repeat; else /* something is drastically wrong: abort */ Success := False; Error_Message := "Unexpected end of packets found."; return; end if; end if; exit; end cycle; Success := True; end Get_Remote_Packet; %Eject(); definition Dump_Receive_Buffer /*box This procedure is used to dump the received buffer in hex etc. */ constant Dump_Width is 35; variable Start is Integer; open Global_Area_Ptr@; Debug_String(" Receive buffer in ASCII: "); Start := 0; cycle if Start >= Length(Receive_Buffer) then exit; end if; Debug_String(" " !! String_To_Hex_Varying(Substring(Receive_Buffer, Start, Min(Length(Receive_Buffer) - Start, Dump_Width)))); Start +:= Dump_Width; end cycle; Debug_String(Readable_Receive_Buffer); end Dump_Receive_Buffer; %Eject(); definition Get_My_Packet_Parameters /*box This procedure initializes the data for the send initalize packet. */ variable Send_Init_Packet is Packet_Parameters_Type; open Global_Area_Ptr@; open Send_Init_Packet; equate Send_Init_Character_Parameters to Send_Init_Packet as Packet_Parameters_Character_Type; Pp_Buffer_Size := My_Packet_Length; Char(Pp_Buffer_Size); Pp_Timeout := My_Timeout; Char(Pp_Timeout); Pp_Padding_Count := My_Padding_Count; Char(Pp_Padding_Count); Pp_Padding_Character := My_Padding_Character; Ctl(Pp_Padding_Character); Pp_End_Of_Line_Character := My_End_Of_Line_Character; Char(Pp_End_Of_Line_Character); Pp_Quote_Character := My_Quote_Character; /* In future add hand shaking determination */ Pp_8_Bit_Quote_Character := Eight_Bit_Quote_Character; /* adjust in the future for more flexible approach */ Pp_Checksum_Type := Checksum_To_External(Checksum_Kind); Pp_Repeat_Character := My_Repeat_Character; Pp_Capability_Byte_1 := Capability_Byte_1; equate Pp_Byte to Pp_Capability_Byte_1 as bit(8); Char(Pp_Byte); Send_Init_Data := Send_Init_Character_Parameters; end Get_My_Packet_Parameters; %Eject(); definition Get_Your_Packet_Parameters /*box This procedure gets the packet parameters sent back by the other KERMIT sets his packet parameters accordingly. */ variable Unchared_Value is Short_Integer; open Global_Area_Ptr@; /* blanks are used to indicate default vaules so indicate default for any missing paraameters */ if Length(Packet_Data) < Byte_Size(Packet_Parameters_Type) then variable I is Short_Integer; do I := 1 to Byte_Size(Packet_Parameters_Type) - Length(Packet_Data) Packet_Data !!:= Ascii_Space; end do; end if; equate Packet_Parameters to Substring(Packet_Data, 0) as Packet_Parameters_Type; open Packet_Parameters; Unchared_Value := Unchar(Pp_Buffer_Size); if Unchared_Value <= 0 then Your_Packet_Length := Default_Packet_Length; else Your_Packet_Length := Unchared_Value; end if; Unchared_Value := Unchar(Pp_Timeout); if Unchared_Value <= 0 then Your_Timeout := Default_Timeout; else Your_Timeout := Unchared_Value; if Your_Timeout < Min_Timeout then Your_Timeout := Min_Timeout; elseif Your_Timeout > Max_Timeout then Your_Timeout := Max_Timeout; end if; end if; Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0); Unchared_Value := Unchar(Pp_Padding_Count); if Pp_Padding_Count <= 0 then Your_Padding_Count := Default_Padding_Count; else Your_Padding_Count := Unchared_Value; end if; Ctl(Pp_Padding_Character); if Pp_Padding_Character = 0 then Your_Padding_Character := Default_Padding_Character; else Your_Padding_Character := Pp_Padding_Character; end if; Unchared_Value := Unchar(Pp_End_Of_Line_Character); if Unchared_Value <= 0 then Your_End_Of_Line_Character := Ascii_Cr; else Your_End_Of_Line_Character := Unchared_Value; end if; if Pp_Quote_Character = Ascii_Space then Your_Quote_Character := Ascii_# else Your_Quote_Character := Pp_Quote_Character; end if; /* 8 bit quoting */ /* check sum checks */ /* repeat count */ equate Pp_Byte to Pp_Capability_Byte_1 as bit(8); Unchared_Value := Unchar(Pp_Byte); if Unchared_Value <= 0 then Send_File_Attributes := False; else variable Pp_Capability_Byte_Byte is bit(8); Pp_Capability_Byte_Byte := Unchared_Value; equate Pp_Capability_Byte_Bits to Pp_Capability_Byte_Byte as Capability_Byte_1_Type; open Pp_Capability_Byte_Bits; if Cb1_Accept_File_Attributes then Send_File_Attributes := True; else Send_File_Attributes := False; end if; end if; end Get_Your_Packet_Parameters; %Eject(); definition Open_Out_File /*box This procedure checks to see that the file given in the global variable "out_filename" can be opened (ie. exists and is accessable). */ variable Access is bit(32), Rc is Integer, Temp_String is character(Max_Data_Length), Catalog_Info is Catalog_Info_Type, File_Info is File_Info_Type, Sharing_Info is Sharing_Info_Type, Ret_Filename is Returned_File_Name_Type, Error_Code is Integer, Error_Msg is character(80), Gfinfo_Rc is Integer; open Global_Area_Ptr@; Success := True; /* check the validity of the out going filename */ if not Parse(Pcb, Check_Mts_Filename, Address(Substring(Out_Filename, 0)), Length(Out_Filename)) then Error_Message := "First name invalid MTS filename."; Success := False; return; end if; Temp_String := Substring(Out_Filename, 0) !! " "; Access := Chkfile(Temp_String return code Rc); if Rc > 0 or (Access & Read_Access) ^= Read_Access then /* file does not exist or is not accessable */ Error_Message := "Mts file doesn't exist or inaccessible"; Success := False; return; end if; /* make sure we really can open the file */ Initialize_File_With_Name(Out_File, Out_Filename, Out_File_Io_Modifiers, Rc); if Rc > 0 then /* couldn't get fdub */ Error_Message := "Unable to open Mts file."; Success := False; return; end if; /* grab file info */ open Catalog_Info; open File_Info; Sharing_Info.Si_Array_Length := 0; Ci_Array_Length := Byte_Size(Catalog_Info_Type) / 4; Fi_Array_Length := Byte_Size(File_Info_Type) / 4; Ret_Filename.Scratch := 0; Gfinfo(Out_File.File_Unit.Fdub, Ret_Filename, Gf_Fdub, Catalog_Info, File_Info, Sharing_Info, Error_Code, Error_Msg return code Gfinfo_Rc); if Gfinfo_Rc ^= 0 then if Debug then if Gfinfo_Rc = 4 then Debug_String(" GFINFO: " !! Error_Msg); else Debug_String(" GFINFO: Bad parameters."); end if; end if; Error_Message := "Unable to open Mts file. No file info."; Success := False; return; end if; if Fi_File_Organization = Sequential_File then File_Is_Line := False; else File_Is_Line := True; end if; if File_Kind = Text_File_Kind then Expected_Packets := Fi_Copied_Size * Expected_Text_Packets_Per_Page; else Expected_Packets := Fi_Copied_Size * Expected_Binary_Packets_Per_Page; end if; File_Attribute_Data := ""; /* Grab the file attribute data now just in case we need it later */ /* First get the file length in K bytes */ variable File_Length_String is character(0 to 12), File_Length_Length is bit(8); /* send length in K bytes */ File_Length_String := Integer_To_Varying(Fi_Copied_Size * 4, 0); File_Length_Length := Length(File_Length_String); Mts_Ebcdic_To_Ascii(Substring(File_Length_String, 0), Length(File_Length_String)); Char(File_Length_Length); File_Attribute_Data := Length_File_Attribute !! File_Length_Length !! File_Length_String; /* Now send file organization */ variable File_Type is bit(8), File_Type_Length is bit(8); select File_Kind from case Text_File_Kind: File_Type := Ascii_A; /* Ascii file */ case Binary_File_Kind: File_Type := Ascii_B; /* Binary file */ case Mts_Binary_File_Kind: if Fi_File_Organization = Sequential_File then File_Type := Ascii_S; else File_Type := Ascii_L; end if; else File_Type := Ascii_A; end select; File_Type_Length := Byte_Size(File_Type); Char(File_Type_Length); File_Attribute_Data !!:= Type_File_Attribute !! File_Type_Length !! File_Type; if File_Kind = Mts_Binary_File_Kind then /* Check remote filename is valid */ if Remote_Filename ^= "" then /* have a different remote name */ if not Parse(Pcb, Check_Mts_Filename, Address(Substring(Remote_Filename, 0)), Length(Remote_Filename)) then Error_Message := "Second name invalid MTS filename."; Success := False; return; end if; end if; /* names are valid */ /* build special mts file attribute */ variable Mts_File_Attribute_Data is Mts_File_Attribute_Type, Mts_File_Attribute_Length is bit(8); open Mts_File_Attribute_Data; Mfa_Maxsize_String := Substring(Integer_To_Varying(Fi_Maxsize, 5), 0); Mts_Ebcdic_To_Ascii(Mfa_Maxsize_String, Length(Mfa_Maxsize_String)); if Ci_Nosave then Mfa_Nosave := Ascii_N; else Mfa_Nosave := Ascii_S; end if; Mfa_Pkey := Ci_Pkey; Mts_Ebcdic_To_Ascii(Mfa_Pkey, Length(Mfa_Pkey)); Mts_File_Attribute_Length := Byte_Size(Mts_File_Attribute_Type); Char(Mts_File_Attribute_Length); equate Buffer to Mts_File_Attribute_Data as character(Byte_Size(Mts_File_Attribute_Type)); File_Attribute_Data !!:= Mts_File_Attribute !! Mts_File_Attribute_Length !! Buffer; end if; /* initialize the output buffer */ File_Buffer_Ptr@ := ""; Out_File_End_Of_File := False; Next_Out_File_Character_Position := 0; Current_Line_Number := 0; Is_First_Out_File_Record := True; if File_Is_Line then Set_First_Line(Out_File); end if; Mts_Binary_State := Start_Mts_Binary_Linenumber_State; end Open_Out_File; %Eject(); definition Flush_Input_Unit /*box This procedure is called before beginning transmission to get rid of any pending input for the packet buffer. This may include unwanted NAK's. Not sure how to do this? Perhaps a timed out read? */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; open Global_Area_Ptr@; if Remote_Kermit then if Debug then Debug_String(" CONTROL: flush"); end if; Control_Command := "flush"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to flush timer:"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; end Flush_Input_Unit; %Eject(); definition Get_Next_Out_File /*box This procedure is called to put the next filename into the global variable out_filename when several files in pattern are being sent. For this version this capability does not exist. */ open Global_Area_Ptr@; Success := False; end Get_Next_Out_File; %Eject(); definition Get_Next_Out_File_Character /*box This procedure gets the next character from the file. It uses the global variable "out_file_buffer" to keep the files records in. */ open Global_Area_Ptr@; Success := True; if Next_Out_File_Character_Position >= Length(File_Buffer_Ptr@) then cycle /* buffer empty: must get next record */ if Out_File_End_Of_File then /* already have end of file */ Success := False; return; end if; Read_Long_Varying(Out_File, File_Buffer_Ptr@); open Out_File; if Last_Return_Code > 0 then /* plumb out of characters */ Out_File_End_Of_File := True; /* Clean up */ Freefd(Out_File.File_Unit.Fdub); Success := False; return; end if; if Is_First_Out_File_Record then if File_Is_Line then Set_Next_Line(Out_File); end if; Is_First_Out_File_Record := False; end if; /* should always be something in line but just in case */ exit unless Length(File_Buffer_Ptr@) <= 0; end cycle; /* check to see if CRLF has to be added for a text file */ if File_Kind = Text_File_Kind then /* first convert MTS EBCDIC to ASCII */ variable Chunk_Position is Integer, Chunk_Length is Short_Integer; Chunk_Position := 0; Chunk_Length := Min(Length(File_Buffer_Ptr@), Standard_String_Length); cycle exit when Chunk_Length <= 0; Mts_Ebcdic_To_Ascii(Substring(File_Buffer_Ptr@, Chunk_Position, 0), Chunk_Length); Chunk_Position +:= Chunk_Length; Chunk_Length := Min(Length(File_Buffer_Ptr@) - Chunk_Position, Standard_String_Length); end cycle; /* restrict text file records to two bytes less than max record length for now */ if Length(File_Buffer_Ptr@) <= Long_String_Length - 2 then File_Buffer_Ptr@ !!:= Ascii_Crlf; end if; end if; Next_Out_File_Character_Position := 0; end if; Next_Character := Substring(File_Buffer_Ptr@, Next_Out_File_Character_Position, 1); Next_Out_File_Character_Position +:= 1; end Get_Next_Out_File_Character; %Eject(); definition Get_Out_File_Data /*box This procedure encodes the characters from the file so that they are suitable for use in a packet. */ constant Zero_Parity_Bit is '7F', Parity_Set is '80'; variable Next_Character is bit(8), Success is Boolean, Temp_Character is bit(8); open Global_Area_Ptr@; Packet_Data := ""; End_Of_File := False; cycle if File_Kind = Mts_Binary_File_Kind then Get_Mts_Binary_Data(Next_Character, Success) else Get_Next_Out_File_Character(Next_Character, Success); end if; if not Success then if Packet_Data = "" then /* true end of file */ End_Of_File := True; return; else /* end of packet: next call will generate EOF */ return; end if; end if; /* first encode text files */ if File_Kind = Text_File_Kind then /* clear the parity bit */ Next_Character &:= Zero_Parity_Bit; if Next_Character < Ascii_Space or Next_Character = Ascii_Del or Next_Character = Your_Quote_Character then /* have to quote the character */ Packet_Data !!:= Your_Quote_Character; if Next_Character ^= Your_Quote_Character then /* controlify the character */ Ctl(Next_Character); end if; end if; else /* file_kind = binary_file_kind */ /* at this point insert code to do eight quoting */ Temp_Character := Next_Character; Temp_Character &:= Zero_Parity_Bit; if Temp_Character < Ascii_Space or Temp_Character >= Ascii_Del or Temp_Character = Your_Quote_Character then Packet_Data !!:= Your_Quote_Character; if Temp_Character ^= Your_Quote_Character then Ctl(Next_Character); end if; end if; end if; /* add character itself (possibly modified) */ Packet_Data !!:= Next_Character; exit when Length(Packet_Data) > Your_Packet_Length - Max_Non_Data_Count - Max_Encoding_Count; end cycle; end Get_Out_File_Data; %Eject(); definition Decode_File_Attributes /*box This procedure is passed a file attribute packet and it fills in mts_file_info with the attributes sent. */ open Global_Area_Ptr@; open Mts_File_Info; variable Next_Pos is String_Length_Type; macro Next_Char; (Substring(File_Attribute_Packet, Next_Pos, 1)) end macro Next_Char; Next_Pos := 0; cycle return when Next_Pos >= Length(File_Attribute_Packet); variable File_Attribute is bit(8), File_Attribute_Length is bit(8), Unchared_Length is Short_Integer, File_Attribute_Data is Packet_Data_Type; File_Attribute := Next_Char(); Next_Pos +:= 1; /* ignore bad attributes etc. */ exit when Next_Pos >= Length(File_Attribute_Packet); File_Attribute_Length := Next_Char(); Unchared_Length := Unchar(File_Attribute_Length); if Unchared_Length < 0 then File_Attribute_Length := 0; else File_Attribute_Length := Unchared_Length; end if; variable I is String_Length_Type; File_Attribute_Data := ""; do I := 1 to File_Attribute_Length Next_Pos +:= 1; return when Next_Pos >= Length(File_Attribute_Packet); File_Attribute_Data !!:= Next_Char(); end do; if Debug then variable Ebcdic_File_Attribute is character(1), Ebcdic_File_Attribute_Length is character(0 to 3), Ebcdic_File_Attribute_Data is Packet_Data_Type; Ebcdic_File_Attribute := File_Attribute; Ascii_To_Mts_Ebcdic(Ebcdic_File_Attribute, 1); Ebcdic_File_Attribute_Length := Integer_To_Varying(File_Attribute_Length, 0); Ebcdic_File_Attribute_Data := File_Attribute_Data; Ascii_To_Mts_Ebcdic(Substring(Ebcdic_File_Attribute_Data, 0), Length(Ebcdic_File_Attribute_Data)); Debug_String(" File attribute: " !! Ebcdic_File_Attribute !! " " !! Ebcdic_File_Attribute_Length !! " " !! Ebcdic_File_Attribute_Data); end if; select File_Attribute from case Length_File_Attribute: variable Filesize is Integer; Ascii_To_Mts_Ebcdic(Substring(File_Attribute_Data, 0), Length(File_Attribute_Data)); variable Error_Ptr is pointer to Varying_String, Error_Msg is Varying_String; Error_Ptr := Address(Error_Msg); Filesize := String_To_Integer(File_Attribute_Data, Error_Ptr); if Error_Msg ^= "" then /* default the filesize to a page */ Filesize := 4; end if; Filesize := Filesize / 4; /* sent in K bytes */ if Filesize < 0 then Filesize := 1 elseif Filesize > Maximum_Short_Integer then /* assume mistake and set to max */ Filesize := Maximum_Short_Integer; end if; Mf_Copied_Size := Filesize; if File_Kind = Text_File_Kind then Expected_Packets := Filesize * Expected_Text_Packets_Per_Page; else Expected_Packets := Filesize * Expected_Binary_Packets_Per_Page; end if; case Type_File_Attribute: variable File_Type is bit(8); if File_Attribute_Length >= 1 then select Substring(File_Attribute_Data, 0, 1) from case Ascii_A: /* Have a Kermit Ascii file */ Set_Filetype_Text(); case Ascii_B: Set_Filetype_Binary(); case Ascii_L: /* MTS Line File */ Set_Filetype_Mts_Binary(); Mf_File_Organization := Line_File; case Ascii_S: /* MTS Sequential File */ Set_Filetype_Mts_Binary(); Mf_File_Organization := Sequential_File; else /* default filetype to ascii */ Set_Filetype_Text(); end select; else /* default filetype to text */ Set_Filetype_Text(); end if; case Mts_File_Attribute: /* special mts attribute: 5 byte maxsize, nosave, 16 byte pkey */ if File_Attribute_Length = Byte_Size(Mts_File_Attribute_Type) then equate Mts_File_Attribute_Data to Substring(File_Attribute_Data, 0) as Mts_File_Attribute_Type; open Mts_File_Attribute_Data; open Mts_File_Info; variable Maxsize_Temp is Integer, Error_Msg is Varying_String, Error_Ptr is pointer to Varying_String; Error_Ptr := Address(Error_Msg); Ascii_To_Mts_Ebcdic(Mfa_Maxsize_String, Length(Mfa_Maxsize_String)); Maxsize_Temp := String_To_Integer(Mfa_Maxsize_String, Error_Ptr); if Error_Msg = "" then if Maxsize_Temp > 0 and Maxsize_Temp <= Maximum_Short_Integer then Mf_Maxsize := Maxsize_Temp; else /* leave as default */ end if; else /* leave as default */ if Debug then Debug_String(" Maxsize conversion: " !! Error_Msg); end if; end if; if Mfa_Nosave = Ascii_N then Mf_Nosave := True; else /* leave as default */ end if; Ascii_To_Mts_Ebcdic(Mfa_Pkey, Length(Mfa_Pkey)); Mf_Pkey := Mfa_Pkey; end if; else /* Attribute not handled: skip */ end select; Next_Pos +:= 1; end cycle; end Decode_File_Attributes; %Eject(); definition Open_In_File /*box This procedure opens the file for incoming data. If the filename sent is an invalid filename or can't be opened for writing KERMIT puts the data into a scratch file -KERMIT. */ variable Rc is Integer, Temp_String is character(Max_Data_Length), Access is bit(32); variable File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type; open Global_Area_Ptr@; File_Buffer_Ptr@ := ""; /* clear buffer */ if File_Kind = Mts_Binary_File_Kind then Current_Line_Number := 0; if Mts_File_Info.Mf_File_Organization = Line_File then File_Io_Modifiers := In_File_Io_Modifiers ! Mts_Io_Indexed; else File_Io_Modifiers := In_File_Io_Modifiers; end if; Mts_Binary_State := Start_Mts_Binary_Linenumber_State; else File_Io_Modifiers := In_File_Io_Modifiers; end if; Pending_Cr := False; Success := True; /* check we have have a valid mts filename */ if Parse(Pcb, Check_Mts_Filename, Address(Substring(In_Filename, 0)), Length(In_Filename)) then /* see if file exists */ Temp_String := Substring(In_Filename, 0) !! " "; Access := Chkfile(Temp_String return code Rc); if Rc = 0 then /* file exists: now access */ if (Access & Write_Access) = Write_Access then /* file exists: replace contents */ Initialize_File_With_Name(In_File, In_Filename, File_Io_Modifiers, Rc); if Rc = 0 then /* all okay: empty file */ Empty(In_File.File_Unit.Fdub return code Rc); if Rc = 0 then /* file is ready for data */ return; end if; /* drop through to default file */ end if; /* drop through to default file */ end if; /* drop through to default file */ elseif Rc = Chkfile_File_Does_Not_Exist then /* create */ variable Create_Size is Create_Size_Type, Volume is Integer, File_Organization is Integer; open Create_Size; open Mts_File_Info; Maximum_Size := Mf_Maxsize; Initial_Size := Mf_Copied_Size; Volume := 0; File_Organization := Mf_File_Organization + 256; Create(Temp_String, Create_Size, Volume, File_Organization return code Rc); if Rc = 0 then /* have created file */ Initialize_File_With_Name(In_File, In_Filename, File_Io_Modifiers, Rc); if Rc = 0 then /* all okay lets return */ return; end if; /* drop through */ else /* something wrong record for debug */ if Debug then Debug_String( " Unable to create incoming file. create rc " !! Integer_To_Varying(Rc, 0)); end if; /* drop through */ end if; end if; end if; /* file couldn't be opened default to scratch */ if not Remote_Kermit then Write_To_User(" Incoming file couldn't be opened " !! Default_In_File !! " used."); else /* send text about state */ end if; Initialize_File_With_Name(In_File, Default_In_File, File_Io_Modifiers, Rc); if Rc > 0 then Success := False; return; end if; end Open_In_File; %Eject(); definition Put_In_File_Data /*box This procedure decodes the data packet and places it into an mts file. */ constant Zero_Parity_Bit is '7F'; /*box This macro grabs the next character from the packet that is being deciphered. */ open Global_Area_Ptr@; variable Next_Character_Position is Short_Integer; macro Get_Next_In_File_Character parameters are Next_Character, Success; if Next_Character_Position >= Length(Packet_Data) then Success := False; else Next_Character := Substring(Packet_Data, Next_Character_Position, 1); Next_Character_Position +:= 1; Success := True; end if; end macro; variable Next_Character is bit(8), Success is Boolean, Write_Success is Boolean, Temp_Character is bit(8); Put_Success := True; Next_Character_Position := 0; cycle Get_Next_In_File_Character(Next_Character, Success); if not Success then /* all done */ return; end if; if Next_Character = My_Quote_Character then Get_Next_In_File_Character(Next_Character, Success); if not Success then /* this should not happen. will ignore it in any case */ return; end if; Temp_Character := Next_Character & Zero_Parity_Bit; if Temp_Character ^= My_Quote_Character then Ctl(Next_Character); end if; end if; if File_Kind = Text_File_Kind then if Pending_Cr then /* have a CR look for a LF */ if Next_Character = Ascii_Lf then /* have end of text record: write it */ Write_In_File_Buffer(Write_Success); File_Buffer_Ptr@ := ""; Pending_Cr := False; if not Write_Success then Put_Success := False; return; end if; repeat; else /* not followed by LF so stash CR */ if Length(File_Buffer_Ptr@) >= In_Buffer_End then Write_In_File_Buffer(Write_Success); if not Write_Success then Put_Success := False; return; end if; File_Buffer_Ptr@ := Ascii_Cr; else File_Buffer_Ptr@ !!:= Ascii_Cr; end if; if Next_Character = Ascii_Cr then Pending_Cr := True; repeat; else Pending_Cr := False; end if; end if; else if Next_Character = Ascii_Cr then Pending_Cr := True; repeat; end if; end if; end if; /* stash the character */ if File_Kind = Mts_Binary_File_Kind then Put_Mts_Binary_Data(Next_Character, Write_Success); if not Write_Success then Put_Success := False; if Debug then Debug_String(" In " !! %Current_Procedure !! " bad " !! "put binary return"); end if; return; end if; else if Length(File_Buffer_Ptr@) >= In_Buffer_End then Write_In_File_Buffer(Write_Success); if not Write_Success then Put_Success := False; return; end if; File_Buffer_Ptr@ := Next_Character; else File_Buffer_Ptr@ !!:= Next_Character; end if; end if; end cycle; end Put_In_File_Data; %Eject(); definition Write_In_File_Buffer /*box If in_file_buffer is text it is translated before writing. */ open Global_Area_Ptr@; Success := True; if File_Kind = Text_File_Kind then variable Chunk_Position is Integer, Chunk_Length is Short_Integer; Chunk_Position := 0; Chunk_Length := Min(Length(File_Buffer_Ptr@), Standard_String_Length); cycle exit when Chunk_Length <= 0; Ascii_To_Mts_Ebcdic(Substring(File_Buffer_Ptr@, Chunk_Position, 0), Chunk_Length); Chunk_Position +:= Chunk_Length; Chunk_Length := Min(Length(File_Buffer_Ptr@) - Chunk_Position, Standard_String_Length); end cycle; end if; Write_Varying(In_File, File_Buffer_Ptr@); open In_File; if Last_Return_Code > 0 then if Debug then Debug_String(" In " !! %Current_Procedure !! " write error rc: " !! Integer_To_Varying(Last_Return_Code, 0)); end if; /* Have a serious error */ if Last_Return_Code = 4 then Error_Message := "File size exceeded"; elseif Last_Return_Code = 24 then Error_Message := "Disk allotment exceeded"; else Error_Message := "Error writing file"; end if; Success := False; end if; end Write_In_File_Buffer; %Eject(); definition Send_Error_Message /*box This procedure sends the text of an error message to the remote kermit using the "E" packet type. It does not wait for any ACK. */ /* first check error will fit packet. Trim if not */ variable Max_Error_Message_Length is Packet_Data_Length_Type, Error_Packet is Packet_Data_Type; open Global_Area_Ptr@; Max_Error_Message_Length := Your_Packet_Length - Max_Non_Data_Count; if Length(Error_Message) > Max_Error_Message_Length then Error_Packet := Substring(Error_Message, 0, Max_Error_Message_Length); else Error_Packet := Error_Message; end if; if Debug then Debug_String(" Error Packet Sent:" !! Error_Packet); end if; Mts_Ebcdic_To_Ascii(Substring(Error_Packet, 0, 0), Length(Error_Packet)); Send_Packet(Error_Code, Current_Sequence_Number, Error_Packet); end Send_Error_Message; %Eject(); definition Server_Node /*box This procedure is called when the user requests that KERMIT go into server mode. In server mode KERMIT talks directly to another kermit rather than through the user interface. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Init_Data is Packet_Data_Type, Receive_Data is Packet_Data_Type; open Global_Area_Ptr@; /* set up a long return for a timed out remote write. This should never be the case for a server node since they are always remote */ Setup_Return_From(Rcb, Success); Success := True; Mode := Server_Mode; cycle Initialize_Sequence_Numbers(); Times_This_Packet_Retried := 0; Side := Receiving_Side; Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Send_Init_Code: variable Receive_Success is Boolean; /* get his parameters and send our parameters */ Get_Your_Packet_Parameters(Receive_Data); Get_My_Packet_Parameters(Init_Data); /* here is where the final adjusment for 8 bit, repeat, and checksum type takes place */ Send_Packet(Acknowledge_Code, Current_Sequence_Number, Init_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); In_Filename := ""; Server_Receive_File(Receive_Success); if Receive_Success then if Debug then Debug_String( " Server mode: file received successfully."); end if; else Handle_Error(); end if; case Receive_Init_Code: variable Open_Success, Send_Success is Boolean; /* convert the received data */ Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0), Length(Receive_Data)); Out_Filename := Receive_Data; Open_Out_File(Open_Success); if Open_Success then Send_File(Send_Success); if Send_Success then if Debug then Debug_String( " Server mode: file sent successfully"); end if; else Handle_Error(); end if; else Handle_Error(); end if; case Generic_Command_Code: variable Quit is Boolean, Generic_Success is Boolean; Do_Generic_Command(Receive_Data, Quit, Generic_Success); if Quit then exit; end if; if not Generic_Success then Handle_Error(); end if; case Host_Command_Code: /* to be done sometime */ case Bad_Code: /* packet garbled */ Send_Packet(Negative_Acknowledge_Code, Current_Sequence_Number, ""); case Error_Code: if Debug then Debug_String(" Error Received: " !! Receive_Data); end if; else end select; end cycle; Mode := User_Mode; end Server_Node; %Eject(); definition Server_Receive_File /* This procedure is called from the server node to receive a file */ open Global_Area_Ptr@; Success := True; State := Receive_File_Header_State; cycle select State from case Receive_File_Header_State: State := Receive_File_Header_Action(); case Receive_File_Attribute_State: State := Receive_File_Attribute_Action(); case Receive_File_Data_State: State := Receive_File_Data_Action(); case Complete_State: return; case Abort_State: /* error sensed at a lower level procedure */ Success := False; return; else /* Something has gone wrong: Abort */ Success := False; Error_Message := "Program error: Unexpected state in " !! "proc " !! %Current_Procedure !! "."; return; end select; end cycle; end Server_Receive_File; %Eject(); definition Do_Generic_Command /*box This procedure is called when a generic command is sent to the KERMIT server. If the generic commandis a request to terminate the server the boolean "quit" is set to true. The Boolean success is set if things abort. */ variable Send_Data is Packet_Data_Type, Generic_Command is character(1); open Global_Area_Ptr@; Send_Data := ""; Quit := False; Success := True; /* on entry the generic command packet is passed. We don't bother with the sequence number */ Send_Packet(Acknowledge_Code, Current_Sequence_Number, Send_Data); Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0), Length(Receive_Data)); Generic_Command := Substring(Receive_Data, 0, 1); select Generic_Command from case "F": /* Finish command - terminate remote KERMIT */ Quit := True; if Remote_Mts then /* Program was started by a remote Kermit. This remote Kermit expects an "Execution Terminated" or such message. It absorbs it so as not to confuse /Kermit users. Check to see whether a dummy must be supplied to users that have turned this feature off. */ variable Etm_Result is character(8), Print_Message is Boolean, Next_Character is character(1), Chr_Pos is String_Length_Type; Guinfo("ETM ", Etm_Result); Case_Conversion(Etm_Result, Byte_Size(Etm_Result)); Print_Message := False; Chr_Pos := 0; cycle Next_Character := Substring(Etm_Result, Chr_Pos, 1); if Next_Character = "W" or Next_Character = "H" or Next_Character = "T" or Next_Character = "R" or Next_Character = "$" then Print_Message := True; exit; end if; exit when Chr_Pos >= 7; Chr_Pos +:= 1; exit when Substring(Etm_Result, Chr_Pos, 1) = "*"; end cycle; if not Print_Message then /* Issue a Dummy Line */ Write_To_User(" Execution terminated"); end if; end if; return; case "L": /* Logoff generic command */ variable Command_Text is Varying_String, Command_Length is Integer; Command_Text := "$SIG $"; Command_Length := Length(Command_Text); Cmdnoe(Substring(Command_Text, 0, Length(Command_Text)), Command_Length); /* we actually never get here */ Quit := True; return; case "T": /* Command to set the filetype specs */ if Substring(Receive_Data, 1) = "TEXT" then Set_Filetype_Text(); elseif Substring(Receive_Data, 1) = "BINARY" then Set_Filetype_Binary(); elseif Substring(Receive_Data, 1) = "MTS-BINARY" then Set_Filetype_Mts_Binary(); else /* bad filetype: ignore for now */ end if; case "D": variable Debug_Open_Success is Boolean; Open_Debug_File(Debug_Open_Success); if Debug_Open_Success then Debug_String(":"); Debug_String("1 Packet Trace and Debug Log"); Debug_String(" "); Debug := True; end if; else /* insert code to send not implemented stuff */ end select; end Do_Generic_Command; %Eject(); definition Get_Valid_Ascii_Control_Char variable Int_Code is Integer; open Global_Area_Ptr@; Success := True; Parse_Get(Pcb, Parsed_Integer, Int_Code, Byte_Size(Int_Code)); if Int_Code < Ascii_Null or Int_Code > Ascii_Del then Ascii_Code := 0; Success := False; elseif Int_Code >= Ascii_Space and Int_Code < Ascii_Del then /* not a control code */ Ascii_Code := 0; Success := False; else /* code is valid: return it */ Ascii_Code := Int_Code; Success := True; return; end if; Write_To_User( " Expecting decimal representation for ASCII control " !! " code."); Write_To_User(" Number ignored."); end Get_Valid_Ascii_Control_Char; %Eject(); definition Get_Remote_Unit /*box This procedure is called when there the user wants to talk to another KERMIT over a mounted network connection. The procedure gets a valid FDUB and opens the unit. */ variable Get_Fdub_Rc is Integer; open Global_Area_Ptr@; Initialize_File_With_Name(Remote_Unit, Remote_Unit_Name, Remote_Unit_Modifiers, Get_Fdub_Rc); if Get_Fdub_Rc > 0 then /* can't even get fdub */ return with False; end if; /* now do a gdinfo to check things */ variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type, Gdinfo_Rc is Integer; Gdinfo_Result_Ptr := Gdinfo(Remote_Unit.File_Unit return code Gdinfo_Rc); if Gdinfo_Rc > 0 then return with False; end if; /* check we have a mounted device */ open Gdinfo_Result_Ptr@; if Gd_Use_Code ^= Gd_Mounted_Device then /* not mounted */ return with False; end if; Freespac(0, Gdinfo_Result_Ptr); return with True; end Get_Remote_Unit; %Eject(); definition Get_Inout_Unit_Types variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type; /*box This procedure is called to establish the device types of the Input_Unit and the Output_Unit. This is needed because if this program tries to treat a 3270 device like a micro, the controller may hang the mainframe] */ open Global_Area_Ptr@; /* now do a GDINFO to check Input_Unit */ Gdinfo_Result_Ptr := Gdinfo(Input_Unit.File_Unit); Input_Unit_Device_Type := Gdinfo_Result_Ptr@.Gd_Type; Freespac(0, Gdinfo_Result_Ptr); /* now do a GDINFO to check Output_Unit */ Gdinfo_Result_Ptr := Gdinfo(Output_Unit.File_Unit); Output_Unit_Device_Type := Gdinfo_Result_Ptr@.Gd_Type; Freespac(0, Gdinfo_Result_Ptr); end Get_Inout_Unit_Types; %Eject(); definition Open_Debug_File /*box This procedure opens the file used for logging debug information. If the permanent file #KERMIT.LOG can't be used then the scratch file -KER.LOG is used. */ variable Rc is Integer, Temp_String is character(20), Access is bit(32); open Global_Area_Ptr@; /* see if file exists */ Temp_String := Substring(Debug_Filename, 0) !! " "; Access := Chkfile(Temp_String return code Rc); if Rc = 0 then /* file exists: now access */ if (Access & Write_Access) = Write_Access then /* file exists: get fdub and all */ Initialize_File_With_Name(Debug_File, Debug_Filename, Debug_File_Io_Modifiers, Rc); if Rc = 0 then /* all okay: empty file */ Empty(Debug_File.File_Unit.Fdub return code Rc); if Rc = 0 then /* file is ready for log data */ if Mode = User_Mode then Write_To_User(" Logging debug info on " !! Debug_Filename); end if; return; end if; /* drop through to alternate debug file */ end if; /* drop through to alternate debug file */ end if; /* drop through to alternate debug file */ elseif Rc = Chkfile_File_Does_Not_Exist then /* create */ variable Create_Size is Create_Size_Type, Volume is Integer; open Create_Size; Maximum_Size := 0; /* default no limit */ Initial_Size := 4; /* default to one page */ Volume := 0; Create(Temp_String, Create_Size, Volume, Line_File + 256 return code Rc); if Rc = 0 then /* have created file */ Initialize_File_With_Name(Debug_File, Debug_Filename, Debug_File_Io_Modifiers, Rc); if Rc = 0 then /* all okay lets return */ if Mode = User_Mode then Write_To_User(" Logging debug info on " !! Debug_Filename); end if; return; end if; /* drop through */ else /* drop through */ end if; end if; /* file couldn't be opened default to debug scratch */ if Mode = User_Mode then Write_To_User(" Logging Debug info on " !! Backup_Debug_Filename); end if; Initialize_File_With_Name(Debug_File, Backup_Debug_Filename, Debug_File_Io_Modifiers, Rc); if Rc > 0 then Success := False; return; end if; end Open_Debug_File; %Eject(); definition Send_Generic_Command /*box This procedure is called to send a generic command. It tries to send the command the number of retries times and returns true if it succeeds or false otherwise. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type; open Global_Area_Ptr@; Initialize_Sequence_Numbers(); Times_This_Packet_Retried := 0; Side := Sending_Side; Mts_Ebcdic_To_Ascii(Substring(Generic_Command, 0), Length(Generic_Command)); Set_Echo_Off(); cycle Send_Packet(Generic_Command_Code, Current_Sequence_Number, Generic_Command); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Acknowledge_Code: Can_Talk_To_Remote_Kermit := True; Success := True; exit; case Error_Code: Handle_Received_Error(Receive_Data); Success := False; exit; else /* anything else is bad */ Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then /* give up and return failure */ Success := False; exit; else Times_This_Packet_Retried +:= 1; end if; end select; end cycle; Set_Echo_On(); end Send_Generic_Command; %Eject(); definition Receive_File_From_Server /*box This procedure is called when a file is to be received from a server KERMIT. If the receive-init is acknowleged with a send-init we go into normal receive file mode. */ variable Receive_Packet_Type is Packet_Type_Type, Receive_Sequence_Number is Sequence_Number_Type, Receive_Data is Packet_Data_Type, Receive_Success is Boolean, Init_Data is Packet_Data_Type; open Global_Area_Ptr@; Setup_Return_From(Rcb, Success); Success := True; Initialize_Sequence_Numbers(); Times_This_Packet_Retried := 0; Side := Receiving_Side; Mts_Ebcdic_To_Ascii(Substring(Receive_Filename, 0), Length(Receive_Filename)); cycle Send_Packet(Receive_Init_Code, Current_Sequence_Number, Receive_Filename); Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number, Receive_Data); select Receive_Packet_Type from case Send_Init_Code: Get_Your_Packet_Parameters(Receive_Data); Get_My_Packet_Parameters(Init_Data); Send_Packet(Acknowledge_Code, Current_Sequence_Number, Init_Data); Times_Last_Packet_Retried := Times_This_Packet_Retried; Times_This_Packet_Retried := 0; Increment_Sequence_Numbers(); Server_Receive_File(Receive_Success); if Receive_Success then Success := True; return; else Success := False; return; end if; case Error_Code: Handle_Received_Error(Receive_Data); Success := False; return; else /* anything else try again */ Check_For_Retries(Times_This_Packet_Retried); if Times_This_Packet_Retried >= Max_Retries then Error_Message := " Unable to ACK for receive init"; Success := False; return; else Times_This_Packet_Retried +:= 1; end if; end select; end cycle; end Receive_File_From_Server; %Eject(); definition Handle_Received_Error /*box This procedure is called when Receive_Packet gets an error message. If KERMIT is being run a remote KERMIT the message is displayed on the terminal. If it is in debug mode the message is logged. In any other case the error message is thrown away. */ open Global_Area_Ptr@; Ascii_To_Mts_Ebcdic(Substring(Error_Packet_Data, 0), Length(Error_Packet_Data)); if Mode = User_Mode then Write_To_User(" Remote Error:" !! Error_Packet_Data); end if; if Debug then Debug_String(" Error Packet Received: " !! Error_Packet_Data); end if; end Handle_Received_Error; %Eject(); definition Display_Packet_Action /*box This procedure is called during file transfer to see if an indication that something is going on should be displayed for a remote kermit. */ open Global_Area_Ptr@; if Remote_Kermit or not Display_Packet_Count then /* Nothing is displayed by a remote kermit */ return; end if; begin /* okay: local kermit. See if time to display */ variable Expected_String is Varying_String, Decimal_Percent is Integer, Whole_Percent is Integer; open Packet_Count; if For_File < Next_Packet_Count_Threshold then return; end if; if Expected_Packets > 0 then Expected_String := " (est. "; Whole_Percent := (For_File * 100) / Expected_Packets; Decimal_Percent := ((For_File * 1000) / Expected_Packets) mod 10; Expected_String !!:= Integer_To_Varying(Whole_Percent, 5) !! "."; if (Whole_Percent = 0) and (Decimal_Percent = 0) then /* Show a minimum of 0.1% */ Expected_String !!:= "1%)"; else Expected_String !!:= Integer_To_Varying(Decimal_Percent, 1) !! "%)"; end if; else Expected_String := ""; end if; if Side = Sending_Side then Write_To_User(" Packets sent: " !! Integer_To_Varying(For_File, 6) !! Expected_String); else Write_To_User(" Packets received: " !! Integer_To_Varying(For_File, 6) !! Expected_String); end if; Next_Packet_Count_Threshold +:= Packet_Count_Interval; end; end Display_Packet_Action; %Eject(); definition Write_To_User /*box This procedure is called when a message is written to the user. The procedure does a sercom to the user and checks to see if the same message should also be logged on the debug file. */ open Global_Area_Ptr@; Sercom_String(Message); if Debug then Debug_String(Message); end if; end Write_To_User; %Eject(); definition Put_Mts_Binary_Data /*box This procedure is called when the file being received is an MTS binary file. These files are binary files which include a length for each line. Each binary line is preceded by halfword length in binary. */ open Global_Area_Ptr@; Put_Success := True; equate Byte_Lengths to Mts_Binary_Length as array (1 to 2) of bit(8); select Mts_Binary_State from case Start_Mts_Binary_Linenumber_State: variable Length_Char is character(0 to 1), Error_Msg is Varying_String, Error_Ptr is pointer to Varying_String; Error_Ptr := Address(Error_Msg); Length_Char := Next_Character; Is_Line_Number_Fraction := False; Ascii_To_Mts_Ebcdic(Substring(Length_Char, 0, 0), 1); Line_Number_String := ""; Line_Number_String_Length := Hex_String_To_Bits(Length_Char, Error_Ptr); if Error_Msg ^= "" then /* missing line number length: error action */ /* for now revert to binary file kind */ Line_Number_String_Length := 0; if Debug then Debug_String( " Expecting line number length found instead '" !! Length_Char !! "'"); end if; end if; if Line_Number_String_Length = 0 then Mts_Binary_State := First_Mts_Binary_Byte_Length_State; Current_Line_Number +:= 1000; elseif Line_Number_String_Length < 'D' then Mts_Binary_State := Build_Mts_Binary_Linenumber_State; else /* must be in range D..F */ Is_Line_Number_Fraction := True; Line_Number_String_Length := Line_Number_String_Length - 'C'; Mts_Binary_State := Build_Mts_Binary_Linenumber_State; end if; case Build_Mts_Binary_Linenumber_State: variable Success is Boolean, Line_Number_Difference is Integer; Line_Number_String !!:= Next_Character; Line_Number_String_Length -:= 1; if Line_Number_String_Length <= 0 then Decode_Mts_Linenumber(Line_Number_String, Line_Number_Difference, Success); if not Success then /* some remedial action */ if Debug then Debug_String(" Unable decode the mts line number"); end if; end if; Current_Line_Number +:= Line_Number_Difference; Mts_Binary_State := First_Mts_Binary_Byte_Length_State; end if; case First_Mts_Binary_Byte_Length_State: Byte_Lengths(1) := Next_Character; Mts_Binary_State := Second_Mts_Binary_Byte_Length_State; case Second_Mts_Binary_Byte_Length_State: Byte_Lengths(2) := Next_Character; Mts_Binary_State := Mts_Binary_Bytes_State; case Mts_Binary_Bytes_State: File_Buffer_Ptr@ !!:= Next_Character; if Length(File_Buffer_Ptr@) >= Mts_Binary_Length then variable Write_Success is Boolean; open In_File; File_Line_Number := Current_Line_Number; Write_In_File_Buffer(Write_Success); File_Buffer_Ptr@ := ""; if not Write_Success then Put_Success := False; if Debug then Debug_String(" In " !! %Current_Procedure !! " unable " !! "to write binary data"); end if; return; end if; Mts_Binary_State := Start_Mts_Binary_Linenumber_State; end if; end select; end Put_Mts_Binary_Data; %Eject(); definition Get_Mts_Binary_Data /*box This procedure is called when mts binary files are to be sent to another mts kermit that is expecting mts binary files. At the moment both kermits must be set to filetype=mts-binary. */ open Global_Area_Ptr@; Success := True; equate Byte_Lengths to Mts_Binary_Length as array (1 to 2) of bit(8); select Mts_Binary_State from case Start_Mts_Binary_Linenumber_State: variable Line_Number_Difference is Integer; Last_Line_Number := Current_Line_Number; if Out_File_End_Of_File then Success := False; return; end if; Read_Long_Varying(Out_File, File_Buffer_Ptr@); open Out_File; if Last_Return_Code > 0 then /* all done - no more characters */ Out_File_End_Of_File := True; /* clean up */ Freefd(Out_File.File_Unit.Fdub); Success := False; return; end if; if Is_First_Out_File_Record then Set_Next_Line(Out_File); Is_First_Out_File_Record := False; end if; Next_Out_File_Character_Position := 0; Mts_Binary_Length := Length(File_Buffer_Ptr@); Current_Line_Number := File_Line_Number; Line_Number_Difference := Current_Line_Number - Last_Line_Number; Encode_Mts_Linenumber(Line_Number_Difference, Line_Number_String); Next_Character := Substring(Line_Number_String, 0, 1); Line_Number_String_Pos := 1; Line_Number_String_Length := Length(Line_Number_String); if Line_Number_String_Pos >= Line_Number_String_Length then Mts_Binary_State := First_Mts_Binary_Byte_Length_State; else Mts_Binary_State := Build_Mts_Binary_Linenumber_State; end if; case Build_Mts_Binary_Linenumber_State: Next_Character := Substring(Line_Number_String, Line_Number_String_Pos, 1); Line_Number_String_Pos +:= 1; if Line_Number_String_Pos >= Line_Number_String_Length then Mts_Binary_State := First_Mts_Binary_Byte_Length_State; end if; case First_Mts_Binary_Byte_Length_State: Next_Character := Byte_Lengths(1); Mts_Binary_State := Second_Mts_Binary_Byte_Length_State; case Second_Mts_Binary_Byte_Length_State: Next_Character := Byte_Lengths(2); Mts_Binary_State := Mts_Binary_Bytes_State; case Mts_Binary_Bytes_State: Next_Character := Substring(File_Buffer_Ptr@, Next_Out_File_Character_Position, 1); Next_Out_File_Character_Position +:= 1; if Next_Out_File_Character_Position >= Length(File_Buffer_Ptr@) then Mts_Binary_State := Start_Mts_Binary_Linenumber_State; end if; end select; end Get_Mts_Binary_Data; %Eject(); definition Encode_Mts_Linenumber /*box This procedure is used to encode an mts line number. These line numbers are sent along with the data in the file when this KERMIT is talking to another MTS KERMIT and a true file image is wanted. The encoding takes advantage of the fact that MTS line numbers are not random integers but are usually sequentially ordered. Rather than sending the absolute line numbers the program sends the relative line number difference. It assumes at the start that the last line sent was numbered zero. Thus if the first line sent is numbered 1 the first relative value sent is 1. *//* *//* The numbers are encoded using an ascii byte to represent the length followed by the number of bytes needed to represent the difference of this line from the last. If the difference is 1 the length byte is given as an ascii zero and no line number data bytes are given. For differences in the 0.001 to 0.999 range the difference is given as an ascii "D", "E", "F", followed by one, two , or three ascii digits representing a fraction with the decimal on the left. Some examples would be "D2", "E56", and "F787". They represent differences of .2, .56, and .787 respectively. Any other difference is given by a byte length from the range 1..C followed by the difference. If the difference contains a fractional part the decimal is included. All differences except possibly the first one will be positive. For the first case the leading character could be a minus sign. Some examples are: "13", "423.5", "534346", and "52.234". These represent differences of 3, 23.5, 34346, and 2.234. *//* *//* All line numbers are stored as integers with an implicit decimal point. */ variable Fraction_String is Varying_String, Integer_String is Varying_String, Total_String is Varying_String, Length_String_Char is character(0 to 1), Integer_Part is Integer, Fraction_Part is Integer, Is_Positive_Difference is Boolean, String_Length_Char is character(1); open Global_Area_Ptr@; Encoded_Line_Number := ""; if Line_Number_Difference = 1000 then /* have a difference of 1; represent as length 0 */ Encoded_Line_Number := Ascii_0; return; elseif Line_Number_Difference < 1000 and Line_Number_Difference > 0 then /* have a fraction: choose one of three possible versions */ /* add 1000 to ensure leading zeros */ Fraction_String := Integer_To_Varying(1000 + Line_Number_Difference, 0); Mts_Ebcdic_To_Ascii(Substring(Fraction_String, 0, 0), Length(Fraction_String)); if Line_Number_Difference mod 10 = 0 then /* have at most two places of decimal */ if Line_Number_Difference mod 100 = 0 then /* have a single place of decimal */ Encoded_Line_Number := Ascii_D !! Substring(Fraction_String, 1, 1); return; else /* have two decimal places */ Encoded_Line_Number := Ascii_E !! Substring(Fraction_String, 1, 2); return; end if; else /* have a full three places of decimal */ Encoded_Line_Number := Ascii_F !! Substring(Fraction_String, 1, 3); end if; else /* have a value in the range <= 0 or > 1 */ /* integer part */ if Line_Number_Difference < 0 then Is_Positive_Difference := False; Line_Number_Difference := -Line_Number_Difference; else Is_Positive_Difference := True; end if; Integer_Part := Line_Number_Difference / 1000; if Integer_Part > 0 then Integer_String := Integer_To_Varying(Integer_Part, 0); Mts_Ebcdic_To_Ascii(Substring(Integer_String, 0, 0), Length(Integer_String)); else Integer_String := ""; end if; Fraction_Part := Line_Number_Difference mod 1000; if Fraction_Part > 0 then /* add 1000 to force leading zeros */ Fraction_String := Integer_To_Varying(1000 + Fraction_Part, 0); Mts_Ebcdic_To_Ascii(Substring(Fraction_String, 0, 0), Length(Fraction_String)); Fraction_String := Substring(Fraction_String, 1); else Fraction_String := ""; end if; /* now build number */ if Is_Positive_Difference then Total_String := ""; else Total_String := Ascii_Minus; end if; Total_String !!:= Integer_String; if Fraction_String ^= "" then Total_String !!:= Ascii_Period !! Fraction_String; end if; String_Length_Char := Bits_To_Hex_Varying(Length(Total_String), 1); Mts_Ebcdic_To_Ascii(Substring(String_Length_Char, 0, 0), 1); Encoded_Line_Number := String_Length_Char !! Total_String; return; end if; end Encode_Mts_Linenumber; %Eject(); definition Decode_Mts_Linenumber /*box This procedure is used to decode the line number encoded by the encode_mts_linenumber procedure. See that procedure for the algorithm. Input to this procedure is the line number string. The length has already been extracted. The procedure set success to false if it is unable to decode the line number. Also it increments the line number. */ variable Error_Msg is Varying_String, Error_Ptr is pointer to Varying_String; open Global_Area_Ptr@; Success := True; Error_Msg := ""; Error_Ptr := Address(Error_Msg); if Line_Number_String = "" then Line_Number_Difference := 1000; return; end if; Ascii_To_Mts_Ebcdic(Substring(Line_Number_String, 0, 0), Length(Line_Number_String)); if Is_Line_Number_Fraction then Line_Number_String !!:= Substring("000", 0, Length("000") - Length(Line_Number_String)); Line_Number_Difference := String_To_Integer(Line_Number_String, Error_Ptr); if Error_Msg ^= "" then Line_Number_Difference := 1000; Success := False; return; else return; end if; end if; /* have digits with possible imbedded decimal point */ variable Integer_String is Varying_String, Fraction_String is Varying_String, String_Len is String_Length_Type, String_Pos is String_Length_Type; String_Len := Length(Line_Number_String); String_Pos := 0; Integer_String := ""; Fraction_String := ""; /* find integer part */ cycle exit when String_Pos >= String_Len; exit when Substring(Line_Number_String, String_Pos, 1) = "."; Integer_String !!:= Substring(Line_Number_String, String_Pos, 1); String_Pos +:= 1; end cycle; if String_Pos < String_Len - 1 then /* have decimal point */ String_Pos +:= 1; /* skip decimal point */ cycle exit when String_Pos >= String_Len; Fraction_String !!:= Substring(Line_Number_String, String_Pos, 1); String_Pos +:= 1; end cycle; end if; /* check fraction part is right length */ if Length(Fraction_String) > 3 then Line_Number_Difference := 1000; Success := False; return; end if; Fraction_String := Fraction_String !! Substring("000", 0, Length("000") - Length(Fraction_String)); Integer_String !!:= Fraction_String; Line_Number_Difference := String_To_Integer(Integer_String, Error_Ptr); if Error_Msg ^= "" then Line_Number_Difference := 1000; Success := False; return; end if; /* okay alls good */ end Decode_Mts_Linenumber; %Eject(); definition Save_And_Set_Prefix_String /*box This procedure saves the old prefix string and sets a new string. CNFGINFO is used imbed the mts installation within the prefix string. */ variable Prefix_String is Varying_String, New_Prefix is Guinfo_Pfxstr_Type, Command_Length is Integer; open Global_Area_Ptr@; Old_Prefix.Gp_Region_Length := Byte_Size(Old_Prefix); Guinfo("PFXSTR ", Old_Prefix); /* now build a new prefix */ Prefix_String := "KERMIT-"; open Cnfginfo; select Ci_Installation_Code from case Ci_Um: Site := "UM"; case Ci_Ubc: Site := "UBC-" !! Substring(Ci_Host_Name, 0, 1); case Ci_Une: Site := "NCL"; case Ci_Uqv: Site := "UQV"; case Ci_Wsu: Site := "WSU"; case Ci_Rpi: Site := "RPI"; case Ci_Sfu: Site := "SFU"; else Site := "MTS"; end select; Prefix_String !!:= Site !! ">"; open New_Prefix; Gp_Region_Length := Byte_Size(New_Prefix); Gp_Actual_Length := Length(Prefix_String); Gp_Prefix := Substring(Prefix_String, 0, Gp_Actual_Length); Cuinfo("PFXSTR ", New_Prefix); /* set prefix on */ variable Set_Prefix_On_Command is Varying_String, Command_Len is Integer; Set_Prefix_On_Command := "set prefix=on"; Command_Length := Length(Set_Prefix_On_Command); Cmdnoe(Substring(Set_Prefix_On_Command, 0), Command_Length); end Save_And_Set_Prefix_String; %Eject(); definition Setup_Kermit_Environment /*box This procedure is called when entering Kermit to get the space Kermit needs and to save attributes of the calling environment */ variable Getspace_Rc is Integer; Success := True; Storage_Allocated_Info := Initial_Storage_Allocated_Info; open Storage_Allocated_Info; /* Note we have a window while space is for the attn area stacks where space could be left unfreed. So be it */ /* save old attntrp */ Guinfo("ATTNTRP ", Old_Attntrp); Sa_Old_Attn_Saved := True; Mask_Attn_Stack_Ptr := Getspace(Current_Link_Level, Attn_Stack_Length return code Getspace_Rc); if Getspace_Rc > 0 then Success := False; return; end if; Sa_Mask_Attn_Stack := True; /* Close attn window */ Mask_Attn(); Normal_Attn_Stack_Ptr := Getspace(Current_Link_Level, Attn_Stack_Length return code Getspace_Rc); if Getspace_Rc > 0 then Cleanup(); Success := False; return; end if; Sa_Normal_Attn_Stack := True; Global_Area_Ptr := Getspace(Current_Link_Level, Byte_Size(Global_Area_Type) return code Getspace_Rc); if Getspace_Rc > 0 then Cleanup(); Success := False; return; end if; Sa_Global_Area := True; /* get buffer area stuff */ File_Buffer_Ptr := Getspace(Current_Link_Level, Byte_Size(Long_Varying_String) return code Getspace_Rc); if Getspace_Rc > 0 then Cleanup(); Success := False; return; end if; Sa_File_Buffer := True; open Global_Area_Ptr@; Pcb := Parse_Initialize(Null); if Pcb = Null then /* failed to get storage */ Cleanup(); Success := False; end if; Sa_Pcb := True; File_Transfer_Attn_Stack_Ptr := Getspace(Current_Link_Level, Attn_Stack_Length return code Getspace_Rc); if Getspace_Rc > 0 then Cleanup(); Success := False; return; end if; Sa_File_Transfer_Attn := True; Save_And_Set_Prefix_String(); Sa_Old_Prefix_Saved := True; Initialize(); /* allow attns: set default as Normal */ Kill_Remote_Kermit := False; Current_Attn_Kind := Normal_Attn_Kind; Reenable_Attn(); end Setup_Kermit_Environment; %Eject(); definition Cleanup /*box This procedure is called to free any storage that has been aquired by the Kermit program. It may be called by either a graceful or bad exit. The procedure also resets attntrps etc. */ open Global_Area_Ptr@; open Storage_Allocated_Info; Mask_Attn(); if Sa_File_Transfer_Attn then Freespac(0, File_Transfer_Attn_Stack_Ptr); end if; if Sa_Pcb then Parse_Terminate(Pcb); end if; if Sa_File_Buffer then Freespac(0, File_Buffer_Ptr); end if; if Sa_Global_Area then Freespac(0, Global_Area_Ptr); end if; if Sa_Normal_Attn_Stack then Freespac(0, Normal_Attn_Stack_Ptr); end if; if Sa_Old_Prefix_Saved then Cuinfo("PFXSTR ", Old_Prefix); end if; /* restore callers attn environment */ if Sa_Old_Attn_Saved then Cuinfo("ATTNTRP ", Old_Attntrp); end if; if Sa_Mask_Attn_Stack then Freespac(0, Mask_Attn_Stack_Ptr); end if; end Cleanup; %Eject(); definition Configure_Remote_Unit /*box This procedure sets the remote unit x25_timer if possible. Also it sets it so that resets on the network are processed. */ constant Remote_Timeout is "30 seconds"; /* set x25_timer on for remote unit where possible */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; open Global_Area_Ptr@; Mask_Attn(); Control_Command := "x25_timer=" !! Remote_Timeout; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Remote_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then /* can't set x25_timer */ X25_Timer_Set := False; Reenable_Attn(); if Debug then open Control_Return_Info; Debug_String(" Unable to set x25_timer: "); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; else X25_Timer_Set := True; Reenable_Attn(); end if; /* set process_resets on */ Control_Command := "process_resets=on"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Remote_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then /* can't set process resets=on */ if Debug then open Control_Return_Info; Debug_String(" Unable to set process_resets=on"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end Configure_Remote_Unit; %Eject(); definition Send_Kermit_Run_Command /*box This procedure is called to send a run command to the remote kermit when Kermit is entered via net:call's /Kermit command. */ variable Run_Command is Varying_String, Execution_Begins is Varying_String; open Global_Area_Ptr@; Success := True; Run_Command := "$Run " !! Kermit_Program_File !! " Par=rm"; Mts_Ebcdic_To_Ascii(Substring(Run_Command, 0, 0), Length(Run_Command)); Run_Command !!:= Ascii_Cr; Write_Packet(Remote_Unit, Run_Command); begin open Remote_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 12 then /* have a call cleared situation, abort */ Write_To_User( " Line unexpectedly disconnected - Transmission " !! "ceases"); Success := False; end if; if Last_Return_Code = 20 then /* have a timeout on write, quit. */ Write_To_User(" Timed out on remote write. Quitting"); Success := False; end if; end if; end; /* now get the "Execution Begins" Packet */ Read_Packet(Remote_Unit, Execution_Begins); begin open Remote_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 12 then /* have a call cleared situation, abort */ Write_To_User( " Line unexpectedly disconnected - Transmission " !! "ceases"); Success := False; end if; if Last_Return_Code = 20 then /* have a timeout on read. */ end if; end if; end; if Debug then Ascii_To_Mts_Ebcdic(Substring(Execution_Begins, 0), Length(Execution_Begins)); Debug_String(" ex!" !! Execution_Begins !! "!"); end if; end Send_Kermit_Run_Command; %Eject(); definition Handle_Error /*box This procedure is called when an error has been detected. The procedure checks "Error_Message". If this is non-null then it implies that the error was generated locally and the procedure dispatches an error packet to the other kermit. It then resets "Error_Message" to null. If "Error_Message" is null it implies that the error was caused by receiving a remote error message. In that case no further action needs be taken. */ open Global_Area_Ptr@; /* If "" then remote error already handled */ return when Error_Message = ""; /* Have a local Error */ if Mode = User_Mode then Write_To_User(" Local Error: " !! Error_Message); end if; if Debug then Debug_String(" Local Error: " !! Error_Message); end if; Send_Error_Message(Error_Message); Error_Message := ""; end Handle_Error; %Eject(); %Eject(); definition Stop_Remote_Kermit /*box This procedure is called when Kermit is terminated. It checks to see if Kermit is talking to another remote MTS Kermit. If it is then it attempts to shut it down. It also absorbs the "execution terminated" generated by the remote Kermit (The remote Kermit will generate a dummy version in the case of the user having turned this option off. */ variable Success is Boolean, Execution_Terminated is Varying_String; open Global_Area_Ptr@; if Can_Talk_To_Remote_Kermit then /* want to shut down other kermit */ Send_Generic_Command("F", Success); if Success then Write_To_User(" Remote Kermit shut down."); /* now get the "Execution Terminated" Packet */ Read_Packet(Remote_Unit, Execution_Terminated); open Remote_Unit; if Last_Return_Code > 0 then if Last_Return_Code = 12 then Write_To_User(" Line unexpectedly disconnected."); end if; if Last_Return_Code = 20 then /* have a timeout on read. */ end if; end if; if Debug then Ascii_To_Mts_Ebcdic(Substring(Execution_Terminated, 0), Length(Execution_Terminated)); Debug_String(" ex!" !! Execution_Terminated !! "!"); end if; else Write_To_User(" Unable to shut down remote Kermit."); end if; end if; end definition Stop_Remote_Kermit; %Eject(); definition Initialize_Logging /*box This procedure is called at the beginning of a Kermit session. It opens a scratch file in which any error records can be placed. It also fills in the initial fields of the log record. This includes the date, start time, and ccid. */ open Global_Area_Ptr@; open Log_Record; /* blank the filler columns in the record */ equate Fill_String to Log_Record as character(Byte_Size(Log_Record)); Fill_String := Substring(B255, 0, Length(Fill_String)); /* initialize timing */ variable Dummy is Integer; Time(Time_Initialize_Supervisor, 0, Dummy); /* Get starting date */ Time(Time_Long_Date, 0, Lr_Date); /* Get starting time */ Time(Time_Time_Of_Day, 0, Lr_Start_Time); /* Get the current user */ Guinfo("SIGNONID", Lr_Ccid); variable Rc is Integer; Logging_Started := True; end Initialize_Logging; %Eject(); definition Terminate_Logging /*box This procedure is called at the end of a Kermit session. It fills out the log record and puts it into the Kermit Log file. If there was any log of errors then this is also added to the Kermit log file. */ constant Max_Wait_For_Lock is 3000; /* 3 seconds */ open Global_Area_Ptr@; open Log_Record; return when not Logging_Started; /* get the finish time, the elapsed time, and the cpu time */ variable Cpu_Time is Integer, Elapsed_Time is Integer; Time(Time_Cpu_In_Milliseconds, 0, Cpu_Time); Lr_Cpu_Time := Integer_To_Varying(Cpu_Time / 1000, Millisecond_Field_Width - 4) !! "." !! Substring(Integer_To_Varying((Cpu_Time mod 1000) + 1000, 4), 1, 3); Time(Time_Elapsed_In_Milliseconds, 0, Elapsed_Time); Lr_Elapsed_Time := Integer_To_Varying(Elapsed_Time / 1000, Millisecond_Field_Width - 4) !! "." !! Substring(Integer_To_Varying((Elapsed_Time mod 1000) + 1000, 4), 1, 3); Time(Time_Time_Of_Day, 0, Lr_Finish_Time); Lr_Total_Command_Count := Integer_To_Varying(Total_Command_Count, Log_Numeric_Field_Width); Lr_Total_Retries := Integer_To_Varying(Total_Retries, Log_Numeric_Field_Width); Lr_Out_Packet_Count := Integer_To_Varying(Out_Packet_Count.For_Session, Log_Numeric_Field_Width); Lr_In_Packet_Count := Integer_To_Varying(In_Packet_Count.For_Session, Log_Numeric_Field_Width); Lr_Send_Command_Count := Integer_To_Varying(Send_Command_Count, Log_Numeric_Field_Width); Lr_Get_Command_Count := Integer_To_Varying(Get_Command_Count, Log_Numeric_Field_Width); /* Lets see if we can get at the log file */ variable Rc is Integer, Temp_String is character(20), Access is bit(32); Temp_String := Substring(Kermit_Log_Filename, 0) !! " "; Access := Chkfile(Temp_String return code Rc); return when Rc ^= 0; if (Access & Write_Expand_Access) = Write_Expand_Access then Initialize_File_With_Name(Kermit_Log_File, Kermit_Log_Filename, Kermit_Log_File_Modifiers, Rc); return when Rc ^= 0; else return; end if; Lock(Kermit_Log_File.File_Unit, Lock_Modify, Max_Wait_For_Lock return code Rc); return when Rc ^= 0; Set_Last_Line(Kermit_Log_File); Kermit_Log_File.File_Line_Number +:= 1000; Write_Record(Kermit_Log_File, Log_Record); Unlk(Kermit_Log_File.File_Unit); end Terminate_Logging; %Eject(); definition Set_Echo_Off /*box This procedure sets echoing off for the transmission of packets to a microcomputer Kermit. Dumb terminals normally echo the results which would cause the microcomputer Kermit to receive its own packets. Switching echoing off eliminates this. */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; open Global_Area_Ptr@; if Can_Set_Local_Echo then /* set direct terminal off */ Control_Command := "echo=off"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to set terminal echo off:"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Can_Set_Network_Echo then /* set possible remote datapac, telenet echos off */ Control_Command := "set 02:00"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to set datapac echo off:"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Can_Set_8_Bit_Datapac_Transparancy then /* set remote datapac so that it is transparent to 8 bit encoding */ Control_Command := "set 0:0 123:0"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String( " Unable to set datapac to 8 bit transparancy"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; end Set_Echo_Off; %Eject(); definition Set_Echo_On /*box This procedure sets echoing on after a set of packets have been sent At the moment we have no way of sensing what things were like before packet transmission began so we switch all back on for safety. */ variable Control_Command is Varying_String, Control_Command_Length is Short_Integer, Control_Rc is Integer, Control_Return_Info is Control_Return_Info_Type; open Global_Area_Ptr@; if Can_Set_Local_Echo then /* set direct terminal off */ Control_Command := "echo=on"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to set terminal echo on:"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Can_Set_Network_Echo then /* set possible remote datapac, telenet echos on */ Control_Command := "set 02:01"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String(" Unable to set datapac echo on:"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; if Can_Set_8_Bit_Datapac_Transparancy then /* reset 8 bit transparancy back off */ Control_Command := "set 0:0 123:1"; Control_Command_Length := Length(Control_Command); Control(Substring(Control_Command, 0, 0), Control_Command_Length, Input_Unit.File_Unit, Control_Return_Info return code Control_Rc); if Control_Rc > 0 then if Debug then open Control_Return_Info; Debug_String( " Unable to set datapac 8 bit transparancy off"); Debug_String(" Control rc " !! Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !! Integer_To_Varying(Dsr_Return_Code, 0) !! " " !! Substring(Dsr_Message, 0, Dsr_Message_Length)); end if; end if; end if; end Set_Echo_On; %Punch(" DEF 005000 00STAKSIZE 5 page stack");