home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / prime / prime.bwr < prev    next >
Internet Message Format  |  2020-01-01  |  35KB
  1. From C20211@UK.AC.PLYMOUTH.PRIME-A Wed Apr  7 14:08 GMT 1993
  2. Via: uk.ac.plymouth; Wed, 7 Apr 93 14:08:25 GMT
  3. Date:         Wed, 07 Apr 93 15:06:12
  4. From: John Horne  <C20211@UK.AC.PLYMOUTH.PRIME-A>
  5. Subject:      Prime Kermit 8.15 - file 2
  6. To: syspds
  7. In-Reply-To:  Your message of  Fri, 19 Mar 1993 16:21:30 +0000 (GMT)
  8. Status: RO
  9.  
  10.  
  11.    From : John Horne, Computing Service, Polytechnic South West.
  12.    Email : C20211 @ UK.AC.PSW.PA
  13.  
  14.    The following is a list of known bugs and potential problems in the current
  15.    version of Prime Kermit. It is possible for some of the problems to be
  16.    resolved at each individual site by the person responsible for installing
  17.    Kermit, although this may require some minor code changes.
  18.  
  19.    This version has been tested at PRIMOS revisions 21.0.5q and 22.1.1b.
  20.    (It has also been run, but not 'rigorously' tested, at Primos rev 23.2.0b).
  21.  
  22.    1) Odd file lengths are indicated by setting the read/write lock of the file
  23.       to NONE. This will fail (with no warning) if the user does not have P or
  24.       O rights to the directory. The consequence of this is simply a final
  25.       control-Z in the file. Also if the file initially has a read/write lock
  26.       of NONE, then the final character may be lost. I know of no other way of
  27.       "marking" the file as being of odd length. Any ideas?
  28.  
  29.    2) TAKE files try to dynamically obtain a file unit to use. However, it is
  30.       not known what range of file units a user is allowed. So the range from
  31.       7 to 127 is used. Some sites may have limited this range, and so a change
  32.       to the code may be necessary if this is a problem.
  33.  
  34.    3) The Date/Time file created (DTC) attribute can only be set if the user
  35.       has P or O rights. No warning is given if this cannot be set from the
  36.       received attribute packet.
  37.  
  38.    4) Some of the code uses the Primos subroutine T$AMLC to transfer data along
  39.       an AMLC line. Unfortunately this subroutine only returns a zero for
  40.       success, or a one for failure. In the case of a failure Kermit will abort
  41.       the operation, since it cannot correct the problem without knowing what
  42.       it is! It will then display a brief, although possibly vague, message.
  43.  
  44.    5) The end-of-line characters expected in text files must be either a single
  45.       line-feed (LF), a single carriage-return (CR), or a carriage-return (CR)
  46.       followed by a line-feed (CRLF). However, the sequence LFCR will not be
  47.       handled correctly. It is not expected that this will cause any problems!
  48.  
  49.    6) The command "SET BAUD baud_rate" allows only 8 speeds to be specified.
  50.       The first four are 110, 134.5, 300, and 1200, these are fixed within
  51.       Primos. The next value is the programmable clock speed specified by the
  52.       CONFIG directive AMLCLK for the computer. Its default value is 9600, but
  53.       may be changed by the system administrator. The final three values are set
  54.       by hardware jumpers within the computer, the default values are 75, 150,
  55.       and 1800. These may also have been changed at the request of the system
  56.       administrator by Prime. It would be nice to be able to ask Primos what
  57.       these values are, but this is not possible. So it is up to the user to
  58.       ask the system administrator if none of the other values are suitable.
  59.       Also note that 110 baud will use 2 stop bits, but 75 baud will only use
  60.       1. This is because we cannot guarantee that JUMPER_1 is actually 75 baud!
  61.  
  62.       HOWEVER, at PRIMOS revision 22.1 it is possible to ask the computer what
  63.       baud rates are supported on AMLC lines. It is also possible to set any of
  64.       about 20 speeds for ICS lines. So Kermit version 8.14 now only checks on
  65.       the validity of the speed, and lets Primos sort out whether the hardware
  66.       actually supports it. The supported baud rates are not shown at all by
  67.       Kermit, except for those computers using pre-rev 22 Primos when the
  68.       default values of CLOCK, JUMPER_1, JUMPER_2, and JUMPER_3 will be shown.
  69.  
  70.    7) The "SET TIMEOUT" command can only set the local send packet timeout, the
  71.       receive packet timeout has to be set from the "other" Kermit program.
  72.       The "SHOW TIMEOUT" command will show a value for the receive packet
  73.       timeout, but this will be either an initial default value supplied by the
  74.       local Kermit program or the last value received by Kermit from a file
  75.       transfer.
  76.  
  77.    8) The MS-DOS pound conversion facility may seem to switch from OFF to ON
  78.       occasionally. This occurs because the conversion is turned ON or OFF
  79.       depending on the information Kermit receives - either from the user or
  80.       from the remote Kermit during a transfer. E.g. Setting the file type to
  81.       binary will set it OFF, a SHOW command will verify this; if a file is
  82.       now received from an MS-DOS machine (and the attributes packet is sent)
  83.       then the conversion is set ON since Prime Kermit detects that it is
  84.       coming from a DOS machine. Again a SHOW command will verify this.  This
  85.       is not harmful since the pound conversion is only actually performed
  86.       when files are sent, not received. At that time the deciding factors are
  87.       whether the conversion has been explicitly set by the user (either ON or
  88.       OFF), or whether it is a binary file (setting it OFF).  The Prime Kermit
  89.       code has been written to assume that the pound conversion is always ON
  90.       unless either of the two deciding factors above is true. So after
  91.       sending a file (or receiving one from an MS-DOS machine), the pound
  92.       conversion is set back to the default of ON; hence the conversion seems
  93.       to switch from OFF to ON.
  94.  
  95.    9) The acknowledgment received to the file name may have the file name
  96.       encoded with repeat characters. E.g. the file "X0000001" may be
  97.       acknowledged as "X~$01". This will be treated by Prime Kermit as a
  98.       different file name and reported as such. The code for repeat character
  99.       processing is somewhat long-winded, and so has not been included in the
  100.       file name acknowledgment section. This should not give users any real
  101.       problems since it is possible to still work out the correct file name.
  102.  
  103.   10) Bug fix 44 in the PRIME.HLP file should be corrected by having a
  104.       SET SERVER TIMEOUT n command. This will be done later.
  105.  
  106.   11) Sliding windows do not work when the Prime is dialing into a C-Kermit or
  107.       MS-Kermit machine.
  108.  
  109.   12) The code for sizing ASCII files is at the moment inefficient, due to the
  110.       first part of the file being scanned twice. The first scan determines the
  111.       file type, and the second then actually sizes it if it is an ASCII file.
  112.       This could be recoded to only parse the file once, and if a binary file
  113.       then only the first part needs to be examined.
  114.  
  115.   13) Some commands, e.g. SERVER, SEND, and RECEIVE, do not work from within
  116.       a TAKE file. These commands expect to receive packets from the current
  117.       'input stream' which would normally be the 'other side' e.g. a PC, but
  118.       TAKE files get their input from the file itself.
  119.  
  120. ------------------------------
  121.  
  122. Date: 25 Oct 93 12:12:48-0400
  123. From: ABDUL-JAMIL.KHAN@dialcom.tymnet.com
  124. Subject: Fix for Prime Kermit filename handling
  125.  
  126. I have modified KERMIT module REC_SWITCH.PLP to handle filenames
  127. which have the '#' character.  In other words I am properly handling
  128. the quoting and repeat processing.  This means our DOS application can
  129. now send such files to PRIME.
  130.  
  131. I have not done the converse change i.e. sending files to DOS; however,
  132. this is not so important for our application, but I will try and get this
  133. done to keep the code consistent.
  134.  
  135. I am enclosing, below, the modified code for your use/comments.
  136.  
  137. Regards,
  138.  
  139. Jamil Khan
  140.  
  141. ------------REC_SWITCH.PLP-------
  142.  
  143. /* REC_SWITCH -- Handle Kermit file receive protocol. */
  144. /* Modified by Jamil Khan, BT Development Oct 22 93 to
  145.    handling quoting in filename packet */
  146.  
  147. Rec_switch : proc;
  148. $Insert *>insert>common.ins.plp
  149. $Insert *>insert>kermit.ins.plp
  150. $Insert *>insert>primos.ins.plp
  151. $Insert *>insert>constants.ins.plp
  152. $Insert *>insert>rev21keys.ins.plp
  153. $Insert syscom>errd.ins.pl1
  154. Dcl (temp, i, fs_attr_type, rep_count, eof_rec_seq, pathlen) fixed bin,
  155.    new_path char (128) var,
  156.     chr char (1),
  157.     (single_file_rec, test_flag, discard) bit (1) aligned;
  158. /* ************************************************************************* */
  159.    do_flush = true;
  160.    discard = false;
  161.    num_retries = 0;          /* Initialize the number of retries. */
  162.   eof_rec_seq = -1;
  163.    single_file_rec = (length (path_name) ^= 0);
  164.    if packet_log_opened then
  165.      do;
  166.         if single_file_rec then
  167.             errmsg = space_8bit_asc || path_name;
  168.          else
  169.             errmsg = '';
  170.          call log_info (packet_log, '');
  171.         call log_info (packet_log, kversion || ' receiving' || errmsg || '.');
  172.      end;
  173.    do while (true);
  174.       select (state);
  175.          when (state_r)
  176.             state = rec_init ();
  177.          when (state_rf)
  178.            state = rec_file ();
  179.          when (state_ra)
  180.            state = rec_attrib ();
  181.          when (state_rdw)
  182.             state = rec_windowing ();
  183.          when (state_c)
  184.             do;
  185.                call sleep$ (3000);
  186.               return;
  187.             end;
  188.          otherwise                    /* This includes state_a. */
  189.            do;
  190.               do_flush = true;
  191.               call discard_output (i);
  192.               if i ^= 0 then
  193.                  do;
  194.                     call get_error_msg (i);
  195.                      snd_msg = 'Error trying to discard the output file. ' ||
  196.                                errmsg;
  197.                     call send_packet (msg_error, length (snd_msg), msg_number);
  198.                   end;
  199.                call sleep$ (3000);
  200.               return;
  201.             end;
  202.       end;     /* select */
  203.    end;     /* do while ... */
  204. /* ******************************** Rec_init ******************************* */
  205. Rec_init : proc returns (fixed bin);
  206. /* ************************************************************************* */
  207.    msg_number = 0;               /* Initialize sequence numbering. */
  208.    if ^rec_message () then       /* Get a packet. */
  209.      return (state_a);
  210.    if rec_pkt_type = msg_snd_init then
  211.      do;
  212.         call ack_send_init;
  213.          num_retries = 0;
  214.          msg_number = mod (msg_number + 1, 64);
  215.          return (state_rf);         /* Ready to receive file info. */
  216.       end;
  217.   else
  218.      do;
  219.         call send_packet (msg_nak, 0, rec_seq);
  220.          return (state_a);
  221.      end;
  222.    end;      /* Rec_init */
  223. /* ******************************* Rec_file ******************************** */
  224. Rec_file : proc returns (fixed bin);
  225. /* ************************************************************************* */
  226.    if ^rec_message () then             /* Get a packet. */
  227.      return (state_a);
  228.    discard = false;                    /* Initialise these just in case. */
  229.    eof_rec_seq = -1;
  230.    do i = 0 to 63;
  231.      msg_table.slot(i).acked = false;
  232.       msg_table.slot(i).retries = 0;
  233.   end;
  234.    select (rec_pkt_type);
  235.       when (msg_file)
  236.          do;
  237.            if rec_seq ^= msg_number then
  238.               do;
  239.                   snd_msg = 'Protocol error detected.';
  240.                   call send_packet (msg_error, length (snd_msg), msg_number);
  241.                   return (state_a);
  242.                end;
  243.             if length (path_name) = 0 then  /* Get pathname from the packet. */
  244.                do;
  245.                  if single_file_rec then
  246.                     do;
  247.                         snd_msg = 'Error : only ONE file upload allowed.';
  248.                        call send_packet (msg_error, length (snd_msg),
  249.                                           msg_number);
  250.                        return (state_a);
  251.                     end;
  252.                   path_name = substr (rec_msg, pkt_msg, length (rec_msg) -
  253.                                                        pkt_msg);
  254.                  path_name = trim (set8str (path_name), '11'b);
  255.                   /* The pathname may have repeat character processing in it,
  256.                      so we must handle this. 8-bit quoting and control quoting
  257.                     are not allowed in path names, and so will be caught
  258.                     later on. NOT TRUE, CONTROL QUOTING NEEDS TO BE HANDLED.
  259.                     KERMIT ON DOS QUOTES CONTROL QUOTE CHAR - JAMIL KHAN
  260.                      */
  261.                   pathlen = length (path_name);
  262.                   if (do_repeats & index (path_name, loc_rep_chr) ^= 0)
  263.                      | (index (path_name, loc_quote_chr)  ^=0) then
  264.                         do;
  265.                            new_path = '';
  266.                            do i = 1 to pathlen;
  267.                               chr = substr (path_name, i, 1);
  268.                               if chr = loc_quote_chr then /* skip quote */
  269.                                do;
  270.                                 if (i < pathlen) then
  271.                                     i = i + 1;
  272.                                 chr = substr (path_name, i, 1);
  273.                                 rep_count = 1;
  274.                                end;
  275.                                else if do_repeats & chr = loc_rep_chr then
  276.                                  do;
  277.                                    if (i < pathlen) then
  278.                                        i = i + 1;
  279.                                     rep_count = knum (substr (path_name, i, 1));
  280.                                     if (i < pathlen) then
  281.                                       i = i + 1;
  282.                                     chr = substr (path_name, i, 1);
  283.                                     if chr = loc_quote_chr then /* skip */
  284.                                       do;
  285.                                         if (i < pathlen) then
  286.                                           i = i + 1;
  287.                                         chr = substr (path_name, i, 1);
  288.                                       end;
  289.                                  end;
  290.                                  else
  291.                                   rep_count = 1;
  292.                               do temp = 1 to rep_count;
  293.                                  new_path = new_path || chr;
  294.                               end;
  295.                            end;
  296.                            path_name = new_path;
  297.                            call log_info(packet_log,'Unquoted Path '||new_path);
  298.                         end;
  299.                   call set_path (path_name);
  300.                end;
  301.             i = open_output ();      /* Open the file for writing. */
  302.             select (i);
  303.                when (0)
  304.                   snd_msg = '';
  305.                when (e$exst)
  306.                  do;            /* Acknowldege with our new file name. */
  307.                      snd_msg = file_name;
  308.                      call log_info (packet_log,
  309.                   'File already exists. New file name is ' || file_name || '.');
  310.                  end;
  311.                when (e$bnam)
  312.                  do;
  313.                     snd_msg = file_name;
  314.                     call log_info (packet_log, 'The file name is illegal, ' ||
  315.                                    file_name || ' will be used instead.');
  316.                  end;
  317.                when (e$ialn)
  318.                  do;
  319.                     snd_msg =
  320.                      'File already exists. Unable to generate a new file name!';
  321.                     call send_packet (msg_error, length (snd_msg), msg_number);
  322.                      return (state_a);
  323.                  end;
  324.                otherwise
  325.                  do;
  326.                     call get_error_msg (i);
  327.                      snd_msg = 'Error opening file on remote system. ' ||
  328.                                errmsg;
  329.                     call send_packet (msg_error, length (snd_msg), msg_number);
  330.                      return (state_a);
  331.                  end;
  332.             end;
  333.             if explicit_ft_set then
  334.                do;
  335.                  rec_file_type = file_type;
  336.                   if packet_log_opened then
  337.                      do;
  338.                        errmsg =
  339.                           'The receiving file type has been explicitly set to ';
  340.                         select (file_type);
  341.                            when (ascii_ft)
  342.                              errmsg = errmsg || 'ASCII.';
  343.                            when (binary_ft)
  344.                               errmsg = errmsg || 'BINARY.';
  345.                            when (automatic_ft)      /* ? - This can't be! */
  346.                              errmsg = errmsg || 'AUTOMATIC.';
  347.                            otherwise                /* And what's this ? */
  348.                               errmsg = errmsg || 'ILLEGAL.';
  349.                         end;
  350.                         call log_info (packet_log, (errmsg));
  351.                      end;
  352.                end;
  353.             else
  354.               do;
  355.                   rec_file_type = automatic_ft;
  356.                   file_type = ascii_ft;       /* Assume this to start with. */
  357.                   if packet_log_opened then
  358.                      do;
  359.                        call log_info (packet_log,
  360.                      'The receiving file type will be automatically detected.');
  361.                        call log_info (packet_log,
  362.                               'But ASCII file type will initially be assumed.');
  363.                     end;
  364.               end;
  365.             /* Acknowledge the file header packet. */
  366.             num_retries = 0;
  367.            do_flush = false;
  368.            msg_number = mod (msg_number + 1, 64);
  369.             call send_packet (msg_ack, length (snd_msg), rec_seq);
  370.             if loc_file_attrib then    /* Get the file attributes if we can. */
  371.                return (state_ra);
  372.             else
  373.               do;
  374.                   tab_first = msg_number;
  375.                   return (state_rdw);
  376.                end;
  377.          end;
  378.       when (msg_eof, msg_snd_init)
  379.         if rec_seq = mod (msg_number - 1, 64) then
  380.            do;
  381.               if bump_retry () then
  382.                   if rec_pkt_type = msg_eof then
  383.                     call send_packet (msg_ack, 0, rec_seq);
  384.                   else
  385.                     call ack_send_init;
  386.                return (state);
  387.            end;
  388.          else
  389.             do;
  390.                snd_msg = 'Protocol error detected.';
  391.               call send_packet (msg_error, length (snd_msg), msg_number);
  392.                return (state_a);
  393.            end;
  394.       when (msg_break)
  395.         do;
  396.             call send_packet (msg_ack, 0, rec_seq);
  397.             return (state_c);
  398.          end;
  399.       when (msg_error)
  400.         return (state_a);
  401.       otherwise
  402.          do;
  403.            snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
  404.                      '" received on remote system.';
  405.            call send_packet (msg_error, length (snd_msg), msg_number);
  406.            return (state_a);
  407.         end;
  408.    end;      /* Select */
  409.    end;    /* Rec_file */
  410. /* ****************************** Rec_attrib ******************************* */
  411. Rec_attrib : proc returns (fixed bin);
  412. Dcl avail_disk_space fixed bin (31),
  413.    code fixed bin,
  414.    1 quota_info,
  415.      2 (record_size, dir_used, max_quota, quota_used) fixed bin (31),
  416.       2 (duff1, duff2, duff3, duff4) fixed bin (31),
  417.    inf_array (8) fixed bin (31) based;
  418. /* ************************************************************************* */
  419.    if ^rec_message () then                 /* Get a packet. */
  420.      return (state_a);
  421.    select (rec_pkt_type);
  422.       when (msg_attrib)
  423.          do;
  424.            call q$read (dir_name, addr (quota_info) -> inf_array, 4, temp,
  425.                         code);
  426.            if code ^= 0 | temp = 1 then
  427.                avail_disk_space = -1;
  428.             else
  429.               do;
  430.                   avail_disk_space = quota_info.max_quota -
  431.                                      quota_info.quota_used;
  432.                   if quota_info.record_size ^= 1024 then
  433.                     avail_disk_space = divide ((avail_disk_space *
  434.                                     quota_info.record_size) + 1023, 1024, 31);
  435.               end;
  436.             call decode_attrs;
  437.             if avail_disk_space = -1 | rec_file_size <= 0 | rec_file_size <=
  438.                                                          avail_disk_space then
  439.               snd_msg = 'Y';
  440.            else               /* ONLY reject the file if we run out of room. */
  441.                do;
  442.                  call discard_output (temp);
  443.                   if fs_attr_type = 0 then
  444.                     snd_msg = 'N!';
  445.                   else
  446.                     snd_msg = 'N1';
  447.                end;
  448.             if rec_file_dtc = 0 then
  449.               snd_msg = snd_msg || '#';
  450.             if file_type = illegal_ft then
  451.               do;
  452.                   rec_file_type = automatic_ft;
  453.                   file_type = ascii_ft;       /* Reset this, but let the */
  454.                   snd_msg = snd_msg || '"';   /* other side know. */
  455.               end;
  456.             num_retries = 0;
  457.            msg_number = mod (msg_number + 1, 64);
  458.             call send_packet (msg_ack, length (snd_msg), rec_seq);
  459.             if substr (snd_msg, 1, 1) = 'N' then
  460.               call log_info (packet_log, 'Unable to receive the file ' ||
  461.                                           file_name || '. File too big.');
  462.            return (state);
  463.         end;
  464.       when (msg_data)
  465.          do;
  466.            if rec_seq ^= msg_number then    /* Out of sequence messages. */
  467.                if rec_seq = mod (msg_number - 1, 64) then
  468.                   do;
  469.                      if bump_retry () then
  470.                        call send_packet (msg_ack, 0, rec_seq);
  471.                     return (state);
  472.                   end;
  473.               else
  474.                  do;
  475.                     snd_msg = 'Protocol error detected.';
  476.                      call send_packet (msg_error, length (snd_msg), msg_number);
  477.                     return (state_a);
  478.                   end;
  479.             temp = write_output ();
  480.             if temp ^= 0 then
  481.                do;
  482.                  call get_error_msg (temp);
  483.                   snd_msg = 'Unable to write to output file. ' || errmsg;
  484.                   call send_packet (msg_error, length (snd_msg), msg_number);
  485.                   return (state_a);
  486.                end;
  487.             num_retries = 0;
  488.            msg_number = mod (msg_number + 1, 64);
  489.             call send_packet (msg_ack, 0, rec_seq);
  490.             tab_first = msg_number;
  491.             return (state_rdw);
  492.          end;
  493.       when (msg_file)
  494.          if rec_seq = mod (msg_number - 1, 64) then
  495.             do;
  496.                if bump_retry () then
  497.                  call send_packet (msg_ack, 0, rec_seq);
  498.               return (state);
  499.             end;
  500.         else
  501.            do;
  502.               snd_msg = 'Protocol error detected.';
  503.                call send_packet (msg_error, length (snd_msg), msg_number);
  504.               return (state_a);
  505.             end;
  506.       when (msg_eof)
  507.         if rec_seq = msg_number then
  508.            do;
  509.               i = close_output ();
  510.               call set_path ('');    /* Knock out the file_name for later. */
  511.                if i ^= 0 then
  512.                   do;
  513.                      call get_error_msg (i);
  514.                     snd_msg = 'Unable to close output file on remote system. '
  515.                               || errmsg;
  516.                     call send_packet (msg_error, length (snd_msg), msg_number);
  517.                      return (state_a);
  518.                  end;
  519.                num_retries = 0;
  520.                msg_number = mod (msg_number + 1, 64);
  521.                call send_packet (msg_ack, 0, rec_seq);
  522.                return (state_rf);
  523.             end;
  524.         else
  525.            do;
  526.               snd_msg = 'Protocol error detected.';
  527.                call send_packet (msg_error, length (snd_msg), msg_number);
  528.               return (state_a);
  529.             end;
  530.       when (msg_error)
  531.         return (state_a);
  532.       otherwise
  533.          do;
  534.            snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
  535.                      '" received on remote system.';
  536.            call send_packet (msg_error, length (snd_msg), msg_number);
  537.            return (state_a);
  538.         end;
  539.    end;         /* select */
  540.    end;     /* Rec_attrib */
  541. /* ***************************** Rec_windowing ***************************** */
  542. Rec_windowing : proc returns (fixed bin);
  543. /* ************************************************************************* */
  544.    call rec_packet;             /* Get input. */
  545.    select (rec_pkt_type);
  546.       when (msg_data)
  547.          do;
  548.            call update_table;
  549.             if tab_first = eof_rec_seq then
  550.                do;
  551.                  rec_seq = eof_rec_seq;
  552.                   goto eof;
  553.                end;
  554.             else
  555.               return (state);
  556.          end;
  557.       when (msg_eof)
  558.         do;
  559.             eof_rec_seq = rec_seq;
  560.             if length (rec_msg) > pkt_msg then
  561.               rec_msg = substr (rec_msg, pkt_msg, 1);
  562.             else
  563.               rec_msg = '';
  564.             discard = (rec_msg = 'D');
  565.             if discard then
  566.                call discard_output (i);
  567.             else
  568.               do;
  569.                   if tab_first ^= eof_rec_seq then
  570.                     do;
  571.                         call nak_all;
  572.                         return (state);
  573.                      end;
  574. Eof :
  575.                   i = close_output ();
  576.               end;
  577.             do_flush = true;                /* Okay, we can do this now, */
  578.             call set_path ('');             /* and do this for later. */
  579.             if i ^= 0 then
  580.               do;
  581.                   call get_error_msg (i);
  582.                   if discard then
  583.                      snd_msg =
  584.                          'Unable to discard the output file on remote system. '
  585.                           || errmsg;
  586.                  else
  587.                      snd_msg = 'Unable to close output file on remote system. '
  588.                                || errmsg;
  589.                   call send_packet (msg_error, length (snd_msg), msg_number);
  590.                   return (state_a);
  591.                end;
  592.             num_retries = 0;
  593.            msg_number = mod (rec_seq + 1, 64);
  594.            call send_packet (msg_ack, 0, rec_seq);
  595.             return (state_rf);
  596.          end;
  597.       when (msg_error)
  598.         return (state_a);
  599.       when (msg_timeout)
  600.         do;
  601.             if bump_retry () then
  602.                do;
  603.                  num_retries = num_retries - 1;   /* Don't increase this. */
  604.                  call log_info (packet_log,
  605.                                       'Timeout : NAK for most desired packet.');
  606.                  call nak_oldest (true);
  607.               end;
  608.             return (state);
  609.          end;
  610.       when (msg_check_err)
  611.         do;
  612.             if bump_retry () then
  613.                do;
  614.                  num_retries = num_retries - 1;   /* Don't increase this. */
  615.                  call log_info (packet_log,
  616.                             'Checksum error : NAK for oldest unACKed packet.');
  617.                   call nak_oldest (false);
  618.               end;
  619.             return (state);
  620.          end;
  621.       otherwise
  622.          do;
  623.            snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
  624.                      '" received on remote system.';
  625.            call send_packet (msg_error, length (snd_msg), msg_number);
  626.            return (state_a);
  627.         end;
  628.    end;      /* Select */
  629.    end;   /* Rec_windowing */
  630. /* ****************************** Rec_message ****************************** */
  631. Rec_message : proc returns (bit (1) aligned);
  632. /* ************************************************************************* */
  633.    test_flag = false;
  634.    do until (test_flag);
  635.       call rec_packet;
  636.       if rec_pkt_type = msg_timeout | rec_pkt_type = msg_check_err then
  637.          if bump_retry () then
  638.            call send_packet (msg_nak, 0, msg_number);
  639.          else
  640.             return (false);
  641.       else
  642.         test_flag = true;
  643.    end;
  644.    return (true);
  645.    end;       /* Rec_message */
  646. /* ***************************** Update_table ****************************** */
  647. Update_table : proc;
  648. /* ************************************************************************* */
  649.    if ^between (rec_seq, tab_first, mod (tab_first + window_size - 1, 64)) then
  650.       do;
  651.          if between (rec_seq, mod (tab_first - window_size, 64),
  652.                              mod (tab_first - 1, 64)) then
  653.            call send_packet (msg_ack, 0, rec_seq);
  654.          return;
  655.      end;
  656.    /* Add the new data packet to the table. */
  657.    if rec_seq ^= eof_rec_seq then     /* Don't mark the EOF packet as ACKed. */
  658.       do;
  659.          msg_table.slot(rec_seq).msg = rec_msg;
  660.          msg_table.slot(rec_seq).acked = true;
  661.      end;
  662.    if msg_table.slot(tab_first).acked then
  663.      do;
  664.         i = tab_first;
  665.          do until (^msg_table.slot(i).acked);
  666.             rec_msg = msg_table.slot(i).msg;
  667.             temp = write_output ();
  668.             if temp ^= 0 then
  669.                do;
  670.                  call get_error_msg (temp);
  671.                   snd_msg = 'Unable to write to output file. ' || errmsg;
  672.                   call send_packet (msg_error, length (snd_msg), msg_number);
  673.                   state = state_a;
  674.                  return;
  675.               end;
  676.            else
  677.                msg_table.slot(i).acked = false;
  678.             i = mod (i + 1, 64);
  679.         end;
  680.          tab_first = i;
  681.       end;
  682.    num_retries = 0;
  683.    msg_number = mod (rec_seq + 1, 64);
  684.    call send_packet (msg_ack, 0, rec_seq);    /* Acknowledge the packet. */
  685.    return;
  686.    end;      /* Update_table */
  687. /* ****************************** Nak_oldest ******************************* */
  688. Nak_oldest : proc (desire);
  689. Dcl desire bit (1) aligned;
  690. /* ************************************************************************* */
  691.    i = tab_first;
  692.    temp = mod (tab_first + window_size, 64);
  693.    do until (i = temp);
  694.       if ^msg_table.slot(i).acked then
  695.         do;
  696.             call send_packet (msg_nak, 0, i);
  697.             return;
  698.          end;
  699.       i = mod (i + 1, 64);
  700.   end;
  701.    /* No packets to NAK, so NAK for next in hope of unblocking
  702.      sender if a NAK for the most desired packet is required. */
  703.    if desire then
  704.       call send_packet (msg_nak, 0, temp);
  705.    return;
  706.    end;      /* Nak_oldest */
  707. /* ******************************* Nak_all ********************************* */
  708. Nak_all : proc;
  709. /* ************************************************************************* */
  710.    i = tab_first;
  711.    do until (i = eof_rec_seq);
  712.      if ^msg_table.slot(i).acked then
  713.          call send_packet (msg_nak, 0, i);
  714.       i = mod (i + 1, 64);
  715.   end;
  716.    return;
  717.    end;       /* Nak_all */
  718. /* ******************************* Bump_retry ****************************** */
  719. Bump_retry : proc returns (bit (1) aligned);
  720. /* ************************************************************************* */
  721.    if num_retries > max_retries then
  722.      do;
  723.         snd_msg = 'Retry limit exceeded on remote system.';
  724.          call send_packet (msg_error, length (snd_msg), msg_number);
  725.         state = state_a;
  726.         return (false);
  727.       end;
  728.    num_retries = num_retries + 1;
  729.    return (true);
  730.    end;          /* Bump_retry */
  731. /* ****************************** Decode_attrs ***************************** */
  732. Decode_attrs : proc;
  733. Dcl (str, data) char (max_msg) var,
  734.     attr char (1),
  735.    (len, found, code) fixed bin;
  736. /* ************************************************************************* */
  737.    rec_file_size = -1;    /* -1 = Unknown, 0 = Illegal, > 0 = Legal value. */
  738.    rec_file_dtc = -1;
  739.    found = 0;
  740.    str = substr (rec_msg, pkt_msg, length (rec_msg) - pkt_msg);
  741.    str = set8str (str);
  742.    do while (length (str) > 0 & found < 5);
  743.       attr = substr (str, 1, 1);
  744.       len = knum (substr (str, 2, 1));
  745.       data = substr (str, 3, len);
  746.      str = substr (str, len + 3);
  747.       select (attr);
  748.          when ('!')             /* File size in Kbytes. */
  749.            do;
  750.               fs_attr_type = 0;
  751.                rec_file_size = bin (trim (data, '11'b), 31);
  752.            end;
  753.          when ('1')             /* File size in bytes. */
  754.             do;
  755.                fs_attr_type = 1;
  756.               rec_file_size = bin (trim (data, '11'b), 31);
  757.                rec_file_size = divide (rec_file_size + 1023, 1024, 31);
  758.             end;
  759.          when ('#')             /* Date/Time file created (DTC). */
  760.             do;
  761.                if substr (data, 1, 2) = '19' then
  762.                   data = substr (data, 3);    /* Knock off the century. */
  763.                data = substr (data, 1, 2) || '-' || substr (data, 3, 2) ||
  764.                      '-' || substr (data, 5, 2) || '.' ||
  765.                       after (data, space_8bit_asc);
  766.                call cv$dtb (data, rec_file_dtc, code);
  767.               if code ^= 0 then
  768.                   rec_file_dtc = 0;
  769.             end;
  770.          when ('.')             /* Machine and OS. */
  771.             if ^explicit_pound_set &
  772.               (data = 'U8' | substr (data, 1, 1) = 'K') then
  773.               pound_conversion = true;    /* U8 = MS-DOS, K = Atari. */
  774.          when ('"')             /* Indication of file type. */
  775.            if ^explicit_ft_set then     /* Might as well use this if we can. */
  776.                do;
  777.                  select (substr (data, 1, 1));
  778.                      when ('A')
  779.                         do;
  780.                            rec_file_type = ascii_ft;    /* ASCII file. */
  781.                            call log_info (packet_log,
  782.     'The received file type attribute is ASCII, this file type will be used.');
  783.                         end;
  784.                      when ('B')
  785.                         do;
  786.                            rec_file_type = binary_ft;   /* BINARY file. */
  787.                           call log_info (packet_log,
  788.   'The received file type attribute is BINARY, this file type will be used.');
  789.                        end;
  790.                      when ('I')
  791.                         do;
  792.                            rec_file_type = binary_ft; /* IMAGE file (BINARY). */
  793.                           call log_info (packet_log,
  794. 'The received file type attribute is IMAGE, but BINARY file type will be used.'
  795.                                           );
  796.                        end;
  797.                      otherwise
  798.                        do;
  799.                           rec_file_type = illegal_ft;  /* ILLEGAL file type. */
  800.                            call log_info (packet_log,
  801.                                'The received file type attribute is ILLEGAL.');
  802.                            call log_info (packet_log, 'The file type will be '
  803.                || 'automatically detected, but ASCII will initially be used.');
  804.                         end;
  805.                   end;
  806.                   file_type = rec_file_type;
  807.                end;
  808.          otherwise
  809.            found = found - 1;        /* Didn't find one we wanted. */
  810.       end;
  811.       found = found + 1;        /* Assume that we did find one. */
  812.    end;
  813.    return;
  814.    end;          /* Decode_attrs */
  815.    end;       /* Rec_switch */
  816.  
  817. ------------END OF CODE-----------
  818.