home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
mtsplus.tar.gz
/
mtsplus.tar
/
mtskerm.sq
< prev
next >
Wrap
Text File
|
1984-09-10
|
231KB
|
7,248 lines
%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_Block>
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 <Begin_Block> when Attn_Flag;
open Command_Unit;
exit <Begin_Block> 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 <Begin_Block>;
else /* Bad response, ask for
correct one */
Write_To_User(" Enter Y or N.");
end if;
end cycle;
end <Begin_Block>
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_Block>
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 <Begin_Block> when Attn_Flag;
open Command_Unit;
exit <Begin_Block> 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 <Begin_Block>;
else
Write_To_User(" Enter Y or N.");
end if;
end cycle;
end <Begin_Block>
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_Block>
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 <Begin_Block> when Attn_Flag;
open Command_Unit;
exit <Begin_Block> 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 <Begin_Block>
else /* Improper Response */
Write_To_User(" Enter Y or N.");
end if;
end cycle;
end <Begin_Block>
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.
*/
<Find_Start_Of_Packet_Loop>
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 <Find_Start_Of_Packet_Loop>;
end if;
if Next_Character = My_Start_Of_Packet_Character
then
/* header found */
exit <Find_Start_Of_Packet_Loop>;
end if;
end cycle;
end cycle <Find_Start_Of_Packet_Loop>;
/* 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 */
<Unpack_Packet_Loop>
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 <Unpack_Packet_Loop>;
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 <Unpack_Packet_Loop>;
/* 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");