home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / d / mt2ker.sq < prev    next >
Text File  |  2020-01-01  |  231KB  |  7,248 lines
  1. %Title := "KERMIT";
  2. %Listing_Character_Set := "tn";
  3. %Unref := False;
  4.  
  5. /*box,centre
  6.                                KERMIT
  7. *//*
  8.  
  9. *//*
  10.    Author: Bruce Jolliffe
  11. *//*
  12.  
  13. *//*
  14.    The KERMIT protocol is designed for character-oriented
  15.    transmission over serial telecommunication lines. The design
  16.    allows it to be operating system independent. It can be used
  17.    to move files between micros and mainframes and between pairs
  18.    of mainframes over standard telecommunications lines.
  19. *//*
  20.  
  21. *//*
  22.    This version is designed to run under the MTS operating
  23.    system. Besides being able to talk to microcomputers this
  24.    version can also talk to other host versions of Kermit.
  25.    Several MTS dependant enhancements have been added to the
  26.    protocol so that MTS files can be sent complete with their
  27.    internal line structure. The program can send an exact image
  28.    of an MTS file from one MTS system to another.
  29. *//*
  30.  
  31. *//*
  32.    The progam may be called as a main program and as a
  33.    subroutine. If it is called as a main program it it starts in
  34.    server mode ready to talk to another Kermit. It may be started
  35.    in user mode by specifying 'PAR=u' on the run command. If it
  36.    is called as a subroutine it takes three parameters:
  37. *//*as_is
  38.  
  39.         Kermit_Control_Block_Ptr     (full word pointer)
  40.         Switches                     (full word bit string)
  41.         Fdname                       (character string terminated by blank)
  42.  
  43. *//*
  44.    If bit 31 of Switches is set then Kermit assumes you are
  45.    talking to a remote site that has another Kermit in the file
  46.    NET:Kermit. The progam will attempt to establish communication
  47.    with the remote Kermit by starting it. The Fdname is that of
  48.    where the commands are coming from. The local Kermit will be
  49.    started in User mode when the subroutine entry is made. The
  50.    subroutine Kermit assumes Unit 0 is connected to a mounted
  51.    remote device.
  52. *//*
  53.  
  54. *//*
  55.    The Kermit return codes are:
  56. *//*as_is
  57.  
  58.         0 - all okay
  59.         8 - error
  60.  
  61. */
  62.  
  63. %Eject();
  64. %Include(Boolean, Numeric_Types, String_Types, Guser_Varying,
  65.    Sprint_Varying, Mts_Io_Types, Mts_Io_Extended_Modifiers,
  66.    Mts_File_Type, Sercom_String, Chkfile, Mts_File_Access_Codes,
  67.    Initialize_File_With_Name, Initialize_File, Chkfile,
  68.    Read_Varying, Write_Varying, Write_String, S370_Opcodes,
  69.    More_String_Types, Read, Twait, Sercom, Integer_To_Varying,
  70.    Control, Integer_To_Varying, Line_Number_To_Varying,
  71.    String_To_Hex_Varying, Message_Initialize, Message_Terminate,
  72.    Message, Fnametrt, Empty, Create, Mts_File_Organizations, Gdinfo,
  73.    Gdinfo_Result_Type, Return_From, Setup_Return_From, Cnfginfo,
  74.    Bits_To_Hex_Varying, String_To_Integer, Hex_String_To_Bits,
  75.    Set_First_Line, Set_Next_Line, Guinfo, Cuinfo,
  76.    Initialize_File_With_Unit#, Gfinfo, B255, Case_Conversion, Time,
  77.    Write_Record, Lock, Unlk, Set_Last_Line, Freefd);
  78.  
  79. %Include(Semantic_Procedure_Type, Parse_String_Type, Parse,
  80.    Parse_Initialize, Parse_Terminate, Parse_Set, Parse_Get,
  81.    Production_Text, Last_Terminal_Text, Parse_Item_Type, Cmdnoe);
  82.  
  83. /* Attn's includes */
  84. %Include(Exit_Definitions, Set_Exit, Attntrp, Getspace, Mts,
  85.    Freespac);
  86.  
  87. %Include(Kermit_Command_Definitions);
  88.  
  89. %Unref := True;
  90. %Merge_Unref := False;
  91.  
  92. %Eject();
  93.  
  94. global Main_Global
  95.  
  96.    /* Constants for packets */
  97.    constant Kermit_Help_File is "NET.:Kermit_Help ",
  98.       Kermit_Program_File is "NET.:Kermit      ",
  99.       Kermit_Log_Filename is "NET.:Kermit#log  ",
  100.       Kermit_Log_File_Modifiers is Mts_Io_Errrtn,
  101.       Version is "1.00",
  102.       Error_Rc is 4,
  103.       Max_Integer_In_Byte is 255,
  104.       Bits_76 is 'C0',
  105.       Bits_543210 is '3F',
  106.       Checksum_Modulo is 64,
  107.       Max_Packet_Char_Count is 94,
  108.       Min_Packet_Char_Count is 40,
  109.       Uncounted_Packet_Char is 2,
  110.       Max_Packet_Length is Max_Packet_Char_Count +
  111.          Uncounted_Packet_Char,
  112.       Min_Packet_Length is Min_Packet_Char_Count +
  113.          Uncounted_Packet_Char,
  114.       Max_Padding_Count is 20,
  115.       Ascii_Null is '00',
  116.       Ascii_Soh is '01',
  117.       Ascii_Etx is '03',
  118.       Ascii_Cr is '0D',
  119.       Ascii_Lf is '0A',
  120.       Ascii_Crlf is '0D0A',
  121.       Ascii_Space is '20',
  122.       Ascii_# is '23',
  123.       Ascii_Ampersand is '26',
  124.       Ascii_Minus is '2D',
  125.       Ascii_Period is '2E',
  126.       Ascii_0 is '30',
  127.       Ascii_1 is '31',
  128.       Ascii_2 is '32',
  129.       Ascii_3 is '33',
  130.       Ascii_Greater_Than is '3E',
  131.       Ascii_A is '41',
  132.       Ascii_B is '42',
  133.       Ascii_C is '43',
  134.       Ascii_D is '44',
  135.       Ascii_E is '45',
  136.       Ascii_F is '46',
  137.       Ascii_G is '47',
  138.       Ascii_H is '48',
  139.       Ascii_I is '49',
  140.       Ascii_J is '4A',
  141.       Ascii_L is '4C',
  142.       Ascii_N is '4E',
  143.       Ascii_S is '53',
  144.       Ascii_Grave is '60',
  145.       Ascii_Tilde is '7E',
  146.       Ascii_Del is '7F',
  147.       Connect_Escape is "#",
  148.       Max_Retries is 5,
  149.       Max_Timeout_Retries is 10,       /* give it plenty of time */
  150.       Min_Timeout is 10,
  151.       Max_Timeout is 30,
  152.       My_Default_Packet_Length is 75,  /* Make it smaller for the
  153.                                           NIM */
  154.       Default_Packet_Length is Max_Packet_Length,
  155.       Default_Timeout is 10,           /* timeout after 10 seconds
  156.                                        */
  157.       Default_Padding_Count is 0,
  158.       Default_Padding_Character is Ascii_Null,
  159.       Default_End_Of_Line_Character is Ascii_Cr,
  160.       Default_Quote_Character is Ascii_#,
  161.       Default_8_Bit_Quote_Character is Ascii_N, /* no 8 bit quoting
  162.                                                 */
  163.       Default_Repeat_Character is Ascii_Space,  /* no repeat quoting
  164.                                                 */
  165.       Max_Encoding_Count is 5,         /* repeat char, repeat count,
  166.                                           8 bit mark, quote,
  167.                                           character */
  168.       Sequence_Number_Modulo is 64,
  169.  
  170.       /* The following are the codes used to specify the various
  171.          types of packets */
  172.       Bad_Code is '00',
  173.       Abort_Code is '01',
  174.       Data_Packet_Code is '44',        /* ascii D */
  175.       Acknowledge_Code is '59',        /* ascii Y */
  176.       Negative_Acknowledge_Code is '4E',  /* ascii N */
  177.       Send_Init_Code is '53',          /* ascii S */
  178.       Break_Transmission_Code is '42', /* ascii B */
  179.       File_Header_Code is '46',        /* ascii F */
  180.       File_Attribute_Code is '41',     /* ascii A */
  181.       End_Of_File_Code is '5A',        /* ascii Z */
  182.       Error_Code is '45',              /* ascii E */
  183.       Receive_Init_Code is '52',       /* ascii R */
  184.       Generic_Command_Code is '47',    /* ascii G */
  185.       Host_Command_Code is '43',       /* ascii C */
  186.       Text_Code is '58',               /* ascii X */
  187.  
  188.       /* file attribute codes */
  189.       Length_File_Attribute is '21',   /* ascii ] */
  190.       Type_File_Attribute is '22',     /* ascii " */
  191.       Mts_File_Attribute is '4D',      /* ascii M */
  192.  
  193.       /* I/O constants */
  194.       Input_Unit_Name is "SCARDS  ",
  195.       Output_Unit_Name is "SPRINT  ",
  196.       Debug_Unit is "SERCOM  ",
  197.       Sercom_Unit is "SERCOM  ",
  198.       Default_In_File is "-KERMIT",
  199.       Debug_Filename is "KERMIT.LOG",
  200.       Backup_Debug_Filename is "-KER.LOG",
  201.       Debug_File_Io_Modifiers is 0,
  202.       Max_Remote_Unit_Name_Length is 20,
  203.  
  204.       Default_Send_Delay is 10,        /* delays for send init */
  205.       Max_Send_Delay is 100,
  206.       Min_Send_Delay is 0,
  207.       Microseconds_Per_Sec is 1000000,
  208.       Write_Remote_Timeout is "2 minutes",
  209.  
  210.       Max_Blocksize is Long_String_Length,
  211.       Min_Binary_Blocksize is 1,       /* ridiculous but there */
  212.       Max_Binary_Blocksize is Max_Blocksize,
  213.       Default_Binary_Blocksize is 256, /* same as mcp */
  214.       Min_Text_Blocksize is 1,         /* no null stuff */
  215.       Max_Text_Blocksize is Max_Blocksize,
  216.       Default_Text_Blocksize is Max_Blocksize,
  217.       Max_Line_Number_String_Length is 20,
  218.  
  219.       /* constants used in the mts file header */
  220.       Mts_File_Indicator is ",",
  221.       Max_Mts_Total_Filename_Length is 17,
  222.       Mts_Line_File is "L",
  223.       Mts_Sequential_File is "S",
  224.       Mts_Save is "S",
  225.       Mts_Nosave is "N",
  226.       Mts_File_Size_Len is 5,
  227.       Default_Pkey is "*EXEC",
  228.       Expected_Binary_Packets_Per_Page is 82,
  229.       Expected_Text_Packets_Per_Page is 54,
  230.       Log_Numeric_Field_Width is 6,
  231.       Millisecond_Field_Width is 10;
  232.  
  233.    type Packet_Char_Count_Type is (0 to Max_Packet_Char_Count),
  234.       Printable_Range_Type is Packet_Char_Count_Type,
  235.       Packet_Length_Type is (0 to Max_Packet_Length),
  236.       Sequence_Number_Type is (0 to Sequence_Number_Modulo - 1),
  237.       Retry_Count_Type is (0 to Max_Retries),
  238.       Padding_Count_Type is (0 to Max_Padding_Count),
  239.       Byte_Integer_Type is (0 to Max_Integer_In_Byte),
  240.  
  241.       State_Type is (Send_Init_State, Send_File_Header_State,
  242.          Send_File_Attribute_State, Send_File_Data_State,
  243.          Send_Eof_State, Send_Eot_State, Receive_State,
  244.          Receive_File_Header_State, Receive_File_Attribute_State,
  245.          Receive_Send_Init_State, Receive_File_Data_State,
  246.          Complete_State, Abort_State, User_Start_State,
  247.          Server_Start_State),
  248.  
  249.       Packet_Type_Type is bit(8),
  250.       Packet_Header_Type is
  251.          record
  252.             Ph_Mark is bit(8),
  253.             Ph_Count is bit(8),
  254.             Ph_Sequence_Number is bit(8),
  255.             Ph_Type is Packet_Type_Type
  256.          end,
  257.       Packet_Header_Character_Type is
  258.          character(Byte_Size(Packet_Header_Type)),
  259.       Checksum_Kind_Type is (Single_Character_Checksum_Kind,
  260.          Two_Character_Checksum_Kind, Crc_Checksum_Kind),
  261.       Checksum_Type is
  262.          record
  263.          variant Checksum_Kind_Type from
  264.          case Single_Character_Checksum_Kind:
  265.             Single_Character_Checksum is character(1)
  266.          case Two_Character_Checksum_Kind:
  267.             Two_Character_Checksum is character(2)
  268.          case Crc_Checksum_Kind:
  269.             Crc_Checksum is character(3)
  270.          end,
  271.       Checksum_Size_Type is (1 to Byte_Size(Checksum_Type)),
  272.       Checksum_Lengths_Type is array Checksum_Kind_Type of
  273.          Checksum_Size_Type,
  274.       Checksum_To_External_Type is array Checksum_Kind_Type of
  275.          bit(8),
  276.       Mode_Type is (User_Mode, Server_Mode),
  277.       Side_Type is (Sending_Side, Receiving_Side), /* this is used
  278.                                                    to determine
  279.                                                    what to do on
  280.                                                    a timeout: NAK
  281.                                                    or resend */
  282.       File_Kind_Type is (Text_File_Kind, Binary_File_Kind,
  283.          Mts_Binary_File_Kind),
  284.  
  285.       File_Kind_Text_Type is array File_Kind_Type of character(0 to
  286.          16),
  287.  
  288.       Packet_Count_Type is
  289.          record
  290.             For_File is Integer,
  291.             For_Session is Integer,
  292.             Side is Side_Type
  293.          end,
  294.  
  295.       Mts_Binary_State_Type is (Start_Mts_Binary_Linenumber_State,
  296.          Build_Mts_Binary_Linenumber_State,
  297.          First_Mts_Binary_Byte_Length_State,
  298.          Second_Mts_Binary_Byte_Length_State,
  299.          Mts_Binary_Bytes_State),
  300.  
  301.       Line_Number_String_Type is character(0 to
  302.          Max_Line_Number_String_Length),
  303.  
  304.       Mts_File_Attribute_Type is
  305.          record
  306.             Mfa_Maxsize_String is character(5),
  307.             Mfa_Nosave is bit(8),
  308.             Mfa_Pkey is character(16)
  309.          end,
  310.  
  311.       Mts_File_Info_Type is
  312.          record
  313.             Mf_File_Organization is Integer,
  314.             Mf_Copied_Size is Short_Integer,
  315.             Mf_Maxsize is Short_Integer,
  316.             Mf_Nosave is Boolean,
  317.             Mf_Pkey is character(16)
  318.          end,
  319.  
  320.       /* storage allocated status */
  321.       Storage_Allocated_Info_Type is
  322.          record
  323.             Sa_Old_Attn_Saved, Sa_Old_Prefix_Saved,
  324.                Sa_Mask_Attn_Stack, Sa_Normal_Attn_Stack,
  325.                Sa_Global_Area, Sa_File_Buffer, Sa_Pcb,
  326.                Sa_File_Transfer_Attn are Boolean
  327.          end,
  328.  
  329.       Date_Type is character(12),
  330.       Time_Type is character(8),
  331.       Fill_Type is character(2),
  332.       Log_Numeric_Field_Type is character(Log_Numeric_Field_Width),
  333.       Millisecond_Field_Type is character(Millisecond_Field_Width),
  334.  
  335.       Log_Record_Type is
  336.          record
  337.             Lr_Date is Date_Type,
  338.             Lr_Fill1 is Fill_Type,
  339.             Lr_Start_Time is Time_Type,
  340.             Lr_Fill2 is Fill_Type,
  341.             Lr_Finish_Time is Time_Type,
  342.             Lr_Fill3 is Fill_Type,
  343.             Lr_Elapsed_Time is Millisecond_Field_Type,
  344.             Lr_Fill4 is Fill_Type,
  345.             Lr_Cpu_Time is Millisecond_Field_Type,
  346.             Lr_Fill5 is Fill_Type,
  347.             Lr_Ccid is character(4),
  348.             Lr_Fill6 is Fill_Type,
  349.             Lr_Send_Command_Count is Log_Numeric_Field_Type,
  350.             Lr_Fill7 is Fill_Type,
  351.             Lr_Get_Command_Count is Log_Numeric_Field_Type,
  352.             Lr_Fill8 is Fill_Type,
  353.             Lr_Total_Command_Count is Log_Numeric_Field_Type,
  354.             Lr_Fill9 is Fill_Type,
  355.             Lr_Out_Packet_Count is Log_Numeric_Field_Type,
  356.             Lr_Fill10 is Fill_Type,
  357.             Lr_In_Packet_Count is Log_Numeric_Field_Type,
  358.             Lr_Fill11 is Fill_Type,
  359.             Lr_Total_Retries is Log_Numeric_Field_Type
  360.          end;
  361.  
  362.    constant Checksum_Lengths is
  363.          Checksum_Lengths_Type(Byte_Size(Checksum_Type,
  364.          Single_Character_Checksum_Kind), Byte_Size(Checksum_Type,
  365.          Two_Character_Checksum_Kind), Byte_Size(Checksum_Type,
  366.          Crc_Checksum_Kind)),
  367.       Checksum_To_External is Checksum_To_External_Type(Ascii_1,
  368.          Ascii_2, Ascii_3),
  369.       Default_Checksum_Kind is Single_Character_Checksum_Kind,
  370.       Max_Non_Data_Count is Byte_Size(Packet_Header_Type) +
  371.          Byte_Size(Checksum_Type),
  372.       Max_Data_Length is Max_Packet_Length - Max_Non_Data_Count,
  373.  
  374.       File_Kind_Text is File_Kind_Text_Type("TEXT", "BINARY",
  375.          "MTS-BINARY"),
  376.  
  377.       Default_Mts_File_Info is Mts_File_Info_Type(Line_File, 1 /*
  378.                                                    one page */
  379.          , Maximum_Short_Integer, False, Default_Pkey !!
  380.          Substring(B255, 0, 16 - Length(Default_Pkey))),
  381.  
  382.       Initial_Storage_Allocated_Info is
  383.          Storage_Allocated_Info_Type(False, False, False, False,
  384.          False, False, False, False);
  385.  
  386.    type Packet_Data_Type is character(0 to Max_Data_Length),
  387.       Packet_Data_Length_Type is (0 to Max_Data_Length),
  388.       Packet_Int_Data_Type is array (1 to Max_Data_Length) of
  389.          bit(8),
  390.       Non_Data_Count_Type is (0 to Max_Non_Data_Count),
  391.       Packet_Buffer_Type is Varying_String,
  392.  
  393.       Capability_Byte_1_Type is
  394.          record
  395.             Cb1_Nul_Bit7, Cb1_Nul_Bit6, Cb1_Can_Time_Out,
  396.                Cb1_Server, Cb1_Accept_File_Attributes, Cb1_Nul_Bit2,
  397.                Cb1_Nul_Bit1, Cb1_Continue_Bit are packed Boolean
  398.          end,
  399.  
  400.       Packet_Parameters_Type is
  401.          record
  402.             Pp_Buffer_Size is bit(8),
  403.             Pp_Timeout is bit(8),
  404.             Pp_Padding_Count is bit(8),
  405.             Pp_Padding_Character is bit(8),
  406.             Pp_End_Of_Line_Character is bit(8),
  407.             Pp_Quote_Character is bit(8),
  408.             Pp_8_Bit_Quote_Character is bit(8),
  409.             Pp_Checksum_Type is bit(8),
  410.             Pp_Repeat_Character is bit(8),
  411.             Pp_Capability_Byte_1 is Capability_Byte_1_Type
  412.          end,
  413.       Packet_Parameters_Character_Type is
  414.          character(Byte_Size(Packet_Parameters_Type)),
  415.       /* types used in subroutine call */
  416.       Guinfo_Pfxstr_Type is
  417.          record
  418.             Gp_Region_Length is Integer,
  419.             Gp_Actual_Length is Integer,
  420.             Gp_Prefix is character(120)
  421.          end,
  422.       Guinfo_Attntrp_Type is array (1 to 2) of Integer,
  423.       Current_Attn_Kind_Type is (Normal_Attn_Kind,
  424.          File_Transfer_Attn_Kind);
  425.  
  426.    constant Capability_Byte_1 is Capability_Byte_1_Type(False,
  427.          False, True, True, True, False, False, False);
  428.  
  429.    type Global_Area_Type is
  430.          record
  431.  
  432.             Current_Data_Size is Packet_Char_Count_Type,
  433.             Last_Sequence_Number is Sequence_Number_Type,
  434.             Current_Sequence_Number is Sequence_Number_Type,
  435.             Next_Sequence_Number is Sequence_Number_Type,
  436.             My_Packet_Length is Packet_Length_Type,
  437.             Your_Packet_Length is Packet_Length_Type,
  438.             My_Timeout is Printable_Range_Type,
  439.             Your_Timeout is Printable_Range_Type,
  440.             Your_Timeout_Char is character(0 to 11),
  441.             My_Padding_Count is Padding_Count_Type,
  442.             Your_Padding_Count is Padding_Count_Type,
  443.             My_Padding_Character is bit(8),
  444.             Your_Padding_Character is bit(8),
  445.             My_End_Of_Line_Character is bit(8),
  446.             Your_End_Of_Line_Character is bit(8),
  447.             My_Quote_Character is bit(8),
  448.             Your_Quote_Character is bit(8),
  449.             Eight_Bit_Quote_Character is bit(8),
  450.             Checksum_Kind is Checksum_Kind_Type,
  451.             Checksum_Size is Checksum_Size_Type,
  452.             My_Repeat_Character is bit(8),
  453.             Your_Repeat_Character is bit(8),
  454.             Times_This_Packet_Retried is Retry_Count_Type,
  455.             Times_Last_Packet_Retried is Retry_Count_Type,
  456.             State is State_Type,
  457.             My_Start_Of_Packet_Character is bit(8),
  458.             Your_Start_Of_Packet_Character is bit(8),
  459.             Non_Data_Count is Non_Data_Count_Type,
  460.  
  461.             Clear_High_Bit_Pattern is character(256),
  462.  
  463.             Mode is Mode_Type,         /* user or server */
  464.             Remote_Mts is Boolean,     /* set when run by other Mts
  465.                                           Kermit */
  466.             Side is Side_Type,         /* sending or receiving */
  467.             Remote_Kermit is Boolean,  /* local or remote */
  468.             Can_Talk_To_Remote_Kermit is Boolean,
  469.             Kill_Remote_Kermit is Boolean,
  470.             Simple_Receive is Boolean,
  471.  
  472.             /* Buffers for building packets */
  473.             Send_Buffer is Packet_Buffer_Type,
  474.             Receive_Buffer is Packet_Buffer_Type,
  475.             Readable_Receive_Buffer is Varying_String,
  476.             Send_Packet_Data is Packet_Data_Type,
  477.  
  478.             /* some parser variables */
  479.             Pcb is pointer to Parser_Control_Block_Type,
  480.             All_Done is Boolean,       /* flag set when kermit is to
  481.                                           exit */
  482.             Error_Message is Varying_String,
  483.             Rcb is Return_Control_Block_Type,
  484.  
  485.             /* file variables */
  486.             Saved_Filename is Packet_Data_Type,
  487.             Out_Filename is Packet_Data_Type,
  488.             Out_Ascii_Filename is Packet_Data_Type,
  489.             Out_File is Mts_File_Type,
  490.             Out_File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type,
  491.             Is_First_Out_File_Record is Boolean,
  492.             Out_File_End_Of_File is Boolean,
  493.             Next_Out_File_Character_Position is Integer,
  494.             In_Filename is Packet_Data_Type,
  495.             Received_Filename is Packet_Data_Type,
  496.             In_Ascii_Filename is Packet_Data_Type,
  497.             In_File is Mts_File_Type,
  498.             Remote_Filename is Packet_Data_Type,
  499.             Pending_Cr is Boolean,
  500.             In_File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type,
  501.             /* source and sink file blocks */
  502.             Input_Unit is Mts_File_Type,
  503.             Input_Unit_Device_Type is character(4),
  504.             Output_Unit is Mts_File_Type,
  505.             Output_Unit_Device_Type is character(4),
  506.             Command_Unit is Mts_File_Type,   /* unit for reading
  507.                                                 commands */
  508.             Remote_Unit is Mts_File_Type,
  509.             Remote_Unit_Name is character(0 to
  510.                Max_Remote_Unit_Name_Length),
  511.             Remote_Unit_Modifiers is Mts_Io_Extended_Modifiers_Type,
  512.             File_Is_Line is Boolean,
  513.             File_Kind is File_Kind_Type,
  514.             Clear_Parity_Bit is Boolean,
  515.             Debug is Boolean,
  516.             Debug_File is Mts_File_Type,
  517.  
  518.             /* Some site specific features for echoing and timeouts
  519.             */
  520.             Can_Set_Read_Timer is Boolean,
  521.             Can_Set_X25_Timer is Boolean,
  522.             Can_Set_Local_Echo is Boolean,
  523.             Can_Set_Network_Echo is Boolean,
  524.             Can_Set_8_Bit_Datapac_Transparancy is Boolean,
  525.             X25_Timer_Set is Boolean,
  526.             Set_Um_Binary_On is Boolean,
  527.             Telenet_Width_Set is Boolean,
  528.  
  529.             Send_Delay is Integer,     /* this is the amount of time
  530.                                           kermit waits before
  531.                                           sending the first
  532.                                           packet */
  533.             Out_Packet_Count is Packet_Count_Type,
  534.             In_Packet_Count is Packet_Count_Type,
  535.             Next_Packet_Count_Threshold is Integer,
  536.             Packet_Count_Interval is Integer,
  537.             Expected_Packets is Integer,
  538.             Display_Packet_Count is Boolean,
  539.             Binary_Blocksize is Integer,
  540.             Text_Blocksize is Integer,
  541.             In_Buffer_End is Integer,
  542.             Mts_Binary_State is Mts_Binary_State_Type,
  543.             Mts_Binary_Length is Short_Integer,
  544.             Current_Line_Number is Integer,
  545.             Last_Line_Number is Integer,
  546.             Line_Number_String is Line_Number_String_Type,
  547.             Line_Number_String_Length is Short_Integer,
  548.             Line_Number_String_Pos is String_Length_Type,
  549.             Is_Line_Number_Fraction is Boolean,
  550.  
  551.             /* old info for subroutine call etc */
  552.             Subroutine_Entry is Boolean,
  553.             Site is character(0 to 10),
  554.             Par_String is character(0 to 256),
  555.             Calling_Mts_Kermit is Boolean,
  556.             Mts_File_Info is Mts_File_Info_Type,
  557.             File_Attribute_Data is Packet_Data_Type,
  558.             Send_File_Attributes is Boolean,
  559.             Read_Attn_Return is Boolean,
  560.             File_Transfer_Attn_Stack_Ptr is pointer to Stack_Type,
  561.             File_Transfer_Attn_Area is Exit_Area_Type,
  562.  
  563.             /* Logging info */
  564.             Logging_Started is Boolean,
  565.             Log_Record is Log_Record_Type,
  566.             Kermit_Log_File is Mts_File_Type,
  567.             Get_Command_Count is Short_Integer,
  568.             Send_Command_Count is Short_Integer,
  569.             Total_Command_Count is Short_Integer,
  570.             Total_Retries is Short_Integer
  571.  
  572.          end;
  573.  
  574. end Main_Global;
  575.  
  576. %Eject();
  577.  
  578. global Kermit_Global external "KERGLB"
  579.  
  580.    /*box
  581.       This global holds a few pointers to the data structures
  582.       used globally by the program.
  583.    */
  584.  
  585.    variable Global_Area_Ptr is pointer to Global_Area_Type,
  586.       /* buffer to hold maximum file record */
  587.       File_Buffer_Ptr is pointer to Long_Varying_String,
  588.       Old_Prefix is Guinfo_Pfxstr_Type,
  589.       Old_Attntrp is Guinfo_Attntrp_Type,
  590.       Entry_Rcb is Return_Control_Block_Type,
  591.       Storage_Allocated_Info is Storage_Allocated_Info_Type;
  592.  
  593. end Kermit_Global;
  594.  
  595. %Eject();
  596.  
  597. /*box
  598.    Attn global variables, and macros. Note getspace must be
  599.    called to get a small stack for the attn routines (half page).
  600. */
  601.  
  602. global Attn_Global
  603.  
  604.    constant Attn_Stack_Length is 2048; /* half page */
  605.  
  606.    variable Mask_Attn_Stack_Ptr is pointer to Stack_Type,
  607.       Normal_Attn_Stack_Ptr is pointer to Stack_Type,
  608.       Mask_Attn_Area is Exit_Area_Type,
  609.       Normal_Attn_Area is Exit_Area_Type,
  610.       Current_Attn_Kind is Current_Attn_Kind_Type,
  611.       Attn_Flag is Boolean,
  612.       Null_Exit_Area is pointer to unknown;
  613.  
  614. end Attn_Global;
  615.  
  616. macro Mask_Attn;
  617.    Attn_Flag := False;
  618.    Set_Exit(Attntrp, Mask_Attn_Routine, Mask_Attn_Area,
  619.       Mask_Attn_Stack_Ptr@, False);
  620. end macro;
  621.  
  622. macro Reenable_Attn;
  623.    if Attn_Flag
  624.    then
  625.       Check_Attn();
  626.    end if;
  627.    if Current_Attn_Kind = Normal_Attn_Kind
  628.    then
  629.       Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area,
  630.          Normal_Attn_Stack_Ptr@, False);
  631.    else                                /* File transfer attn */
  632.       Set_Exit(Attntrp, File_Transfer_Attn, File_Transfer_Attn_Area,
  633.          File_Transfer_Attn_Stack_Ptr@, False);
  634.    end if;
  635.    Attn_Flag := False;
  636. end macro;
  637.  
  638. macro Set_Normal_Attn;
  639.    Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area,
  640.       Normal_Attn_Stack_Ptr@, False);
  641.    Current_Attn_Kind := Normal_Attn_Kind;
  642. end macro;
  643.  
  644. macro Set_File_Transfer_Attn;
  645.    Set_Exit(Attntrp, File_Transfer_Attn, File_Transfer_Attn_Area,
  646.       File_Transfer_Attn_Stack_Ptr@, False);
  647.    Current_Attn_Kind := File_Transfer_Attn_Kind;
  648. end macro;
  649.  
  650. %Eject();
  651.  
  652. /*box
  653.    This section includes the encoding macros:
  654. *//*
  655.  
  656. *//*as_is
  657.          char(x) = x + Ascii_Space (x'20')
  658.  
  659.          unchar(x) = x - Ascii_Space
  660.  
  661.          ctl(x) = x xor '40'
  662. */
  663.  
  664. macro Char
  665.    parameter is X;
  666.    X +:= Ascii_Space;
  667. end macro;
  668.  
  669. macro Unchar
  670.    parameter is X;
  671.    (X - Ascii_Space)
  672. end macro;
  673.  
  674. macro Ctl
  675.    parameter is X;
  676.    X xor:= '40';
  677. end macro;
  678.  
  679. /*Box
  680.    Macros to cycle sequence number. Note three global variables
  681.    last_sequence_number, current_sequence_number, and
  682.    next_sequence_number are used to by these macros to keep track
  683.    of the packet sequence.
  684. */
  685. macro Increment_Sequence_Numbers;
  686.    Last_Sequence_Number := (Last_Sequence_Number + 1) mod
  687.       Sequence_Number_Modulo;
  688.    Current_Sequence_Number := (Current_Sequence_Number + 1) mod
  689.       Sequence_Number_Modulo;
  690.    Next_Sequence_Number := (Next_Sequence_Number + 1) mod
  691.       Sequence_Number_Modulo;
  692. end macro;
  693.  
  694. macro Initialize_Sequence_Numbers;
  695.    Last_Sequence_Number := Sequence_Number_Modulo - 1;
  696.    Current_Sequence_Number := 0;
  697.    Next_Sequence_Number := 1;
  698. end macro;
  699.  
  700. macro Read_Long_Varying
  701.    parameters are Mts_File, Long_Var_String;
  702.    equate Buffer to Long_Var_String as
  703.          Long_Varying_String_Structure_Type;
  704.    open Buffer,
  705.       Mts_File;
  706.    /* set maxlen even though in this case it matters little */
  707.    File_Length.Maximum_Length := Long_String_Length;
  708.    File_Simple_Length := 0;            /* for EOF */
  709.    Last_Result := Read(Long_Varying_String_Text, File_Length,
  710.       File_Modifiers, File_Line_Number, File_Unit return code
  711.       Last_Return_Code);
  712.    Long_Varying_String_Length := File_Simple_Length;
  713. end macro;
  714.  
  715. macro Ascii_To_Mts_Ebcdic
  716.    parameters are String, Len;
  717.    /* This macro converts a string from ASCII to MTS EBCDIC. Note
  718.       the string must be <= 255 bytes long. */
  719.    variable Tr_Inst is aligned 16 left bit(48),
  720.       Lenm1 is Integer in register 15;
  721.    variable Convert_Table is value character(256) external "ASCEBC";
  722.    Lenm1 := Len - 1;
  723.    if Lenm1 >= 0
  724.    then
  725.       variable String_Addr is pointer to unknown in register 2,
  726.          Convert_Addr is pointer to value character(256) in register
  727.             3;
  728.       Tr_Inst := 'DC 00 2000 3000';
  729.       String_Addr := Address(String);
  730.       Convert_Addr := Address(Convert_Table);
  731.       Inline(Ex, Lenm1, 0, Tr_Inst, String_Addr, Convert_Addr);
  732.    end if;
  733. end macro;
  734.  
  735. macro Mts_Ebcdic_To_Ascii
  736.    parameters are String, Len;
  737.    /* This macro converts a string from MTS EBCDIC to ASCII. Note
  738.       the string must be <= 255 bytes long. */
  739.    /* The macro also clears the parity bit */
  740.    variable Tr_Inst is aligned 16 left bit(48),
  741.       Nc_Inst is aligned 16 left bit(48),
  742.       Lenm1 is Integer in register 15;
  743.    variable Convert_Table is value character(256) external "EBCASC";
  744.    Lenm1 := Len - 1;
  745.    if Lenm1 >= 0
  746.    then
  747.       variable String_Addr is pointer to unknown in register 2,
  748.          Convert_Addr is pointer to value character(256) in register
  749.             3;
  750.       Tr_Inst := 'DC 00 2000 3000';
  751.       String_Addr := Address(String);
  752.       Convert_Addr := Address(Convert_Table);
  753.       Inline(Ex, Lenm1, 0, Tr_Inst, String_Addr, Convert_Addr);
  754.       Nc_Inst := 'D4 00 2000 3000';
  755.       Convert_Addr := Address(Clear_High_Bit_Pattern);
  756.       Inline(Ex, Lenm1, 0, Nc_Inst, String_Addr, Convert_Addr);
  757.    end if;
  758. end macro;
  759.  
  760. macro Read_From_User
  761.    parameters are Mts_Unit, Varying_String;
  762.    open Mts_Unit;
  763.    File_Modifiers := 0;
  764.    Read_Varying(Mts_Unit, Varying_String);
  765. end macro;
  766.  
  767. macro Read_Packet
  768.    parameters are Mts_Unit, Varying_String;
  769.    open Mts_Unit;
  770.    File_Modifiers := Mts_Io_Binary ! Mts_Io_Errrtn ! Mts_Io_Not_Trim;
  771.    Read_Varying(Mts_Unit, Varying_String);
  772. end macro;
  773.  
  774. macro Write_Packet
  775.    parameters are Mts_Unit, Varying_String;
  776.    open Mts_Unit;
  777.    File_Modifiers := Mts_Io_Binary ! Mts_Io_Errrtn ! Mts_Io_Not_Trim;
  778.    Write_Varying(Mts_Unit, Varying_String);
  779. end macro;
  780.  
  781. macro Debug_String
  782.    parameter is String;
  783.    variable Line is Varying_String;
  784.    Line := String;
  785.    Write_Varying(Debug_File, Line);
  786. end macro;
  787.  
  788. macro Increment_Packet_Count
  789.    parameter is Packet_Count;
  790.    open Packet_Count;
  791.    For_File +:= 1;
  792.    For_Session +:= 1;
  793. end macro;
  794.  
  795. macro Initialize_Packet_Count
  796.    parameter is Packet_Count;
  797.    Packet_Count.For_File := 0;
  798.    Next_Packet_Count_Threshold := Packet_Count_Interval;
  799.    Display_Packet_Count := True;
  800.    Expected_Packets := 0;
  801. end macro;
  802.  
  803. macro Set_Filetype_Text;
  804.    Clear_Parity_Bit := True;
  805.    File_Kind := Text_File_Kind;
  806.    In_Buffer_End := Text_Blocksize;
  807. end macro;
  808.  
  809. macro Set_Filetype_Binary;
  810.    Clear_Parity_Bit := False;
  811.    File_Kind := Binary_File_Kind;
  812.    In_Buffer_End := Binary_Blocksize;
  813. end macro;
  814.  
  815. macro Set_Filetype_Mts_Binary;
  816.    Clear_Parity_Bit := False;
  817.    File_Kind := Mts_Binary_File_Kind;
  818.    In_Buffer_End := Max_Blocksize;
  819. end macro;
  820.  
  821. macro Check_For_Retries
  822.    parameter is Retry_Kind;
  823.    if Retry_Kind > 0
  824.    then
  825.       Total_Retries +:= 1;
  826.    end if;
  827. end macro;
  828.  
  829. %Eject();
  830.  
  831. /*box
  832.    This sections lists all the procedures defined in the program
  833. */
  834.  
  835. procedure Main is
  836.       procedure
  837.       reference optional parameter Par is character(0 to 256) in
  838.             register 0
  839.       result Rc is Integer in register 15
  840.       end external "MAIN" linkage "PLUSENTR";
  841.  
  842. %Library := True;
  843.  
  844. procedure Kermit_Subroutine is
  845.       procedure
  846.       reference parameter Kermitcb is pointer to unknown,
  847.       reference parameter Kermit_Switches is bit(32),
  848.       reference parameter Commands_Fdname is character(20),
  849.       result Rc is Integer in register 15
  850.       end external "KERMIT" linkage system;
  851.  
  852. procedure Kermit_Main is
  853.       procedure
  854.       result Rc is Integer
  855.       end external "MAINKER";
  856.  
  857. procedure Setup_Kermit_Environment is
  858.       procedure
  859.       reference parameter Success is Boolean
  860.       end external "SETUPKEN";
  861.  
  862. procedure Cleanup is
  863.       procedure
  864.       end external "CLEANUP";
  865.  
  866. procedure Mask_Attn_Routine is Exit_Routine_Type external
  867.    "MASKATTN";
  868.  
  869. procedure Normal_Attn_Routine is Exit_Routine_Type external
  870.       "NORMATTN";
  871.  
  872. procedure File_Transfer_Attn is Exit_Routine_Type external
  873.       "FILEATTN";
  874.  
  875. procedure Check_Attn is
  876.       procedure
  877.       end external "CHKATTN";
  878.  
  879. procedure Main_Semantics is Semantic_Procedure_Type;
  880.  
  881. procedure Set_Semantics is Semantic_Procedure_Type;
  882.  
  883. procedure Show_Semantics is Semantic_Procedure_Type;
  884.  
  885. procedure Par_String_Semantics is Semantic_Procedure_Type;
  886.  
  887. procedure Filename_Semantics is Semantic_Procedure_Type;
  888.  
  889. procedure Initialize is
  890.       procedure
  891.       end external "INITLIZE";
  892.  
  893. procedure Send_File is
  894.       procedure
  895.       reference parameter Success is Boolean
  896.       end;
  897.  
  898. procedure Send_Init_Action is
  899.       procedure
  900.       result Next_State is State_Type
  901.       end external "SND_INTA";
  902.  
  903. procedure Send_File_Header_Action is
  904.       procedure
  905.       result Next_State is State_Type
  906.       end external "SND_FHA";
  907.  
  908. procedure Send_File_Attribute_Action is
  909.       procedure
  910.       result Next_State is State_Type
  911.       end external "SND_FAA";
  912.  
  913. procedure Send_File_Data_Action is
  914.       procedure
  915.       result Next_State is State_Type
  916.       end external "SND_FDA";
  917.  
  918. procedure Send_Eof_Action is
  919.       procedure
  920.       result Next_State is State_Type
  921.       end external "SND_EOFA";
  922.  
  923. procedure Send_Eot_Action is
  924.       procedure
  925.       result Next_State is State_Type
  926.       end external "SND_EOTA";
  927.  
  928. procedure Receive_File is
  929.       procedure
  930.       reference parameter Success is Boolean
  931.       end;
  932.  
  933. procedure Receive_File_Header_Action is
  934.       procedure
  935.       result Next_State is State_Type
  936.       end external "REC_FHA";
  937.  
  938. procedure Receive_File_Attribute_Action is
  939.       procedure
  940.       result Next_State is State_Type
  941.       end external "REC_FAA";
  942.  
  943. procedure Receive_File_Data_Action is
  944.       procedure
  945.       result Next_State is State_Type
  946.       end external "REC_FDA";
  947.  
  948. procedure Receive_Send_Init_Action is
  949.       procedure
  950.       result Next_State is State_Type
  951.       end external "REC_SINA";
  952.  
  953. procedure Server_Node is
  954.       procedure
  955.       reference parameter Success is Boolean
  956.       end external "SERVNODE";
  957.  
  958. procedure Server_Receive_File is
  959.       procedure
  960.       reference parameter Success is Boolean
  961.       end external "SERVRCVF";
  962.  
  963. procedure Receive_File_From_Server is
  964.       procedure
  965.       parameter Receive_Filename is Packet_Data_Type,
  966.       reference parameter Success is Boolean
  967.       end external "RECFSERV";
  968.  
  969. procedure Send_Packet is
  970.       procedure
  971.       parameter Packet_Type is Packet_Type_Type
  972.       parameter Sequence_Number is Sequence_Number_Type,
  973.       parameter Packet_Data is Packet_Data_Type
  974.       end external "SENDPACK";
  975.  
  976. procedure Send_Remote_Packet is
  977.       procedure
  978.       end external "SENDRPKT";
  979.  
  980. procedure Receive_Packet is
  981.       procedure
  982.       reference parameter Packet_Type is Packet_Type_Type,
  983.       reference parameter Sequence_Number is Sequence_Number_Type,
  984.       reference parameter Packet_Data is Packet_Data_Type
  985.       end;
  986.  
  987. procedure Get_Local_Packet is
  988.       procedure
  989.       reference parameter Success is Boolean
  990.       end external "GETLPCKT";
  991.  
  992. procedure Get_Remote_Packet is
  993.       procedure
  994.       reference parameter Success is Boolean
  995.       end external "GETRPCKT";
  996.  
  997. procedure Dump_Receive_Buffer is
  998.       procedure
  999.       end external "DUMPRCBF";
  1000.  
  1001. procedure Get_My_Packet_Parameters is
  1002.       procedure
  1003.       reference parameter Send_Init_Data is Packet_Data_Type
  1004.       end external "GTMYPARM";
  1005.  
  1006. procedure Get_Your_Packet_Parameters is
  1007.       procedure
  1008.       reference parameter Packet_Data is Packet_Data_Type
  1009.       end external "GTYRPARM";
  1010.  
  1011. procedure Get_Out_File_Data is
  1012.       procedure
  1013.       reference parameter Packet_Data is Packet_Data_Type,
  1014.       reference parameter End_Of_File is Boolean
  1015.       end;
  1016.  
  1017. procedure Get_Next_Out_File_Character is
  1018.       procedure
  1019.       reference parameter Next_Character is bit(8),
  1020.       reference parameter Success is Boolean
  1021.       end external "GETNOFCH";
  1022.  
  1023. procedure Put_In_File_Data is
  1024.       procedure
  1025.       reference parameter Packet_Data is Packet_Data_Type,
  1026.       reference parameter Put_Success is Boolean
  1027.       end;
  1028.  
  1029. procedure Decode_File_Attributes is
  1030.       procedure
  1031.       parameter File_Attribute_Packet is Packet_Data_Type
  1032.       end external "DECODEFA";
  1033.  
  1034. procedure Open_In_File is
  1035.       procedure
  1036.       reference parameter Success is Boolean
  1037.       end external "OPENINF";
  1038.  
  1039. procedure Open_Out_File is
  1040.       procedure
  1041.       reference parameter Success is Boolean
  1042.       end external "OPENOUTF";
  1043.  
  1044. procedure Flush_Input_Unit is
  1045.       procedure
  1046.       end;
  1047.  
  1048. procedure Write_In_File_Buffer is
  1049.       procedure
  1050.       reference parameter Success is Boolean
  1051.       end;
  1052.  
  1053. procedure Get_Next_Out_File is
  1054.       procedure
  1055.       reference parameter Success is Boolean
  1056.       end external "GETNOUTF";
  1057.  
  1058. procedure Send_Error_Message is
  1059.       procedure
  1060.       parameter Error_Message is Varying_String
  1061.       end external "SNDERRMG";
  1062.  
  1063. procedure Handle_Received_Error is
  1064.       procedure
  1065.       parameter Error_Packet_Data is Packet_Data_Type
  1066.       end external "HNDLRERR";
  1067.  
  1068. procedure Handle_Error is
  1069.       procedure
  1070.       end external "HANDLERR";
  1071.  
  1072. procedure Do_Generic_Command is
  1073.       procedure
  1074.       parameter Receive_Data is Packet_Data_Type,
  1075.       reference parameter Quit is Boolean,
  1076.       reference parameter Success is Boolean
  1077.       end external "DOGENCMD";
  1078.  
  1079. procedure Get_Valid_Ascii_Control_Char is
  1080.       procedure
  1081.       reference parameter Ascii_Code is bit(8),
  1082.       reference parameter Success is Boolean
  1083.       end external "GETVACC";
  1084.  
  1085. procedure Get_Remote_Unit is
  1086.       procedure
  1087.       result Success is Boolean
  1088.       end external "GETRUNIT";
  1089.  
  1090. procedure Configure_Remote_Unit is
  1091.       procedure
  1092.       end external "CNFGREMU";
  1093.  
  1094. procedure Get_Inout_Unit_Types is
  1095.       procedure
  1096.       end external "TYPE_IOU";
  1097.  
  1098. procedure Open_Debug_File is
  1099.       procedure
  1100.       reference parameter Success is Boolean
  1101.       end external "OPENDBGF";
  1102.  
  1103. procedure Send_Generic_Command is
  1104.       procedure
  1105.       parameter Generic_Command is Packet_Data_Type,
  1106.       reference parameter Success is Boolean
  1107.       end external "SENDGCMD";
  1108.  
  1109. procedure Display_Packet_Action is
  1110.       procedure
  1111.       parameter Packet_Count is Packet_Count_Type
  1112.       end external "DISPCKAC";
  1113.  
  1114. procedure Write_To_User is
  1115.       procedure
  1116.       parameter Message is Varying_String
  1117.       end external "PUTMSG";
  1118.  
  1119. procedure Put_Mts_Binary_Data is
  1120.       procedure
  1121.       parameter Next_Character is bit(8),
  1122.       reference parameter Put_Success is Boolean
  1123.       end external "PUTMTSBD";
  1124.  
  1125. procedure Get_Mts_Binary_Data is
  1126.       procedure
  1127.       reference parameter Next_Character is bit(8),
  1128.       reference parameter Success is Boolean
  1129.       end external "GETMTSBD";
  1130.  
  1131. procedure Encode_Mts_Linenumber is
  1132.       procedure
  1133.       parameter Line_Number_Difference is Integer,
  1134.       reference parameter Encoded_Line_Number is
  1135.             Line_Number_String_Type
  1136.       end external "ENCODEL#";
  1137.  
  1138. procedure Decode_Mts_Linenumber is
  1139.       procedure
  1140.       parameter Line_Number_String is Line_Number_String_Type,
  1141.       reference parameter Line_Number_Difference is Integer,
  1142.       reference parameter Success is Boolean
  1143.       end external "DECODEL#";
  1144.  
  1145. procedure Save_And_Set_Prefix_String is
  1146.       procedure
  1147.       end external "SASETPFX";
  1148.  
  1149. procedure Send_Kermit_Run_Command is
  1150.       procedure
  1151.       result Success is Boolean
  1152.       end external "SENDKERR";
  1153.  
  1154. procedure Stop_Remote_Kermit is
  1155.       procedure
  1156.       end external "STOPRKER";
  1157.  
  1158. procedure Initialize_Logging is
  1159.       procedure
  1160.       end external "INITLOG";
  1161.  
  1162. procedure Terminate_Logging is
  1163.       procedure
  1164.       end external "TERMLOG";
  1165.  
  1166. procedure Set_Echo_Off is
  1167.       procedure
  1168.       end external "SETEOFF";
  1169.  
  1170. procedure Set_Echo_On is
  1171.       procedure
  1172.       end external "SETEON";
  1173.  
  1174. %Eject();
  1175.  
  1176. definition Main
  1177.  
  1178.    /*box
  1179.       Entry point used when KERMIT is called as a main program.
  1180.    */
  1181.  
  1182.    Rc := 0;
  1183.    variable Good_Environment is Boolean;
  1184.    /* get an environment */
  1185.    Setup_Kermit_Environment(Good_Environment);
  1186.    return when not Good_Environment with Error_Rc;
  1187.  
  1188.    open Global_Area_Ptr@;
  1189.    Par_String := Par;
  1190.    Subroutine_Entry := False;
  1191.    Calling_Mts_Kermit := False;
  1192.    Initialize_File(Command_Unit, "GUSER   ", 0);
  1193.    /* check to see if logical unit 0 is attached to a mounted device
  1194.    */
  1195.    variable Temp_Unit is Mts_File_Type;
  1196.    Initialize_File_With_Unit#(Temp_Unit, 0, Remote_Unit_Modifiers);
  1197.    Remote_Kermit := True;
  1198.    Mode := User_Mode;
  1199.    Set_Filetype_Text();
  1200.    variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type,
  1201.       Gdinfo_Rc is Integer;
  1202.    Gdinfo_Result_Ptr := Gdinfo(Temp_Unit.File_Unit return code
  1203.       Gdinfo_Rc);
  1204.    if Gdinfo_Rc = 0
  1205.    then                                /* have something attached to
  1206.                                           unit */
  1207.       open Gdinfo_Result_Ptr@;
  1208.       if Gd_Use_Code = Gd_Mounted_Device
  1209.       then                             /* have attached mounted unit
  1210.                                        */
  1211.          Remote_Unit := Temp_Unit;
  1212.          Configure_Remote_Unit();
  1213.          Remote_Kermit := False;
  1214.       end if;
  1215.    end if;
  1216.    Rc := Kermit_Main();
  1217.    if Kill_Remote_Kermit
  1218.    then
  1219.       Stop_Remote_Kermit();
  1220.    end if;
  1221.    Terminate_Logging();
  1222.    Cleanup();
  1223.  
  1224. end Main;
  1225.  
  1226. %Eject();
  1227.  
  1228. definition Kermit_Subroutine
  1229.  
  1230.    /*box
  1231.       This is the entry point used when KERMIT is called as a
  1232.       subroutine. It takes three parameters, a control block
  1233.       (Kermitcb), some switches (kermit_switches), and an fdname
  1234.       for the commands input. Unit 0 is used to connect to the
  1235.       remote kermit. The return codes are:
  1236.    *//*
  1237.  
  1238.    *//*
  1239.       0 - all okay. If kermit called again this parameter is
  1240.       zero.
  1241.    *//*
  1242.       4 - okay but returned kermitcb is retained and passed
  1243.       again.
  1244.    *//*
  1245.       8 - error. Kermitcb will be zero if called again.
  1246.    */
  1247.  
  1248.    constant Mts_Switch is '00 00 00 01';
  1249.  
  1250.    variable Get_Fdub_Rc is Integer,
  1251.       Good_Environment is Boolean;
  1252.    Rc := 0;
  1253.    /* allocate global area */
  1254.    Setup_Kermit_Environment(Good_Environment);
  1255.    return when not Good_Environment with Error_Rc;
  1256.  
  1257.    open Global_Area_Ptr@;
  1258.    Subroutine_Entry := True;
  1259.    Remote_Kermit := False;
  1260.    Mode := User_Mode;
  1261.    if Kermit_Switches & Mts_Switch = Mts_Switch
  1262.    then
  1263.       Calling_Mts_Kermit := True;
  1264.       Set_Filetype_Mts_Binary();
  1265.    else                                /* default to text */
  1266.       Calling_Mts_Kermit := False;
  1267.       Set_Filetype_Text();
  1268.    end if;
  1269.    Initialize_File_With_Name(Command_Unit, Commands_Fdname, 0,
  1270.       Get_Fdub_Rc);
  1271.    return when Get_Fdub_Rc > 0 with 8;
  1272.    Initialize_File_With_Unit#(Remote_Unit, 0,
  1273.       Remote_Unit_Modifiers);
  1274.    Configure_Remote_Unit();
  1275.    if Calling_Mts_Kermit
  1276.    then
  1277.       if not Send_Kermit_Run_Command()
  1278.       then
  1279.          Rc := Error_Rc;
  1280.          return;
  1281.       end if;
  1282.    end if;
  1283.    Rc := Kermit_Main();
  1284.    if Kill_Remote_Kermit
  1285.    then
  1286.       Stop_Remote_Kermit();
  1287.    end if;
  1288.    Terminate_Logging();
  1289.    Cleanup();
  1290.  
  1291. end Kermit_Subroutine;
  1292.  
  1293. %Eject();
  1294.  
  1295. definition Kermit_Main
  1296.  
  1297.    /*box
  1298.       This procedure initializes the variables used to build
  1299.       packets, parses commands, and calls the tasks needed to
  1300.       carryout the commands.
  1301.    */
  1302.  
  1303.    variable Command_Line is Varying_String,
  1304.       Getspace_Rc is Integer;
  1305.  
  1306.    open Global_Area_Ptr@;
  1307.    /* set up exit for attn etc */
  1308.    Setup_Return_From(Entry_Rcb, Rc);
  1309.    Rc := 0;
  1310.    /* set up the input and output units scards and sprint */
  1311.    /* These unit are used when Kermit is talking to a microcomputer
  1312.       Kermit */
  1313.    Initialize_Logging();
  1314.    Initialize_File(Input_Unit, Input_Unit_Name, 0);
  1315.    Initialize_File(Output_Unit, Output_Unit_Name, 0);
  1316.    Get_Inout_Unit_Types();
  1317.  
  1318.    /* Set up the Help file */
  1319.    Parse_Set(Pcb, Help_File_Name,
  1320.       Parse_String_Type(Kermit_Help_File));
  1321.  
  1322.    if Calling_Mts_Kermit
  1323.    then
  1324.       variable Success is Boolean;
  1325.       /*box
  1326.          We have a call to a remote Mts Kermit. By now the remote
  1327.          Kermit should be running. We'll try to see if we can
  1328.          establish contact using a generic command. If we don't
  1329.          succeed tell the user there maybe nobody at the other
  1330.          end. If we can talk the generic command routine sets
  1331.          Can_Talk_To_Remote_Mts to True. When you shut down the
  1332.          local Mts Kermit if it can talk to another kermit it
  1333.          will shut it down.
  1334.       */
  1335.       Send_Delay := 0;
  1336.       Send_Generic_Command("T" !! File_Kind_Text(File_Kind),
  1337.          Success);
  1338.       if not Success
  1339.       then
  1340.          Write_To_User(" Unable to set remote filetype to " !!
  1341.             File_Kind_Text(File_Kind) !! ".");
  1342.          Write_To_User(" Remote Kermit probably not successfully "
  1343.             !! "started.");
  1344.       end if;
  1345.    else                                /* Program entry point: check
  1346.                                           Par string */
  1347.       if Length(Par_String) > 0
  1348.       then
  1349.          Parse(Pcb, Par_String_List, Address(Substring(Par_String,
  1350.             0)), Length(Par_String));
  1351.       end if;
  1352.    end if;
  1353.  
  1354.    if not Remote_Mts
  1355.    then
  1356.       /* Display Banner */
  1357.       Write_To_User("     MTS KERMIT (" !! Site !! ")      V" !!
  1358.          Version !! "(" !! Substring(%Time, 0, 5) !!
  1359.          Substring(%Date, 4, 3) !! Substring(%Date, 8, 5) !! ")");
  1360.    end if;
  1361.  
  1362.    if Mode = Server_Mode
  1363.    then
  1364.       if not Remote_Mts
  1365.       then
  1366.          open Cnfginfo;
  1367.          if (Ci_Installation_Code = Ci_Ubc) & Calling_Mts_Kermit
  1368.          then
  1369.             Write_To_User(" Kermit in Server mode. Enter /KERMIT.");
  1370.          else
  1371.             Write_To_User(
  1372.                " Kermit in Server mode. Escape to Local Kermit.");
  1373.          end if;
  1374.       end if;
  1375.       variable Success is Boolean;
  1376.       Set_Echo_Off();
  1377.       Server_Node(Success);
  1378.       Set_Echo_On();
  1379.       All_Done := True;
  1380.    else                                /* user mode */
  1381.       cycle
  1382.          /*box
  1383.             When Kermit is in user mode this loop is used to read
  1384.             user commands. The only other place user commands are
  1385.             read is in the Normal_Attn_Routine and the
  1386.             File_Transfer_Attn. In those routines the user is
  1387.             asked whether he wants to continue or not. The
  1388.             procedure that perform all the action are called by
  1389.             the semantic routines. The STOP (EXIT, FINISH)
  1390.             commands or End_Of_File will terminate the program.
  1391.          */
  1392.          Read_Attn_Return := False;
  1393.          Read_From_User(Command_Unit, Command_Line);
  1394.          open Command_Unit;
  1395.          if Last_Return_Code > 0
  1396.          then
  1397.             exit;
  1398.          end if;
  1399.          repeat when Read_Attn_Return;
  1400.          if Debug
  1401.          then
  1402.             Debug_String(" User input: " !! Command_Line);
  1403.          end if;
  1404.          Total_Command_Count +:= 1;
  1405.          Parse(Pcb, Kermit_Command, Address(Substring(Command_Line,
  1406.             0)), Length(Command_Line));
  1407.          exit when All_Done;
  1408.       end cycle;
  1409.    end if;
  1410.  
  1411. end Kermit_Main;
  1412.  
  1413. %Eject();
  1414.  
  1415. definition Mask_Attn_Routine
  1416.  
  1417.    /*box
  1418.       This procedure is used to temporarily disable attention
  1419.       interrupts in critical processing sections of the program.
  1420.       It sets the global "Attn_flag" to true if an attention
  1421.       interrupt has occured. The macros mask_attn and
  1422.       reenable_attn should surround the critical section.
  1423.    */
  1424.  
  1425.    open Global_Area_Ptr@;
  1426.    Attn_Flag := True;
  1427.    /* disable attn's - return to program */
  1428.    Set_Exit(Attntrp, Mask_Attn_Routine, Mask_Attn_Area,
  1429.       Mask_Attn_Stack_Ptr@, True);
  1430.  
  1431. end Mask_Attn_Routine;
  1432.  
  1433. %Eject();
  1434.  
  1435. definition Normal_Attn_Routine
  1436.  
  1437.    /*box
  1438.       This is the attentions handler for the bulk of the program.
  1439.       A separate attention handler is setup for the region of the
  1440.       program where the timers are set to make sure no
  1441.       outstanding timers are left enabled. If the attention is
  1442.       received by a remote Kermit any allocated space is freed
  1443.       and the program stops. If it is a local Kermit the user is
  1444.       asked if he wants to continue. If he does the program
  1445.       continues, if not space is freed and the program is
  1446.       terminated.
  1447.    */
  1448.    open Global_Area_Ptr@;
  1449.    /* stop multiple attn's for a while */
  1450.    Mask_Attn();
  1451.    Set_Echo_On();
  1452.    if Mode = User_Mode
  1453.    then
  1454.       <Begin_Block>
  1455.       begin
  1456.          /* check to see if user wants to continue */
  1457.          variable User_Response is Varying_String;
  1458.          Write_To_User(" Attn] Do you wish to continue (Y/N)?");
  1459.          cycle
  1460.             Read_From_User(Command_Unit, User_Response);
  1461.             exit <Begin_Block> when Attn_Flag;
  1462.             open Command_Unit;
  1463.             exit <Begin_Block> when Last_Return_Code > 0 or
  1464.                Length(User_Response) = 0;
  1465.             /* Check response */
  1466.             Case_Conversion(Substring(User_Response, 0),
  1467.                Length(User_Response));
  1468.             if Substring(User_Response, 0, 1) = "Y"
  1469.             then
  1470.                /* Have user who wants to resume so do so */
  1471.                Read_Attn_Return := True;
  1472.                Set_Exit(Attntrp, Normal_Attn_Routine,
  1473.                   Normal_Attn_Area, Normal_Attn_Stack_Ptr@, True);
  1474.             elseif Substring(User_Response, 0, 1) = "N"
  1475.             then
  1476.                exit <Begin_Block>;
  1477.             else                       /* Bad response, ask for
  1478.                                           correct one */
  1479.                Write_To_User(" Enter Y or N.");
  1480.             end if;
  1481.          end cycle;
  1482.       end <Begin_Block>
  1483.    end if;
  1484.  
  1485.    /* okay person doesn't want to continue, kill program */
  1486.    Kill_Remote_Kermit := True;
  1487.    Return_From(Entry_Rcb, Integer(Error_Rc));
  1488.  
  1489. end Normal_Attn_Routine;
  1490.  
  1491. %Eject();
  1492.  
  1493. definition File_Transfer_Attn
  1494.  
  1495.    /*box
  1496.       This procedure is called when an attention occurs during a
  1497.       file tranfer. If it does occur the user is asked if he
  1498.       wants to continue. If not the user is returned to user
  1499.       command mode.
  1500.    */
  1501.  
  1502.    open Global_Area_Ptr@;
  1503.    /* Stop Multiple Attn's */
  1504.    Mask_Attn();
  1505.    Set_Echo_On();
  1506.    if Mode = User_Mode
  1507.    then
  1508.       <Begin_Block>
  1509.       begin
  1510.          /* check to see if we should continue */
  1511.          variable User_Response is Varying_String;
  1512.          Write_To_User(" Attn] Do you wish to continue the file " !!
  1513.             "transfer (Y/N)?");
  1514.          cycle
  1515.             Read_From_User(Command_Unit, User_Response);
  1516.             exit <Begin_Block> when Attn_Flag;
  1517.             open Command_Unit;
  1518.             exit <Begin_Block> when Last_Return_Code > 0 or
  1519.                Length(User_Response) = 0;
  1520.             /* Check response */
  1521.             Case_Conversion(Substring(User_Response, 0, 1),
  1522.                Length(User_Response));
  1523.             if Substring(User_Response, 0, 1) = "Y"
  1524.             then
  1525.                /* Have user that wishes to continue */
  1526.                Read_Attn_Return := True;
  1527.                Set_Echo_Off();
  1528.                Set_Exit(Attntrp, File_Transfer_Attn,
  1529.                   File_Transfer_Attn_Area,
  1530.                   File_Transfer_Attn_Stack_Ptr@, True);
  1531.             elseif Substring(User_Response, 0, 1) = "N"
  1532.             then
  1533.                exit <Begin_Block>;
  1534.             else
  1535.                Write_To_User(" Enter Y or N.");
  1536.             end if;
  1537.          end cycle;
  1538.       end <Begin_Block>
  1539.    end if;
  1540.  
  1541.    /* okay person wants to stop transfer */
  1542.    Error_Message := "File transfer aborted.";
  1543.    /* Restore exit to normal Attn */
  1544.    Read_Attn_Return := True;
  1545.    Current_Attn_Kind := Normal_Attn_Kind;
  1546.    Set_Exit(Attntrp, Normal_Attn_Routine, Normal_Attn_Area,
  1547.       Normal_Attn_Stack_Ptr@, False);
  1548.    Return_From(Rcb, Boolean(False));
  1549.  
  1550. end File_Transfer_Attn;
  1551.  
  1552. %Eject();
  1553.  
  1554. definition Check_Attn
  1555.  
  1556.    /*box
  1557.       This routine is called if after a critical region it is
  1558.       discovered that an attention has been given. It asks the
  1559.       user whether it should continue or quit. If the user wants
  1560.       to quit the environment is cleaned up and we return to the
  1561.       caller.
  1562.    */
  1563.    open Global_Area_Ptr@;
  1564.    /* stop multiple attn's for a while */
  1565.    Mask_Attn();
  1566.    Set_Echo_On();
  1567.    if Mode = User_Mode
  1568.    then
  1569.       <Begin_Block>
  1570.       begin
  1571.          /* check to see if user wants to continue */
  1572.          variable User_Response is Varying_String;
  1573.          if Current_Attn_Kind = Normal_Attn_Kind
  1574.          then
  1575.             Write_To_User(
  1576.                " Attn] Do you wish to continue the program (Y/N)?");
  1577.          else                          /* File Transfer Attn */
  1578.             Write_To_User(" Attn] Do you wish to continue with the "
  1579.                !! "file transfer (Y/N)?");
  1580.          end if;
  1581.          cycle
  1582.             Read_From_User(Command_Unit, User_Response);
  1583.             exit <Begin_Block> when Attn_Flag;
  1584.             open Command_Unit;
  1585.             exit <Begin_Block> when Last_Return_Code > 0 or
  1586.                Length(User_Response) = 0;
  1587.             /* Check response */
  1588.             Case_Conversion(Substring(User_Response, 0),
  1589.                Length(User_Response));
  1590.             if Substring(User_Response, 0, 1) = "Y"
  1591.             then
  1592.                /* Have user who wants to resume so do so */
  1593.                if Current_Attn_Kind = File_Transfer_Attn_Kind
  1594.                then
  1595.                   Set_Echo_Off();
  1596.                end;
  1597.                return
  1598.             elseif Substring(User_Response, 0, 1) = "N"
  1599.             then
  1600.                exit <Begin_Block>
  1601.             else                       /* Improper Response */
  1602.                Write_To_User(" Enter Y or N.");
  1603.             end if;
  1604.          end cycle;
  1605.       end <Begin_Block>
  1606.    end if;
  1607.    if Current_Attn_Kind = Normal_Attn_Kind
  1608.    then
  1609.       /* okay person doesn't want to continue, kill program */
  1610.       Stop_Remote_Kermit();
  1611.       Return_From(Entry_Rcb, Integer(Error_Rc));
  1612.    else                                /* File transfer attn */
  1613.       Return_From(Rcb, Boolean(False));
  1614.    end if;
  1615.  
  1616. end Check_Attn;
  1617.  
  1618. %Eject();
  1619.  
  1620. definition Main_Semantics
  1621.  
  1622.    /*box
  1623.       This is the main semantics routine. The semantic routines
  1624.       Set_Semantics and Show_Semantics also analyze user
  1625.       commands. These routines should be consulted along with the
  1626.       grammar.
  1627.    */
  1628.    open Global_Area_Ptr@;
  1629.    Success := True;
  1630.    select Semantic_Action from
  1631.    case Ks_Exit_Command:
  1632.       All_Done := True;
  1633.       Stop_Remote_Kermit();
  1634.    case Ks_Finish_Command:
  1635.       variable Finish_Success is Boolean;
  1636.       Send_Generic_Command("F", Finish_Success);   /* send finish
  1637.                                                    command */
  1638.       if Finish_Success
  1639.       then
  1640.          Write_To_User(" Server shut down but not logged off.");
  1641.          Can_Talk_To_Remote_Kermit := False;
  1642.       else
  1643.          Write_To_User(" Unable to shut remote server down.");
  1644.       end if;
  1645.    case Ks_Bye_Command:
  1646.       variable Bye_Success is Boolean;
  1647.       Send_Generic_Command("L", Bye_Success);   /* send bye (logoff)
  1648.                                                    command */
  1649.       if Bye_Success
  1650.       then
  1651.          Write_To_User(" Server shut down and logged off.");
  1652.       else
  1653.          Write_To_User(" Unable to logoff remote server.");
  1654.       end if;
  1655.    case Ks_Save_Filename:
  1656.       variable Temp_Filename is Varying_String;
  1657.       Temp_Filename := Last_Terminal_Text(Pcb, True);
  1658.       Saved_Filename := Substring(Temp_Filename, 0,
  1659.          Min(Length(Temp_Filename), Max_Data_Length));
  1660.    case Ks_Send_Simple_Filename:
  1661.       variable Open_Success, Send_Success are Boolean;
  1662.       Out_Filename := Saved_Filename;
  1663.       Remote_Filename := "";
  1664.       Initialize_Packet_Count(Out_Packet_Count);
  1665.       Open_Out_File(Open_Success);
  1666.       if Open_Success
  1667.       then
  1668.          Write_To_User(" Preparing to send file '" !! Out_Filename
  1669.             !! "'.");
  1670.          if Send_Delay ^= 0
  1671.          then
  1672.             variable Wait_Time is array (1 to 2) of Integer;
  1673.             Wait_Time(1) := 0;
  1674.             Wait_Time(2) := Send_Delay;
  1675.             Twait(Microsec_From_Call, Wait_Time);
  1676.          end if;
  1677.          Send_Command_Count +:= 1;
  1678.          Set_File_Transfer_Attn();
  1679.          Set_Echo_Off();
  1680.          Send_File(Send_Success);
  1681.          Set_Echo_On();
  1682.          Set_Normal_Attn();
  1683.          if not Send_Success
  1684.          then
  1685.             Handle_Error();
  1686.          else
  1687.             Write_To_User(" File sent successfully.");
  1688.          end if;
  1689.       else
  1690.          Handle_Error();
  1691.       end if;
  1692.       Display_Packet_Count := False;
  1693.    case Ks_Send_Local_Filename:
  1694.       variable Local_Filename is Varying_String;
  1695.       Local_Filename := Production_Text(Pcb, True);
  1696.       Out_Filename := Substring(Local_Filename, 0,
  1697.          Min(Length(Local_Filename), Max_Data_Length));
  1698.    case Ks_Send_Remote_Filename:
  1699.       variable Open_Success, Send_Success are Boolean;
  1700.       Remote_Filename := Saved_Filename;
  1701.       Initialize_Packet_Count(Out_Packet_Count);
  1702.       /* Check we can get the file to send */
  1703.       Open_Out_File(Open_Success);
  1704.       if Open_Success
  1705.       then
  1706.          Write_To_User(" Preparing to send MTS file '" !!
  1707.             Out_Filename !! "' to remote file '" !! Remote_Filename
  1708.             !! "'.");
  1709.          if Send_Delay ^= 0
  1710.          then
  1711.             variable Wait_Time is array (1 to 2) of Integer;
  1712.             Wait_Time(1) := 0;
  1713.             Wait_Time(2) := Send_Delay;
  1714.             Twait(Microsec_From_Call, Wait_Time);
  1715.          end if;
  1716.          Send_Command_Count +:= 1;
  1717.          Set_File_Transfer_Attn();
  1718.          Set_Echo_Off();
  1719.          Send_File(Send_Success);
  1720.          Set_Echo_On();
  1721.          Set_Normal_Attn();
  1722.          if not Send_Success
  1723.          then
  1724.             Handle_Error();
  1725.          else
  1726.             Write_To_User(" File sent successfully.");
  1727.          end if;
  1728.       else
  1729.          Handle_Error();
  1730.       end if;
  1731.       Display_Packet_Count := False;
  1732.    case Ks_Receive:
  1733.       if Can_Talk_To_Remote_Kermit
  1734.       then
  1735.          Write_To_User(" Use 'Get' for remote Server Kermit");
  1736.          return;
  1737.       end if;
  1738.       variable Receive_Success is Boolean;
  1739.       Get_Command_Count +:= 1;
  1740.       Initialize_Packet_Count(In_Packet_Count);
  1741.       Simple_Receive := True;
  1742.       In_Filename := "";
  1743.       Write_To_User(" Preparing to receive file.");
  1744.       Set_File_Transfer_Attn();
  1745.       Set_Echo_Off();
  1746.       Receive_File(Receive_Success);
  1747.       Set_Echo_On();
  1748.       Set_Normal_Attn();
  1749.       if not Receive_Success
  1750.       then
  1751.          Handle_Error();
  1752.       else
  1753.          Write_To_User(" File received successfully.");
  1754.       end if;
  1755.       Display_Packet_Count := False;
  1756.    case Ks_Receive_Local_Filename:
  1757.       if Can_Talk_To_Remote_Kermit
  1758.       then
  1759.          Write_To_User(" Use 'Get' for remote Server Kermit");
  1760.          return;
  1761.       end if;
  1762.       variable Receive_Success is Boolean;
  1763.       Get_Command_Count +:= 1;
  1764.       Initialize_Packet_Count(In_Packet_Count);
  1765.       /* use given name for file */
  1766.       In_Filename := Saved_Filename;
  1767.       Write_To_User(" File being received will be placed into " !!
  1768.          "MTS file '" !! In_Filename !! "'");
  1769.       Set_File_Transfer_Attn();
  1770.       Set_Echo_Off();
  1771.       Receive_File(Receive_Success);
  1772.       Set_Echo_On();
  1773.       Set_Normal_Attn();
  1774.       if not Receive_Success
  1775.       then
  1776.          Handle_Error();
  1777.       else
  1778.          Write_To_User(" File received successfully.");
  1779.       end if;
  1780.       Display_Packet_Count := False;
  1781.    case Ks_Get_Simple_Filename:
  1782.       /* Get a remote file */
  1783.       variable Simple_Name is Varying_String,
  1784.          Receive_Success is Boolean;
  1785.       Simple_Name := Saved_Filename;
  1786.       Get_Command_Count +:= 1;
  1787.       Initialize_Packet_Count(In_Packet_Count);
  1788.       In_Filename := "";
  1789.       Write_To_User(" Getting remote file '" !! Simple_Name !! "'");
  1790.       Set_File_Transfer_Attn();
  1791.       Receive_File_From_Server(Simple_Name, Receive_Success);
  1792.       Set_Normal_Attn();
  1793.       if not Receive_Success
  1794.       then
  1795.          Handle_Error();
  1796.       else
  1797.          Write_To_User(" File received successfully.");
  1798.       end if;
  1799.       Display_Packet_Count := False;
  1800.    case Ks_Get_Remote_Filename:
  1801.       variable Temp_Filename is Varying_String;
  1802.       Temp_Filename := Production_Text(Pcb, True);
  1803.       Remote_Filename := Substring(Temp_Filename, 0,
  1804.          Min(Length(Temp_Filename), Max_Data_Length));
  1805.    case Ks_Get_Local_Filename:
  1806.       variable Receive_Success is Boolean;
  1807.       In_Filename := Saved_Filename;
  1808.       Get_Command_Count +:= 1;
  1809.       Initialize_Packet_Count(In_Packet_Count);
  1810.       Write_To_User(" Getting remote file '" !! Remote_Filename !!
  1811.          "'");
  1812.       Set_File_Transfer_Attn();
  1813.       Receive_File_From_Server(Remote_Filename, Receive_Success);
  1814.       Set_Normal_Attn();
  1815.       if Receive_Success
  1816.       then
  1817.          Write_To_User(" Remote file '" !! Remote_Filename !!
  1818.             "' successfully received. Put in MTS file '" !!
  1819.             In_Filename !! "'");
  1820.       else
  1821.          Handle_Error();
  1822.       end if;
  1823.       Display_Packet_Count := False;
  1824.       Remote_Filename := "";
  1825.    case Ks_Set_Debug_On:
  1826.       variable Debug_Open_Success is Boolean;
  1827.       Open_Debug_File(Debug_Open_Success);
  1828.       if Debug_Open_Success
  1829.       then
  1830.          Debug_String(":");
  1831.          Debug_String("1             Packet Trace and Debug Log");
  1832.          Debug_String(" ");
  1833.          Debug := True;
  1834.       else
  1835.          Write_To_User(" Unable to find a file to log debugging");
  1836.       end if;
  1837.       if Calling_Mts_Kermit
  1838.       then
  1839.          variable Remote_Debug_Success is Boolean;
  1840.          Send_Generic_Command("DO", Remote_Debug_Success);
  1841.          if not Remote_Debug_Success
  1842.          then
  1843.             Write_To_User(" Unable to set remote debugging on.");
  1844.          end if;
  1845.       end if;
  1846.    case Ks_Set_Delay:
  1847.       /* this is called for resetting the send-init delay */
  1848.       Parse_Get(Pcb, Parsed_Integer, Send_Delay,
  1849.          Byte_Size(Send_Delay));
  1850.       if Send_Delay > Max_Send_Delay
  1851.       then
  1852.          Send_Delay := Max_Send_Delay;
  1853.       elseif Send_Delay < Min_Send_Delay
  1854.       then
  1855.          Send_Delay := Min_Send_Delay;
  1856.       end if;
  1857.       Write_To_User(" Send delay set to " !!
  1858.          Integer_To_Varying(Send_Delay, 0) !! " seconds.");
  1859.       Send_Delay := Send_Delay * Microseconds_Per_Sec;
  1860.    case Ks_Set_Filetype_Text:
  1861.       variable Success is Boolean;
  1862.       Set_Filetype_Text();
  1863.       Write_To_User(" Text filetype set.");
  1864.       if not Remote_Kermit
  1865.       then
  1866.          Send_Generic_Command("TTEXT", Success);
  1867.          if not Success
  1868.          then
  1869.             Write_To_User(" Unable to set remote filetype to TEXT.")
  1870.                ;
  1871.          end if;
  1872.       end if;
  1873.    case Ks_Set_Filetype_Binary:
  1874.       variable Success is Boolean;
  1875.       Set_Filetype_Binary();
  1876.       Write_To_User(" Binary filetype set.");
  1877.       if not Remote_Kermit
  1878.       then
  1879.          Send_Generic_Command("TBINARY", Success);
  1880.          if not Success
  1881.          then
  1882.             Write_To_User(
  1883.                " Unable to set remote filetype to BINARY.");
  1884.          end if;
  1885.       end if;
  1886.    case Ks_Set_Filetype_Mts_Binary:
  1887.       variable Success is Boolean;
  1888.       Set_Filetype_Mts_Binary();
  1889.       Write_To_User(" MTS binary filetype set.");
  1890.       if not Remote_Kermit
  1891.       then
  1892.          Send_Generic_Command("TMTS-BINARY", Success);
  1893.          if not Success
  1894.          then
  1895.             Write_To_User(
  1896.                " Unable to set remote filetype to MTS-BINARY.");
  1897.          end if;
  1898.       end if;
  1899.    case Ks_Set_Binary_Blocksize:
  1900.       variable Temp is Integer;
  1901.       Parse_Get(Pcb, Parsed_Integer, Temp, Byte_Size(Temp));
  1902.       if Temp > Max_Binary_Blocksize
  1903.       then
  1904.          Binary_Blocksize := Max_Binary_Blocksize;
  1905.       elseif Temp < Min_Binary_Blocksize
  1906.       then
  1907.          Binary_Blocksize := Min_Binary_Blocksize;
  1908.       else
  1909.          Binary_Blocksize := Temp;
  1910.       end if;
  1911.       Write_To_User(" Binary blocksize set to " !!
  1912.          Integer_To_Varying(Binary_Blocksize, 0) !! ".");
  1913.       if File_Kind = Binary_File_Kind
  1914.       then
  1915.          In_Buffer_End := Binary_Blocksize;
  1916.       end if;
  1917.    case Ks_Set_Text_Blocksize:
  1918.       variable Temp is Integer;
  1919.       Parse_Get(Pcb, Parsed_Integer, Temp, Byte_Size(Temp));
  1920.       if Temp > Max_Text_Blocksize
  1921.       then
  1922.          Text_Blocksize := Max_Text_Blocksize;
  1923.       elseif Temp < Min_Text_Blocksize
  1924.       then
  1925.          Text_Blocksize := Min_Text_Blocksize;
  1926.       else
  1927.          Text_Blocksize := Temp;
  1928.       end if;
  1929.       Write_To_User(" Text blocksize set to " !!
  1930.          Integer_To_Varying(Text_Blocksize, 0) !! ".");
  1931.       if File_Kind = Text_File_Kind
  1932.       then
  1933.          In_Buffer_End := Text_Blocksize;
  1934.       end if;
  1935.    case Ks_Set_Line:
  1936.       variable Temp_Unit is Varying_String;
  1937.       Temp_Unit := Production_Text(Pcb, False);
  1938.       Remote_Unit_Name := Substring(Temp_Unit, 0,
  1939.          Min(Length(Temp_Unit), Max_Remote_Unit_Name_Length));
  1940.       if not Get_Remote_Unit()
  1941.       then
  1942.          /* couldn't open mounted device */
  1943.          Write_To_User(" Unable to open network connection " !!
  1944.             Remote_Unit_Name);
  1945.       else
  1946.          Configure_Remote_Unit();
  1947.          Write_To_User(" Line to remote KERMIT connected.");
  1948.          Remote_Kermit := False;
  1949.       end if;
  1950.    case Ks_Mcmd:
  1951.       variable Command_Text is Varying_String,
  1952.          Command_Length is Integer;
  1953.       Command_Text := Production_Text(Pcb, False);
  1954.       Command_Length := Length(Command_Text);
  1955.       Cmdnoe(Substring(Command_Text, 0, Length(Command_Text)),
  1956.          Command_Length);
  1957.    case Ks_Server_Command:
  1958.       variable Server_Success is Boolean;
  1959.       Write_To_User(
  1960.          " Kermit in server mode. Escape to local KERMIT.");
  1961.       Set_Echo_Off();
  1962.       Server_Node(Server_Success);
  1963.       Set_Echo_On();
  1964.       All_Done := True;
  1965.    case Ks_Invalid_Command:
  1966.       variable Invalid_Command is Varying_String;
  1967.       Invalid_Command := Production_Text(Pcb, False);
  1968.       if Invalid_Command ^= ""
  1969.       then
  1970.          Write_To_User(" Invalid command: '" !! Invalid_Command !!
  1971.             "'");
  1972.          Write_To_User(
  1973.             " Enter HELP COMMANDS for a list of commands.");
  1974.       end if;
  1975.    case Ks_Error_Bad_Get_Parm:
  1976.       variable Bad_Get_Parm is Varying_String;
  1977.       Bad_Get_Parm := Production_Text(Pcb, False);
  1978.       Write_To_User(" Invalid GET parameters: '" !! Bad_Get_Parm !!
  1979.          "'");
  1980.       Write_To_User(" Enter HELP GET for valid syntax.");
  1981.    case Ks_Error_Bad_Receive_Parm:
  1982.       variable Bad_Receive_Parm is Varying_String;
  1983.       Bad_Receive_Parm := Production_Text(Pcb, False);
  1984.       Write_To_User(" Invalid RECEIVE parameters: '" !!
  1985.          Bad_Receive_Parm !! "'");
  1986.       Write_To_User(" Enter HELP RECEIVE for valid syntax.");
  1987.    case Ks_Error_Bad_Send_Parm:
  1988.       variable Bad_Send_Parm is Varying_String;
  1989.       Bad_Send_Parm := Production_Text(Pcb, False);
  1990.       Write_To_User(" Invalid SEND parameters: '" !! Bad_Send_Parm
  1991.          !! "'");
  1992.       Write_To_User(" Enter HELP SEND for valid syntax.");
  1993.    case Ks_Error_On_Off:
  1994.       Write_To_User(
  1995.          " This SET command accepts only nothing, ON, or OFF " !!
  1996.          "as an option.");
  1997.    case Ks_Set_Failure:
  1998.       variable Failing_Set_Option is Varying_String;
  1999.       Failing_Set_Option := Production_Text(Pcb, True);
  2000.       Write_To_User(" Invalid SET option: '" !! Failing_Set_Option
  2001.          !! "'");
  2002.       Write_To_User(" Enter 'HELP SET' for a list of options.");
  2003.    else
  2004.       Write_To_User(" Semantic action not implemented yet");
  2005.    end select;
  2006.  
  2007. end Main_Semantics;
  2008.  
  2009. %Eject();
  2010.  
  2011. definition Set_Semantics
  2012.  
  2013.    /*box
  2014.       This procedure is called by the semantic actions that allow
  2015.       the user to set the receive and send parameters for the
  2016.       packets.
  2017.    */
  2018.    variable Ascii_Char is bit(8),
  2019.       Byte_Int is bit(8),
  2020.       Char_Ok is Boolean;
  2021.    open Global_Area_Ptr@;
  2022.    Success := True;
  2023.    select Semantic_Action from
  2024.    case Ks_My_End_Of_Line:
  2025.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2026.       if Char_Ok
  2027.       then
  2028.          My_End_Of_Line_Character := Ascii_Char;
  2029.       end if;
  2030.    case Ks_My_Packet_Length:
  2031.       variable New_Packet_Length is Integer;
  2032.       Parse_Get(Pcb, Parsed_Integer, New_Packet_Length,
  2033.          Byte_Size(New_Packet_Length));
  2034.       if New_Packet_Length < Min_Packet_Length
  2035.       then
  2036.          My_Packet_Length := Min_Packet_Length;
  2037.       elseif New_Packet_Length > Max_Packet_Length
  2038.       then
  2039.          My_Packet_Length := Max_Packet_Length;
  2040.       else
  2041.          My_Packet_Length := New_Packet_Length;
  2042.       end if;
  2043.    case Ks_My_Padding:
  2044.       variable New_Padding_Count is Integer;
  2045.       Parse_Get(Pcb, Parsed_Integer, New_Padding_Count,
  2046.          Byte_Size(New_Padding_Count));
  2047.       if New_Padding_Count < 0
  2048.       then
  2049.          My_Padding_Count := 0;
  2050.       elseif New_Padding_Count > Max_Padding_Count
  2051.       then
  2052.          My_Padding_Count := Max_Padding_Count;
  2053.       else
  2054.          My_Padding_Count := New_Padding_Count;
  2055.       end if;
  2056.    case Ks_My_Padchar:
  2057.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2058.       if Char_Ok
  2059.       then
  2060.          My_Padding_Character := Ascii_Char;
  2061.       end if;
  2062.    case Ks_My_Quote:
  2063.       variable New_Quote is Integer;
  2064.       Parse_Get(Pcb, Parsed_Integer, New_Quote,
  2065.          Byte_Size(New_Quote));
  2066.       /* check lies within ascii range permitable */
  2067.       if (New_Quote > Ascii_Space and New_Quote <=
  2068.          Ascii_Greater_Than) or (New_Quote >= Ascii_Grave and
  2069.          New_Quote <= Ascii_Tilde)
  2070.       then
  2071.          Byte_Int := New_Quote;
  2072.          My_Quote_Character := Byte_Int;
  2073.       else
  2074.          Write_To_User(
  2075.             " New quote out of range. Must lie within the " !!
  2076.             "range " !! Integer_To_Varying(Ascii_Space + 1, 0) !!
  2077.             " to " !! Integer_To_Varying(Ascii_Greater_Than, 0) !!
  2078.             " or " !! Integer_To_Varying(Ascii_Grave, 0) !! " to "
  2079.             !! Integer_To_Varying(Ascii_Tilde, 0) !! ".");
  2080.       end if;
  2081.    case Ks_My_Start_Of_Packet:
  2082.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2083.       if Char_Ok
  2084.       then
  2085.          My_Start_Of_Packet_Character := Ascii_Char;
  2086.       end if;
  2087.    case Ks_My_Timeout:
  2088.       variable New_Timeout is Integer;
  2089.       Parse_Get(Pcb, Parsed_Integer, New_Timeout,
  2090.          Byte_Size(New_Timeout));
  2091.       if New_Timeout < Min_Timeout
  2092.       then
  2093.          My_Timeout := Min_Timeout;
  2094.       elseif New_Timeout > Max_Timeout
  2095.       then
  2096.          My_Timeout := Max_Timeout;
  2097.       else
  2098.          My_Timeout := New_Timeout;
  2099.       end if;
  2100.    case Ks_Your_End_Of_Line:
  2101.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2102.       if Char_Ok
  2103.       then
  2104.          Your_End_Of_Line_Character := Ascii_Char;
  2105.       end if;
  2106.    case Ks_Your_Packet_Length:
  2107.       variable New_Packet_Length is Integer;
  2108.       Parse_Get(Pcb, Parsed_Integer, New_Packet_Length,
  2109.          Byte_Size(New_Packet_Length));
  2110.       if New_Packet_Length < Min_Packet_Length
  2111.       then
  2112.          Your_Packet_Length := Min_Packet_Length;
  2113.       elseif New_Packet_Length > Max_Packet_Length
  2114.       then
  2115.          Your_Packet_Length := Max_Packet_Length;
  2116.       else
  2117.          Your_Packet_Length := New_Packet_Length;
  2118.       end if;
  2119.    case Ks_Your_Padding:
  2120.       variable New_Padding_Count is Integer;
  2121.       Parse_Get(Pcb, Parsed_Integer, New_Padding_Count,
  2122.          Byte_Size(New_Padding_Count));
  2123.       if New_Padding_Count < 0
  2124.       then
  2125.          Your_Padding_Count := 0;
  2126.       elseif New_Padding_Count > Max_Padding_Count
  2127.       then
  2128.          Your_Padding_Count := Max_Padding_Count;
  2129.       else
  2130.          Your_Padding_Count := New_Padding_Count;
  2131.       end if;
  2132.    case Ks_Your_Padchar:
  2133.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2134.       if Char_Ok
  2135.       then
  2136.          Your_Padding_Character := Ascii_Char;
  2137.       end if;
  2138.    case Ks_Your_Quote:
  2139.       variable New_Quote is Integer;
  2140.       Parse_Get(Pcb, Parsed_Integer, New_Quote,
  2141.          Byte_Size(New_Quote));
  2142.       /* check lies within ascii range permitable */
  2143.       if (New_Quote > Ascii_Space and New_Quote <=
  2144.          Ascii_Greater_Than) or (New_Quote >= Ascii_Grave and
  2145.          New_Quote <= Ascii_Tilde)
  2146.       then
  2147.          Byte_Int := New_Quote;
  2148.          Your_Quote_Character := Byte_Int;
  2149.       else
  2150.          Write_To_User(
  2151.             " New quote out of range. Must lie within the " !!
  2152.             "range " !! Integer_To_Varying(Ascii_Space + 1, 0) !!
  2153.             " to " !! Integer_To_Varying(Ascii_Greater_Than, 0) !!
  2154.             " or " !! Integer_To_Varying(Ascii_Grave, 0) !! " to "
  2155.             !! Integer_To_Varying(Ascii_Tilde, 0) !! ".");
  2156.       end if;
  2157.    case Ks_Your_Start_Of_Packet:
  2158.       Get_Valid_Ascii_Control_Char(Ascii_Char, Char_Ok);
  2159.       if Char_Ok
  2160.       then
  2161.          Your_Start_Of_Packet_Character := Ascii_Char;
  2162.       end if;
  2163.    case Ks_Your_Timeout:
  2164.       variable New_Timeout is Integer;
  2165.       Parse_Get(Pcb, Parsed_Integer, New_Timeout,
  2166.          Byte_Size(New_Timeout));
  2167.       if New_Timeout < Min_Timeout
  2168.       then
  2169.          Your_Timeout := Min_Timeout;
  2170.       elseif New_Timeout > Max_Timeout
  2171.       then
  2172.          Your_Timeout := Max_Timeout;
  2173.       else
  2174.          Your_Timeout := New_Timeout;
  2175.       end if;
  2176.       Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0);
  2177.    case Ks_Set_Packet_Count_Interval:
  2178.       /* set the frequency the packet count is displayed */
  2179.       variable New_Interval_Count is Integer;
  2180.       Parse_Get(Pcb, Parsed_Integer, New_Interval_Count,
  2181.          Byte_Size(New_Interval_Count));
  2182.       if New_Interval_Count <= 0
  2183.       then
  2184.          Write_To_User(" Notify turned off.");
  2185.          Packet_Count_Interval := Maximum_Integer;
  2186.       else
  2187.          Packet_Count_Interval := New_Interval_Count;
  2188.       end if;
  2189.    case Ks_Set_Packet_Count_Interval_Off:
  2190.       Packet_Count_Interval := Maximum_Integer;
  2191.    else
  2192.       /* dummy nothing */
  2193.    end select;
  2194.  
  2195. end Set_Semantics;
  2196.  
  2197. %Eject();
  2198.  
  2199. definition Show_Semantics
  2200.  
  2201.    /*box
  2202.       This procedure handles the semantics for the SHOW command.
  2203.       The show command allows the user to display the current
  2204.       settings of the parameters that may be set using the SET
  2205.       command.
  2206.    */
  2207.  
  2208.    open Global_Area_Ptr@;
  2209.    Success := True;
  2210.    select Semantic_Action from
  2211.    case Kssh_Binary_Blocksize:
  2212.       Write_To_User(" Binary Blocksize is " !!
  2213.          Integer_To_Varying(Binary_Blocksize, 0));
  2214.    case Kssh_Debug:
  2215.       if Debug
  2216.       then
  2217.          Write_To_User(" Debug is on");
  2218.       else
  2219.          Write_To_User(" Debug is off");
  2220.       end if;
  2221.    case Kssh_Delay:
  2222.       Write_To_User(" Delay is " !! Integer_To_Varying(Send_Delay /
  2223.          1000000, 0) !! " seconds");
  2224.    case Kssh_Filetype:
  2225.       Write_To_User(" Filetype is " !! File_Kind_Text(File_Kind));
  2226.    case Kssh_Notify:
  2227.       Write_To_User(" Notify frequency is " !!
  2228.          Integer_To_Varying(Packet_Count_Interval, 0));
  2229.    case Kssh_My_End_Of_Line:
  2230.       Write_To_User(" My End of Line Character in decimal is " !!
  2231.          Integer_To_Varying(My_End_Of_Line_Character, 0));
  2232.    case Kssh_My_Packet_Length:
  2233.       Write_To_User(" My Packet Length is " !!
  2234.          Integer_To_Varying(My_Packet_Length, 0));
  2235.    case Kssh_My_Padding:
  2236.       Write_To_User(" My padding count is " !!
  2237.          Integer_To_Varying(My_Padding_Count, 0));
  2238.    case Kssh_My_Padchar:
  2239.       Write_To_User(" My padding character in decimal is " !!
  2240.          Integer_To_Varying(My_Padding_Character, 0));
  2241.    case Kssh_My_Quote:
  2242.       Write_To_User(" My quote character in decimal is " !!
  2243.          Integer_To_Varying(My_Quote_Character, 0));
  2244.    case Kssh_My_Start_Of_Packet:
  2245.       Write_To_User(" My start of packet character is " !!
  2246.          Integer_To_Varying(My_Start_Of_Packet_Character, 0));
  2247.    case Kssh_My_Timeout:
  2248.       Write_To_User(" My timeout is " !!
  2249.          Integer_To_Varying(My_Timeout, 0) !! " seconds");
  2250.    case Kssh_Your_End_Of_Line:
  2251.       Write_To_User(" Your End of Line Character in decimal is " !!
  2252.          Integer_To_Varying(Your_End_Of_Line_Character, 0));
  2253.    case Kssh_Your_Packet_Length:
  2254.       Write_To_User(" Your Packet Length is " !!
  2255.          Integer_To_Varying(Your_Packet_Length, 0));
  2256.    case Kssh_Your_Padding:
  2257.       Write_To_User(" Your padding count is " !!
  2258.          Integer_To_Varying(Your_Padding_Count, 0));
  2259.    case Kssh_Your_Padchar:
  2260.       Write_To_User(" Your padding character in decimal is " !!
  2261.          Integer_To_Varying(Your_Padding_Character, 0));
  2262.    case Kssh_Your_Quote:
  2263.       Write_To_User(" Your quote character in decimal is " !!
  2264.          Integer_To_Varying(Your_Quote_Character, 0));
  2265.    case Kssh_Your_Start_Of_Packet:
  2266.       Write_To_User(" Your start of packet character is " !!
  2267.          Integer_To_Varying(Your_Start_Of_Packet_Character, 0));
  2268.    case Kssh_Your_Timeout:
  2269.       Write_To_User(" Your timeout is " !!
  2270.          Integer_To_Varying(Your_Timeout, 0) !! " seconds");
  2271.    else                                /* Should never occur */
  2272.    end select;
  2273.  
  2274. end Show_Semantics;
  2275.  
  2276. %Eject();
  2277.  
  2278. definition Par_String_Semantics
  2279.  
  2280.    /*box
  2281.       This procedure is called during the analysis of the PAR
  2282.       string. Several options may be set. These include
  2283.    *//*as_is
  2284.  
  2285.       User                - run kermit in user rather than default server mode
  2286.       FileType Binary     - set initial filetype to Binary
  2287.       FileType MTS-Binary - set initial filetype to MTS-Binary
  2288.    */
  2289.  
  2290.    open Global_Area_Ptr@;
  2291.    Success := True;
  2292.    select Semantic_Action from
  2293.    case Ps_Set_Mode_User:
  2294.       Mode := User_Mode;
  2295.    case Ps_Set_Mode_Server:
  2296.       Mode := Server_Mode;
  2297.    case Ps_Remote_Mts:
  2298.       Remote_Mts := True;
  2299.       Mode := Server_Mode;
  2300.       /* Other Kermit expects an "Execution begins" or such line
  2301.          when it starts this Kermit. If the user has shut this
  2302.          feature off issue a dummy line to keep the Kermits in
  2303.          synch */
  2304.       variable Ebm_Result is character(8),
  2305.          Print_Message is Boolean,
  2306.          Chr_Pos is String_Length_Type;
  2307.       Guinfo("EBM     ", Ebm_Result);
  2308.       Case_Conversion(Ebm_Result, Byte_Size(Ebm_Result));
  2309.       Print_Message := False;
  2310.       Chr_Pos := 0;
  2311.       cycle
  2312.          if Substring(Ebm_Result, Chr_Pos, 1) = "W" or
  2313.             Substring(Ebm_Result, Chr_Pos, 1) = "H"
  2314.          then
  2315.             Print_Message := True;
  2316.             exit;
  2317.          end if;
  2318.          exit when Chr_Pos >= 7;
  2319.          Chr_Pos +:= 1;
  2320.          exit when Substring(Ebm_Result, Chr_Pos, 1) = "*";
  2321.       end cycle;
  2322.       if not Print_Message
  2323.       then
  2324.          /* Issue a Dummy Line */
  2325.          Write_To_User(" Execution begins");
  2326.       end if;
  2327.    case Ps_Set_Debug:
  2328.       Debug := True;
  2329.    case Ps_Set_Filetype_Binary:
  2330.       variable Success is Boolean;
  2331.       Set_Filetype_Binary();
  2332.       if not Remote_Kermit
  2333.       then
  2334.          Send_Generic_Command("TBINARY", Success);
  2335.          if Success
  2336.          then
  2337.             Write_To_User(" Filetype set to binary.");
  2338.          else
  2339.             Write_To_User(
  2340.                " Unable to set remote filetype to binary.");
  2341.          end if;
  2342.       end if;
  2343.    case Ps_Set_Filetype_Text:
  2344.       variable Success is Boolean;
  2345.       Set_Filetype_Text();
  2346.       if not Remote_Kermit
  2347.       then
  2348.          Send_Generic_Command("TTEXT", Success);
  2349.          if Success
  2350.          then
  2351.             Write_To_User(" Filetype set to text.");
  2352.          else
  2353.             Write_To_User(" Unable to set remote filetype to text.")
  2354.                ;
  2355.          end if;
  2356.       end if;
  2357.    case Ps_Set_Filetype_Mts_Binary:
  2358.       variable Success is Boolean;
  2359.       Set_Filetype_Mts_Binary();
  2360.       if not Remote_Kermit
  2361.       then
  2362.          Send_Generic_Command("TMTS-BINARY", Success);
  2363.          if Success
  2364.          then
  2365.             Write_To_User(" Filetype set to MTS-binary.");
  2366.          else
  2367.             Write_To_User(
  2368.                " Unable to set remote filetype to MTS-binary.");
  2369.          end if;
  2370.       end if;
  2371.    else                                /* just in case */
  2372.    end select;
  2373.  
  2374. end Par_String_Semantics;
  2375.  
  2376. %Eject();
  2377.  
  2378. definition Filename_Semantics
  2379.  
  2380.    /*box
  2381.       This procedure is called when to check an mts filename is
  2382.       valid.
  2383.    */
  2384.  
  2385.    constant Max_Mts_Filename_Length is 12;
  2386.  
  2387.    variable I is Short_Integer,        /* index for name scan */
  2388.       Filename_Char is character(1),
  2389.       Filename is Varying_String;
  2390.  
  2391.    open Global_Area_Ptr@;
  2392.    Success := True;
  2393.    select Semantic_Action from
  2394.    case Ks_Mts_Simple_Filename:
  2395.       Filename := Production_Text(Pcb, True);
  2396.       if Length(Filename) > Max_Mts_Filename_Length or
  2397.          Length(Filename) <= 0
  2398.       then
  2399.          Success := False;
  2400.          return;
  2401.       end if;
  2402.       /* check name contains valid characters */
  2403.       do I := 0 to Length(Filename) - 1
  2404.          Filename_Char := Substring(Filename, I, 1);
  2405.          select Fnametrt(Filename_Char) from
  2406.          case Fnametrt_Valid:
  2407.          else
  2408.             Success := False;
  2409.             return;
  2410.          end select;
  2411.       end do;
  2412.    else
  2413.    end select;
  2414.  
  2415. end Filename_Semantics;
  2416.  
  2417. %Eject();
  2418.  
  2419. definition Initialize
  2420.  
  2421.    /*box
  2422.       This procedure sets the initial data packet parameters and
  2423.       other default values.
  2424.    */
  2425.  
  2426.    open Global_Area_Ptr@;
  2427.    Remote_Mts := False;
  2428.    Logging_Started := False;
  2429.    Can_Talk_To_Remote_Kermit := False;
  2430.    /* initialize clear high bit pattern */
  2431.    Substring(Clear_High_Bit_Pattern, 0, 1) := '7F';
  2432.    Substring(Clear_High_Bit_Pattern, 1,
  2433.       Length(Clear_High_Bit_Pattern) - 1) :=
  2434.       Substring(Clear_High_Bit_Pattern, 0,
  2435.       Length(Clear_High_Bit_Pattern) - 1);
  2436.  
  2437.    Text_Blocksize := Default_Text_Blocksize;
  2438.    Binary_Blocksize := Default_Binary_Blocksize;
  2439.    Send_File_Attributes := False;
  2440.    Simple_Receive := False;
  2441.    Remote_Filename := "";
  2442.    Send_Delay := Default_Send_Delay * Microseconds_Per_Sec;
  2443.    Out_Packet_Count.For_File := 0;
  2444.    Out_Packet_Count.For_Session := 0;
  2445.    Out_Packet_Count.Side := Sending_Side;
  2446.    In_Packet_Count.For_File := 0;
  2447.    In_Packet_Count.For_Session := 0;
  2448.    Send_Command_Count := 0;
  2449.    Get_Command_Count := 0;
  2450.    Total_Command_Count := 0;
  2451.    Total_Retries := 0;
  2452.    In_Packet_Count.Side := Receiving_Side;
  2453.    Packet_Count_Interval := 20;
  2454.    Display_Packet_Count := False;
  2455.    Debug := False;
  2456.    Error_Message := "";
  2457.    My_Packet_Length := My_Default_Packet_Length;
  2458.    My_Timeout := Default_Timeout;
  2459.    My_Padding_Count := Default_Padding_Count;
  2460.    My_Padding_Character := Default_Padding_Character;
  2461.    My_End_Of_Line_Character := Default_End_Of_Line_Character;
  2462.    Your_End_Of_Line_Character := Ascii_Cr;   /* assume CR to start
  2463.                                              */
  2464.    My_Quote_Character := Default_Quote_Character;
  2465.    Eight_Bit_Quote_Character := Default_8_Bit_Quote_Character;
  2466.    Checksum_Kind := Default_Checksum_Kind;
  2467.    Checksum_Size := Checksum_Lengths(Checksum_Kind);
  2468.    My_Repeat_Character := Default_Repeat_Character;
  2469.    Your_Repeat_Character := Default_Repeat_Character;
  2470.    /* set sum defaults for the initial packet; rest will come in ACK
  2471.    */
  2472.    Your_Timeout := Default_Timeout;
  2473.    Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0);
  2474.    Your_Padding_Count := Default_Padding_Count;
  2475.    Your_Padding_Character := Default_Padding_Character;
  2476.    Your_End_Of_Line_Character := Default_End_Of_Line_Character;
  2477.    Your_Start_Of_Packet_Character := Ascii_Soh;
  2478.    My_Start_Of_Packet_Character := Ascii_Soh;
  2479.    All_Done := False;
  2480.    Non_Data_Count := Byte_Size(Packet_Header_Type) + Checksum_Size -
  2481.       Uncounted_Packet_Char;
  2482.    /* some file initialization parameters */
  2483.    Out_File_Io_Modifiers := Mts_Io_Not_Trim ! Mts_Io_Not_Ic !
  2484.       Mts_Io_Not_Endfile;
  2485.    In_File_Io_Modifiers := Mts_Io_Not_Trim ! Mts_Io_Errrtn;
  2486.    Remote_Unit_Modifiers := Mts_Io_Errrtn;
  2487.    open Cnfginfo;
  2488.    select Ci_Installation_Code from
  2489.    case Ci_Um:
  2490.       Set_Um_Binary_On := True;
  2491.       Can_Set_Read_Timer := False;
  2492.       Can_Set_X25_Timer := False;
  2493.       Can_Set_Local_Echo := True;
  2494.       Can_Set_Network_Echo := True;
  2495.       Can_Set_8_Bit_Datapac_Transparancy := False;
  2496.    case Ci_Ubc:
  2497.       Set_Um_Binary_On := False;
  2498.       Can_Set_Read_Timer := True;
  2499.       Can_Set_X25_Timer := True;
  2500.       Can_Set_Local_Echo := True;
  2501.       Can_Set_Network_Echo := True;
  2502.       Can_Set_8_Bit_Datapac_Transparancy := True;
  2503.    case Ci_Uqv:
  2504.       Set_Um_Binary_On := False;
  2505.       Can_Set_Read_Timer := False;
  2506.       Can_Set_X25_Timer := False;
  2507.       Can_Set_Local_Echo := False;
  2508.       Can_Set_Network_Echo := False;
  2509.       Can_Set_8_Bit_Datapac_Transparancy := False;
  2510.    case Ci_Sfu:
  2511.       Set_Um_Binary_On := False;
  2512.       Can_Set_Read_Timer := True;
  2513.       Can_Set_X25_Timer := True;
  2514.       Can_Set_Local_Echo := True;
  2515.       Can_Set_Network_Echo := True;
  2516.       Can_Set_8_Bit_Datapac_Transparancy := True;
  2517.    else
  2518.       Set_Um_Binary_On := False;
  2519.       Can_Set_Read_Timer := False;
  2520.       Can_Set_X25_Timer := False;
  2521.       Can_Set_Local_Echo := True;
  2522.       Can_Set_Network_Echo := True;
  2523.       Can_Set_8_Bit_Datapac_Transparancy := False;
  2524.    end select;
  2525.    Telenet_Width_Set := False;
  2526.  
  2527. end Initialize;
  2528.  
  2529. %Eject();
  2530.  
  2531. definition Send_File
  2532.  
  2533.    /*box
  2534.       This procedure is used to send a file to another host. The
  2535.       name of the file to be sent should be in the global
  2536.       variable "out_filename". If the procedure is unable to send
  2537.       the file it returns false in the parameter "success" and
  2538.       puts an error message in the global variable
  2539.       "error_message".
  2540.    */
  2541.  
  2542.    /* set up a long return for the a timed out write when talking to
  2543.       a remote kermit */
  2544.    open Global_Area_Ptr@;
  2545.    Setup_Return_From(Rcb, Success);
  2546.    Success := True;
  2547.    Initialize_Sequence_Numbers();
  2548.    Times_This_Packet_Retried := 0;
  2549.    Side := Sending_Side;
  2550.    State := Send_Init_State;
  2551.    cycle
  2552.       select State from
  2553.       case Send_Init_State:
  2554.          State := Send_Init_Action();
  2555.       case Send_File_Header_State:
  2556.          State := Send_File_Header_Action();
  2557.       case Send_File_Attribute_State:
  2558.          State := Send_File_Attribute_Action();
  2559.       case Send_File_Data_State:
  2560.          State := Send_File_Data_Action();
  2561.       case Send_Eof_State:
  2562.          State := Send_Eof_Action();
  2563.       case Send_Eot_State:
  2564.          State := Send_Eot_Action();
  2565.       case Complete_State:
  2566.          return;
  2567.       case Abort_State:
  2568.          /* error sensed at a lower level procedure */
  2569.          Success := False;
  2570.          return;
  2571.       else
  2572.          /* Something has gone wrong: Abort */
  2573.          Success := False;
  2574.          Error_Message := "Program error: Unexpected state in " !!
  2575.             "proc " !! %Current_Procedure !! ".";
  2576.          return;
  2577.       end select;
  2578.    end cycle;
  2579. end Send_File;
  2580.  
  2581. %Eject();
  2582.  
  2583. definition Send_Init_Action
  2584.  
  2585.    /*box
  2586.       This procedure initiates file transfer: it sends this
  2587.       kermits paramters and gets back the other Kermits
  2588.       parameters.
  2589.    */
  2590.  
  2591.    variable Send_Init_Data is Packet_Data_Type,
  2592.       Receive_Packet_Type is Packet_Type_Type,
  2593.       Receive_Sequence_Number is Sequence_Number_Type,
  2594.       Receive_Data is Packet_Data_Type,
  2595.       Success is Boolean;
  2596.  
  2597.    open Global_Area_Ptr@;
  2598.    /* Flush the input buffer to get rid of NAK's */
  2599.    Flush_Input_Unit();
  2600.    Check_For_Retries(Times_This_Packet_Retried);
  2601.    if Times_This_Packet_Retried >= Max_Retries
  2602.    then
  2603.       Error_Message :=
  2604.          "Send Init: unable to get ACK for init packet.";
  2605.       Next_State := Abort_State;
  2606.       return;
  2607.    else
  2608.       Times_This_Packet_Retried +:= 1;
  2609.    end if;
  2610.    Get_My_Packet_Parameters(Send_Init_Data);
  2611.    Send_Packet(Send_Init_Code, Current_Sequence_Number,
  2612.       Send_Init_Data);
  2613.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  2614.       Receive_Data);
  2615.    select Receive_Packet_Type from
  2616.    case Negative_Acknowledge_Code:
  2617.       Next_State := Send_Init_State;
  2618.       return;
  2619.    case Acknowledge_Code:
  2620.       if Receive_Sequence_Number ^= Current_Sequence_Number
  2621.       then
  2622.          /* wrong ACK stay in initialize state */
  2623.          Next_State := Send_Init_State;
  2624.          return;
  2625.       end if;
  2626.       Get_Your_Packet_Parameters(Receive_Data);
  2627.       /* Here is where final agreement is made as what checksum, 8
  2628.          bit quoting and repeat characters to use */
  2629.  
  2630.       /* File is ready and open */
  2631.  
  2632.       Times_This_Packet_Retried := 0;
  2633.       Increment_Sequence_Numbers();
  2634.       Next_State := Send_File_Header_State;
  2635.       return;
  2636.    case Bad_Code:
  2637.       /* bad packet */
  2638.       Next_State := Send_Init_State;
  2639.       return;
  2640.    case Error_Code:
  2641.       Handle_Received_Error(Receive_Data);
  2642.       Next_State := Abort_State;
  2643.       return;
  2644.    else                                /* assume either abort_code
  2645.                                           or unknown */
  2646.       Next_State := Abort_State;
  2647.       return;
  2648.    end select;
  2649.  
  2650. end;
  2651.  
  2652. %Eject();
  2653.  
  2654. definition Send_File_Header_Action
  2655.  
  2656.    /*box
  2657.       This procedure sends the name of the file that the data is
  2658.       to be placed into.
  2659.    */
  2660.  
  2661.    variable Receive_Packet_Type is Packet_Type_Type,
  2662.       Receive_Sequence_Number is Sequence_Number_Type,
  2663.       Receive_Data is Packet_Data_Type,
  2664.       End_Of_File is Boolean;
  2665.  
  2666.    open Global_Area_Ptr@;
  2667.    Check_For_Retries(Times_This_Packet_Retried);
  2668.    if Times_This_Packet_Retried >= Max_Retries
  2669.    then
  2670.       Error_Message := "Send file header: unable to get ACK for " !!
  2671.          "packet.";
  2672.       Next_State := Abort_State;
  2673.       return;
  2674.    else
  2675.       Times_This_Packet_Retried +:= 1;
  2676.    end if;
  2677.    if Remote_Filename = ""
  2678.    then
  2679.       Out_Ascii_Filename := Out_Filename;
  2680.    else
  2681.       Out_Ascii_Filename := Remote_Filename;
  2682.    end if;
  2683.    Mts_Ebcdic_To_Ascii(Substring(Out_Ascii_Filename, 0, 0),
  2684.       Length(Out_Ascii_Filename));
  2685.    Send_Packet(File_Header_Code, Current_Sequence_Number,
  2686.       Out_Ascii_Filename);
  2687.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  2688.       Receive_Data);
  2689.    select Receive_Packet_Type from
  2690.    case Negative_Acknowledge_Code:
  2691.       /* check to see if NAK for following packet */
  2692.       if Receive_Sequence_Number = Next_Sequence_Number
  2693.       then
  2694.          /* assume file header accepted, so process */
  2695.       else
  2696.          /* try again for an ACK */
  2697.          Next_State := Send_File_Header_State;
  2698.          return;
  2699.       end if;
  2700.    case Acknowledge_Code:
  2701.       /* check sequence numbers match */
  2702.       if Receive_Sequence_Number = Current_Sequence_Number
  2703.       then
  2704.          /* process file header */
  2705.       else
  2706.          Next_State := Send_File_Header_State;
  2707.          return;
  2708.       end if;
  2709.    case Bad_Code:
  2710.       Next_State := Send_File_Header_State;
  2711.       return;
  2712.    case Error_Code:
  2713.       Handle_Received_Error(Receive_Data);
  2714.       Next_State := Abort_State;
  2715.       return;
  2716.    else                                /* something really bad */
  2717.       Error_Message := "Send File Header: inconsistent state.";
  2718.       Next_State := Abort_State;
  2719.       return;
  2720.    end select;
  2721.    /* File header has been received properly */
  2722.    Times_This_Packet_Retried := 0;
  2723.    Increment_Sequence_Numbers();
  2724.    if Send_File_Attributes
  2725.    then
  2726.       Next_State := Send_File_Attribute_State;
  2727.    else
  2728.       /* Grab the first record from the file */
  2729.       Get_Out_File_Data(Send_Packet_Data, End_Of_File);
  2730.       if End_Of_File
  2731.       then
  2732.          Next_State := Send_Eof_State;
  2733.          return;
  2734.       else
  2735.          Next_State := Send_File_Data_State;
  2736.       end if;
  2737.    end if;
  2738.  
  2739. end Send_File_Header_Action;
  2740.  
  2741. %Eject();
  2742.  
  2743. definition Send_File_Attribute_Action
  2744.  
  2745.    /*box
  2746.       This procedure is used to send the file attributes to an
  2747.       MTS Kermit. Three attributes are sent; Length (size of file
  2748.       in Kbytes), Type, and Mts atributes. The first attribute is
  2749.       standard, the second includes as data the standard types A
  2750.       (Ascii), B (Binary), D (varying length binary, MTS
  2751.       sequential), and the non-standard type L (MTS line file).
  2752.    */
  2753.  
  2754.    variable Receive_Packet_Type is Packet_Type_Type,
  2755.       Receive_Sequence_Number is Sequence_Number_Type,
  2756.       Receive_Data is Packet_Data_Type;
  2757.  
  2758.    open Global_Area_Ptr@;
  2759.    Check_For_Retries(Times_This_Packet_Retried);
  2760.    if Times_This_Packet_Retried >= Max_Retries
  2761.    then
  2762.       Error_Message := "Send file attribute: unable to get ACK for "
  2763.          !! "packet.";
  2764.       Next_State := Abort_State;
  2765.       return;
  2766.    else
  2767.       Times_This_Packet_Retried +:= 1;
  2768.    end if;
  2769.    if Debug
  2770.    then
  2771.       variable Text is Varying_String;
  2772.       Text := File_Attribute_Data;
  2773.       Ascii_To_Mts_Ebcdic(Substring(Text, 0), Length(Text));
  2774.       Debug_String(" File attributes: " !! Text);
  2775.    end if;
  2776.    Send_Packet(File_Attribute_Code, Current_Sequence_Number,
  2777.       File_Attribute_Data);
  2778.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  2779.       Receive_Data);
  2780.    select Receive_Packet_Type from
  2781.    case Negative_Acknowledge_Code:
  2782.       /* check to see if NAK for following packet */
  2783.       if Receive_Sequence_Number = Next_Sequence_Number
  2784.       then
  2785.          /* assume file attribute accepted, so process */
  2786.       else
  2787.          /* try again for an ACK */
  2788.          Next_State := Send_File_Attribute_State;
  2789.          return;
  2790.       end if;
  2791.    case Acknowledge_Code:
  2792.       /* check sequence numbers match */
  2793.       if Receive_Sequence_Number = Current_Sequence_Number
  2794.       then
  2795.          /* process file attribute */
  2796.       else
  2797.          Next_State := Send_File_Attribute_State;
  2798.          return;
  2799.       end if;
  2800.    case Bad_Code:
  2801.       Next_State := Send_File_Attribute_State;
  2802.       return;
  2803.    case Error_Code:
  2804.       Handle_Received_Error(Receive_Data);
  2805.       Next_State := Abort_State;
  2806.       return;
  2807.    else                                /* something really bad */
  2808.       Error_Message := "Send File Header: inconsistent state.";
  2809.       Next_State := Abort_State;
  2810.       return;
  2811.    end select;
  2812.    /* File attribute has been sent properly */
  2813.    variable End_Of_File is Boolean;
  2814.    /* Grab the first record from the file */
  2815.    Get_Out_File_Data(Send_Packet_Data, End_Of_File);
  2816.    Times_This_Packet_Retried := 0;
  2817.    Increment_Sequence_Numbers();
  2818.    if End_Of_File
  2819.    then
  2820.       Next_State := Send_Eof_State;
  2821.       return;
  2822.    else
  2823.       Next_State := Send_File_Data_State;
  2824.    end if;
  2825.  
  2826. end Send_File_Attribute_State;
  2827.  
  2828. %Eject();
  2829.  
  2830. definition Send_File_Data_Action
  2831.  
  2832.    /*box
  2833.       This is the state used send the file data
  2834.    */
  2835.  
  2836.    variable Receive_Packet_Type is Packet_Type_Type,
  2837.       Receive_Sequence_Number is Sequence_Number_Type,
  2838.       Receive_Data is Packet_Data_Type,
  2839.       No_More_Data is Boolean;
  2840.  
  2841.    open Global_Area_Ptr@;
  2842.    Check_For_Retries(Times_This_Packet_Retried);
  2843.    if Times_This_Packet_Retried >= Max_Retries
  2844.    then
  2845.       Error_Message :=
  2846.          "Send data: Unable to get ACK for data packet";
  2847.       Next_State := Abort_State;
  2848.       return;
  2849.    else
  2850.       Times_This_Packet_Retried +:= 1;
  2851.    end if;
  2852.    Send_Packet(Data_Packet_Code, Current_Sequence_Number,
  2853.       Send_Packet_Data);
  2854.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  2855.       Receive_Data);
  2856.    select Receive_Packet_Type from
  2857.    case Negative_Acknowledge_Code:
  2858.       /* check to see if NAK for next packet */
  2859.       if Receive_Sequence_Number = Next_Sequence_Number
  2860.       then
  2861.          /* assume data packet and process */
  2862.       else                             /* try again to get an ACK */
  2863.          Next_State := Send_File_Data_State;
  2864.          return;
  2865.       end if;
  2866.    case Acknowledge_Code:
  2867.       /* check sequence numbers match */
  2868.       if Receive_Sequence_Number = Current_Sequence_Number
  2869.       then
  2870.          /* looks okay so process */
  2871.       else
  2872.          /* reject and try again */
  2873.          Next_State := Send_File_Data_State;
  2874.          return;
  2875.       end if;
  2876.    case Bad_Code:                      /* lower procedure is asking
  2877.                                           for retry */
  2878.       Next_State := Send_File_Data_State;
  2879.       return;
  2880.    case Error_Code:
  2881.       Handle_Received_Error(Receive_Data);
  2882.       Next_State := Abort_State;
  2883.       return;
  2884.    else                                /* (abort_code) things are
  2885.                                           more serious: quit */
  2886.       Next_State := Abort_State;
  2887.       return;
  2888.    end select;
  2889.  
  2890.    Display_Packet_Action(Out_Packet_Count);
  2891.    /* okay folks data sent okay: get next packet */
  2892.    Times_This_Packet_Retried := 0;
  2893.    Increment_Sequence_Numbers();
  2894.    Get_Out_File_Data(Send_Packet_Data, No_More_Data);
  2895.    if No_More_Data
  2896.    then
  2897.       Next_State := Send_Eof_State;
  2898.       return
  2899.    else
  2900.       Next_State := Send_File_Data_State;
  2901.       return
  2902.    end if;
  2903.  
  2904. end Send_File_Data_Action;
  2905.  
  2906. %Eject();
  2907.  
  2908. definition Send_Eof_Action
  2909.  
  2910.    /*box
  2911.       KERMIT enters this state after a file has been sent and an
  2912.       EOF is detected
  2913.    */
  2914.  
  2915.    variable Receive_Packet_Type is Packet_Type_Type,
  2916.       Receive_Sequence_Number is Sequence_Number_Type,
  2917.       Receive_Data is Packet_Data_Type,
  2918.       Success is Boolean;
  2919.  
  2920.    open Global_Area_Ptr@;
  2921.    Check_For_Retries(Times_This_Packet_Retried);
  2922.    if Times_This_Packet_Retried >= Max_Retries
  2923.    then
  2924.       Error_Message := "Send EOF: Unable to get ACK for EOF packet";
  2925.       Next_State := Abort_State;
  2926.       return;
  2927.    else
  2928.       Times_This_Packet_Retried +:= 1;
  2929.    end if;
  2930.    Send_Packet_Data := "";
  2931.    Send_Packet(End_Of_File_Code, Current_Sequence_Number,
  2932.       Send_Packet_Data);
  2933.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  2934.       Receive_Data);
  2935.    select Receive_Packet_Type from
  2936.    case Negative_Acknowledge_Code:
  2937.       /* check to see if NAK for next packet */
  2938.       if Receive_Sequence_Number = Next_Sequence_Number
  2939.       then
  2940.          /* assume data packet and process */
  2941.       else                             /* try again to get an ACK */
  2942.          Next_State := Send_Eof_State;
  2943.          return;
  2944.       end if;
  2945.    case Acknowledge_Code:
  2946.       /* check sequence numbers match */
  2947.       if Receive_Sequence_Number = Current_Sequence_Number
  2948.       then
  2949.          /* looks okay so process */
  2950.       else
  2951.          /* reject and try again */
  2952.          Next_State := Send_Eof_State;
  2953.          return;
  2954.       end if;
  2955.    case Bad_Code:                      /* lower procedure is asking
  2956.                                           for retry */
  2957.       Next_State := Send_Eof_State;
  2958.       return;
  2959.    case Error_Code:
  2960.       Handle_Received_Error(Receive_Data);
  2961.       Next_State := Abort_State;
  2962.       return;
  2963.    else                                /* (abort_code) things are
  2964.                                           more serious: quit */
  2965.       Next_State := Abort_State;
  2966.       return;
  2967.    end select;
  2968.  
  2969.    /* EOF has been acknowleged */
  2970.    Times_This_Packet_Retried := 0;
  2971.    Increment_Sequence_Numbers();
  2972.  
  2973.    /* for multiple files we will want to return to send file header
  2974.       if there are more files to send */
  2975.    Get_Next_Out_File(Success);
  2976.    if Success
  2977.    then
  2978.       Next_State := Send_File_Header_State;
  2979.       return;
  2980.    else
  2981.       Next_State := Send_Eot_State;
  2982.       return;
  2983.    end if;
  2984.  
  2985. end Send_Eof_Action;
  2986.  
  2987. %Eject();
  2988.  
  2989. definition Send_Eot_Action
  2990.  
  2991.    /*box
  2992.       KERMIT enters this state when we have to break transmission
  2993.    */
  2994.  
  2995.    variable Receive_Packet_Type is Packet_Type_Type,
  2996.       Receive_Sequence_Number is Sequence_Number_Type,
  2997.       Receive_Data is Packet_Data_Type;
  2998.  
  2999.    open Global_Area_Ptr@;
  3000.    Check_For_Retries(Times_This_Packet_Retried);
  3001.    if Times_This_Packet_Retried >= Max_Retries
  3002.    then
  3003.       Error_Message := "Send EOT: Unable to get ACK for EOT packet";
  3004.       Next_State := Abort_State;
  3005.       return;
  3006.    else
  3007.       Times_This_Packet_Retried +:= 1;
  3008.    end if;
  3009.    Send_Packet_Data := "";
  3010.    Send_Packet(Break_Transmission_Code, Current_Sequence_Number,
  3011.       Send_Packet_Data);
  3012.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  3013.       Receive_Data);
  3014.    select Receive_Packet_Type from
  3015.    case Negative_Acknowledge_Code:
  3016.       /* check to see if NAK for next packet */
  3017.       if Receive_Sequence_Number = Next_Sequence_Number
  3018.       then
  3019.          /* assume data packet and process */
  3020.       else                             /* try again to get an ACK */
  3021.          Next_State := Send_Eot_State;
  3022.          return;
  3023.       end if;
  3024.    case Acknowledge_Code:
  3025.       /* check sequence numbers match */
  3026.       if Receive_Sequence_Number = Current_Sequence_Number
  3027.       then
  3028.          /* looks okay so process */
  3029.       else
  3030.          /* reject and try again */
  3031.          Next_State := Send_Eot_State;
  3032.          return;
  3033.       end if;
  3034.    case Error_Code:
  3035.       Handle_Received_Error(Receive_Data);
  3036.       Next_State := Abort_State;
  3037.       return;
  3038.    case Bad_Code:                      /* lower procedure is asking
  3039.                                           for retry */
  3040.       Next_State := Send_Eot_State;
  3041.       return;
  3042.    else                                /* (abort_code) things are
  3043.                                           more serious: quit */
  3044.       Next_State := Abort_State;
  3045.       return;
  3046.    end select;
  3047.  
  3048.    /* EOT has been acknowleged */
  3049.    Times_This_Packet_Retried := 0;
  3050.    Increment_Sequence_Numbers();
  3051.    Next_State := Complete_State;
  3052.  
  3053. end Send_Eot_Action;
  3054.  
  3055. %Eject();
  3056.  
  3057. definition Receive_File
  3058.  
  3059.    /*box
  3060.       This procedure is used to get a file from another host or
  3061.       micro. If the global "in_filename" is the empty string then
  3062.       the name in the file header packet is used for the recieved
  3063.       file. If the value of the global is not empty then that
  3064.       name will be used for the file and the name in the file
  3065.       header packet will be used. If the procedure is unable to
  3066.       get the file it returns false in the second parameter
  3067.       "success" and puts into the global variable "Error_message"
  3068.       a string describing the error.
  3069.    */
  3070.  
  3071.    /* set up a return for the case of a timed out write on a remote
  3072.       call
  3073.    */
  3074.    open Global_Area_Ptr@;
  3075.    Setup_Return_From(Rcb, Success);
  3076.    Success := True;
  3077.    Initialize_Sequence_Numbers();
  3078.    Times_This_Packet_Retried := 0;
  3079.    Side := Receiving_Side;
  3080.    State := Receive_Send_Init_State;
  3081.    cycle
  3082.       select State from
  3083.       case Receive_Send_Init_State:
  3084.          State := Receive_Send_Init_Action();
  3085.       case Receive_File_Header_State:
  3086.          State := Receive_File_Header_Action();
  3087.       case Receive_File_Attribute_State:
  3088.          State := Receive_File_Attribute_Action();
  3089.       case Receive_File_Data_State:
  3090.          State := Receive_File_Data_Action();
  3091.       case Complete_State:
  3092.          return;
  3093.       case Abort_State:
  3094.          /* error sensed at a lower level procedure */
  3095.          Success := False;
  3096.          return;
  3097.       else
  3098.          /* Something has gone wrong: Abort */
  3099.          Success := False;
  3100.          Error_Message := "Program error: Unexpected state in " !!
  3101.             "proc " !! %Current_Procedure !! ".";
  3102.          return;
  3103.       end select;
  3104.    end cycle;
  3105. end Send_File;
  3106.  
  3107. %Eject();
  3108.  
  3109. definition Receive_Send_Init_Action
  3110.  
  3111.    /*box
  3112.       KERMIT enters this state when it is waiting for a "send
  3113.       init" from another KERMIT.
  3114.    */
  3115.  
  3116.    variable Receive_Packet_Type is Packet_Type_Type,
  3117.       Receive_Sequence_Number is Sequence_Number_Type,
  3118.       Receive_Data is Packet_Data_Type,
  3119.       Init_Data is Packet_Data_Type;
  3120.  
  3121.    open Global_Area_Ptr@;
  3122.    Check_For_Retries(Times_This_Packet_Retried);
  3123.    if Times_This_Packet_Retried >= Max_Retries
  3124.    then
  3125.       Error_Message := "Receive Send Init: Unable to get " !!
  3126.          "packet";
  3127.       Next_State := Abort_State;
  3128.       return;
  3129.    else
  3130.       Times_This_Packet_Retried +:= 1;
  3131.    end if;
  3132.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  3133.       Receive_Data);
  3134.    select Receive_Packet_Type from
  3135.    case Send_Init_Code:
  3136.       /* get his parameters and send our parameters */
  3137.       Get_Your_Packet_Parameters(Receive_Data);
  3138.       Get_My_Packet_Parameters(Init_Data);
  3139.       /* here is where the final adjusment for 8 bit, repeat, and
  3140.          checksum type takes place */
  3141.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3142.          Init_Data);
  3143.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3144.       Times_This_Packet_Retried := 0;
  3145.       Increment_Sequence_Numbers();
  3146.       Next_State := Receive_File_Header_State;
  3147.       return;
  3148.  
  3149.    case Bad_Code:
  3150.       /* garbled packet */
  3151.       Send_Packet(Negative_Acknowledge_Code,
  3152.          Current_Sequence_Number, "");
  3153.       Next_State := Receive_Send_Init_State;
  3154.       return;
  3155.    case Error_Code:
  3156.       Handle_Received_Error(Receive_Data);
  3157.       Next_State := Abort_State;
  3158.       return;
  3159.    else                                /* (abort_code) things are
  3160.                                           more serious: quit */
  3161.       Next_State := Abort_State;
  3162.       return;
  3163.    end select;
  3164.  
  3165. end Receive_Send_Init_Action;
  3166.  
  3167. %Eject();
  3168.  
  3169. definition Receive_File_Header_Action
  3170.  
  3171.    /*box
  3172.       KERMIT enters this state when it is waiting for a "file
  3173.       header" from another KERMIT.
  3174.    */
  3175.  
  3176.    variable Receive_Packet_Type is Packet_Type_Type,
  3177.       Receive_Sequence_Number is Sequence_Number_Type,
  3178.       Receive_Data is Packet_Data_Type,
  3179.       Send_Data is Packet_Data_Type,
  3180.       Success is Boolean;
  3181.  
  3182.    open Global_Area_Ptr@;
  3183.    Check_For_Retries(Times_This_Packet_Retried);
  3184.    if Times_This_Packet_Retried >= Max_Retries
  3185.    then
  3186.       Error_Message := "Receive File Header: Unable to get " !!
  3187.          "packet";
  3188.       Next_State := Abort_State;
  3189.       return;
  3190.    else
  3191.       Times_This_Packet_Retried +:= 1;
  3192.    end if;
  3193.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  3194.       Receive_Data);
  3195.    select Receive_Packet_Type from
  3196.    case Send_Init_Code:
  3197.       Check_For_Retries(Times_Last_Packet_Retried);
  3198.       if Times_Last_Packet_Retried >= Max_Retries
  3199.       then
  3200.          Error_Message := "Receive File Header : Unable to get" !!
  3201.             " packet (send init instead)";
  3202.          Next_State := Abort_State;
  3203.          return;
  3204.       else
  3205.          Times_Last_Packet_Retried +:= 1;
  3206.       end if;
  3207.       if Receive_Sequence_Number = Last_Sequence_Number
  3208.       then
  3209.          /* lost our ACK so send ACK again with our parameters */
  3210.          Get_My_Packet_Parameters(Send_Data);
  3211.          Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3212.             Send_Data);
  3213.          Times_This_Packet_Retried := 0;
  3214.          Next_State := Receive_File_Header_State;
  3215.          return;
  3216.       else
  3217.          Error_Message := "Receive File Header: Unable to get " !!
  3218.             "packet (send init instead)";
  3219.          Next_State := Abort_State;
  3220.          return;
  3221.       end if;
  3222.  
  3223.    case End_Of_File_Code:
  3224.       Check_For_Retries(Times_Last_Packet_Retried);
  3225.       if Times_Last_Packet_Retried >= Max_Retries
  3226.       then
  3227.          Error_Message := "Receive File Header : Unable to get" !!
  3228.             " packet (EOF instead)";
  3229.          Next_State := Abort_State;
  3230.          return;
  3231.       else
  3232.          Times_Last_Packet_Retried +:= 1;
  3233.       end if;
  3234.       if Receive_Sequence_Number = Last_Sequence_Number
  3235.       then
  3236.          /* lost our ACK so send ACK again */
  3237.          Send_Data := "";
  3238.          Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3239.             Send_Data);
  3240.          Times_This_Packet_Retried := 0;
  3241.          Next_State := Receive_File_Header_State;
  3242.          return;
  3243.       else
  3244.          Error_Message := "Receive File Header: Unable to get " !!
  3245.             "packet (EOF instead).";
  3246.          Next_State := Abort_State;
  3247.          return;
  3248.       end if;
  3249.    case File_Header_Code:
  3250.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3251.       then
  3252.          /* have to abort */
  3253.          Error_Message :=
  3254.             "Receive file header: bad sequence number.";
  3255.          Next_State := Abort_State;
  3256.          return;
  3257.       end if;
  3258.       if In_Filename = ""
  3259.       then
  3260.          /* use the filename received for the file */
  3261.          /* convert it to ebcdic */
  3262.          Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0),
  3263.             Length(Receive_Data));
  3264.          In_Filename := Receive_Data;
  3265.          if Debug
  3266.          then
  3267.             Debug_String(" Incoming filename !" !! In_Filename !!
  3268.                "!");
  3269.          end if;
  3270.          if not Remote_Kermit and Simple_Receive
  3271.          then
  3272.             Write_To_User(" Incoming filename '" !! In_Filename !!
  3273.                "'");
  3274.          end if;
  3275.          Simple_Receive := False;
  3276.       end if;
  3277.       /* set default mts file info junk */
  3278.       Mts_File_Info := Default_Mts_File_Info;
  3279.       /* acknowledge file header */
  3280.       Send_Data := "";
  3281.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3282.          Send_Data);
  3283.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3284.       Times_This_Packet_Retried := 0;
  3285.       Increment_Sequence_Numbers();
  3286.       Next_State := Receive_File_Attribute_State;
  3287.       return;
  3288.    case Break_Transmission_Code:
  3289.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3290.       then
  3291.          /* abort */
  3292.          Error_Message :=
  3293.             "Receive File Header: Bad sequence number for " !!
  3294.             "EOT";
  3295.          Next_State := Abort_State;
  3296.          return;
  3297.       end if;
  3298.       /* acknowledge Break of transmission */
  3299.       Send_Data := "";
  3300.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3301.          Send_Data);
  3302.       Next_State := Complete_State;
  3303.       return;
  3304.    case Bad_Code:
  3305.       /* packet garbled */
  3306.       Send_Packet(Negative_Acknowledge_Code,
  3307.          Current_Sequence_Number, "");
  3308.       Next_State := Receive_File_Header_State;
  3309.       return;
  3310.    case Error_Code:
  3311.       Handle_Received_Error(Receive_Data);
  3312.       Next_State := Abort_State;
  3313.       return;
  3314.    else
  3315.       Error_Message :=
  3316.          "Receive File Header: unexpected packet type";
  3317.       Next_State := Abort_State;
  3318.       return;
  3319.    end select;
  3320.  
  3321. end Receive_File_Header_Action;
  3322.  
  3323. %Eject();
  3324.  
  3325. definition Receive_File_Attribute_Action
  3326.  
  3327.    /*box
  3328.       KERMIT enters this state when it is receiving file
  3329.       attributes. Only a few file attributes are checked.
  3330.    */
  3331.  
  3332.    variable Receive_Packet_Type is Packet_Type_Type,
  3333.       Receive_Sequence_Number is Sequence_Number_Type,
  3334.       Receive_Data is Packet_Data_Type,
  3335.       Send_Data is Packet_Data_Type,
  3336.       Success is Boolean;
  3337.  
  3338.    open Global_Area_Ptr@;
  3339.    Check_For_Retries(Times_This_Packet_Retried);
  3340.    if Times_This_Packet_Retried >= Max_Retries
  3341.    then
  3342.       Error_Message := "Receive File attribute: Unable to get " !!
  3343.          "packet.";
  3344.       Next_State := Abort_State;
  3345.       return;
  3346.    else
  3347.       Times_This_Packet_Retried +:= 1;
  3348.    end if;
  3349.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  3350.       Receive_Data);
  3351.    select Receive_Packet_Type from
  3352.    case File_Attribute_Code:
  3353.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3354.       then
  3355.          /* wrong packet */
  3356.          Check_For_Retries(Times_Last_Packet_Retried);
  3357.          if Times_Last_Packet_Retried >= Max_Retries
  3358.          then
  3359.             Error_Message :=
  3360.                "Receive File Attribute : Unable to get" !!
  3361.                " Attributes (too many retries)";
  3362.             Next_State := Abort_State;
  3363.             return;
  3364.          else
  3365.             Times_Last_Packet_Retried +:= 1;
  3366.          end if;
  3367.          if Receive_Sequence_Number = Last_Sequence_Number
  3368.          then
  3369.             /* acknowledge last packet */
  3370.             Send_Data := "";
  3371.             Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3372.                Send_Data);
  3373.             Times_This_Packet_Retried := 0;
  3374.             Next_State := Receive_File_Attribute_State;
  3375.             return;
  3376.          else
  3377.             Error_Message :=
  3378.                "Receive File Attribute: Bad sequence number" !!
  3379.                " for packet.";
  3380.             Next_State := Abort_State;
  3381.             return;
  3382.          end if;
  3383.       end if;
  3384.  
  3385.       /* decipher file attributes */
  3386.       if Debug
  3387.       then
  3388.          variable Text is Varying_String;
  3389.          Text := Receive_Data;
  3390.          Ascii_To_Mts_Ebcdic(Substring(Text, 0), Length(Text));
  3391.          Debug_String(" Received Attributes: " !! Text);
  3392.       end if;
  3393.       Decode_File_Attributes(Receive_Data);
  3394.       Send_Data := "";
  3395.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3396.          Send_Data);
  3397.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3398.       Times_This_Packet_Retried := 0;
  3399.       Increment_Sequence_Numbers();
  3400.       Next_State := Receive_File_Attribute_State;
  3401.  
  3402.    case Data_Packet_Code:
  3403.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3404.       then
  3405.          /* have to abort */
  3406.          Error_Message :=
  3407.             "Receive File Attribute: 1st data packet: " !!
  3408.             "bad sequence number.";
  3409.          Next_State := Abort_State;
  3410.          return;
  3411.       end if;
  3412.  
  3413.       /* open file */
  3414.       Open_In_File(Success);
  3415.       if not Success
  3416.       then
  3417.          Next_State := Abort_State;
  3418.          return;
  3419.       else
  3420.          /* if have terminal notify packet is being received */
  3421.       end if;
  3422.       Display_Packet_Action(In_Packet_Count);
  3423.       /* write the data to the file */
  3424.       variable Put_Success is Boolean;
  3425.       Put_In_File_Data(Receive_Data, Put_Success);
  3426.       if not Put_Success
  3427.       then
  3428.          if Debug
  3429.          then
  3430.             Debug_String(" Put_in_file_data error in " !!
  3431.                %Current_Procedure);
  3432.          end if;
  3433.          Next_State := Abort_State;
  3434.          return;
  3435.       end if;
  3436.       Send_Data := "";
  3437.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3438.          Send_Data);
  3439.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3440.       Times_This_Packet_Retried := 0;
  3441.       Increment_Sequence_Numbers();
  3442.       Next_State := Receive_File_Data_State;
  3443.  
  3444.    case File_Header_Code:
  3445.       Check_For_Retries(Times_Last_Packet_Retried);
  3446.       if Times_Last_Packet_Retried >= Max_Retries
  3447.       then
  3448.          Error_Message := "Receive File Attribute : Unable to get"
  3449.             !! " data or attribute packet (file header instead)";
  3450.          Next_State := Abort_State;
  3451.          return;
  3452.       else
  3453.          Times_Last_Packet_Retried +:= 1;
  3454.       end if;
  3455.       if Receive_Sequence_Number = Last_Sequence_Number
  3456.       then
  3457.          /* lost our ACK so send ACK again */
  3458.          Send_Data := "";
  3459.          Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3460.             Send_Data);
  3461.          Times_This_Packet_Retried := 0;
  3462.          Next_State := Receive_File_Attribute_State;
  3463.          return;
  3464.       else
  3465.          Error_Message := "Receive File Attribute: Unable to get "
  3466.             !! "data or attribute packet (file header instead).";
  3467.          Next_State := Abort_State;
  3468.          return;
  3469.       end if;
  3470.    case End_Of_File_Code:
  3471.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3472.       then
  3473.          /* have to abort */
  3474.          Error_Message :=
  3475.             "Receive file Attribute: bad sequence number " !!
  3476.             "(EOF)";
  3477.          Next_State := Abort_State;
  3478.          return;
  3479.       end if;
  3480.       Send_Data := "";
  3481.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3482.          Send_Data);
  3483.       /* no file sent return to header state */
  3484.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3485.       Times_This_Packet_Retried := 0;
  3486.       Increment_Sequence_Numbers();
  3487.       Next_State := Receive_File_Header_State;
  3488.       return;
  3489.    case Bad_Code:
  3490.       /* packet garbled */
  3491.       Send_Packet(Negative_Acknowledge_Code,
  3492.          Current_Sequence_Number, "");
  3493.       Next_State := Receive_File_Attribute_State;
  3494.       return;
  3495.    case Error_Code:
  3496.       Handle_Received_Error(Receive_Data);
  3497.       Next_State := Abort_State;
  3498.       return;
  3499.    else
  3500.       Error_Message :=
  3501.          "Receive File Attribute: unexpected packet type.";
  3502.       Next_State := Abort_State;
  3503.       return;
  3504.    end select;
  3505.  
  3506. end Receive_File_Attribute_Action;
  3507.  
  3508. %Eject();
  3509.  
  3510. definition Receive_File_Data_Action
  3511.  
  3512.    /*box
  3513.       KERMIT enters this state when it is putting data from
  3514.       another KERMIT into a file.
  3515.    */
  3516.  
  3517.    variable Receive_Packet_Type is Packet_Type_Type,
  3518.       Receive_Sequence_Number is Sequence_Number_Type,
  3519.       Receive_Data is Packet_Data_Type,
  3520.       Send_Data is Packet_Data_Type,
  3521.       Success is Boolean;
  3522.  
  3523.    open Global_Area_Ptr@;
  3524.    Check_For_Retries(Times_This_Packet_Retried);
  3525.    if Times_This_Packet_Retried >= Max_Retries
  3526.    then
  3527.       Error_Message := "Receive File Data: Unable to get " !!
  3528.          "packet";
  3529.       Next_State := Abort_State;
  3530.       return;
  3531.    else
  3532.       Times_This_Packet_Retried +:= 1;
  3533.    end if;
  3534.    Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  3535.       Receive_Data);
  3536.    select Receive_Packet_Type from
  3537.    case Data_Packet_Code:
  3538.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3539.       then
  3540.          /* wrong packet */
  3541.          Check_For_Retries(Times_Last_Packet_Retried);
  3542.          if Times_Last_Packet_Retried >= Max_Retries
  3543.          then
  3544.             Error_Message := "Receive File Data : Unable to get" !!
  3545.                " packet (too many retries)";
  3546.             Next_State := Abort_State;
  3547.             return;
  3548.          else
  3549.             Times_Last_Packet_Retried +:= 1;
  3550.          end if;
  3551.          if Receive_Sequence_Number = Last_Sequence_Number
  3552.          then
  3553.             /* acknowledge last packet */
  3554.             Send_Data := "";
  3555.             Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3556.                Send_Data);
  3557.             Times_This_Packet_Retried := 0;
  3558.             Next_State := Receive_File_Data_State;
  3559.             return;
  3560.          else
  3561.             Error_Message :=
  3562.                "Receive File data: Bad sequence number" !!
  3563.                " for packet";
  3564.             Next_State := Abort_State;
  3565.             return;
  3566.          end if;
  3567.       end if;
  3568.  
  3569.       Display_Packet_Action(In_Packet_Count);
  3570.       /* write the data to the file */
  3571.       variable Put_Success is Boolean;
  3572.       Put_In_File_Data(Receive_Data, Put_Success);
  3573.       if not Put_Success
  3574.       then
  3575.          if Debug
  3576.          then
  3577.             Debug_String(" Bad put data in " !! %Current_Procedure);
  3578.          end if;
  3579.          Next_State := Abort_State;
  3580.          return;
  3581.       end if;
  3582.       Send_Data := "";
  3583.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3584.          Send_Data);
  3585.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3586.       Times_This_Packet_Retried := 0;
  3587.       Increment_Sequence_Numbers();
  3588.       Next_State := Receive_File_Data_State;
  3589.  
  3590.    case File_Header_Code:
  3591.       Check_For_Retries(Times_Last_Packet_Retried);
  3592.       if Times_Last_Packet_Retried >= Max_Retries
  3593.       then
  3594.          Error_Message := "Receive File data : Unable to get" !!
  3595.             " packet (file header instead)";
  3596.          Next_State := Abort_State;
  3597.          return;
  3598.       else
  3599.          Times_Last_Packet_Retried +:= 1;
  3600.       end if;
  3601.       if Receive_Sequence_Number = Last_Sequence_Number
  3602.       then
  3603.          /* lost our ACK so send ACK again */
  3604.          Send_Data := "";
  3605.          Send_Packet(Acknowledge_Code, Last_Sequence_Number,
  3606.             Send_Data);
  3607.          Times_This_Packet_Retried := 0;
  3608.          Next_State := Receive_File_Data_State;
  3609.          return;
  3610.       else
  3611.          Error_Message := "Receive File data: Unable to get " !!
  3612.             "packet (file header instead).";
  3613.          Next_State := Abort_State;
  3614.          return;
  3615.       end if;
  3616.    case End_Of_File_Code:
  3617.       if Receive_Sequence_Number ^= Current_Sequence_Number
  3618.       then
  3619.          /* have to abort */
  3620.          Error_Message := "Receive file data: bad sequence number "
  3621.             !! "(EOF)";
  3622.          Next_State := Abort_State;
  3623.          return;
  3624.       end if;
  3625.       Send_Data := "";
  3626.       Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  3627.          Send_Data);
  3628.       /* close file */
  3629.       if Length(File_Buffer_Ptr@) > 0
  3630.       then
  3631.          Write_In_File_Buffer(Success);
  3632.          File_Buffer_Ptr@ := "";
  3633.          if not Success
  3634.          then
  3635.             /* Unable to complete writing file - abort */
  3636.             Next_State := Abort_State;
  3637.             return;
  3638.          end if;
  3639.       end if;
  3640.       /* apply final attributes to file */
  3641.       variable Control_Command is Varying_String,
  3642.          Control_Command_Length is Short_Integer,
  3643.          Control_Rc is Integer,
  3644.          Control_Return_Info is Control_Return_Info_Type;
  3645.       open Mts_File_Info;
  3646.       if Mf_Nosave
  3647.       then
  3648.          Control_Command := "nosave";
  3649.          Control_Command_Length := Length(Control_Command);
  3650.          Control(Substring(Control_Command, 0, 0),
  3651.             Control_Command_Length, In_File.File_Unit,
  3652.             Control_Return_Info return code Control_Rc);
  3653.       end if;
  3654.       /* put the pkey on the file */
  3655.       Control_Command := "pkey=" !! Mf_Pkey;
  3656.       Control_Command_Length := Length(Control_Command);
  3657.       Control(Substring(Control_Command, 0, 0),
  3658.          Control_Command_Length, In_File.File_Unit,
  3659.          Control_Return_Info return code Control_Rc);
  3660.       /* Clean up, get rid of Fdub */
  3661.       Freefd(In_File.File_Unit.Fdub);
  3662.  
  3663.       Times_Last_Packet_Retried := Times_This_Packet_Retried;
  3664.       Times_This_Packet_Retried := 0;
  3665.       Increment_Sequence_Numbers();
  3666.       Next_State := Receive_File_Header_State;
  3667.       return;
  3668.    case Bad_Code:
  3669.       /* packet got garbled */
  3670.       Send_Packet(Negative_Acknowledge_Code,
  3671.          Current_Sequence_Number, "");
  3672.       Next_State := Receive_File_Data_State;
  3673.       return;
  3674.    case Error_Code:
  3675.       Handle_Received_Error(Receive_Data);
  3676.       Next_State := Abort_State;
  3677.       return;
  3678.    else
  3679.       Error_Message :=
  3680.          "Receive File Data Action : unexpected packet type.";
  3681.       Next_State := Abort_State;
  3682.       return;
  3683.    end select;
  3684.  
  3685. end Receive_File_Data_Action;
  3686.  
  3687. %Eject();
  3688.  
  3689. definition Send_Packet
  3690.  
  3691.    /*box
  3692.       This procedure takes a packet type and its data as input,
  3693.       builds a packet and ships it off to the other KERMIT. The
  3694.       procedure does the checksum computation.
  3695.    */
  3696.  
  3697.    variable I is Integer,
  3698.       Checksum is Integer,
  3699.       Packet_Header is Packet_Header_Type,
  3700.       Data_Length is Packet_Data_Length_Type,
  3701.       Packet_Char_Count is bit(8);
  3702.  
  3703.    open Global_Area_Ptr@;
  3704.    /* initialize buffer and insert padding */
  3705.    Send_Buffer := "";
  3706.    do I := 1 to Your_Padding_Count
  3707.       Send_Buffer !!:= Your_Padding_Character;
  3708.    end do;
  3709.    open Packet_Header;
  3710.    Ph_Mark := Your_Start_Of_Packet_Character;
  3711.    Data_Length := Length(Packet_Data);
  3712.    Packet_Char_Count := Data_Length + Non_Data_Count;
  3713.    /* accumulate checksum for package */
  3714.    Char(Packet_Char_Count);            /* make printable */
  3715.    Ph_Count := Packet_Char_Count;
  3716.    Checksum := Ph_Count;
  3717.    Ph_Sequence_Number := Sequence_Number;
  3718.    Char(Ph_Sequence_Number);
  3719.    Checksum +:= Ph_Sequence_Number;
  3720.    Ph_Type := Packet_Type;
  3721.    Checksum +:= Ph_Type;
  3722.    /* put header into packet */
  3723.    equate Packet_Header_Char to Packet_Header as
  3724.          Packet_Header_Character_Type;
  3725.    Send_Buffer !!:= Packet_Header_Char;
  3726.    /* put in the data */
  3727.    Send_Buffer !!:= Packet_Data;
  3728.    equate Int_Data to Substring(Packet_Data, 0) as
  3729.          Packet_Int_Data_Type;
  3730.    do I := 1 to Data_Length
  3731.       Checksum +:= Int_Data(I);
  3732.    end do;
  3733.    Checksum := (Checksum + (Checksum & Bits_76) / Checksum_Modulo) &
  3734.       Bits_543210;
  3735.    variable Checksum_Char is bit(8);
  3736.    Checksum_Char := Checksum;
  3737.    Char(Checksum_Char);
  3738.    Send_Buffer !!:= Checksum_Char;
  3739.  
  3740.    Send_Buffer !!:= Your_End_Of_Line_Character;
  3741.    /* send buffer */
  3742.    if Debug
  3743.    then
  3744.       variable Readable_Packet_Type is bit(8);
  3745.       Readable_Packet_Type := Packet_Type;
  3746.       Ascii_To_Mts_Ebcdic(Readable_Packet_Type, 1);
  3747.       Debug_String(" Packet sent:     data length " !!
  3748.          Integer_To_Varying(Length(Packet_Data), 2) !! " number " !!
  3749.          Integer_To_Varying(Sequence_Number, 2) !! " type " !!
  3750.          Readable_Packet_Type);
  3751.    end if;
  3752.    if Remote_Kermit
  3753.    then
  3754.       if Output_Unit_Device_Type = "3270"
  3755.       then
  3756.          Write_To_User(" KERMIT won't treat a 3270 like a micro]");
  3757.          if Debug
  3758.          then
  3759.             Debug_String(" KERMIT won't treat a 3270 like a micro]")
  3760.                ;
  3761.          end if;
  3762.          Return_From(Entry_Rcb, Integer(99));
  3763.       end if;
  3764.       Write_Packet(Output_Unit, Send_Buffer);
  3765.       Increment_Packet_Count(Out_Packet_Count);
  3766.    else
  3767.       Send_Remote_Packet();
  3768.    end if;
  3769.  
  3770. end Send_Packet;
  3771.  
  3772. %Eject();
  3773.  
  3774. definition Send_Remote_Packet
  3775.  
  3776.    /*box
  3777.       This procedure sends the next packet to a mounted unit. The
  3778.       X25_timer is used to prevent deadlocks.
  3779.    */
  3780.  
  3781.    variable Control_Command is Varying_String,
  3782.       Control_Command_Length is Short_Integer,
  3783.       Control_Rc is Integer,
  3784.       Control_Return_Info is Control_Return_Info_Type;
  3785.  
  3786.    /*box
  3787.       If possible the X25_timer is set so as to avoid write
  3788.       deadlocks. If the timer goes off a rc of 20 is given for
  3789.       the write. A rc of 12 will be returned if the network dies.
  3790.    */
  3791.    open Global_Area_Ptr@;
  3792.    Write_Packet(Remote_Unit, Send_Buffer);
  3793.    open Remote_Unit;
  3794.    if Last_Return_Code > 0
  3795.    then
  3796.       if Last_Return_Code = 12
  3797.       then
  3798.          /* have a call cleared situation, abort */
  3799.          Error_Message := "Line unexpectedly disconnected - " !!
  3800.             "(write) transmission ceases";
  3801.          /* have to abort. Do a long jump */
  3802.          Return_From(Rcb, Boolean(False));
  3803.       end if;
  3804.       if Last_Return_Code = 20
  3805.       then
  3806.          /* have a timeout on write, quit. */
  3807.          Error_Message := "Timed out on remote write.";
  3808.          /* Have to abort. Do a long jump */
  3809.          Return_From(Rcb, Boolean(False));
  3810.       end if;
  3811.    end if;
  3812.    Increment_Packet_Count(Out_Packet_Count);
  3813.  
  3814. end Send_Remote_Packet;
  3815.  
  3816. %Eject();
  3817.  
  3818. definition Receive_Packet
  3819.  
  3820.    /*box
  3821.       This procedure gets the next packet from the input buffer.
  3822.       It returns the type of packet found, the packets sequence
  3823.       number, and the data in the packet.
  3824.    */
  3825.  
  3826.    constant Zero_Parity_Bit is '7F';
  3827.  
  3828.    variable Success is Boolean,        /* true if there is a "next
  3829.                                           character" in buffer */
  3830.       Next_Character is bit(8),        /* next character in buffer
  3831.                                        */
  3832.       Got_Packet is Boolean;
  3833.  
  3834.    open Global_Area_Ptr@;
  3835.    /*box
  3836.       This macro gets the next character from the input buffer.
  3837.       It keeps a private variable next_character_position that
  3838.       should be set to 0 before the first call is made. Beware of
  3839.       this if you modify this macro.
  3840.    */
  3841.  
  3842.    variable Next_Character_Position is Short_Integer;
  3843.  
  3844.    macro Get_Character
  3845.       parameters are String, Next_Character, Success;
  3846.       if Next_Character_Position >= Length(String) /* one beyond
  3847.                                                    last position */
  3848.       then
  3849.          Success := False;
  3850.       else
  3851.          Next_Character := Substring(String,
  3852.             Next_Character_Position, 1);
  3853.          Success := True;
  3854.          Next_Character_Position +:= 1;
  3855.       end if;
  3856.    end macro Get_Character;
  3857.  
  3858.  
  3859.    /* initialize return values so they don't have to be set on an
  3860.       unexpected return */
  3861.    Packet_Type := Bad_Code;
  3862.    Sequence_Number := Current_Sequence_Number;
  3863.    Packet_Data := "";
  3864.  
  3865.    /*box
  3866.       We'll assume that a Kermit packet will contain a valid
  3867.       start of packet character. If such a packet does no arrive
  3868.       we'll ignore it at this point and get a new line. This
  3869.       should help the situation where we have remote garbage
  3870.       generated during start up etc. Should reduce the chances of
  3871.       mis synchronization.
  3872.    */
  3873.  
  3874.    <Find_Start_Of_Packet_Loop>
  3875.    cycle
  3876.       /* get the buffer */
  3877.       if Remote_Kermit
  3878.       then
  3879.          Get_Local_Packet(Got_Packet);
  3880.       else
  3881.          Get_Remote_Packet(Got_Packet);
  3882.       end if;
  3883.       if not Got_Packet
  3884.       then
  3885.          Packet_Type := Abort_Code;
  3886.          return;
  3887.       end if;
  3888.       if Debug
  3889.       then
  3890.          Debug_String(" Packet received:");
  3891.          Readable_Receive_Buffer := "            text: ";
  3892.       end if;
  3893.  
  3894.       /* initialize string buffer position */
  3895.       Next_Character_Position := 0;
  3896.       /* scan for the start of the packet */
  3897.       cycle
  3898.          Get_Character(Receive_Buffer, Next_Character, Success);
  3899.          if not Success
  3900.          then                          /* call it an error */
  3901.             if Debug
  3902.             then
  3903.                Debug_String(
  3904.                   " Unable to find start of packet character " !!
  3905.                   "in line. Going back for more.");
  3906.                Dump_Receive_Buffer();
  3907.             end if;
  3908.             repeat <Find_Start_Of_Packet_Loop>;
  3909.          end if;
  3910.          if Next_Character = My_Start_Of_Packet_Character
  3911.          then
  3912.             /* header found */
  3913.             exit <Find_Start_Of_Packet_Loop>;
  3914.          end if;
  3915.       end cycle;
  3916.    end cycle <Find_Start_Of_Packet_Loop>;
  3917.  
  3918.    /* build packet and check the checksum */
  3919.    variable Checksum is Integer,
  3920.       Data_Length is Packet_Data_Length_Type,
  3921.       Temp is Integer,
  3922.       Temp_Length is Integer;          /* used to check length
  3923.                                           before assigning */
  3924.    <Unpack_Packet_Loop>
  3925.    cycle
  3926.       /* get packet character count */
  3927.       Get_Character(Receive_Buffer, Next_Character, Success);
  3928.       if not Success
  3929.       then                             /* have an error */
  3930.          if Debug
  3931.          then
  3932.             Debug_String(" Bad return from " !! %Current_Procedure
  3933.                !! " line " !! Line_Number_To_Varying(%Source_Line,
  3934.                0) !! " co-ord " !! Integer_To_Varying(%Coordinate,
  3935.                0));
  3936.             Dump_Receive_Buffer();
  3937.          end if;
  3938.          Packet_Type := Bad_Code;
  3939.          return;
  3940.       end if;
  3941.       /* clear parity bit */
  3942.       Next_Character &:= Zero_Parity_Bit;
  3943.       if Next_Character = My_Start_Of_Packet_Character
  3944.       then
  3945.          /* resychronize */
  3946.          repeat;
  3947.       end if;
  3948.       Checksum := Next_Character;
  3949.       Temp_Length := Unchar(Next_Character); /* packet character
  3950.                                                 count */
  3951.       Temp_Length := Temp_Length - Non_Data_Count;
  3952.       if Temp_Length < 0 or Temp_Length > Max_Data_Length
  3953.       then
  3954.          if Debug
  3955.          then
  3956.             Debug_String(" Bad return from " !! %Current_Procedure
  3957.                !! " line " !! Line_Number_To_Varying(%Source_Line,
  3958.                0) !! " co-ord " !! Integer_To_Varying(%Coordinate,
  3959.                0));
  3960.             Dump_Receive_Buffer();
  3961.          end if;
  3962.          Packet_Type := Bad_Code;
  3963.          return;
  3964.       end if;
  3965.       Data_Length := Temp_Length;
  3966.       if Debug
  3967.       then
  3968.          Readable_Receive_Buffer !!:= "data length " !!
  3969.             Integer_To_Varying(Data_Length, 2);
  3970.       end if;
  3971.       /* get sequence number */
  3972.       Get_Character(Receive_Buffer, Next_Character, Success);
  3973.       if not Success
  3974.       then                             /* bad packet: try again */
  3975.          if Debug
  3976.          then
  3977.             Debug_String(" Bad return from " !! %Current_Procedure
  3978.                !! " line " !! Line_Number_To_Varying(%Source_Line,
  3979.                0) !! " co-ord " !! Integer_To_Varying(%Coordinate,
  3980.                0));
  3981.             Dump_Receive_Buffer();
  3982.          end if;
  3983.          Packet_Type := Bad_Code;
  3984.          return;
  3985.       end if;
  3986.       /* clear parity bit */
  3987.       Next_Character &:= Zero_Parity_Bit;
  3988.       if Next_Character = My_Start_Of_Packet_Character
  3989.       then
  3990.          /* resychronize packet */
  3991.          repeat;
  3992.       end if;
  3993.       Checksum +:= Next_Character;
  3994.       Temp := Unchar(Next_Character);
  3995.       if Temp < 0 or Temp > Sequence_Number_Modulo - 1
  3996.       then
  3997.          Packet_Type := Bad_Code;
  3998.          return;
  3999.       end if;
  4000.       Sequence_Number := Temp;
  4001.       if Debug
  4002.       then
  4003.          Readable_Receive_Buffer !!:= " number " !!
  4004.             Integer_To_Varying(Sequence_Number, 2);
  4005.       end if;
  4006.  
  4007.       /* Get the packet type */
  4008.       Get_Character(Receive_Buffer, Next_Character, Success);
  4009.       if not Success
  4010.       then                             /* bad packet: try again */
  4011.          if Debug
  4012.          then
  4013.             Debug_String(" Bad return from " !! %Current_Procedure
  4014.                !! " line " !! Line_Number_To_Varying(%Source_Line,
  4015.                0) !! " co-ord " !! Integer_To_Varying(%Coordinate,
  4016.                0));
  4017.             Dump_Receive_Buffer();
  4018.          end if;
  4019.          Packet_Type := Bad_Code;
  4020.          return;
  4021.       end if;
  4022.       /* clear parity bit */
  4023.       Next_Character &:= Zero_Parity_Bit;
  4024.       if Next_Character = My_Start_Of_Packet_Character
  4025.       then
  4026.          /* resychronize packet */
  4027.          repeat;
  4028.       end if;
  4029.       Checksum +:= Next_Character;
  4030.       Packet_Type := Next_Character;
  4031.       if Debug
  4032.       then
  4033.          variable Readable_Packet_Type is bit(8);
  4034.          Readable_Packet_Type := Packet_Type;
  4035.          Ascii_To_Mts_Ebcdic(Readable_Packet_Type, 1);
  4036.          Readable_Receive_Buffer !!:= " type " !!
  4037.             Readable_Packet_Type;
  4038.       end if;
  4039.  
  4040.       /* Now get the data portion of the packet */
  4041.       Packet_Data := "";
  4042.       variable I is Short_Integer,
  4043.          Temp_Character is bit(8);
  4044.       do I := 1 to Data_Length;
  4045.          Get_Character(Receive_Buffer, Next_Character, Success);
  4046.          if not Success
  4047.          then                          /* unexpected end: try again
  4048.                                        */
  4049.             if Debug
  4050.             then
  4051.                Debug_String(" Bad return from " !!
  4052.                   %Current_Procedure !! " line " !!
  4053.                   Line_Number_To_Varying(%Source_Line, 0) !!
  4054.                   " co-ord " !! Integer_To_Varying(%Coordinate, 0));
  4055.                Dump_Receive_Buffer();
  4056.             end if;
  4057.             Packet_Type := Bad_Code;
  4058.             return;
  4059.          end if;
  4060.          Temp_Character := Next_Character & Zero_Parity_Bit;
  4061.          if Temp_Character = My_Start_Of_Packet_Character
  4062.          then
  4063.             /* resychronize packet */
  4064.             repeat <Unpack_Packet_Loop>;
  4065.          end if;
  4066.          if Clear_Parity_Bit
  4067.          then
  4068.             Next_Character := Temp_Character;
  4069.          end if;
  4070.          Checksum +:= Next_Character;
  4071.          Packet_Data !!:= Next_Character;
  4072.       end do;
  4073.  
  4074.       /* get the checksum */
  4075.       Get_Character(Receive_Buffer, Next_Character, Success);
  4076.       if not Success
  4077.       then                             /* unexpected end: try again
  4078.                                        */
  4079.          if Debug
  4080.          then
  4081.             Debug_String(" Bad return from " !! %Current_Procedure
  4082.                !! " line " !! Line_Number_To_Varying(%Source_Line,
  4083.                0) !! " co-ord " !! Integer_To_Varying(%Coordinate,
  4084.                0));
  4085.             Dump_Receive_Buffer();
  4086.          end if;
  4087.          Packet_Type := Bad_Code;
  4088.          return;
  4089.       end if;
  4090.       /* clear parity bit */
  4091.       Next_Character &:= Zero_Parity_Bit;
  4092.       if Next_Character = My_Start_Of_Packet_Character
  4093.       then
  4094.          /* resychronize packet */
  4095.          repeat;
  4096.       end if;
  4097.       exit;
  4098.    end cycle <Unpack_Packet_Loop>;
  4099.  
  4100.    /* check that the checksums match */
  4101.    Temp := Unchar(Next_Character);
  4102.    Checksum := (Checksum + (Checksum & Bits_76) / Checksum_Modulo) &
  4103.       Bits_543210;
  4104.    if Debug
  4105.    then
  4106.       Debug_String(Readable_Receive_Buffer);
  4107.    end if;
  4108.    if Temp = Checksum
  4109.    then                                /* we have a good packet */
  4110.       return;
  4111.    else
  4112.       if Debug
  4113.       then
  4114.          Debug_String(" Bad checksum in received packet.");
  4115.          Debug_String(" Received checksum: " !!
  4116.             Integer_To_Varying(Next_Character, 0) !!
  4117.             "  Calculated checksum: " !!
  4118.             Integer_To_Varying(Checksum, 0));
  4119.          Dump_Receive_Buffer();
  4120.       end if;
  4121.       Packet_Type := Bad_Code;
  4122.       return;
  4123.    end if;
  4124.  
  4125. end Receive_Packet;
  4126.  
  4127. %Eject();
  4128.  
  4129. definition Get_Local_Packet
  4130.  
  4131.    /*box
  4132.       This procedure reads the next packet from the normal input
  4133.       unit. If the input is a network terminal it also does a
  4134.       timeout.
  4135.    */
  4136.  
  4137.    variable Control_Command is Varying_String,
  4138.       Control_Command_Length is Short_Integer,
  4139.       Control_Rc is Integer,
  4140.       Control_Return_Info is Control_Return_Info_Type,
  4141.       Nak_Data is Packet_Data_Type,
  4142.       Timeout_Retry_Count is Short_Integer;
  4143.  
  4144.    /*box
  4145.       Set Timeout: this is a kluge that will work on UBCnet. In
  4146.       standard MTS there is no way to timeout an I/O operation
  4147.       but on UBCnet there is a control command that allows you
  4148.       set a timer (Read_timer n). If there is no response within
  4149.       in that time the Read subroutine will respond with a return
  4150.       code of 20.
  4151.    */
  4152.    open Global_Area_Ptr@;
  4153.    if Input_Unit_Device_Type = "3270"
  4154.    then
  4155.       Write_To_User(" KERMIT won't treat a 3270 like a micro]");
  4156.       if Debug
  4157.       then
  4158.          Debug_String(" KERMIT won't treat a 3270 like a micro]");
  4159.       end if;
  4160.       Return_From(Entry_Rcb, Integer(99));
  4161.    end if;
  4162.    Timeout_Retry_Count := 0;
  4163.    cycle
  4164.       if Mode = User_Mode or Side = Sending_Side
  4165.       then
  4166.          /* timeout retries only when not a waiting server */
  4167.          if Timeout_Retry_Count > Max_Timeout_Retries
  4168.          then
  4169.             Success := False;
  4170.             Error_Message := "Timeout retry count exceeded";
  4171.             return;
  4172.          else
  4173.             Timeout_Retry_Count +:= 1;
  4174.          end if;
  4175.       end if;
  4176.       /* try the read_timer command */
  4177.       if Can_Set_Read_Timer
  4178.       then
  4179.          /* Initially we assume we can set read_timer: once we fail
  4180.             we don't bother again. */
  4181.          Mask_Attn();
  4182.          Control_Command := "read_timer " !! Your_Timeout_Char;
  4183.          Control_Command_Length := Length(Control_Command);
  4184.          Control(Substring(Control_Command, 0, 0),
  4185.             Control_Command_Length, Input_Unit.File_Unit,
  4186.             Control_Return_Info return code Control_Rc);
  4187.          if Control_Rc > 0
  4188.          then
  4189.             /* can't set timer interval */
  4190.             Can_Set_Read_Timer := False;
  4191.             Reenable_Attn();
  4192.             if Debug
  4193.             then
  4194.                open Control_Return_Info;
  4195.                Debug_String(
  4196.              " Unable to set timer interval (won't try any more]): "
  4197.                   );
  4198.                Debug_String(" Control rc " !!
  4199.                   Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  4200.                   Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  4201.                   Substring(Dsr_Message, 0, Dsr_Message_Length));
  4202.             end if;
  4203.          end if;
  4204.       end if;
  4205.       if Set_Um_Binary_On
  4206.       then
  4207.          /* @bin has to be implemented using control command at um
  4208.          */
  4209.          Control_Command := "binary=on";
  4210.          Control_Command_Length := Length(Control_Command);
  4211.          Control(Substring(Control_Command, 0, 0),
  4212.             Control_Command_Length, Input_Unit.File_Unit,
  4213.             Control_Return_Info return code Control_Rc);
  4214.          if Control_Rc > 0
  4215.          then
  4216.             if Debug
  4217.             then
  4218.                open Control_Return_Info;
  4219.                Debug_String(" Unable to turn on ASCII input: ");
  4220.                Debug_String(" Control rc " !!
  4221.                   Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  4222.                   Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  4223.                   Substring(Dsr_Message, 0, Dsr_Message_Length));
  4224.             end if;
  4225.          end if;
  4226.          /* DO THIS ONCE :: Telenet WIDTH parameter must be cleared
  4227.          */
  4228.          if not Telenet_Width_Set
  4229.          then
  4230.             Control_Command := "set 10:0";
  4231.             Control_Command_Length := Length(Control_Command);
  4232.             Control(Substring(Control_Command, 0, 0),
  4233.                Control_Command_Length, Input_Unit.File_Unit,
  4234.                Control_Return_Info return code Control_Rc);
  4235.             if Control_Rc > 0
  4236.             then
  4237.                if Debug
  4238.                then
  4239.                   open Control_Return_Info;
  4240.                   Debug_String(" Unable to SET 10:0 for Telenet: ");
  4241.                   Debug_String(" Control rc " !!
  4242.                      Integer_To_Varying(Control_Rc, 0) !! " dsr rc "
  4243.                      !! Integer_To_Varying(Dsr_Return_Code, 0) !!
  4244.                      " " !! Substring(Dsr_Message, 0,
  4245.                      Dsr_Message_Length));
  4246.                end if;
  4247.             end if;
  4248.             Telenet_Width_Set := True;
  4249.          end if;
  4250.       end if;
  4251.       Read_Packet(Input_Unit, Receive_Buffer);
  4252.       if Set_Um_Binary_On
  4253.       then
  4254.          /* @bin has to be implemented using control command at um
  4255.          */
  4256.          Control_Command := "binary=off";
  4257.          Control_Command_Length := Length(Control_Command);
  4258.          Control(Substring(Control_Command, 0, 0),
  4259.             Control_Command_Length, Input_Unit.File_Unit,
  4260.             Control_Return_Info return code Control_Rc);
  4261.          if Control_Rc > 0
  4262.          then
  4263.             if Debug
  4264.             then
  4265.                open Control_Return_Info;
  4266.                Debug_String(" Unable to turn off ASCII input: ");
  4267.                Debug_String(" Control rc " !!
  4268.                   Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  4269.                   Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  4270.                   Substring(Dsr_Message, 0, Dsr_Message_Length));
  4271.             end if;
  4272.          end if;
  4273.       end if;
  4274.       if Can_Set_Read_Timer
  4275.       then
  4276.          /* clear the read timer and re-enable attn's */
  4277.          Control_Command := "read_timer off";
  4278.          Control_Command_Length := Length(Control_Command);
  4279.          Control(Substring(Control_Command, 0, 0),
  4280.             Control_Command_Length, Input_Unit.File_Unit,
  4281.             Control_Return_Info return code Control_Rc);
  4282.          if Control_Rc > 0
  4283.          then
  4284.             if Debug
  4285.             then                       /* Should never happen but
  4286.                                           just in case */
  4287.                open Control_Return_Info;
  4288.                Debug_String(" Unable to set timer interval: ");
  4289.                Debug_String(" Control rc " !!
  4290.                   Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  4291.                   Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  4292.                   Substring(Dsr_Message, 0, Dsr_Message_Length));
  4293.             end if;
  4294.          end if;
  4295.          Reenable_Attn();
  4296.       end if;
  4297.       Increment_Packet_Count(In_Packet_Count);
  4298.       open Input_Unit;
  4299.       if Last_Return_Code > 0
  4300.       then
  4301.          if Last_Return_Code = 20
  4302.          then
  4303.             /* have a timeout send NAK if receiving or resend the
  4304.                last packet if sending */
  4305.             if Side = Receiving_Side
  4306.             then
  4307.                Total_Retries +:= 1;
  4308.                Nak_Data := "";
  4309.                Send_Packet(Negative_Acknowledge_Code,
  4310.                   Current_Sequence_Number, Nak_Data);
  4311.             else                       /* sending side */
  4312.                if Debug
  4313.                then
  4314.                   Debug_String(" Sending a timeout repeat");
  4315.                end if;
  4316.                Total_Retries +:= 1;
  4317.                Write_Packet(Output_Unit, Send_Buffer);
  4318.                Increment_Packet_Count(Out_Packet_Count);
  4319.             end if;
  4320.             repeat;
  4321.          else
  4322.             /* something is drastically wrong: abort */
  4323.             Success := False;
  4324.             Error_Message := "Unexpected end of packets found.";
  4325.             return;
  4326.          end if;
  4327.       end if;
  4328.       exit;
  4329.    end cycle;
  4330.    Success := True;
  4331.  
  4332. end Get_Local_Packet;
  4333.  
  4334. %Eject();
  4335.  
  4336. definition Get_Remote_Packet
  4337.  
  4338.    /*box
  4339.       This procedure reads the next packet from a mounted unit.
  4340.       The X25_timer is used to prevent deadlocks.
  4341.    */
  4342.  
  4343.    variable Control_Command is Varying_String,
  4344.       Control_Command_Length is Short_Integer,
  4345.       Control_Rc is Integer,
  4346.       Control_Return_Info is Control_Return_Info_Type,
  4347.       Nak_Data is Packet_Data_Type,
  4348.       Timeout_Retry_Count is Short_Integer;
  4349.  
  4350.    /*box
  4351.       Set Timeout: this is a way to prevent deadlocks on the
  4352.       remote unit. The X25_timer is set to go off if there is no
  4353.       response within a specified period. If the call is clears
  4354.       it resonds with a rc of 12. If there is no response within
  4355.       in that time the Read subroutine will respond with a return
  4356.       code of 20.
  4357.    */
  4358.    open Global_Area_Ptr@;
  4359.    Timeout_Retry_Count := 0;
  4360.    cycle
  4361.       if Mode = User_Mode or Side = Sending_Side
  4362.       then
  4363.          /* timeout retries only when not a waiting server */
  4364.          if Timeout_Retry_Count > Max_Timeout_Retries
  4365.          then
  4366.             Success := False;
  4367.             Error_Message := "Timeout retry count exceeded";
  4368.             return;
  4369.          else
  4370.             Timeout_Retry_Count +:= 1;
  4371.          end if;
  4372.       end if;
  4373.       if Set_Um_Binary_On
  4374.       then
  4375.          /* @bin has to be implemented using control command at um
  4376.          */
  4377.          Control_Command := "binary=on";
  4378.          Control_Command_Length := Length(Control_Command);
  4379.          Control(Substring(Control_Command, 0, 0),
  4380.             Control_Command_Length, Remote_Unit.File_Unit,
  4381.             Control_Return_Info return code Control_Rc);
  4382.       end if;
  4383.       Read_Packet(Remote_Unit, Receive_Buffer);
  4384.       if Set_Um_Binary_On
  4385.       then
  4386.          /* @bin has to be implemented using control command at um
  4387.          */
  4388.          Control_Command := "binary=off";
  4389.          Control_Command_Length := Length(Control_Command);
  4390.          Control(Substring(Control_Command, 0, 0),
  4391.             Control_Command_Length, Remote_Unit.File_Unit,
  4392.             Control_Return_Info return code Control_Rc);
  4393.       end if;
  4394.       Increment_Packet_Count(In_Packet_Count);
  4395.       open Remote_Unit;
  4396.       if Last_Return_Code > 0
  4397.       then
  4398.          if Last_Return_Code = 12
  4399.          then
  4400.             /* have a call cleared situation, abort */
  4401.             Error_Message := " Line unexpectedly disconnected - " !!
  4402.                "transmission ceases";
  4403.             Success := False;
  4404.             return;
  4405.          end if;
  4406.          if Last_Return_Code = 20
  4407.          then
  4408.             /* have a timeout send NAK if receiving or resend the
  4409.                last packet if sending */
  4410.             if Side = Receiving_Side
  4411.             then
  4412.                Total_Retries +:= 1;
  4413.                Nak_Data := "";
  4414.                Send_Packet(Negative_Acknowledge_Code,
  4415.                   Current_Sequence_Number, Nak_Data);
  4416.             else                       /* sending side */
  4417.                /* resend the buffer */
  4418.                Total_Retries +:= 1;
  4419.                Send_Remote_Packet();
  4420.                if Debug
  4421.                then
  4422.                   Debug_String(" Sending a timeout repeat");
  4423.                end if;
  4424.                /* Its possible to abort at this point */
  4425.             end if;
  4426.             repeat;
  4427.          else
  4428.             /* something is drastically wrong: abort */
  4429.             Success := False;
  4430.             Error_Message := "Unexpected end of packets found.";
  4431.             return;
  4432.          end if;
  4433.       end if;
  4434.       exit;
  4435.    end cycle;
  4436.    Success := True;
  4437.  
  4438. end Get_Remote_Packet;
  4439.  
  4440. %Eject();
  4441.  
  4442. definition Dump_Receive_Buffer
  4443.  
  4444.    /*box
  4445.       This procedure is used to dump the received buffer in hex
  4446.       etc.
  4447.    */
  4448.  
  4449.    constant Dump_Width is 35;
  4450.    variable Start is Integer;
  4451.    open Global_Area_Ptr@;
  4452.    Debug_String(" Receive buffer in ASCII: ");
  4453.    Start := 0;
  4454.    cycle
  4455.       if Start >= Length(Receive_Buffer)
  4456.       then
  4457.          exit;
  4458.       end if;
  4459.       Debug_String(" " !!
  4460.          String_To_Hex_Varying(Substring(Receive_Buffer, Start,
  4461.          Min(Length(Receive_Buffer) - Start, Dump_Width))));
  4462.       Start +:= Dump_Width;
  4463.    end cycle;
  4464.    Debug_String(Readable_Receive_Buffer);
  4465.  
  4466. end Dump_Receive_Buffer;
  4467.  
  4468. %Eject();
  4469.  
  4470. definition Get_My_Packet_Parameters
  4471.  
  4472.    /*box
  4473.       This procedure initializes the data for the send initalize
  4474.       packet.
  4475.    */
  4476.  
  4477.    variable Send_Init_Packet is Packet_Parameters_Type;
  4478.  
  4479.    open Global_Area_Ptr@;
  4480.    open Send_Init_Packet;
  4481.    equate Send_Init_Character_Parameters to Send_Init_Packet as
  4482.          Packet_Parameters_Character_Type;
  4483.    Pp_Buffer_Size := My_Packet_Length;
  4484.    Char(Pp_Buffer_Size);
  4485.    Pp_Timeout := My_Timeout;
  4486.    Char(Pp_Timeout);
  4487.    Pp_Padding_Count := My_Padding_Count;
  4488.    Char(Pp_Padding_Count);
  4489.    Pp_Padding_Character := My_Padding_Character;
  4490.    Ctl(Pp_Padding_Character);
  4491.    Pp_End_Of_Line_Character := My_End_Of_Line_Character;
  4492.    Char(Pp_End_Of_Line_Character);
  4493.    Pp_Quote_Character := My_Quote_Character;
  4494.    /* In future add hand shaking determination */
  4495.    Pp_8_Bit_Quote_Character := Eight_Bit_Quote_Character;
  4496.    /* adjust in the future for more flexible approach */
  4497.    Pp_Checksum_Type := Checksum_To_External(Checksum_Kind);
  4498.    Pp_Repeat_Character := My_Repeat_Character;
  4499.    Pp_Capability_Byte_1 := Capability_Byte_1;
  4500.    equate Pp_Byte to Pp_Capability_Byte_1 as bit(8);
  4501.    Char(Pp_Byte);
  4502.    Send_Init_Data := Send_Init_Character_Parameters;
  4503.  
  4504. end Get_My_Packet_Parameters;
  4505.  
  4506. %Eject();
  4507.  
  4508. definition Get_Your_Packet_Parameters
  4509.  
  4510.    /*box
  4511.       This procedure gets the packet parameters sent back by the
  4512.       other KERMIT sets his packet parameters accordingly.
  4513.    */
  4514.  
  4515.    variable Unchared_Value is Short_Integer;
  4516.  
  4517.    open Global_Area_Ptr@;
  4518.    /* blanks are used to indicate default vaules so indicate default
  4519.       for any missing paraameters */
  4520.    if Length(Packet_Data) < Byte_Size(Packet_Parameters_Type)
  4521.    then
  4522.       variable I is Short_Integer;
  4523.       do I := 1 to Byte_Size(Packet_Parameters_Type) -
  4524.          Length(Packet_Data)
  4525.          Packet_Data !!:= Ascii_Space;
  4526.       end do;
  4527.    end if;
  4528.    equate Packet_Parameters to Substring(Packet_Data, 0) as
  4529.          Packet_Parameters_Type;
  4530.    open Packet_Parameters;
  4531.    Unchared_Value := Unchar(Pp_Buffer_Size);
  4532.    if Unchared_Value <= 0
  4533.    then
  4534.       Your_Packet_Length := Default_Packet_Length;
  4535.    else
  4536.       Your_Packet_Length := Unchared_Value;
  4537.    end if;
  4538.    Unchared_Value := Unchar(Pp_Timeout);
  4539.    if Unchared_Value <= 0
  4540.    then
  4541.       Your_Timeout := Default_Timeout;
  4542.    else
  4543.       Your_Timeout := Unchared_Value;
  4544.       if Your_Timeout < Min_Timeout
  4545.       then
  4546.          Your_Timeout := Min_Timeout;
  4547.       elseif Your_Timeout > Max_Timeout
  4548.       then
  4549.          Your_Timeout := Max_Timeout;
  4550.       end if;
  4551.    end if;
  4552.    Your_Timeout_Char := Integer_To_Varying(Your_Timeout, 0);
  4553.    Unchared_Value := Unchar(Pp_Padding_Count);
  4554.    if Pp_Padding_Count <= 0
  4555.    then
  4556.       Your_Padding_Count := Default_Padding_Count;
  4557.    else
  4558.       Your_Padding_Count := Unchared_Value;
  4559.    end if;
  4560.    Ctl(Pp_Padding_Character);
  4561.    if Pp_Padding_Character = 0
  4562.    then
  4563.       Your_Padding_Character := Default_Padding_Character;
  4564.    else
  4565.       Your_Padding_Character := Pp_Padding_Character;
  4566.    end if;
  4567.    Unchared_Value := Unchar(Pp_End_Of_Line_Character);
  4568.    if Unchared_Value <= 0
  4569.    then
  4570.       Your_End_Of_Line_Character := Ascii_Cr;
  4571.    else
  4572.       Your_End_Of_Line_Character := Unchared_Value;
  4573.    end if;
  4574.    if Pp_Quote_Character = Ascii_Space
  4575.    then
  4576.       Your_Quote_Character := Ascii_#
  4577.    else
  4578.       Your_Quote_Character := Pp_Quote_Character;
  4579.    end if;
  4580.    /* 8 bit quoting */
  4581.    /* check sum checks */
  4582.    /* repeat count */
  4583.    equate Pp_Byte to Pp_Capability_Byte_1 as bit(8);
  4584.    Unchared_Value := Unchar(Pp_Byte);
  4585.    if Unchared_Value <= 0
  4586.    then
  4587.       Send_File_Attributes := False;
  4588.    else
  4589.       variable Pp_Capability_Byte_Byte is bit(8);
  4590.       Pp_Capability_Byte_Byte := Unchared_Value;
  4591.       equate Pp_Capability_Byte_Bits to Pp_Capability_Byte_Byte as
  4592.             Capability_Byte_1_Type;
  4593.       open Pp_Capability_Byte_Bits;
  4594.       if Cb1_Accept_File_Attributes
  4595.       then
  4596.          Send_File_Attributes := True;
  4597.       else
  4598.          Send_File_Attributes := False;
  4599.       end if;
  4600.    end if;
  4601.  
  4602. end Get_Your_Packet_Parameters;
  4603.  
  4604. %Eject();
  4605.  
  4606. definition Open_Out_File
  4607.  
  4608.    /*box
  4609.       This procedure checks to see that the file given in the
  4610.       global variable "out_filename" can be opened (ie. exists
  4611.       and is accessable).
  4612.    */
  4613.  
  4614.    variable Access is bit(32),
  4615.       Rc is Integer,
  4616.       Temp_String is character(Max_Data_Length),
  4617.       Catalog_Info is Catalog_Info_Type,
  4618.       File_Info is File_Info_Type,
  4619.       Sharing_Info is Sharing_Info_Type,
  4620.       Ret_Filename is Returned_File_Name_Type,
  4621.       Error_Code is Integer,
  4622.       Error_Msg is character(80),
  4623.       Gfinfo_Rc is Integer;
  4624.  
  4625.    open Global_Area_Ptr@;
  4626.    Success := True;
  4627.    /* check the validity of the out going filename */
  4628.    if not Parse(Pcb, Check_Mts_Filename,
  4629.       Address(Substring(Out_Filename, 0)), Length(Out_Filename))
  4630.    then
  4631.       Error_Message := "First name invalid MTS filename.";
  4632.       Success := False;
  4633.       return;
  4634.    end if;
  4635.    Temp_String := Substring(Out_Filename, 0) !! " ";
  4636.    Access := Chkfile(Temp_String return code Rc);
  4637.    if Rc > 0 or (Access & Read_Access) ^= Read_Access
  4638.    then
  4639.       /* file does not exist or is not accessable */
  4640.       Error_Message := "Mts file doesn't exist or inaccessible";
  4641.       Success := False;
  4642.       return;
  4643.    end if;
  4644.    /* make sure we really can open the file */
  4645.    Initialize_File_With_Name(Out_File, Out_Filename,
  4646.       Out_File_Io_Modifiers, Rc);
  4647.    if Rc > 0
  4648.    then                                /* couldn't get fdub */
  4649.       Error_Message := "Unable to open Mts file.";
  4650.       Success := False;
  4651.       return;
  4652.    end if;
  4653.    /* grab file info */
  4654.    open Catalog_Info;
  4655.    open File_Info;
  4656.    Sharing_Info.Si_Array_Length := 0;
  4657.    Ci_Array_Length := Byte_Size(Catalog_Info_Type) / 4;
  4658.    Fi_Array_Length := Byte_Size(File_Info_Type) / 4;
  4659.    Ret_Filename.Scratch := 0;
  4660.    Gfinfo(Out_File.File_Unit.Fdub, Ret_Filename, Gf_Fdub,
  4661.       Catalog_Info, File_Info, Sharing_Info, Error_Code, Error_Msg
  4662.       return code Gfinfo_Rc);
  4663.    if Gfinfo_Rc ^= 0
  4664.    then
  4665.       if Debug
  4666.       then
  4667.          if Gfinfo_Rc = 4
  4668.          then
  4669.             Debug_String(" GFINFO: " !! Error_Msg);
  4670.          else
  4671.             Debug_String(" GFINFO: Bad parameters.");
  4672.          end if;
  4673.       end if;
  4674.       Error_Message := "Unable to open Mts file. No file info.";
  4675.       Success := False;
  4676.       return;
  4677.    end if;
  4678.    if Fi_File_Organization = Sequential_File
  4679.    then
  4680.       File_Is_Line := False;
  4681.    else
  4682.       File_Is_Line := True;
  4683.    end if;
  4684.    if File_Kind = Text_File_Kind
  4685.    then
  4686.       Expected_Packets := Fi_Copied_Size *
  4687.          Expected_Text_Packets_Per_Page;
  4688.    else
  4689.       Expected_Packets := Fi_Copied_Size *
  4690.          Expected_Binary_Packets_Per_Page;
  4691.    end if;
  4692.    File_Attribute_Data := "";
  4693.  
  4694.    /* Grab the file attribute data now just in case we need it later
  4695.    */
  4696.    /* First get the file length in K bytes */
  4697.    variable File_Length_String is character(0 to 12),
  4698.       File_Length_Length is bit(8);
  4699.    /* send length in K bytes */
  4700.    File_Length_String := Integer_To_Varying(Fi_Copied_Size * 4, 0);
  4701.    File_Length_Length := Length(File_Length_String);
  4702.    Mts_Ebcdic_To_Ascii(Substring(File_Length_String, 0),
  4703.       Length(File_Length_String));
  4704.    Char(File_Length_Length);
  4705.    File_Attribute_Data := Length_File_Attribute !!
  4706.       File_Length_Length !! File_Length_String;
  4707.    /* Now send file organization */
  4708.    variable File_Type is bit(8),
  4709.       File_Type_Length is bit(8);
  4710.    select File_Kind from
  4711.    case Text_File_Kind:
  4712.       File_Type := Ascii_A;            /* Ascii file */
  4713.    case Binary_File_Kind:
  4714.       File_Type := Ascii_B;            /* Binary file */
  4715.    case Mts_Binary_File_Kind:
  4716.       if Fi_File_Organization = Sequential_File
  4717.       then
  4718.          File_Type := Ascii_S;
  4719.       else
  4720.          File_Type := Ascii_L;
  4721.       end if;
  4722.    else
  4723.       File_Type := Ascii_A;
  4724.    end select;
  4725.    File_Type_Length := Byte_Size(File_Type);
  4726.    Char(File_Type_Length);
  4727.    File_Attribute_Data !!:= Type_File_Attribute !! File_Type_Length
  4728.       !! File_Type;
  4729.  
  4730.    if File_Kind = Mts_Binary_File_Kind
  4731.    then
  4732.       /* Check remote filename is valid */
  4733.       if Remote_Filename ^= ""
  4734.       then                             /* have a different remote
  4735.                                           name */
  4736.          if not Parse(Pcb, Check_Mts_Filename,
  4737.             Address(Substring(Remote_Filename, 0)),
  4738.             Length(Remote_Filename))
  4739.          then
  4740.             Error_Message := "Second name invalid MTS filename.";
  4741.             Success := False;
  4742.             return;
  4743.          end if;
  4744.       end if;
  4745.       /* names are valid */
  4746.       /* build special mts file attribute */
  4747.       variable Mts_File_Attribute_Data is Mts_File_Attribute_Type,
  4748.          Mts_File_Attribute_Length is bit(8);
  4749.       open Mts_File_Attribute_Data;
  4750.       Mfa_Maxsize_String := Substring(Integer_To_Varying(Fi_Maxsize,
  4751.          5), 0);
  4752.       Mts_Ebcdic_To_Ascii(Mfa_Maxsize_String,
  4753.          Length(Mfa_Maxsize_String));
  4754.       if Ci_Nosave
  4755.       then
  4756.          Mfa_Nosave := Ascii_N;
  4757.       else
  4758.          Mfa_Nosave := Ascii_S;
  4759.       end if;
  4760.       Mfa_Pkey := Ci_Pkey;
  4761.       Mts_Ebcdic_To_Ascii(Mfa_Pkey, Length(Mfa_Pkey));
  4762.       Mts_File_Attribute_Length :=
  4763.          Byte_Size(Mts_File_Attribute_Type);
  4764.       Char(Mts_File_Attribute_Length);
  4765.       equate Buffer to Mts_File_Attribute_Data as
  4766.             character(Byte_Size(Mts_File_Attribute_Type));
  4767.       File_Attribute_Data !!:= Mts_File_Attribute !!
  4768.          Mts_File_Attribute_Length !! Buffer;
  4769.    end if;
  4770.    /* initialize the output buffer */
  4771.    File_Buffer_Ptr@ := "";
  4772.    Out_File_End_Of_File := False;
  4773.    Next_Out_File_Character_Position := 0;
  4774.    Current_Line_Number := 0;
  4775.    Is_First_Out_File_Record := True;
  4776.    if File_Is_Line
  4777.    then
  4778.       Set_First_Line(Out_File);
  4779.    end if;
  4780.    Mts_Binary_State := Start_Mts_Binary_Linenumber_State;
  4781.  
  4782. end Open_Out_File;
  4783.  
  4784. %Eject();
  4785.  
  4786. definition Flush_Input_Unit
  4787.  
  4788.    /*box
  4789.       This procedure is called before beginning transmission to
  4790.       get rid of any pending input for the packet buffer. This
  4791.       may include unwanted NAK's. Not sure how to do this?
  4792.       Perhaps a timed out read?
  4793.    */
  4794.    variable Control_Command is Varying_String,
  4795.       Control_Command_Length is Short_Integer,
  4796.       Control_Rc is Integer,
  4797.       Control_Return_Info is Control_Return_Info_Type;
  4798.  
  4799.    open Global_Area_Ptr@;
  4800.    if Remote_Kermit
  4801.    then
  4802.       if Debug
  4803.       then
  4804.          Debug_String(" CONTROL: flush");
  4805.       end if;
  4806.       Control_Command := "flush";
  4807.       Control_Command_Length := Length(Control_Command);
  4808.       Control(Substring(Control_Command, 0, 0),
  4809.          Control_Command_Length, Input_Unit.File_Unit,
  4810.          Control_Return_Info return code Control_Rc);
  4811.       if Control_Rc > 0
  4812.       then
  4813.          if Debug
  4814.          then
  4815.             open Control_Return_Info;
  4816.             Debug_String(" Unable to flush timer:");
  4817.             Debug_String(" Control rc " !!
  4818.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  4819.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  4820.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  4821.          end if;
  4822.       end if;
  4823.    end if;
  4824.  
  4825. end Flush_Input_Unit;
  4826.  
  4827. %Eject();
  4828.  
  4829. definition Get_Next_Out_File
  4830.  
  4831.    /*box
  4832.       This procedure is called to put the next filename into the
  4833.       global variable out_filename when several files in pattern
  4834.       are being sent. For this version this capability does not
  4835.       exist.
  4836.    */
  4837.  
  4838.    open Global_Area_Ptr@;
  4839.    Success := False;
  4840.  
  4841. end Get_Next_Out_File;
  4842.  
  4843. %Eject();
  4844.  
  4845. definition Get_Next_Out_File_Character
  4846.  
  4847.    /*box
  4848.       This procedure gets the next character from the file. It
  4849.       uses the global variable "out_file_buffer" to keep the
  4850.       files records in.
  4851.    */
  4852.  
  4853.    open Global_Area_Ptr@;
  4854.    Success := True;
  4855.    if Next_Out_File_Character_Position >= Length(File_Buffer_Ptr@)
  4856.    then
  4857.       cycle
  4858.          /* buffer empty: must get next record */
  4859.          if Out_File_End_Of_File
  4860.          then
  4861.             /* already have end of file */
  4862.             Success := False;
  4863.             return;
  4864.          end if;
  4865.          Read_Long_Varying(Out_File, File_Buffer_Ptr@);
  4866.          open Out_File;
  4867.          if Last_Return_Code > 0
  4868.          then
  4869.             /* plumb out of characters */
  4870.             Out_File_End_Of_File := True;
  4871.             /* Clean up */
  4872.             Freefd(Out_File.File_Unit.Fdub);
  4873.             Success := False;
  4874.             return;
  4875.          end if;
  4876.          if Is_First_Out_File_Record
  4877.          then
  4878.             if File_Is_Line
  4879.             then
  4880.                Set_Next_Line(Out_File);
  4881.             end if;
  4882.             Is_First_Out_File_Record := False;
  4883.          end if;
  4884.          /* should always be something in line but just in case */
  4885.          exit unless Length(File_Buffer_Ptr@) <= 0;
  4886.       end cycle;
  4887.       /* check to see if CRLF has to be added for a text file */
  4888.       if File_Kind = Text_File_Kind
  4889.       then
  4890.          /* first convert MTS EBCDIC to ASCII */
  4891.          variable Chunk_Position is Integer,
  4892.             Chunk_Length is Short_Integer;
  4893.          Chunk_Position := 0;
  4894.          Chunk_Length := Min(Length(File_Buffer_Ptr@),
  4895.             Standard_String_Length);
  4896.          cycle
  4897.             exit when Chunk_Length <= 0;
  4898.             Mts_Ebcdic_To_Ascii(Substring(File_Buffer_Ptr@,
  4899.                Chunk_Position, 0), Chunk_Length);
  4900.             Chunk_Position +:= Chunk_Length;
  4901.             Chunk_Length := Min(Length(File_Buffer_Ptr@) -
  4902.                Chunk_Position, Standard_String_Length);
  4903.          end cycle;
  4904.          /* restrict text file records to two bytes less than max
  4905.             record length for now */
  4906.          if Length(File_Buffer_Ptr@) <= Long_String_Length - 2
  4907.          then
  4908.             File_Buffer_Ptr@ !!:= Ascii_Crlf;
  4909.          end if;
  4910.       end if;
  4911.       Next_Out_File_Character_Position := 0;
  4912.    end if;
  4913.    Next_Character := Substring(File_Buffer_Ptr@,
  4914.       Next_Out_File_Character_Position, 1);
  4915.    Next_Out_File_Character_Position +:= 1;
  4916.  
  4917. end Get_Next_Out_File_Character;
  4918.  
  4919. %Eject();
  4920.  
  4921. definition Get_Out_File_Data
  4922.  
  4923.    /*box
  4924.       This procedure encodes the characters from the file so that
  4925.       they are suitable for use in a packet.
  4926.    */
  4927.    constant Zero_Parity_Bit is '7F',
  4928.       Parity_Set is '80';
  4929.  
  4930.    variable Next_Character is bit(8),
  4931.       Success is Boolean,
  4932.       Temp_Character is bit(8);
  4933.  
  4934.    open Global_Area_Ptr@;
  4935.    Packet_Data := "";
  4936.    End_Of_File := False;
  4937.    cycle
  4938.       if File_Kind = Mts_Binary_File_Kind
  4939.       then
  4940.          Get_Mts_Binary_Data(Next_Character, Success)
  4941.       else
  4942.          Get_Next_Out_File_Character(Next_Character, Success);
  4943.       end if;
  4944.       if not Success
  4945.       then
  4946.          if Packet_Data = ""
  4947.          then
  4948.             /* true end of file */
  4949.             End_Of_File := True;
  4950.             return;
  4951.          else                          /* end of packet: next call
  4952.                                           will generate EOF */
  4953.             return;
  4954.          end if;
  4955.       end if;
  4956.       /* first encode text files */
  4957.       if File_Kind = Text_File_Kind
  4958.       then
  4959.          /* clear the parity bit */
  4960.          Next_Character &:= Zero_Parity_Bit;
  4961.          if Next_Character < Ascii_Space or Next_Character =
  4962.             Ascii_Del or Next_Character = Your_Quote_Character
  4963.          then                          /* have to quote the
  4964.                                           character */
  4965.             Packet_Data !!:= Your_Quote_Character;
  4966.             if Next_Character ^= Your_Quote_Character
  4967.             then
  4968.                /* controlify the character */
  4969.                Ctl(Next_Character);
  4970.             end if;
  4971.          end if;
  4972.       else                             /* file_kind =
  4973.                                           binary_file_kind */
  4974.          /* at this point insert code to do eight quoting */
  4975.          Temp_Character := Next_Character;
  4976.          Temp_Character &:= Zero_Parity_Bit;
  4977.          if Temp_Character < Ascii_Space or Temp_Character >=
  4978.             Ascii_Del or Temp_Character = Your_Quote_Character
  4979.          then
  4980.             Packet_Data !!:= Your_Quote_Character;
  4981.             if Temp_Character ^= Your_Quote_Character
  4982.             then
  4983.                Ctl(Next_Character);
  4984.             end if;
  4985.          end if;
  4986.       end if;
  4987.       /* add character itself (possibly modified) */
  4988.       Packet_Data !!:= Next_Character;
  4989.       exit when Length(Packet_Data) > Your_Packet_Length -
  4990.          Max_Non_Data_Count - Max_Encoding_Count;
  4991.    end cycle;
  4992.  
  4993. end Get_Out_File_Data;
  4994.  
  4995. %Eject();
  4996.  
  4997. definition Decode_File_Attributes
  4998.  
  4999.    /*box
  5000.       This procedure is passed a file attribute packet and it
  5001.       fills in mts_file_info with the attributes sent.
  5002.    */
  5003.  
  5004.    open Global_Area_Ptr@;
  5005.    open Mts_File_Info;
  5006.    variable Next_Pos is String_Length_Type;
  5007.  
  5008.    macro Next_Char;
  5009.       (Substring(File_Attribute_Packet, Next_Pos, 1))
  5010.    end macro Next_Char;
  5011.  
  5012.    Next_Pos := 0;
  5013.    cycle
  5014.       return when Next_Pos >= Length(File_Attribute_Packet);
  5015.       variable File_Attribute is bit(8),
  5016.          File_Attribute_Length is bit(8),
  5017.          Unchared_Length is Short_Integer,
  5018.          File_Attribute_Data is Packet_Data_Type;
  5019.  
  5020.       File_Attribute := Next_Char();
  5021.       Next_Pos +:= 1;
  5022.       /* ignore bad attributes etc. */
  5023.       exit when Next_Pos >= Length(File_Attribute_Packet);
  5024.       File_Attribute_Length := Next_Char();
  5025.       Unchared_Length := Unchar(File_Attribute_Length);
  5026.       if Unchared_Length < 0
  5027.       then
  5028.          File_Attribute_Length := 0;
  5029.       else
  5030.          File_Attribute_Length := Unchared_Length;
  5031.       end if;
  5032.       variable I is String_Length_Type;
  5033.       File_Attribute_Data := "";
  5034.       do I := 1 to File_Attribute_Length
  5035.          Next_Pos +:= 1;
  5036.          return when Next_Pos >= Length(File_Attribute_Packet);
  5037.          File_Attribute_Data !!:= Next_Char();
  5038.       end do;
  5039.       if Debug
  5040.       then
  5041.          variable Ebcdic_File_Attribute is character(1),
  5042.             Ebcdic_File_Attribute_Length is character(0 to 3),
  5043.             Ebcdic_File_Attribute_Data is Packet_Data_Type;
  5044.          Ebcdic_File_Attribute := File_Attribute;
  5045.          Ascii_To_Mts_Ebcdic(Ebcdic_File_Attribute, 1);
  5046.          Ebcdic_File_Attribute_Length :=
  5047.             Integer_To_Varying(File_Attribute_Length, 0);
  5048.          Ebcdic_File_Attribute_Data := File_Attribute_Data;
  5049.          Ascii_To_Mts_Ebcdic(Substring(Ebcdic_File_Attribute_Data,
  5050.             0), Length(Ebcdic_File_Attribute_Data));
  5051.          Debug_String(" File attribute: " !! Ebcdic_File_Attribute
  5052.             !! " " !! Ebcdic_File_Attribute_Length !! " " !!
  5053.             Ebcdic_File_Attribute_Data);
  5054.       end if;
  5055.  
  5056.       select File_Attribute from
  5057.       case Length_File_Attribute:
  5058.          variable Filesize is Integer;
  5059.          Ascii_To_Mts_Ebcdic(Substring(File_Attribute_Data, 0),
  5060.             Length(File_Attribute_Data));
  5061.          variable Error_Ptr is pointer to Varying_String,
  5062.             Error_Msg is Varying_String;
  5063.          Error_Ptr := Address(Error_Msg);
  5064.          Filesize := String_To_Integer(File_Attribute_Data,
  5065.             Error_Ptr);
  5066.          if Error_Msg ^= ""
  5067.          then
  5068.             /* default the filesize to a page */
  5069.             Filesize := 4;
  5070.          end if;
  5071.          Filesize := Filesize / 4;     /* sent in K bytes */
  5072.          if Filesize < 0
  5073.          then
  5074.             Filesize := 1
  5075.          elseif Filesize > Maximum_Short_Integer
  5076.          then
  5077.             /* assume mistake and set to max */
  5078.             Filesize := Maximum_Short_Integer;
  5079.          end if;
  5080.          Mf_Copied_Size := Filesize;
  5081.          if File_Kind = Text_File_Kind
  5082.          then
  5083.             Expected_Packets := Filesize *
  5084.                Expected_Text_Packets_Per_Page;
  5085.          else
  5086.             Expected_Packets := Filesize *
  5087.                Expected_Binary_Packets_Per_Page;
  5088.          end if;
  5089.       case Type_File_Attribute:
  5090.          variable File_Type is bit(8);
  5091.          if File_Attribute_Length >= 1
  5092.          then
  5093.             select Substring(File_Attribute_Data, 0, 1) from
  5094.             case Ascii_A:
  5095.                /* Have a Kermit Ascii file */
  5096.                Set_Filetype_Text();
  5097.             case Ascii_B:
  5098.                Set_Filetype_Binary();
  5099.             case Ascii_L:
  5100.                /* MTS Line File */
  5101.                Set_Filetype_Mts_Binary();
  5102.                Mf_File_Organization := Line_File;
  5103.             case Ascii_S:
  5104.                /* MTS Sequential File */
  5105.                Set_Filetype_Mts_Binary();
  5106.                Mf_File_Organization := Sequential_File;
  5107.             else
  5108.                /* default filetype to ascii */
  5109.                Set_Filetype_Text();
  5110.             end select;
  5111.          else
  5112.             /* default filetype to text */
  5113.             Set_Filetype_Text();
  5114.          end if;
  5115.       case Mts_File_Attribute:
  5116.          /* special mts attribute: 5 byte maxsize, nosave, 16 byte
  5117.             pkey */
  5118.          if File_Attribute_Length =
  5119.             Byte_Size(Mts_File_Attribute_Type)
  5120.          then
  5121.             equate Mts_File_Attribute_Data to
  5122.                   Substring(File_Attribute_Data, 0) as
  5123.                   Mts_File_Attribute_Type;
  5124.             open Mts_File_Attribute_Data;
  5125.             open Mts_File_Info;
  5126.             variable Maxsize_Temp is Integer,
  5127.                Error_Msg is Varying_String,
  5128.                Error_Ptr is pointer to Varying_String;
  5129.             Error_Ptr := Address(Error_Msg);
  5130.             Ascii_To_Mts_Ebcdic(Mfa_Maxsize_String,
  5131.                Length(Mfa_Maxsize_String));
  5132.             Maxsize_Temp := String_To_Integer(Mfa_Maxsize_String,
  5133.                Error_Ptr);
  5134.             if Error_Msg = ""
  5135.             then
  5136.                if Maxsize_Temp > 0 and Maxsize_Temp <=
  5137.                   Maximum_Short_Integer
  5138.                then
  5139.                   Mf_Maxsize := Maxsize_Temp;
  5140.                else                    /* leave as default */
  5141.                end if;
  5142.             else                       /* leave as default */
  5143.                if Debug
  5144.                then
  5145.                   Debug_String(" Maxsize conversion: " !!
  5146.                      Error_Msg);
  5147.                end if;
  5148.             end if;
  5149.             if Mfa_Nosave = Ascii_N
  5150.             then
  5151.                Mf_Nosave := True;
  5152.             else                       /* leave as default */
  5153.             end if;
  5154.             Ascii_To_Mts_Ebcdic(Mfa_Pkey, Length(Mfa_Pkey));
  5155.             Mf_Pkey := Mfa_Pkey;
  5156.          end if;
  5157.       else
  5158.          /* Attribute not handled: skip */
  5159.       end select;
  5160.       Next_Pos +:= 1;
  5161.    end cycle;
  5162.  
  5163. end Decode_File_Attributes;
  5164.  
  5165. %Eject();
  5166.  
  5167. definition Open_In_File
  5168.  
  5169.    /*box
  5170.       This procedure opens the file for incoming data. If the
  5171.       filename sent is an invalid filename or can't be opened for
  5172.       writing KERMIT puts the data into a scratch file -KERMIT.
  5173.    */
  5174.  
  5175.    variable Rc is Integer,
  5176.       Temp_String is character(Max_Data_Length),
  5177.       Access is bit(32);
  5178.    variable File_Io_Modifiers is Mts_Io_Extended_Modifiers_Type;
  5179.  
  5180.    open Global_Area_Ptr@;
  5181.    File_Buffer_Ptr@ := "";             /* clear buffer */
  5182.    if File_Kind = Mts_Binary_File_Kind
  5183.    then
  5184.       Current_Line_Number := 0;
  5185.       if Mts_File_Info.Mf_File_Organization = Line_File
  5186.       then
  5187.          File_Io_Modifiers := In_File_Io_Modifiers ! Mts_Io_Indexed;
  5188.       else
  5189.          File_Io_Modifiers := In_File_Io_Modifiers;
  5190.       end if;
  5191.       Mts_Binary_State := Start_Mts_Binary_Linenumber_State;
  5192.    else
  5193.       File_Io_Modifiers := In_File_Io_Modifiers;
  5194.    end if;
  5195.    Pending_Cr := False;
  5196.    Success := True;
  5197.    /* check we have have a valid mts filename */
  5198.    if Parse(Pcb, Check_Mts_Filename, Address(Substring(In_Filename,
  5199.       0)), Length(In_Filename))
  5200.    then
  5201.       /* see if file exists */
  5202.       Temp_String := Substring(In_Filename, 0) !! " ";
  5203.       Access := Chkfile(Temp_String return code Rc);
  5204.       if Rc = 0
  5205.       then                             /* file exists: now access */
  5206.          if (Access & Write_Access) = Write_Access
  5207.          then
  5208.             /* file exists: replace contents */
  5209.             Initialize_File_With_Name(In_File, In_Filename,
  5210.                File_Io_Modifiers, Rc);
  5211.             if Rc = 0
  5212.             then                       /* all okay: empty file */
  5213.                Empty(In_File.File_Unit.Fdub return code Rc);
  5214.                if Rc = 0
  5215.                then                    /* file is ready for data */
  5216.                   return;
  5217.                end if;
  5218.                /* drop through to default file */
  5219.             end if;
  5220.             /* drop through to default file */
  5221.          end if;
  5222.          /* drop through to default file */
  5223.       elseif Rc = Chkfile_File_Does_Not_Exist
  5224.       then                             /* create */
  5225.          variable Create_Size is Create_Size_Type,
  5226.             Volume is Integer,
  5227.             File_Organization is Integer;
  5228.          open Create_Size;
  5229.          open Mts_File_Info;
  5230.          Maximum_Size := Mf_Maxsize;
  5231.          Initial_Size := Mf_Copied_Size;
  5232.          Volume := 0;
  5233.          File_Organization := Mf_File_Organization + 256;
  5234.          Create(Temp_String, Create_Size, Volume, File_Organization
  5235.             return code Rc);
  5236.          if Rc = 0
  5237.          then                          /* have created file */
  5238.             Initialize_File_With_Name(In_File, In_Filename,
  5239.                File_Io_Modifiers, Rc);
  5240.             if Rc = 0
  5241.             then                       /* all okay lets return */
  5242.                return;
  5243.             end if;
  5244.             /* drop through */
  5245.          else                          /* something wrong record for
  5246.                                           debug */
  5247.             if Debug
  5248.             then
  5249.                Debug_String(
  5250.                   " Unable to create incoming file. create rc " !!
  5251.                   Integer_To_Varying(Rc, 0));
  5252.             end if;
  5253.             /* drop through */
  5254.          end if;
  5255.       end if;
  5256.    end if;
  5257.    /* file couldn't be opened default to scratch */
  5258.    if not Remote_Kermit
  5259.    then
  5260.       Write_To_User(" Incoming file couldn't be opened " !!
  5261.          Default_In_File !! " used.");
  5262.    else
  5263.       /* send text about state */
  5264.    end if;
  5265.    Initialize_File_With_Name(In_File, Default_In_File,
  5266.       File_Io_Modifiers, Rc);
  5267.    if Rc > 0
  5268.    then
  5269.       Success := False;
  5270.       return;
  5271.    end if;
  5272.  
  5273. end Open_In_File;
  5274.  
  5275. %Eject();
  5276.  
  5277. definition Put_In_File_Data
  5278.  
  5279.    /*box
  5280.       This procedure decodes the data packet and places it into
  5281.       an mts file.
  5282.    */
  5283.  
  5284.    constant Zero_Parity_Bit is '7F';
  5285.  
  5286.    /*box
  5287.       This macro grabs the next character from the packet that is
  5288.       being deciphered.
  5289.    */
  5290.    open Global_Area_Ptr@;
  5291.  
  5292.    variable Next_Character_Position is Short_Integer;
  5293.  
  5294.    macro Get_Next_In_File_Character
  5295.       parameters are Next_Character, Success;
  5296.       if Next_Character_Position >= Length(Packet_Data)
  5297.       then
  5298.          Success := False;
  5299.       else
  5300.          Next_Character := Substring(Packet_Data,
  5301.             Next_Character_Position, 1);
  5302.          Next_Character_Position +:= 1;
  5303.          Success := True;
  5304.       end if;
  5305.    end macro;
  5306.  
  5307.    variable Next_Character is bit(8),
  5308.       Success is Boolean,
  5309.       Write_Success is Boolean,
  5310.       Temp_Character is bit(8);
  5311.  
  5312.    Put_Success := True;
  5313.    Next_Character_Position := 0;
  5314.    cycle
  5315.       Get_Next_In_File_Character(Next_Character, Success);
  5316.       if not Success
  5317.       then
  5318.          /* all done */
  5319.          return;
  5320.       end if;
  5321.       if Next_Character = My_Quote_Character
  5322.       then
  5323.          Get_Next_In_File_Character(Next_Character, Success);
  5324.          if not Success
  5325.          then
  5326.             /* this should not happen. will ignore it in any case */
  5327.             return;
  5328.          end if;
  5329.          Temp_Character := Next_Character & Zero_Parity_Bit;
  5330.          if Temp_Character ^= My_Quote_Character
  5331.          then
  5332.             Ctl(Next_Character);
  5333.          end if;
  5334.       end if;
  5335.       if File_Kind = Text_File_Kind
  5336.       then
  5337.          if Pending_Cr
  5338.          then
  5339.             /* have a CR look for a LF */
  5340.             if Next_Character = Ascii_Lf
  5341.             then
  5342.                /* have end of text record: write it */
  5343.                Write_In_File_Buffer(Write_Success);
  5344.                File_Buffer_Ptr@ := "";
  5345.                Pending_Cr := False;
  5346.                if not Write_Success
  5347.                then
  5348.                   Put_Success := False;
  5349.                   return;
  5350.                end if;
  5351.                repeat;
  5352.             else                       /* not followed by LF so
  5353.                                           stash CR */
  5354.                if Length(File_Buffer_Ptr@) >= In_Buffer_End
  5355.                then
  5356.                   Write_In_File_Buffer(Write_Success);
  5357.                   if not Write_Success
  5358.                   then
  5359.                      Put_Success := False;
  5360.                      return;
  5361.                   end if;
  5362.                   File_Buffer_Ptr@ := Ascii_Cr;
  5363.                else
  5364.                   File_Buffer_Ptr@ !!:= Ascii_Cr;
  5365.                end if;
  5366.                if Next_Character = Ascii_Cr
  5367.                then
  5368.                   Pending_Cr := True;
  5369.                   repeat;
  5370.                else
  5371.                   Pending_Cr := False;
  5372.                end if;
  5373.             end if;
  5374.          else
  5375.             if Next_Character = Ascii_Cr
  5376.             then
  5377.                Pending_Cr := True;
  5378.                repeat;
  5379.             end if;
  5380.          end if;
  5381.       end if;
  5382.       /* stash the character */
  5383.       if File_Kind = Mts_Binary_File_Kind
  5384.       then
  5385.          Put_Mts_Binary_Data(Next_Character, Write_Success);
  5386.          if not Write_Success
  5387.          then
  5388.             Put_Success := False;
  5389.             if Debug
  5390.             then
  5391.                Debug_String(" In " !! %Current_Procedure !! " bad "
  5392.                   !! "put binary return");
  5393.             end if;
  5394.             return;
  5395.          end if;
  5396.       else
  5397.          if Length(File_Buffer_Ptr@) >= In_Buffer_End
  5398.          then
  5399.             Write_In_File_Buffer(Write_Success);
  5400.             if not Write_Success
  5401.             then
  5402.                Put_Success := False;
  5403.                return;
  5404.             end if;
  5405.             File_Buffer_Ptr@ := Next_Character;
  5406.          else
  5407.             File_Buffer_Ptr@ !!:= Next_Character;
  5408.          end if;
  5409.       end if;
  5410.    end cycle;
  5411.  
  5412. end Put_In_File_Data;
  5413.  
  5414. %Eject();
  5415.  
  5416. definition Write_In_File_Buffer
  5417.  
  5418.    /*box
  5419.       If in_file_buffer is text it is translated before writing.
  5420.    */
  5421.  
  5422.    open Global_Area_Ptr@;
  5423.    Success := True;
  5424.    if File_Kind = Text_File_Kind
  5425.    then
  5426.       variable Chunk_Position is Integer,
  5427.          Chunk_Length is Short_Integer;
  5428.       Chunk_Position := 0;
  5429.       Chunk_Length := Min(Length(File_Buffer_Ptr@),
  5430.          Standard_String_Length);
  5431.       cycle
  5432.          exit when Chunk_Length <= 0;
  5433.          Ascii_To_Mts_Ebcdic(Substring(File_Buffer_Ptr@,
  5434.             Chunk_Position, 0), Chunk_Length);
  5435.          Chunk_Position +:= Chunk_Length;
  5436.          Chunk_Length := Min(Length(File_Buffer_Ptr@) -
  5437.             Chunk_Position, Standard_String_Length);
  5438.       end cycle;
  5439.    end if;
  5440.    Write_Varying(In_File, File_Buffer_Ptr@);
  5441.    open In_File;
  5442.    if Last_Return_Code > 0
  5443.    then
  5444.       if Debug
  5445.       then
  5446.          Debug_String(" In " !! %Current_Procedure !!
  5447.             " write error rc: " !!
  5448.             Integer_To_Varying(Last_Return_Code, 0));
  5449.       end if;
  5450.       /* Have a serious error */
  5451.       if Last_Return_Code = 4
  5452.       then
  5453.          Error_Message := "File size exceeded";
  5454.       elseif Last_Return_Code = 24
  5455.       then
  5456.          Error_Message := "Disk allotment exceeded";
  5457.       else
  5458.          Error_Message := "Error writing file";
  5459.       end if;
  5460.       Success := False;
  5461.    end if;
  5462.  
  5463. end Write_In_File_Buffer;
  5464.  
  5465. %Eject();
  5466.  
  5467. definition Send_Error_Message
  5468.  
  5469.    /*box
  5470.       This procedure sends the text of an error message to the
  5471.       remote kermit using the "E" packet type. It does not wait
  5472.       for any ACK.
  5473.    */
  5474.  
  5475.  
  5476.    /* first check error will fit packet. Trim if not */
  5477.    variable Max_Error_Message_Length is Packet_Data_Length_Type,
  5478.       Error_Packet is Packet_Data_Type;
  5479.  
  5480.    open Global_Area_Ptr@;
  5481.    Max_Error_Message_Length := Your_Packet_Length -
  5482.       Max_Non_Data_Count;
  5483.    if Length(Error_Message) > Max_Error_Message_Length
  5484.    then
  5485.       Error_Packet := Substring(Error_Message, 0,
  5486.          Max_Error_Message_Length);
  5487.    else
  5488.       Error_Packet := Error_Message;
  5489.    end if;
  5490.    if Debug
  5491.    then
  5492.       Debug_String(" Error Packet Sent:" !! Error_Packet);
  5493.    end if;
  5494.    Mts_Ebcdic_To_Ascii(Substring(Error_Packet, 0, 0),
  5495.       Length(Error_Packet));
  5496.    Send_Packet(Error_Code, Current_Sequence_Number, Error_Packet);
  5497.  
  5498. end Send_Error_Message;
  5499.  
  5500. %Eject();
  5501.  
  5502. definition Server_Node
  5503.  
  5504.    /*box
  5505.       This procedure is called when the user requests that KERMIT
  5506.       go into server mode. In server mode KERMIT talks directly
  5507.       to another kermit rather than through the user interface.
  5508.    */
  5509.  
  5510.    variable Receive_Packet_Type is Packet_Type_Type,
  5511.       Receive_Sequence_Number is Sequence_Number_Type,
  5512.       Init_Data is Packet_Data_Type,
  5513.       Receive_Data is Packet_Data_Type;
  5514.  
  5515.    open Global_Area_Ptr@;
  5516.    /* set up a long return for a timed out remote write. This should
  5517.       never be the case for a server node since they are always
  5518.       remote */
  5519.    Setup_Return_From(Rcb, Success);
  5520.    Success := True;
  5521.    Mode := Server_Mode;
  5522.    cycle
  5523.       Initialize_Sequence_Numbers();
  5524.       Times_This_Packet_Retried := 0;
  5525.       Side := Receiving_Side;
  5526.       Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  5527.          Receive_Data);
  5528.       select Receive_Packet_Type from
  5529.       case Send_Init_Code:
  5530.          variable Receive_Success is Boolean;
  5531.          /* get his parameters and send our parameters */
  5532.          Get_Your_Packet_Parameters(Receive_Data);
  5533.          Get_My_Packet_Parameters(Init_Data);
  5534.          /* here is where the final adjusment for 8 bit, repeat, and
  5535.             checksum type takes place */
  5536.          Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  5537.             Init_Data);
  5538.          Times_Last_Packet_Retried := Times_This_Packet_Retried;
  5539.          Times_This_Packet_Retried := 0;
  5540.          Increment_Sequence_Numbers();
  5541.          In_Filename := "";
  5542.          Server_Receive_File(Receive_Success);
  5543.          if Receive_Success
  5544.          then
  5545.             if Debug
  5546.             then
  5547.                Debug_String(
  5548.                   " Server mode: file received successfully.");
  5549.             end if;
  5550.          else
  5551.             Handle_Error();
  5552.          end if;
  5553.       case Receive_Init_Code:
  5554.          variable Open_Success, Send_Success is Boolean;
  5555.          /* convert the received data */
  5556.          Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0),
  5557.             Length(Receive_Data));
  5558.          Out_Filename := Receive_Data;
  5559.          Open_Out_File(Open_Success);
  5560.          if Open_Success
  5561.          then
  5562.             Send_File(Send_Success);
  5563.             if Send_Success
  5564.             then
  5565.                if Debug
  5566.                then
  5567.                   Debug_String(
  5568.                      " Server mode: file sent successfully");
  5569.                end if;
  5570.             else
  5571.                Handle_Error();
  5572.             end if;
  5573.          else
  5574.             Handle_Error();
  5575.          end if;
  5576.       case Generic_Command_Code:
  5577.          variable Quit is Boolean,
  5578.             Generic_Success is Boolean;
  5579.          Do_Generic_Command(Receive_Data, Quit, Generic_Success);
  5580.          if Quit
  5581.          then
  5582.             exit;
  5583.          end if;
  5584.          if not Generic_Success
  5585.          then
  5586.             Handle_Error();
  5587.          end if;
  5588.       case Host_Command_Code:
  5589.          /* to be done sometime */
  5590.       case Bad_Code:
  5591.          /* packet garbled */
  5592.          Send_Packet(Negative_Acknowledge_Code,
  5593.             Current_Sequence_Number, "");
  5594.       case Error_Code:
  5595.          if Debug
  5596.          then
  5597.             Debug_String(" Error Received: " !! Receive_Data);
  5598.          end if;
  5599.       else
  5600.       end select;
  5601.    end cycle;
  5602.    Mode := User_Mode;
  5603.  
  5604. end Server_Node;
  5605.  
  5606. %Eject();
  5607.  
  5608. definition Server_Receive_File
  5609.  
  5610.    /* This procedure is called from the server node to receive a
  5611.       file */
  5612.    open Global_Area_Ptr@;
  5613.    Success := True;
  5614.    State := Receive_File_Header_State;
  5615.    cycle
  5616.       select State from
  5617.       case Receive_File_Header_State:
  5618.          State := Receive_File_Header_Action();
  5619.       case Receive_File_Attribute_State:
  5620.          State := Receive_File_Attribute_Action();
  5621.       case Receive_File_Data_State:
  5622.          State := Receive_File_Data_Action();
  5623.       case Complete_State:
  5624.          return;
  5625.       case Abort_State:
  5626.          /* error sensed at a lower level procedure */
  5627.          Success := False;
  5628.          return;
  5629.       else
  5630.          /* Something has gone wrong: Abort */
  5631.          Success := False;
  5632.          Error_Message := "Program error: Unexpected state in " !!
  5633.             "proc " !! %Current_Procedure !! ".";
  5634.          return;
  5635.       end select;
  5636.    end cycle;
  5637.  
  5638. end Server_Receive_File;
  5639.  
  5640. %Eject();
  5641.  
  5642. definition Do_Generic_Command
  5643.  
  5644.    /*box
  5645.       This procedure is called when a generic command is sent to
  5646.       the KERMIT server. If the generic commandis a request to
  5647.       terminate the server the boolean "quit" is set to true. The
  5648.       Boolean success is set if things abort.
  5649.    */
  5650.  
  5651.    variable Send_Data is Packet_Data_Type,
  5652.       Generic_Command is character(1);
  5653.    open Global_Area_Ptr@;
  5654.    Send_Data := "";
  5655.    Quit := False;
  5656.    Success := True;
  5657.    /* on entry the generic command packet is passed. We don't bother
  5658.       with the sequence number */
  5659.    Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  5660.       Send_Data);
  5661.    Ascii_To_Mts_Ebcdic(Substring(Receive_Data, 0),
  5662.       Length(Receive_Data));
  5663.    Generic_Command := Substring(Receive_Data, 0, 1);
  5664.    select Generic_Command from
  5665.    case "F":                           /* Finish command - terminate
  5666.                                           remote KERMIT */
  5667.       Quit := True;
  5668.       if Remote_Mts
  5669.       then
  5670.          /* Program was started by a remote Kermit. This remote
  5671.             Kermit expects an "Execution Terminated" or such
  5672.             message. It absorbs it so as not to confuse /Kermit
  5673.             users. Check to see whether a dummy must be supplied
  5674.             to users that have turned this feature off. */
  5675.          variable Etm_Result is character(8),
  5676.             Print_Message is Boolean,
  5677.             Next_Character is character(1),
  5678.             Chr_Pos is String_Length_Type;
  5679.          Guinfo("ETM     ", Etm_Result);
  5680.          Case_Conversion(Etm_Result, Byte_Size(Etm_Result));
  5681.          Print_Message := False;
  5682.          Chr_Pos := 0;
  5683.          cycle
  5684.             Next_Character := Substring(Etm_Result, Chr_Pos, 1);
  5685.             if Next_Character = "W" or Next_Character = "H" or
  5686.                Next_Character = "T" or Next_Character = "R" or
  5687.                Next_Character = "$"
  5688.             then
  5689.                Print_Message := True;
  5690.                exit;
  5691.             end if;
  5692.             exit when Chr_Pos >= 7;
  5693.             Chr_Pos +:= 1;
  5694.             exit when Substring(Etm_Result, Chr_Pos, 1) = "*";
  5695.          end cycle;
  5696.          if not Print_Message
  5697.          then
  5698.             /* Issue a Dummy Line */
  5699.             Write_To_User(" Execution terminated");
  5700.          end if;
  5701.       end if;
  5702.       return;
  5703.    case "L":
  5704.       /* Logoff generic command */
  5705.       variable Command_Text is Varying_String,
  5706.          Command_Length is Integer;
  5707.       Command_Text := "$SIG $";
  5708.       Command_Length := Length(Command_Text);
  5709.       Cmdnoe(Substring(Command_Text, 0, Length(Command_Text)),
  5710.          Command_Length);
  5711.       /* we actually never get here */
  5712.       Quit := True;
  5713.       return;
  5714.    case "T":
  5715.       /* Command to set the filetype specs */
  5716.       if Substring(Receive_Data, 1) = "TEXT"
  5717.       then
  5718.          Set_Filetype_Text();
  5719.       elseif Substring(Receive_Data, 1) = "BINARY"
  5720.       then
  5721.          Set_Filetype_Binary();
  5722.       elseif Substring(Receive_Data, 1) = "MTS-BINARY"
  5723.       then
  5724.          Set_Filetype_Mts_Binary();
  5725.       else                             /* bad filetype: ignore for
  5726.                                           now */
  5727.       end if;
  5728.    case "D":
  5729.       variable Debug_Open_Success is Boolean;
  5730.       Open_Debug_File(Debug_Open_Success);
  5731.       if Debug_Open_Success
  5732.       then
  5733.          Debug_String(":");
  5734.          Debug_String("1             Packet Trace and Debug Log");
  5735.          Debug_String(" ");
  5736.          Debug := True;
  5737.       end if;
  5738.    else
  5739.       /* insert code to send not implemented stuff */
  5740.    end select;
  5741.  
  5742. end Do_Generic_Command;
  5743.  
  5744. %Eject();
  5745.  
  5746. definition Get_Valid_Ascii_Control_Char
  5747.  
  5748.    variable Int_Code is Integer;
  5749.    open Global_Area_Ptr@;
  5750.    Success := True;
  5751.    Parse_Get(Pcb, Parsed_Integer, Int_Code, Byte_Size(Int_Code));
  5752.    if Int_Code < Ascii_Null or Int_Code > Ascii_Del
  5753.    then
  5754.       Ascii_Code := 0;
  5755.       Success := False;
  5756.    elseif Int_Code >= Ascii_Space and Int_Code < Ascii_Del
  5757.    then
  5758.       /* not a control code */
  5759.       Ascii_Code := 0;
  5760.       Success := False;
  5761.    else                                /* code is valid: return it
  5762.                                        */
  5763.       Ascii_Code := Int_Code;
  5764.       Success := True;
  5765.       return;
  5766.    end if;
  5767.    Write_To_User(
  5768.       " Expecting decimal representation for ASCII control " !!
  5769.       " code.");
  5770.    Write_To_User(" Number ignored.");
  5771.  
  5772. end Get_Valid_Ascii_Control_Char;
  5773.  
  5774. %Eject();
  5775.  
  5776. definition Get_Remote_Unit
  5777.  
  5778.    /*box
  5779.       This procedure is called when there the user wants to talk
  5780.       to another KERMIT over a mounted network connection. The
  5781.       procedure gets a valid FDUB and opens the unit.
  5782.    */
  5783.  
  5784.    variable Get_Fdub_Rc is Integer;
  5785.  
  5786.    open Global_Area_Ptr@;
  5787.  
  5788.    Initialize_File_With_Name(Remote_Unit, Remote_Unit_Name,
  5789.       Remote_Unit_Modifiers, Get_Fdub_Rc);
  5790.    if Get_Fdub_Rc > 0
  5791.    then                                /* can't even get fdub */
  5792.       return with False;
  5793.    end if;
  5794.    /* now do a gdinfo to check things */
  5795.    variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type,
  5796.       Gdinfo_Rc is Integer;
  5797.    Gdinfo_Result_Ptr := Gdinfo(Remote_Unit.File_Unit return code
  5798.       Gdinfo_Rc);
  5799.    if Gdinfo_Rc > 0
  5800.    then
  5801.       return with False;
  5802.    end if;
  5803.    /* check we have a mounted device */
  5804.    open Gdinfo_Result_Ptr@;
  5805.    if Gd_Use_Code ^= Gd_Mounted_Device
  5806.    then
  5807.       /* not mounted */
  5808.       return with False;
  5809.    end if;
  5810.    Freespac(0, Gdinfo_Result_Ptr);
  5811.    return with True;
  5812.  
  5813. end Get_Remote_Unit;
  5814.  
  5815. %Eject();
  5816.  
  5817. definition Get_Inout_Unit_Types
  5818.    variable Gdinfo_Result_Ptr is pointer to Gdinfo_Result_Type;
  5819.  
  5820.    /*box
  5821.       This procedure is called to establish the device types of
  5822.       the Input_Unit and the Output_Unit. This is needed because
  5823.       if this program tries to treat a 3270 device like a micro,
  5824.       the controller may hang the mainframe]
  5825.    */
  5826.  
  5827.    open Global_Area_Ptr@;
  5828.  
  5829.    /* now do a GDINFO to check Input_Unit */
  5830.    Gdinfo_Result_Ptr := Gdinfo(Input_Unit.File_Unit);
  5831.    Input_Unit_Device_Type := Gdinfo_Result_Ptr@.Gd_Type;
  5832.    Freespac(0, Gdinfo_Result_Ptr);
  5833.  
  5834.    /* now do a GDINFO to check Output_Unit */
  5835.    Gdinfo_Result_Ptr := Gdinfo(Output_Unit.File_Unit);
  5836.    Output_Unit_Device_Type := Gdinfo_Result_Ptr@.Gd_Type;
  5837.    Freespac(0, Gdinfo_Result_Ptr);
  5838.  
  5839. end Get_Inout_Unit_Types;
  5840.  
  5841. %Eject();
  5842.  
  5843. definition Open_Debug_File
  5844.  
  5845.    /*box
  5846.       This procedure opens the file used for logging debug
  5847.       information. If the permanent file #KERMIT.LOG can't be
  5848.       used then the scratch file -KER.LOG is used.
  5849.    */
  5850.  
  5851.    variable Rc is Integer,
  5852.       Temp_String is character(20),
  5853.       Access is bit(32);
  5854.  
  5855.    open Global_Area_Ptr@;
  5856.    /* see if file exists */
  5857.    Temp_String := Substring(Debug_Filename, 0) !! " ";
  5858.    Access := Chkfile(Temp_String return code Rc);
  5859.    if Rc = 0
  5860.    then                                /* file exists: now access */
  5861.       if (Access & Write_Access) = Write_Access
  5862.       then
  5863.          /* file exists: get fdub and all */
  5864.          Initialize_File_With_Name(Debug_File, Debug_Filename,
  5865.             Debug_File_Io_Modifiers, Rc);
  5866.          if Rc = 0
  5867.          then                          /* all okay: empty file */
  5868.             Empty(Debug_File.File_Unit.Fdub return code Rc);
  5869.             if Rc = 0
  5870.             then                       /* file is ready for log data
  5871.                                        */
  5872.                if Mode = User_Mode
  5873.                then
  5874.                   Write_To_User(" Logging debug info on " !!
  5875.                      Debug_Filename);
  5876.                end if;
  5877.                return;
  5878.             end if;
  5879.             /* drop through to alternate debug file */
  5880.          end if;
  5881.          /* drop through to alternate debug file */
  5882.       end if;
  5883.       /* drop through to alternate debug file */
  5884.    elseif Rc = Chkfile_File_Does_Not_Exist
  5885.    then                                /* create */
  5886.       variable Create_Size is Create_Size_Type,
  5887.          Volume is Integer;
  5888.       open Create_Size;
  5889.       Maximum_Size := 0;               /* default no limit */
  5890.       Initial_Size := 4;               /* default to one page */
  5891.       Volume := 0;
  5892.       Create(Temp_String, Create_Size, Volume, Line_File + 256
  5893.          return code Rc);
  5894.       if Rc = 0
  5895.       then                             /* have created file */
  5896.          Initialize_File_With_Name(Debug_File, Debug_Filename,
  5897.             Debug_File_Io_Modifiers, Rc);
  5898.          if Rc = 0
  5899.          then                          /* all okay lets return */
  5900.             if Mode = User_Mode
  5901.             then
  5902.                Write_To_User(" Logging debug info on " !!
  5903.                   Debug_Filename);
  5904.             end if;
  5905.             return;
  5906.          end if;
  5907.          /* drop through */
  5908.       else
  5909.          /* drop through */
  5910.       end if;
  5911.    end if;
  5912.    /* file couldn't be opened default to debug scratch */
  5913.    if Mode = User_Mode
  5914.    then
  5915.       Write_To_User(" Logging Debug info on " !!
  5916.          Backup_Debug_Filename);
  5917.    end if;
  5918.    Initialize_File_With_Name(Debug_File, Backup_Debug_Filename,
  5919.       Debug_File_Io_Modifiers, Rc);
  5920.    if Rc > 0
  5921.    then
  5922.       Success := False;
  5923.       return;
  5924.    end if;
  5925.  
  5926. end Open_Debug_File;
  5927.  
  5928. %Eject();
  5929.  
  5930. definition Send_Generic_Command
  5931.  
  5932.    /*box
  5933.       This procedure is called to send a generic command. It
  5934.       tries to send the command the number of retries times and
  5935.       returns true if it succeeds or false otherwise.
  5936.    */
  5937.  
  5938.    variable Receive_Packet_Type is Packet_Type_Type,
  5939.       Receive_Sequence_Number is Sequence_Number_Type,
  5940.       Receive_Data is Packet_Data_Type;
  5941.    open Global_Area_Ptr@;
  5942.    Initialize_Sequence_Numbers();
  5943.    Times_This_Packet_Retried := 0;
  5944.    Side := Sending_Side;
  5945.    Mts_Ebcdic_To_Ascii(Substring(Generic_Command, 0),
  5946.       Length(Generic_Command));
  5947.    Set_Echo_Off();
  5948.    cycle
  5949.       Send_Packet(Generic_Command_Code, Current_Sequence_Number,
  5950.          Generic_Command);
  5951.       Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  5952.          Receive_Data);
  5953.       select Receive_Packet_Type from
  5954.       case Acknowledge_Code:
  5955.          Can_Talk_To_Remote_Kermit := True;
  5956.          Success := True;
  5957.          exit;
  5958.       case Error_Code:
  5959.          Handle_Received_Error(Receive_Data);
  5960.          Success := False;
  5961.          exit;
  5962.       else                             /* anything else is bad */
  5963.          Check_For_Retries(Times_This_Packet_Retried);
  5964.          if Times_This_Packet_Retried >= Max_Retries
  5965.          then
  5966.             /* give up and return failure */
  5967.             Success := False;
  5968.             exit;
  5969.          else
  5970.             Times_This_Packet_Retried +:= 1;
  5971.          end if;
  5972.       end select;
  5973.    end cycle;
  5974.    Set_Echo_On();
  5975.  
  5976. end Send_Generic_Command;
  5977.  
  5978. %Eject();
  5979.  
  5980. definition Receive_File_From_Server
  5981.  
  5982.    /*box
  5983.       This procedure is called when a file is to be received from
  5984.       a server KERMIT. If the receive-init is acknowleged with a
  5985.       send-init we go into normal receive file mode.
  5986.    */
  5987.  
  5988.    variable Receive_Packet_Type is Packet_Type_Type,
  5989.       Receive_Sequence_Number is Sequence_Number_Type,
  5990.       Receive_Data is Packet_Data_Type,
  5991.       Receive_Success is Boolean,
  5992.       Init_Data is Packet_Data_Type;
  5993.    open Global_Area_Ptr@;
  5994.    Setup_Return_From(Rcb, Success);
  5995.    Success := True;
  5996.    Initialize_Sequence_Numbers();
  5997.    Times_This_Packet_Retried := 0;
  5998.    Side := Receiving_Side;
  5999.    Mts_Ebcdic_To_Ascii(Substring(Receive_Filename, 0),
  6000.       Length(Receive_Filename));
  6001.    cycle
  6002.       Send_Packet(Receive_Init_Code, Current_Sequence_Number,
  6003.          Receive_Filename);
  6004.       Receive_Packet(Receive_Packet_Type, Receive_Sequence_Number,
  6005.          Receive_Data);
  6006.       select Receive_Packet_Type from
  6007.       case Send_Init_Code:
  6008.          Get_Your_Packet_Parameters(Receive_Data);
  6009.          Get_My_Packet_Parameters(Init_Data);
  6010.          Send_Packet(Acknowledge_Code, Current_Sequence_Number,
  6011.             Init_Data);
  6012.          Times_Last_Packet_Retried := Times_This_Packet_Retried;
  6013.          Times_This_Packet_Retried := 0;
  6014.          Increment_Sequence_Numbers();
  6015.          Server_Receive_File(Receive_Success);
  6016.          if Receive_Success
  6017.          then
  6018.             Success := True;
  6019.             return;
  6020.          else
  6021.             Success := False;
  6022.             return;
  6023.          end if;
  6024.       case Error_Code:
  6025.          Handle_Received_Error(Receive_Data);
  6026.          Success := False;
  6027.          return;
  6028.       else                             /* anything else try again */
  6029.          Check_For_Retries(Times_This_Packet_Retried);
  6030.          if Times_This_Packet_Retried >= Max_Retries
  6031.          then
  6032.             Error_Message := " Unable to ACK for receive init";
  6033.             Success := False;
  6034.             return;
  6035.          else
  6036.             Times_This_Packet_Retried +:= 1;
  6037.          end if;
  6038.       end select;
  6039.    end cycle;
  6040.  
  6041. end Receive_File_From_Server;
  6042.  
  6043. %Eject();
  6044.  
  6045. definition Handle_Received_Error
  6046.  
  6047.    /*box
  6048.       This procedure is called when Receive_Packet gets an error
  6049.       message. If KERMIT is being run a remote KERMIT the message
  6050.       is displayed on the terminal. If it is in debug mode the
  6051.       message is logged. In any other case the error message is
  6052.       thrown away.
  6053.    */
  6054.  
  6055.    open Global_Area_Ptr@;
  6056.    Ascii_To_Mts_Ebcdic(Substring(Error_Packet_Data, 0),
  6057.       Length(Error_Packet_Data));
  6058.    if Mode = User_Mode
  6059.    then
  6060.       Write_To_User(" Remote Error:" !! Error_Packet_Data);
  6061.    end if;
  6062.    if Debug
  6063.    then
  6064.       Debug_String(" Error Packet Received: " !! Error_Packet_Data);
  6065.    end if;
  6066.  
  6067. end Handle_Received_Error;
  6068.  
  6069. %Eject();
  6070.  
  6071. definition Display_Packet_Action
  6072.  
  6073.    /*box
  6074.       This procedure is called during file transfer to see if an
  6075.       indication that something is going on should be displayed
  6076.       for a remote kermit.
  6077.    */
  6078.  
  6079.    open Global_Area_Ptr@;
  6080.    if Remote_Kermit or not Display_Packet_Count
  6081.    then
  6082.       /* Nothing is displayed by a remote kermit */
  6083.       return;
  6084.    end if;
  6085.    begin
  6086.       /* okay: local kermit. See if time to display */
  6087.       variable Expected_String is Varying_String,
  6088.          Decimal_Percent is Integer,
  6089.          Whole_Percent is Integer;
  6090.       open Packet_Count;
  6091.       if For_File < Next_Packet_Count_Threshold
  6092.       then
  6093.          return;
  6094.       end if;
  6095.       if Expected_Packets > 0
  6096.       then
  6097.          Expected_String := "  (est. ";
  6098.          Whole_Percent := (For_File * 100) / Expected_Packets;
  6099.          Decimal_Percent := ((For_File * 1000) / Expected_Packets)
  6100.             mod 10;
  6101.          Expected_String !!:= Integer_To_Varying(Whole_Percent, 5)
  6102.             !! ".";
  6103.          if (Whole_Percent = 0) and (Decimal_Percent = 0)
  6104.          then
  6105.             /* Show a minimum of 0.1% */
  6106.             Expected_String !!:= "1%)";
  6107.          else
  6108.             Expected_String !!:= Integer_To_Varying(Decimal_Percent,
  6109.                1) !! "%)";
  6110.          end if;
  6111.       else
  6112.          Expected_String := "";
  6113.       end if;
  6114.       if Side = Sending_Side
  6115.       then
  6116.          Write_To_User(" Packets sent: " !!
  6117.             Integer_To_Varying(For_File, 6) !! Expected_String);
  6118.       else
  6119.          Write_To_User(" Packets received: " !!
  6120.             Integer_To_Varying(For_File, 6) !! Expected_String);
  6121.       end if;
  6122.       Next_Packet_Count_Threshold +:= Packet_Count_Interval;
  6123.    end;
  6124.  
  6125. end Display_Packet_Action;
  6126.  
  6127. %Eject();
  6128.  
  6129. definition Write_To_User
  6130.  
  6131.    /*box
  6132.       This procedure is called when a message is written to the
  6133.       user. The procedure does a sercom to the user and checks to
  6134.       see if the same message should also be logged on the debug
  6135.       file.
  6136.    */
  6137.  
  6138.    open Global_Area_Ptr@;
  6139.    Sercom_String(Message);
  6140.    if Debug
  6141.    then
  6142.       Debug_String(Message);
  6143.    end if;
  6144.  
  6145. end Write_To_User;
  6146.  
  6147. %Eject();
  6148.  
  6149. definition Put_Mts_Binary_Data
  6150.  
  6151.    /*box
  6152.       This procedure is called when the file being received is an
  6153.       MTS binary file. These files are binary files which include
  6154.       a length for each line. Each binary line is preceded by
  6155.       halfword length in binary.
  6156.    */
  6157.  
  6158.    open Global_Area_Ptr@;
  6159.    Put_Success := True;
  6160.    equate Byte_Lengths to Mts_Binary_Length as array (1 to 2) of
  6161.          bit(8);
  6162.    select Mts_Binary_State from
  6163.    case Start_Mts_Binary_Linenumber_State:
  6164.       variable Length_Char is character(0 to 1),
  6165.          Error_Msg is Varying_String,
  6166.          Error_Ptr is pointer to Varying_String;
  6167.       Error_Ptr := Address(Error_Msg);
  6168.       Length_Char := Next_Character;
  6169.       Is_Line_Number_Fraction := False;
  6170.       Ascii_To_Mts_Ebcdic(Substring(Length_Char, 0, 0), 1);
  6171.       Line_Number_String := "";
  6172.       Line_Number_String_Length := Hex_String_To_Bits(Length_Char,
  6173.          Error_Ptr);
  6174.       if Error_Msg ^= ""
  6175.       then                             /* missing line number
  6176.                                           length: error action */
  6177.          /* for now revert to binary file kind */
  6178.          Line_Number_String_Length := 0;
  6179.          if Debug
  6180.          then
  6181.             Debug_String(
  6182.                " Expecting line number length found instead '" !!
  6183.                Length_Char !! "'");
  6184.          end if;
  6185.       end if;
  6186.       if Line_Number_String_Length = 0
  6187.       then
  6188.          Mts_Binary_State := First_Mts_Binary_Byte_Length_State;
  6189.          Current_Line_Number +:= 1000;
  6190.       elseif Line_Number_String_Length < 'D'
  6191.       then
  6192.          Mts_Binary_State := Build_Mts_Binary_Linenumber_State;
  6193.       else                             /* must be in range D..F */
  6194.          Is_Line_Number_Fraction := True;
  6195.          Line_Number_String_Length := Line_Number_String_Length -
  6196.             'C';
  6197.          Mts_Binary_State := Build_Mts_Binary_Linenumber_State;
  6198.       end if;
  6199.    case Build_Mts_Binary_Linenumber_State:
  6200.       variable Success is Boolean,
  6201.          Line_Number_Difference is Integer;
  6202.       Line_Number_String !!:= Next_Character;
  6203.       Line_Number_String_Length -:= 1;
  6204.       if Line_Number_String_Length <= 0
  6205.       then
  6206.          Decode_Mts_Linenumber(Line_Number_String,
  6207.             Line_Number_Difference, Success);
  6208.          if not Success
  6209.          then
  6210.             /* some remedial action */
  6211.             if Debug
  6212.             then
  6213.                Debug_String(" Unable decode the mts line number");
  6214.             end if;
  6215.          end if;
  6216.          Current_Line_Number +:= Line_Number_Difference;
  6217.          Mts_Binary_State := First_Mts_Binary_Byte_Length_State;
  6218.       end if;
  6219.    case First_Mts_Binary_Byte_Length_State:
  6220.       Byte_Lengths(1) := Next_Character;
  6221.       Mts_Binary_State := Second_Mts_Binary_Byte_Length_State;
  6222.    case Second_Mts_Binary_Byte_Length_State:
  6223.       Byte_Lengths(2) := Next_Character;
  6224.       Mts_Binary_State := Mts_Binary_Bytes_State;
  6225.    case Mts_Binary_Bytes_State:
  6226.       File_Buffer_Ptr@ !!:= Next_Character;
  6227.       if Length(File_Buffer_Ptr@) >= Mts_Binary_Length
  6228.       then
  6229.          variable Write_Success is Boolean;
  6230.          open In_File;
  6231.          File_Line_Number := Current_Line_Number;
  6232.          Write_In_File_Buffer(Write_Success);
  6233.          File_Buffer_Ptr@ := "";
  6234.          if not Write_Success
  6235.          then
  6236.             Put_Success := False;
  6237.             if Debug
  6238.             then
  6239.                Debug_String(" In " !! %Current_Procedure !!
  6240.                   " unable " !! "to write binary data");
  6241.             end if;
  6242.             return;
  6243.          end if;
  6244.          Mts_Binary_State := Start_Mts_Binary_Linenumber_State;
  6245.       end if;
  6246.    end select;
  6247.  
  6248. end Put_Mts_Binary_Data;
  6249.  
  6250. %Eject();
  6251.  
  6252. definition Get_Mts_Binary_Data
  6253.  
  6254.    /*box
  6255.       This procedure is called when mts binary files are to be
  6256.       sent to another mts kermit that is expecting mts binary
  6257.       files. At the moment both kermits must be set to
  6258.       filetype=mts-binary.
  6259.    */
  6260.  
  6261.    open Global_Area_Ptr@;
  6262.    Success := True;
  6263.    equate Byte_Lengths to Mts_Binary_Length as array (1 to 2) of
  6264.          bit(8);
  6265.    select Mts_Binary_State from
  6266.    case Start_Mts_Binary_Linenumber_State:
  6267.       variable Line_Number_Difference is Integer;
  6268.       Last_Line_Number := Current_Line_Number;
  6269.       if Out_File_End_Of_File
  6270.       then
  6271.          Success := False;
  6272.          return;
  6273.       end if;
  6274.       Read_Long_Varying(Out_File, File_Buffer_Ptr@);
  6275.       open Out_File;
  6276.       if Last_Return_Code > 0
  6277.       then
  6278.          /* all done - no more characters */
  6279.          Out_File_End_Of_File := True;
  6280.          /* clean up */
  6281.          Freefd(Out_File.File_Unit.Fdub);
  6282.          Success := False;
  6283.          return;
  6284.       end if;
  6285.       if Is_First_Out_File_Record
  6286.       then
  6287.          Set_Next_Line(Out_File);
  6288.          Is_First_Out_File_Record := False;
  6289.       end if;
  6290.       Next_Out_File_Character_Position := 0;
  6291.       Mts_Binary_Length := Length(File_Buffer_Ptr@);
  6292.       Current_Line_Number := File_Line_Number;
  6293.       Line_Number_Difference := Current_Line_Number -
  6294.          Last_Line_Number;
  6295.       Encode_Mts_Linenumber(Line_Number_Difference,
  6296.          Line_Number_String);
  6297.       Next_Character := Substring(Line_Number_String, 0, 1);
  6298.       Line_Number_String_Pos := 1;
  6299.       Line_Number_String_Length := Length(Line_Number_String);
  6300.       if Line_Number_String_Pos >= Line_Number_String_Length
  6301.       then
  6302.          Mts_Binary_State := First_Mts_Binary_Byte_Length_State;
  6303.       else
  6304.          Mts_Binary_State := Build_Mts_Binary_Linenumber_State;
  6305.       end if;
  6306.    case Build_Mts_Binary_Linenumber_State:
  6307.       Next_Character := Substring(Line_Number_String,
  6308.          Line_Number_String_Pos, 1);
  6309.       Line_Number_String_Pos +:= 1;
  6310.       if Line_Number_String_Pos >= Line_Number_String_Length
  6311.       then
  6312.          Mts_Binary_State := First_Mts_Binary_Byte_Length_State;
  6313.       end if;
  6314.    case First_Mts_Binary_Byte_Length_State:
  6315.       Next_Character := Byte_Lengths(1);
  6316.       Mts_Binary_State := Second_Mts_Binary_Byte_Length_State;
  6317.    case Second_Mts_Binary_Byte_Length_State:
  6318.       Next_Character := Byte_Lengths(2);
  6319.       Mts_Binary_State := Mts_Binary_Bytes_State;
  6320.    case Mts_Binary_Bytes_State:
  6321.       Next_Character := Substring(File_Buffer_Ptr@,
  6322.          Next_Out_File_Character_Position, 1);
  6323.       Next_Out_File_Character_Position +:= 1;
  6324.       if Next_Out_File_Character_Position >=
  6325.          Length(File_Buffer_Ptr@)
  6326.       then
  6327.          Mts_Binary_State := Start_Mts_Binary_Linenumber_State;
  6328.       end if;
  6329.    end select;
  6330.  
  6331. end Get_Mts_Binary_Data;
  6332.  
  6333. %Eject();
  6334.  
  6335. definition Encode_Mts_Linenumber
  6336.  
  6337.    /*box
  6338.       This procedure is used to encode an mts line number. These
  6339.       line numbers are sent along with the data in the file when
  6340.       this KERMIT is talking to another MTS KERMIT and a true
  6341.       file image is wanted. The encoding takes advantage of the
  6342.       fact that MTS line numbers are not random integers but are
  6343.       usually sequentially ordered. Rather than sending the
  6344.       absolute line numbers the program sends the relative line
  6345.       number difference. It assumes at the start that the last
  6346.       line sent was numbered zero. Thus if the first line sent is
  6347.       numbered 1 the first relative value sent is 1.
  6348.    *//*
  6349.  
  6350.    *//*
  6351.       The numbers are encoded using an ascii byte to represent
  6352.       the length followed by the number of bytes needed to
  6353.       represent the difference of this line from the last. If the
  6354.       difference is 1 the length byte is given as an ascii zero
  6355.       and no line number data bytes are given. For differences in
  6356.       the 0.001 to 0.999 range the difference is given as an
  6357.       ascii "D", "E", "F", followed by one, two , or three ascii
  6358.       digits representing a fraction with the decimal on the
  6359.       left. Some examples would be "D2", "E56", and "F787". They
  6360.       represent differences of .2, .56, and .787 respectively.
  6361.       Any other difference is given by a byte length from the
  6362.       range 1..C followed by the difference. If the difference
  6363.       contains a fractional part the decimal is included. All
  6364.       differences except possibly the first one will be positive.
  6365.       For the first case the leading character could be a minus
  6366.       sign. Some examples are: "13", "423.5", "534346", and
  6367.       "52.234". These represent differences of 3, 23.5, 34346,
  6368.       and 2.234.
  6369.    *//*
  6370.  
  6371.    *//*
  6372.       All line numbers are stored as integers with an implicit
  6373.       decimal point.
  6374.    */
  6375.  
  6376.    variable Fraction_String is Varying_String,
  6377.       Integer_String is Varying_String,
  6378.       Total_String is Varying_String,
  6379.       Length_String_Char is character(0 to 1),
  6380.       Integer_Part is Integer,
  6381.       Fraction_Part is Integer,
  6382.       Is_Positive_Difference is Boolean,
  6383.       String_Length_Char is character(1);
  6384.  
  6385.    open Global_Area_Ptr@;
  6386.    Encoded_Line_Number := "";
  6387.    if Line_Number_Difference = 1000
  6388.    then                                /* have a difference of 1;
  6389.                                           represent as length 0 */
  6390.       Encoded_Line_Number := Ascii_0;
  6391.       return;
  6392.    elseif Line_Number_Difference < 1000 and Line_Number_Difference >
  6393.       0
  6394.    then
  6395.       /* have a fraction: choose one of three possible versions */
  6396.       /* add 1000 to ensure leading zeros */
  6397.       Fraction_String := Integer_To_Varying(1000 +
  6398.          Line_Number_Difference, 0);
  6399.       Mts_Ebcdic_To_Ascii(Substring(Fraction_String, 0, 0),
  6400.          Length(Fraction_String));
  6401.       if Line_Number_Difference mod 10 = 0
  6402.       then                             /* have at most two places of
  6403.                                           decimal */
  6404.          if Line_Number_Difference mod 100 = 0
  6405.          then                          /* have a single place of
  6406.                                           decimal */
  6407.             Encoded_Line_Number := Ascii_D !!
  6408.                Substring(Fraction_String, 1, 1);
  6409.             return;
  6410.          else                          /* have two decimal places */
  6411.             Encoded_Line_Number := Ascii_E !!
  6412.                Substring(Fraction_String, 1, 2);
  6413.             return;
  6414.          end if;
  6415.       else                             /* have a full three places
  6416.                                           of decimal */
  6417.          Encoded_Line_Number := Ascii_F !!
  6418.             Substring(Fraction_String, 1, 3);
  6419.       end if;
  6420.    else                                /* have a value in the range
  6421.                                           <= 0 or > 1 */
  6422.       /* integer part */
  6423.       if Line_Number_Difference < 0
  6424.       then
  6425.          Is_Positive_Difference := False;
  6426.          Line_Number_Difference := -Line_Number_Difference;
  6427.       else
  6428.          Is_Positive_Difference := True;
  6429.       end if;
  6430.       Integer_Part := Line_Number_Difference / 1000;
  6431.       if Integer_Part > 0
  6432.       then
  6433.          Integer_String := Integer_To_Varying(Integer_Part, 0);
  6434.          Mts_Ebcdic_To_Ascii(Substring(Integer_String, 0, 0),
  6435.             Length(Integer_String));
  6436.       else
  6437.          Integer_String := "";
  6438.       end if;
  6439.       Fraction_Part := Line_Number_Difference mod 1000;
  6440.       if Fraction_Part > 0
  6441.       then
  6442.          /* add 1000 to force leading zeros */
  6443.          Fraction_String := Integer_To_Varying(1000 + Fraction_Part,
  6444.             0);
  6445.          Mts_Ebcdic_To_Ascii(Substring(Fraction_String, 0, 0),
  6446.             Length(Fraction_String));
  6447.          Fraction_String := Substring(Fraction_String, 1);
  6448.       else
  6449.          Fraction_String := "";
  6450.       end if;
  6451.       /* now build number */
  6452.       if Is_Positive_Difference
  6453.       then
  6454.          Total_String := "";
  6455.       else
  6456.          Total_String := Ascii_Minus;
  6457.       end if;
  6458.       Total_String !!:= Integer_String;
  6459.       if Fraction_String ^= ""
  6460.       then
  6461.          Total_String !!:= Ascii_Period !! Fraction_String;
  6462.       end if;
  6463.       String_Length_Char :=
  6464.          Bits_To_Hex_Varying(Length(Total_String), 1);
  6465.       Mts_Ebcdic_To_Ascii(Substring(String_Length_Char, 0, 0), 1);
  6466.       Encoded_Line_Number := String_Length_Char !! Total_String;
  6467.       return;
  6468.    end if;
  6469.  
  6470. end Encode_Mts_Linenumber;
  6471.  
  6472. %Eject();
  6473.  
  6474. definition Decode_Mts_Linenumber
  6475.  
  6476.    /*box
  6477.       This procedure is used to decode the line number encoded by
  6478.       the encode_mts_linenumber procedure. See that procedure for
  6479.       the algorithm. Input to this procedure is the line number
  6480.       string. The length has already been extracted. The
  6481.       procedure set success to false if it is unable to decode
  6482.       the line number. Also it increments the line number.
  6483.    */
  6484.  
  6485.    variable Error_Msg is Varying_String,
  6486.       Error_Ptr is pointer to Varying_String;
  6487.  
  6488.    open Global_Area_Ptr@;
  6489.    Success := True;
  6490.    Error_Msg := "";
  6491.    Error_Ptr := Address(Error_Msg);
  6492.    if Line_Number_String = ""
  6493.    then
  6494.       Line_Number_Difference := 1000;
  6495.       return;
  6496.    end if;
  6497.    Ascii_To_Mts_Ebcdic(Substring(Line_Number_String, 0, 0),
  6498.       Length(Line_Number_String));
  6499.    if Is_Line_Number_Fraction
  6500.    then
  6501.       Line_Number_String !!:= Substring("000", 0, Length("000") -
  6502.          Length(Line_Number_String));
  6503.       Line_Number_Difference :=
  6504.          String_To_Integer(Line_Number_String, Error_Ptr);
  6505.       if Error_Msg ^= ""
  6506.       then
  6507.          Line_Number_Difference := 1000;
  6508.          Success := False;
  6509.          return;
  6510.       else
  6511.          return;
  6512.       end if;
  6513.    end if;
  6514.    /* have digits with possible imbedded decimal point */
  6515.    variable Integer_String is Varying_String,
  6516.       Fraction_String is Varying_String,
  6517.       String_Len is String_Length_Type,
  6518.       String_Pos is String_Length_Type;
  6519.  
  6520.    String_Len := Length(Line_Number_String);
  6521.    String_Pos := 0;
  6522.    Integer_String := "";
  6523.    Fraction_String := "";
  6524.    /* find integer part */
  6525.    cycle
  6526.       exit when String_Pos >= String_Len;
  6527.       exit when Substring(Line_Number_String, String_Pos, 1) = ".";
  6528.       Integer_String !!:= Substring(Line_Number_String, String_Pos,
  6529.          1);
  6530.       String_Pos +:= 1;
  6531.    end cycle;
  6532.    if String_Pos < String_Len - 1
  6533.    then                                /* have decimal point */
  6534.       String_Pos +:= 1;                /* skip decimal point */
  6535.       cycle
  6536.          exit when String_Pos >= String_Len;
  6537.          Fraction_String !!:= Substring(Line_Number_String,
  6538.             String_Pos, 1);
  6539.          String_Pos +:= 1;
  6540.       end cycle;
  6541.    end if;
  6542.    /* check fraction part is right length */
  6543.    if Length(Fraction_String) > 3
  6544.    then
  6545.       Line_Number_Difference := 1000;
  6546.       Success := False;
  6547.       return;
  6548.    end if;
  6549.    Fraction_String := Fraction_String !! Substring("000", 0,
  6550.       Length("000") - Length(Fraction_String));
  6551.    Integer_String !!:= Fraction_String;
  6552.    Line_Number_Difference := String_To_Integer(Integer_String,
  6553.       Error_Ptr);
  6554.    if Error_Msg ^= ""
  6555.    then
  6556.       Line_Number_Difference := 1000;
  6557.       Success := False;
  6558.       return;
  6559.    end if;
  6560.    /* okay alls good */
  6561.  
  6562. end Decode_Mts_Linenumber;
  6563.  
  6564. %Eject();
  6565.  
  6566. definition Save_And_Set_Prefix_String
  6567.  
  6568.    /*box
  6569.       This procedure saves the old prefix string and sets a new
  6570.       string. CNFGINFO is used imbed the mts installation within
  6571.       the prefix string.
  6572.    */
  6573.  
  6574.    variable Prefix_String is Varying_String,
  6575.       New_Prefix is Guinfo_Pfxstr_Type,
  6576.       Command_Length is Integer;
  6577.  
  6578.    open Global_Area_Ptr@;
  6579.    Old_Prefix.Gp_Region_Length := Byte_Size(Old_Prefix);
  6580.    Guinfo("PFXSTR  ", Old_Prefix);
  6581.    /* now build a new prefix */
  6582.    Prefix_String := "KERMIT-";
  6583.    open Cnfginfo;
  6584.    select Ci_Installation_Code from
  6585.    case Ci_Um:
  6586.       Site := "UM";
  6587.    case Ci_Ubc:
  6588.       Site := "UBC-" !! Substring(Ci_Host_Name, 0, 1);
  6589.    case Ci_Une:
  6590.       Site := "NCL";
  6591.    case Ci_Uqv:
  6592.       Site := "UQV";
  6593.    case Ci_Wsu:
  6594.       Site := "WSU";
  6595.    case Ci_Rpi:
  6596.       Site := "RPI";
  6597.    case Ci_Sfu:
  6598.       Site := "SFU";
  6599.    else
  6600.       Site := "MTS";
  6601.    end select;
  6602.    Prefix_String !!:= Site !! ">";
  6603.    open New_Prefix;
  6604.    Gp_Region_Length := Byte_Size(New_Prefix);
  6605.    Gp_Actual_Length := Length(Prefix_String);
  6606.    Gp_Prefix := Substring(Prefix_String, 0, Gp_Actual_Length);
  6607.    Cuinfo("PFXSTR  ", New_Prefix);
  6608.    /* set prefix on */
  6609.    variable Set_Prefix_On_Command is Varying_String,
  6610.       Command_Len is Integer;
  6611.    Set_Prefix_On_Command := "set prefix=on";
  6612.    Command_Length := Length(Set_Prefix_On_Command);
  6613.    Cmdnoe(Substring(Set_Prefix_On_Command, 0), Command_Length);
  6614.  
  6615. end Save_And_Set_Prefix_String;
  6616.  
  6617. %Eject();
  6618.  
  6619. definition Setup_Kermit_Environment
  6620.  
  6621.    /*box
  6622.       This procedure is called when entering Kermit to get the
  6623.       space Kermit needs and to save attributes of the calling
  6624.       environment */
  6625.  
  6626.    variable Getspace_Rc is Integer;
  6627.  
  6628.    Success := True;
  6629.    Storage_Allocated_Info := Initial_Storage_Allocated_Info;
  6630.    open Storage_Allocated_Info;
  6631.    /* Note we have a window while space is for the attn area stacks
  6632.       where space could be left unfreed. So be it */
  6633.    /* save old attntrp */
  6634.    Guinfo("ATTNTRP ", Old_Attntrp);
  6635.    Sa_Old_Attn_Saved := True;
  6636.    Mask_Attn_Stack_Ptr := Getspace(Current_Link_Level,
  6637.       Attn_Stack_Length return code Getspace_Rc);
  6638.    if Getspace_Rc > 0
  6639.    then
  6640.       Success := False;
  6641.       return;
  6642.    end if;
  6643.    Sa_Mask_Attn_Stack := True;
  6644.    /* Close attn window */
  6645.    Mask_Attn();
  6646.    Normal_Attn_Stack_Ptr := Getspace(Current_Link_Level,
  6647.       Attn_Stack_Length return code Getspace_Rc);
  6648.    if Getspace_Rc > 0
  6649.    then
  6650.       Cleanup();
  6651.       Success := False;
  6652.       return;
  6653.    end if;
  6654.    Sa_Normal_Attn_Stack := True;
  6655.    Global_Area_Ptr := Getspace(Current_Link_Level,
  6656.       Byte_Size(Global_Area_Type) return code Getspace_Rc);
  6657.    if Getspace_Rc > 0
  6658.    then
  6659.       Cleanup();
  6660.       Success := False;
  6661.       return;
  6662.    end if;
  6663.    Sa_Global_Area := True;
  6664.    /* get buffer area stuff */
  6665.    File_Buffer_Ptr := Getspace(Current_Link_Level,
  6666.       Byte_Size(Long_Varying_String) return code Getspace_Rc);
  6667.    if Getspace_Rc > 0
  6668.    then
  6669.       Cleanup();
  6670.       Success := False;
  6671.       return;
  6672.    end if;
  6673.    Sa_File_Buffer := True;
  6674.    open Global_Area_Ptr@;
  6675.    Pcb := Parse_Initialize(Null);
  6676.    if Pcb = Null
  6677.    then
  6678.       /* failed to get storage */
  6679.       Cleanup();
  6680.       Success := False;
  6681.    end if;
  6682.    Sa_Pcb := True;
  6683.    File_Transfer_Attn_Stack_Ptr := Getspace(Current_Link_Level,
  6684.       Attn_Stack_Length return code Getspace_Rc);
  6685.    if Getspace_Rc > 0
  6686.    then
  6687.       Cleanup();
  6688.       Success := False;
  6689.       return;
  6690.    end if;
  6691.    Sa_File_Transfer_Attn := True;
  6692.    Save_And_Set_Prefix_String();
  6693.    Sa_Old_Prefix_Saved := True;
  6694.  
  6695.    Initialize();
  6696.    /* allow attns: set default as Normal */
  6697.    Kill_Remote_Kermit := False;
  6698.    Current_Attn_Kind := Normal_Attn_Kind;
  6699.    Reenable_Attn();
  6700.  
  6701. end Setup_Kermit_Environment;
  6702.  
  6703. %Eject();
  6704.  
  6705. definition Cleanup
  6706.  
  6707.    /*box
  6708.       This procedure is called to free any storage that has been
  6709.       aquired by the Kermit program. It may be called by either a
  6710.       graceful or bad exit. The procedure also resets attntrps
  6711.       etc.
  6712.    */
  6713.  
  6714.    open Global_Area_Ptr@;
  6715.    open Storage_Allocated_Info;
  6716.    Mask_Attn();
  6717.    if Sa_File_Transfer_Attn
  6718.    then
  6719.       Freespac(0, File_Transfer_Attn_Stack_Ptr);
  6720.    end if;
  6721.    if Sa_Pcb
  6722.    then
  6723.       Parse_Terminate(Pcb);
  6724.    end if;
  6725.    if Sa_File_Buffer
  6726.    then
  6727.       Freespac(0, File_Buffer_Ptr);
  6728.    end if;
  6729.    if Sa_Global_Area
  6730.    then
  6731.       Freespac(0, Global_Area_Ptr);
  6732.    end if;
  6733.    if Sa_Normal_Attn_Stack
  6734.    then
  6735.       Freespac(0, Normal_Attn_Stack_Ptr);
  6736.    end if;
  6737.    if Sa_Old_Prefix_Saved
  6738.    then
  6739.       Cuinfo("PFXSTR  ", Old_Prefix);
  6740.    end if;
  6741.    /* restore callers attn environment */
  6742.    if Sa_Old_Attn_Saved
  6743.    then
  6744.       Cuinfo("ATTNTRP ", Old_Attntrp);
  6745.    end if;
  6746.    if Sa_Mask_Attn_Stack
  6747.    then
  6748.       Freespac(0, Mask_Attn_Stack_Ptr);
  6749.    end if;
  6750.  
  6751. end Cleanup;
  6752.  
  6753. %Eject();
  6754.  
  6755. definition Configure_Remote_Unit
  6756.  
  6757.    /*box
  6758.       This procedure sets the remote unit x25_timer if possible.
  6759.       Also it sets it so that resets on the network are
  6760.       processed.
  6761.    */
  6762.  
  6763.    constant Remote_Timeout is "30 seconds";
  6764.  
  6765.    /* set x25_timer on for remote unit where possible */
  6766.    variable Control_Command is Varying_String,
  6767.       Control_Command_Length is Short_Integer,
  6768.       Control_Rc is Integer,
  6769.       Control_Return_Info is Control_Return_Info_Type;
  6770.  
  6771.    open Global_Area_Ptr@;
  6772.    Mask_Attn();
  6773.    Control_Command := "x25_timer=" !! Remote_Timeout;
  6774.    Control_Command_Length := Length(Control_Command);
  6775.    Control(Substring(Control_Command, 0, 0), Control_Command_Length,
  6776.       Remote_Unit.File_Unit, Control_Return_Info return code
  6777.       Control_Rc);
  6778.    if Control_Rc > 0
  6779.    then
  6780.       /* can't set x25_timer */
  6781.       X25_Timer_Set := False;
  6782.       Reenable_Attn();
  6783.       if Debug
  6784.       then
  6785.          open Control_Return_Info;
  6786.          Debug_String(" Unable to set x25_timer: ");
  6787.          Debug_String(" Control rc " !!
  6788.             Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  6789.             Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  6790.             Substring(Dsr_Message, 0, Dsr_Message_Length));
  6791.       end if;
  6792.    else
  6793.       X25_Timer_Set := True;
  6794.       Reenable_Attn();
  6795.    end if;
  6796.    /* set process_resets on */
  6797.    Control_Command := "process_resets=on";
  6798.    Control_Command_Length := Length(Control_Command);
  6799.    Control(Substring(Control_Command, 0, 0), Control_Command_Length,
  6800.       Remote_Unit.File_Unit, Control_Return_Info return code
  6801.       Control_Rc);
  6802.    if Control_Rc > 0
  6803.    then
  6804.       /* can't set process resets=on */
  6805.       if Debug
  6806.       then
  6807.          open Control_Return_Info;
  6808.          Debug_String(" Unable to set process_resets=on");
  6809.          Debug_String(" Control rc " !!
  6810.             Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  6811.             Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  6812.             Substring(Dsr_Message, 0, Dsr_Message_Length));
  6813.       end if;
  6814.    end if;
  6815.  
  6816. end Configure_Remote_Unit;
  6817.  
  6818. %Eject();
  6819.  
  6820. definition Send_Kermit_Run_Command
  6821.  
  6822.    /*box
  6823.       This procedure is called to send a run command to the
  6824.       remote kermit when Kermit is entered via net:call's /Kermit
  6825.       command.
  6826.    */
  6827.  
  6828.    variable Run_Command is Varying_String,
  6829.       Execution_Begins is Varying_String;
  6830.  
  6831.    open Global_Area_Ptr@;
  6832.    Success := True;
  6833.    Run_Command := "$Run " !! Kermit_Program_File !! " Par=rm";
  6834.    Mts_Ebcdic_To_Ascii(Substring(Run_Command, 0, 0),
  6835.       Length(Run_Command));
  6836.    Run_Command !!:= Ascii_Cr;
  6837.    Write_Packet(Remote_Unit, Run_Command);
  6838.    begin
  6839.       open Remote_Unit;
  6840.       if Last_Return_Code > 0
  6841.       then
  6842.          if Last_Return_Code = 12
  6843.          then
  6844.             /* have a call cleared situation, abort */
  6845.             Write_To_User(
  6846.                " Line unexpectedly disconnected - Transmission " !!
  6847.                "ceases");
  6848.             Success := False;
  6849.          end if;
  6850.          if Last_Return_Code = 20
  6851.          then
  6852.             /* have a timeout on write, quit. */
  6853.             Write_To_User(" Timed out on remote write. Quitting");
  6854.             Success := False;
  6855.          end if;
  6856.       end if;
  6857.    end;
  6858.    /* now get the "Execution Begins" Packet */
  6859.    Read_Packet(Remote_Unit, Execution_Begins);
  6860.    begin
  6861.       open Remote_Unit;
  6862.       if Last_Return_Code > 0
  6863.       then
  6864.          if Last_Return_Code = 12
  6865.          then
  6866.             /* have a call cleared situation, abort */
  6867.             Write_To_User(
  6868.                " Line unexpectedly disconnected - Transmission " !!
  6869.                "ceases");
  6870.             Success := False;
  6871.          end if;
  6872.          if Last_Return_Code = 20
  6873.          then
  6874.             /* have a timeout on read. */
  6875.          end if;
  6876.       end if;
  6877.    end;
  6878.    if Debug
  6879.    then
  6880.       Ascii_To_Mts_Ebcdic(Substring(Execution_Begins, 0),
  6881.          Length(Execution_Begins));
  6882.       Debug_String(" ex!" !! Execution_Begins !! "!");
  6883.    end if;
  6884.  
  6885. end Send_Kermit_Run_Command;
  6886.  
  6887. %Eject();
  6888.  
  6889. definition Handle_Error
  6890.  
  6891.    /*box
  6892.       This procedure is called when an error has been detected.
  6893.       The procedure checks "Error_Message". If this is non-null
  6894.       then it implies that the error was generated locally and
  6895.       the procedure dispatches an error packet to the other
  6896.       kermit. It then resets "Error_Message" to null. If
  6897.       "Error_Message" is null it implies that the error was
  6898.       caused by receiving a remote error message. In that case no
  6899.       further action needs be taken.
  6900.    */
  6901.  
  6902.    open Global_Area_Ptr@;
  6903.    /* If "" then remote error already handled */
  6904.    return when Error_Message = "";
  6905.    /* Have a local Error */
  6906.    if Mode = User_Mode
  6907.    then
  6908.       Write_To_User(" Local Error: " !! Error_Message);
  6909.    end if;
  6910.    if Debug
  6911.    then
  6912.       Debug_String(" Local Error: " !! Error_Message);
  6913.    end if;
  6914.    Send_Error_Message(Error_Message);
  6915.    Error_Message := "";
  6916.  
  6917. end Handle_Error;
  6918.  
  6919. %Eject();
  6920.  
  6921. %Eject();
  6922.  
  6923. definition Stop_Remote_Kermit
  6924.  
  6925.    /*box
  6926.       This procedure is called when Kermit is terminated. It
  6927.       checks to see if Kermit is talking to another remote MTS
  6928.       Kermit. If it is then it attempts to shut it down. It also
  6929.       absorbs the "execution terminated" generated by the remote
  6930.       Kermit (The remote Kermit will generate a dummy version in
  6931.       the case of the user having turned this option off.
  6932.    */
  6933.  
  6934.    variable Success is Boolean,
  6935.       Execution_Terminated is Varying_String;
  6936.  
  6937.    open Global_Area_Ptr@;
  6938.    if Can_Talk_To_Remote_Kermit
  6939.    then
  6940.       /* want to shut down other kermit */
  6941.       Send_Generic_Command("F", Success);
  6942.       if Success
  6943.       then
  6944.          Write_To_User(" Remote Kermit shut down.");
  6945.          /* now get the "Execution Terminated" Packet */
  6946.          Read_Packet(Remote_Unit, Execution_Terminated);
  6947.          open Remote_Unit;
  6948.          if Last_Return_Code > 0
  6949.          then
  6950.             if Last_Return_Code = 12
  6951.             then
  6952.                Write_To_User(" Line unexpectedly disconnected.");
  6953.             end if;
  6954.             if Last_Return_Code = 20
  6955.             then
  6956.                /* have a timeout on read. */
  6957.             end if;
  6958.          end if;
  6959.          if Debug
  6960.          then
  6961.             Ascii_To_Mts_Ebcdic(Substring(Execution_Terminated, 0),
  6962.                Length(Execution_Terminated));
  6963.             Debug_String(" ex!" !! Execution_Terminated !! "!");
  6964.          end if;
  6965.       else
  6966.          Write_To_User(" Unable to shut down remote Kermit.");
  6967.       end if;
  6968.    end if;
  6969.  
  6970. end definition Stop_Remote_Kermit;
  6971.  
  6972. %Eject();
  6973.  
  6974. definition Initialize_Logging
  6975.  
  6976.    /*box
  6977.       This procedure is called at the beginning of a Kermit
  6978.       session. It opens a scratch file in which any error records
  6979.       can be placed. It also fills in the initial fields of the
  6980.       log record. This includes the date, start time, and ccid.
  6981.    */
  6982.  
  6983.    open Global_Area_Ptr@;
  6984.    open Log_Record;
  6985.    /* blank the filler columns in the record */
  6986.    equate Fill_String to Log_Record as
  6987.          character(Byte_Size(Log_Record));
  6988.    Fill_String := Substring(B255, 0, Length(Fill_String));
  6989.    /* initialize timing */
  6990.    variable Dummy is Integer;
  6991.    Time(Time_Initialize_Supervisor, 0, Dummy);
  6992.    /* Get starting date */
  6993.    Time(Time_Long_Date, 0, Lr_Date);
  6994.    /* Get starting time */
  6995.    Time(Time_Time_Of_Day, 0, Lr_Start_Time);
  6996.    /* Get the current user */
  6997.    Guinfo("SIGNONID", Lr_Ccid);
  6998.    variable Rc is Integer;
  6999.    Logging_Started := True;
  7000.  
  7001. end Initialize_Logging;
  7002.  
  7003. %Eject();
  7004.  
  7005. definition Terminate_Logging
  7006.  
  7007.    /*box
  7008.       This procedure is called at the end of a Kermit session. It
  7009.       fills out the log record and puts it into the Kermit Log
  7010.       file. If there was any log of errors then this is also
  7011.       added to the Kermit log file.
  7012.    */
  7013.  
  7014.    constant Max_Wait_For_Lock is 3000; /* 3 seconds */
  7015.  
  7016.    open Global_Area_Ptr@;
  7017.    open Log_Record;
  7018.    return when not Logging_Started;
  7019.    /* get the finish time, the elapsed time, and the cpu time */
  7020.    variable Cpu_Time is Integer,
  7021.       Elapsed_Time is Integer;
  7022.    Time(Time_Cpu_In_Milliseconds, 0, Cpu_Time);
  7023.    Lr_Cpu_Time := Integer_To_Varying(Cpu_Time / 1000,
  7024.       Millisecond_Field_Width - 4) !! "." !!
  7025.       Substring(Integer_To_Varying((Cpu_Time mod 1000) + 1000, 4),
  7026.       1, 3);
  7027.    Time(Time_Elapsed_In_Milliseconds, 0, Elapsed_Time);
  7028.    Lr_Elapsed_Time := Integer_To_Varying(Elapsed_Time / 1000,
  7029.       Millisecond_Field_Width - 4) !! "." !!
  7030.       Substring(Integer_To_Varying((Elapsed_Time mod 1000) + 1000,
  7031.       4), 1, 3);
  7032.    Time(Time_Time_Of_Day, 0, Lr_Finish_Time);
  7033.    Lr_Total_Command_Count := Integer_To_Varying(Total_Command_Count,
  7034.       Log_Numeric_Field_Width);
  7035.    Lr_Total_Retries := Integer_To_Varying(Total_Retries,
  7036.       Log_Numeric_Field_Width);
  7037.    Lr_Out_Packet_Count :=
  7038.       Integer_To_Varying(Out_Packet_Count.For_Session,
  7039.       Log_Numeric_Field_Width);
  7040.    Lr_In_Packet_Count :=
  7041.       Integer_To_Varying(In_Packet_Count.For_Session,
  7042.       Log_Numeric_Field_Width);
  7043.    Lr_Send_Command_Count := Integer_To_Varying(Send_Command_Count,
  7044.       Log_Numeric_Field_Width);
  7045.    Lr_Get_Command_Count := Integer_To_Varying(Get_Command_Count,
  7046.       Log_Numeric_Field_Width);
  7047.    /* Lets see if we can get at the log file */
  7048.    variable Rc is Integer,
  7049.       Temp_String is character(20),
  7050.       Access is bit(32);
  7051.    Temp_String := Substring(Kermit_Log_Filename, 0) !! " ";
  7052.    Access := Chkfile(Temp_String return code Rc);
  7053.    return when Rc ^= 0;
  7054.    if (Access & Write_Expand_Access) = Write_Expand_Access
  7055.    then
  7056.       Initialize_File_With_Name(Kermit_Log_File,
  7057.          Kermit_Log_Filename, Kermit_Log_File_Modifiers, Rc);
  7058.       return when Rc ^= 0;
  7059.    else
  7060.       return;
  7061.    end if;
  7062.    Lock(Kermit_Log_File.File_Unit, Lock_Modify, Max_Wait_For_Lock
  7063.       return code Rc);
  7064.    return when Rc ^= 0;
  7065.    Set_Last_Line(Kermit_Log_File);
  7066.    Kermit_Log_File.File_Line_Number +:= 1000;
  7067.    Write_Record(Kermit_Log_File, Log_Record);
  7068.    Unlk(Kermit_Log_File.File_Unit);
  7069.  
  7070. end Terminate_Logging;
  7071.  
  7072. %Eject();
  7073.  
  7074. definition Set_Echo_Off
  7075.  
  7076.    /*box
  7077.       This procedure sets echoing off for the transmission of
  7078.       packets to a microcomputer Kermit. Dumb terminals normally
  7079.       echo the results which would cause the microcomputer Kermit
  7080.       to receive its own packets. Switching echoing off
  7081.       eliminates this.
  7082.    */
  7083.  
  7084.    variable Control_Command is Varying_String,
  7085.       Control_Command_Length is Short_Integer,
  7086.       Control_Rc is Integer,
  7087.       Control_Return_Info is Control_Return_Info_Type;
  7088.  
  7089.    open Global_Area_Ptr@;
  7090.    if Can_Set_Local_Echo
  7091.    then
  7092.       /* set direct terminal off */
  7093.       Control_Command := "echo=off";
  7094.       Control_Command_Length := Length(Control_Command);
  7095.       Control(Substring(Control_Command, 0, 0),
  7096.          Control_Command_Length, Input_Unit.File_Unit,
  7097.          Control_Return_Info return code Control_Rc);
  7098.       if Control_Rc > 0
  7099.       then
  7100.          if Debug
  7101.          then
  7102.             open Control_Return_Info;
  7103.             Debug_String(" Unable to set terminal echo off:");
  7104.             Debug_String(" Control rc " !!
  7105.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7106.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7107.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7108.          end if;
  7109.       end if;
  7110.    end if;
  7111.  
  7112.    if Can_Set_Network_Echo
  7113.    then
  7114.       /* set possible remote datapac, telenet echos off */
  7115.       Control_Command := "set 02:00";
  7116.       Control_Command_Length := Length(Control_Command);
  7117.       Control(Substring(Control_Command, 0, 0),
  7118.          Control_Command_Length, Input_Unit.File_Unit,
  7119.          Control_Return_Info return code Control_Rc);
  7120.       if Control_Rc > 0
  7121.       then
  7122.          if Debug
  7123.          then
  7124.             open Control_Return_Info;
  7125.             Debug_String(" Unable to set datapac echo off:");
  7126.             Debug_String(" Control rc " !!
  7127.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7128.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7129.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7130.          end if;
  7131.       end if;
  7132.    end if;
  7133.  
  7134.    if Can_Set_8_Bit_Datapac_Transparancy
  7135.    then
  7136.       /* set remote datapac so that it is transparent to 8 bit
  7137.          encoding
  7138.       */
  7139.       Control_Command := "set 0:0 123:0";
  7140.       Control_Command_Length := Length(Control_Command);
  7141.       Control(Substring(Control_Command, 0, 0),
  7142.          Control_Command_Length, Input_Unit.File_Unit,
  7143.          Control_Return_Info return code Control_Rc);
  7144.       if Control_Rc > 0
  7145.       then
  7146.          if Debug
  7147.          then
  7148.             open Control_Return_Info;
  7149.             Debug_String(
  7150.                " Unable to set datapac to 8 bit transparancy");
  7151.             Debug_String(" Control rc " !!
  7152.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7153.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7154.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7155.          end if;
  7156.       end if;
  7157.    end if;
  7158.  
  7159. end Set_Echo_Off;
  7160.  
  7161. %Eject();
  7162.  
  7163. definition Set_Echo_On
  7164.  
  7165.    /*box
  7166.       This procedure sets echoing on after a set of packets have
  7167.       been sent At the moment we have no way of sensing what
  7168.       things were like before packet transmission began so we
  7169.       switch all back on for safety.
  7170.    */
  7171.  
  7172.    variable Control_Command is Varying_String,
  7173.       Control_Command_Length is Short_Integer,
  7174.       Control_Rc is Integer,
  7175.       Control_Return_Info is Control_Return_Info_Type;
  7176.  
  7177.    open Global_Area_Ptr@;
  7178.    if Can_Set_Local_Echo
  7179.    then
  7180.       /* set direct terminal off */
  7181.       Control_Command := "echo=on";
  7182.       Control_Command_Length := Length(Control_Command);
  7183.       Control(Substring(Control_Command, 0, 0),
  7184.          Control_Command_Length, Input_Unit.File_Unit,
  7185.          Control_Return_Info return code Control_Rc);
  7186.       if Control_Rc > 0
  7187.       then
  7188.          if Debug
  7189.          then
  7190.             open Control_Return_Info;
  7191.             Debug_String(" Unable to set terminal echo on:");
  7192.             Debug_String(" Control rc " !!
  7193.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7194.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7195.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7196.          end if;
  7197.       end if;
  7198.    end if;
  7199.  
  7200.    if Can_Set_Network_Echo
  7201.    then
  7202.       /* set possible remote datapac, telenet echos on */
  7203.       Control_Command := "set 02:01";
  7204.       Control_Command_Length := Length(Control_Command);
  7205.       Control(Substring(Control_Command, 0, 0),
  7206.          Control_Command_Length, Input_Unit.File_Unit,
  7207.          Control_Return_Info return code Control_Rc);
  7208.       if Control_Rc > 0
  7209.       then
  7210.          if Debug
  7211.          then
  7212.             open Control_Return_Info;
  7213.             Debug_String(" Unable to set datapac echo on:");
  7214.             Debug_String(" Control rc " !!
  7215.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7216.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7217.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7218.          end if;
  7219.       end if;
  7220.    end if;
  7221.    if Can_Set_8_Bit_Datapac_Transparancy
  7222.    then
  7223.       /* reset 8 bit transparancy back off */
  7224.       Control_Command := "set 0:0 123:1";
  7225.       Control_Command_Length := Length(Control_Command);
  7226.       Control(Substring(Control_Command, 0, 0),
  7227.          Control_Command_Length, Input_Unit.File_Unit,
  7228.          Control_Return_Info return code Control_Rc);
  7229.       if Control_Rc > 0
  7230.       then
  7231.          if Debug
  7232.          then
  7233.             open Control_Return_Info;
  7234.             Debug_String(
  7235.                " Unable to set datapac 8 bit transparancy off");
  7236.             Debug_String(" Control rc " !!
  7237.                Integer_To_Varying(Control_Rc, 0) !! " dsr rc " !!
  7238.                Integer_To_Varying(Dsr_Return_Code, 0) !! " " !!
  7239.                Substring(Dsr_Message, 0, Dsr_Message_Length));
  7240.          end if;
  7241.       end if;
  7242.    end if;
  7243.  
  7244. end Set_Echo_On;
  7245.  
  7246. %Punch(" DEF  005000  00STAKSIZE    5 page stack");
  7247.  
  7248.