25-Oct-93 16:36:56-GMT,29401;000000000005
Return-Path: <anewcomb>
Received: by watsun.cc.columbia.edu (5.59/FCB/jba)
	id AA03152; Mon, 25 Oct 93 12:36:54 EDT
Date: Mon, 25 Oct 93 12:36:52 EDT
From: Andy Newcomb <anewcomb@watsun.cc.columbia.edu>
To: kermites
Subject: a prime kermit fix
Message-Id: <CMM.0.90.4.751567012.anewcomb@watsun.cc.columbia.edu>


A guy has been complaining about Prime Kermit 8.15's mishandling of repeat
# signs in filenames, and he verifies the behavior with MSKermit 3.13.
Then he fixes it. 

                ---------------

Received: from mailhub.cc.columbia.edu by watsun.cc.columbia.edu (5.59/FCB/jba)
	id AA01831; Mon, 25 Oct 93 12:13:47 EDT
Received: from tymix.Tymnet.COM by mailhub.cc.columbia.edu with SMTP id AA06492
  (5.65c+CU/IDA-1.4.4/HLK for anewcomb@watsun.cc.columbia.edu); Mon, 25 Oct 1993 12:13:34 -0400
Received: from spiff.Tymnet.COM by tymix.Tymnet.COM (4.1/SMI-4.1)
	id AA01017; Mon, 25 Oct 93 09:10:58 PDT
Received: from bullwinkle.Tymnet.COM by spiff.Tymnet.COM (4.1/SMI-4.1)
	id AA23985; Mon, 25 Oct 93 09:13:30 PDT
Return-Path: <ABDUL-JAMIL.KHAN@dialcom.Tymnet.COM>
Received: from spiff.Tymnet.COM by bullwinkle.Tymnet.COM (4.1/SMI-4.0-MHS-6.0)
 id AA22080; Mon, 25 Oct 93 09:13:28 PDT
Received: from bullwinkle.Tymnet.COM by spiff.Tymnet.COM (4.1/SMI-4.1) id
 AA23982; Mon, 25 Oct 93 09:13:27 PDT
Received: by x400-gate.Tymnet.COM (SXG 7.0a/bullwinkle1.6) with X.400 id
 00gmzgYua001; 25 Oct 93 16:13:10 UT
Date: 25 Oct 93 12:12:48-0400
P1-Message-Id: US*DIALCOM;0013593102512125100301
Priority: urgent
P1-Recipient: x400-gate-d@bullwinkle.Tymnet.COM
From: ABDUL-JAMIL.KHAN@dialcom.tymnet.com
Message-Id: <"IPM-195-931025-000011231"*@x400-gate.Tymnet.COM>
To: anewcomb@columbia.edu

Andy,

I have modified KERMIT module REC_SWITCH.PLP to handle filenames
which have the '#' chacarter. In other words I am properly handling
the quoting and repeat processing. This means our DOS application can
now send such files to PRIME.

I have not done the converse change i.e. sending files to DOS; however,
this is not so important for our apllication,but I will try and get this
done to keep the code consistent.

I am enclosing, below, the modified code for your use/comments.

Regards,

Jamil Khan

------------REC_SWITCH.PLP-------

/* REC_SWITCH -- Handle Kermit file receive protocol. */
/* Modified by Jamil Khan, BT Development Oct 22 93 to
   handling quoting in filename packet */

Rec_switch : proc;
$Insert *>insert>common.ins.plp
$Insert *>insert>kermit.ins.plp
$Insert *>insert>primos.ins.plp
$Insert *>insert>constants.ins.plp
$Insert *>insert>rev21keys.ins.plp
$Insert syscom>errd.ins.pl1
Dcl (temp, i, fs_attr_type, rep_count, eof_rec_seq, pathlen) fixed bin,
   new_path char (128) var,
    chr char (1),
    (single_file_rec, test_flag, discard) bit (1) aligned;
/* ************************************************************************* */
   do_flush = true;
   discard = false;
   num_retries = 0;          /* Initialize the number of retries. */
  eof_rec_seq = -1;
   single_file_rec = (length (path_name) ^= 0);
   if packet_log_opened then
     do;
        if single_file_rec then
            errmsg = space_8bit_asc || path_name;
         else
            errmsg = '';
         call log_info (packet_log, '');
        call log_info (packet_log, kversion || ' receiving' || errmsg || '.');
     end;
   do while (true);
      select (state);
         when (state_r)
            state = rec_init ();
         when (state_rf)
           state = rec_file ();
         when (state_ra)
           state = rec_attrib ();
         when (state_rdw)
            state = rec_windowing ();
         when (state_c)
            do;
               call sleep$ (3000);
              return;
            end;
         otherwise                    /* This includes state_a. */
           do;
              do_flush = true;
              call discard_output (i);
              if i ^= 0 then
                 do;
                    call get_error_msg (i);
                     snd_msg = 'Error trying to discard the output file. ' ||
                               errmsg;
                    call send_packet (msg_error, length (snd_msg), msg_number);
                  end;
               call sleep$ (3000);
              return;
            end;
      end;     /* select */
   end;     /* do while ... */
/* ******************************** Rec_init ******************************* */
Rec_init : proc returns (fixed bin);
/* ************************************************************************* */
   msg_number = 0;               /* Initialize sequence numbering. */
   if ^rec_message () then       /* Get a packet. */
     return (state_a);
   if rec_pkt_type = msg_snd_init then
     do;
        call ack_send_init;
         num_retries = 0;
         msg_number = mod (msg_number + 1, 64);
         return (state_rf);         /* Ready to receive file info. */
      end;
  else
     do;
        call send_packet (msg_nak, 0, rec_seq);
         return (state_a);
     end;
   end;      /* Rec_init */
/* ******************************* Rec_file ******************************** */
Rec_file : proc returns (fixed bin);
/* ************************************************************************* */
   if ^rec_message () then             /* Get a packet. */
     return (state_a);
   discard = false;                    /* Initialise these just in case. */
   eof_rec_seq = -1;
   do i = 0 to 63;
     msg_table.slot(i).acked = false;
      msg_table.slot(i).retries = 0;
  end;
   select (rec_pkt_type);
      when (msg_file)
         do;
           if rec_seq ^= msg_number then
              do;
                  snd_msg = 'Protocol error detected.';
                  call send_packet (msg_error, length (snd_msg), msg_number);
                  return (state_a);
               end;
            if length (path_name) = 0 then  /* Get pathname from the packet. */
               do;
                 if single_file_rec then
                    do;
                        snd_msg = 'Error : only ONE file upload allowed.';
                       call send_packet (msg_error, length (snd_msg),
                                          msg_number);
                       return (state_a);
                    end;
                  path_name = substr (rec_msg, pkt_msg, length (rec_msg) -
                                                       pkt_msg);
                 path_name = trim (set8str (path_name), '11'b);
                  /* The pathname may have repeat character processing in it,
                     so we must handle this. 8-bit quoting and control quoting
                    are not allowed in path names, and so will be caught
                    later on. NOT TRUE, CONTROL QUOTING NEEDS TO BE HANDLED.
                    KERMIT ON DOS QUOTES CONTROL QUOTE CHAR - JAMIL KHAN
                     */
                  pathlen = length (path_name);
                  if (do_repeats & index (path_name, loc_rep_chr) ^= 0)
                     | (index (path_name, loc_quote_chr)  ^=0) then
                        do;
                           new_path = '';
                           do i = 1 to pathlen;
                              chr = substr (path_name, i, 1);
                              if chr = loc_quote_chr then /* skip quote */
                               do;
                                if (i < pathlen) then
                                    i = i + 1;
                                chr = substr (path_name, i, 1);
                                rep_count = 1;
                               end;
                               else if do_repeats & chr = loc_rep_chr then
                                 do;
                                   if (i < pathlen) then
                                       i = i + 1;
                                    rep_count = knum (substr (path_name, i, 1));
                                    if (i < pathlen) then
                                      i = i + 1;
                                    chr = substr (path_name, i, 1);
                                    if chr = loc_quote_chr then /* skip */
                                      do;
                                        if (i < pathlen) then
                                          i = i + 1;
                                        chr = substr (path_name, i, 1);
                                      end;
                                 end;
                                 else
                                  rep_count = 1;
                              do temp = 1 to rep_count;
                                 new_path = new_path || chr;
                              end;
                           end;
                           path_name = new_path;
                           call log_info(packet_log,'Unquoted Path '||new_path);
                        end;
                  call set_path (path_name);
               end;
            i = open_output ();      /* Open the file for writing. */
            select (i);
               when (0)
                  snd_msg = '';
               when (e$exst)
                 do;            /* Acknowldege with our new file name. */
                     snd_msg = file_name;
                     call log_info (packet_log,
                  'File already exists. New file name is ' || file_name || '.');
                 end;
               when (e$bnam)
                 do;
                    snd_msg = file_name;
                    call log_info (packet_log, 'The file name is illegal, ' ||
                                   file_name || ' will be used instead.');
                 end;
               when (e$ialn)
                 do;
                    snd_msg =
                     'File already exists. Unable to generate a new file name!';
                    call send_packet (msg_error, length (snd_msg), msg_number);
                     return (state_a);
                 end;
               otherwise
                 do;
                    call get_error_msg (i);
                     snd_msg = 'Error opening file on remote system. ' ||
                               errmsg;
                    call send_packet (msg_error, length (snd_msg), msg_number);
                     return (state_a);
                 end;
            end;
            if explicit_ft_set then
               do;
                 rec_file_type = file_type;
                  if packet_log_opened then
                     do;
                       errmsg =
                          'The receiving file type has been explicitly set to ';
                        select (file_type);
                           when (ascii_ft)
                             errmsg = errmsg || 'ASCII.';
                           when (binary_ft)
                              errmsg = errmsg || 'BINARY.';
                           when (automatic_ft)      /* ? - This can't be! */
                             errmsg = errmsg || 'AUTOMATIC.';
                           otherwise                /* And what's this ? */
                              errmsg = errmsg || 'ILLEGAL.';
                        end;
                        call log_info (packet_log, (errmsg));
                     end;
               end;
            else
              do;
                  rec_file_type = automatic_ft;
                  file_type = ascii_ft;       /* Assume this to start with. */
                  if packet_log_opened then
                     do;
                       call log_info (packet_log,
                     'The receiving file type will be automatically detected.');
                       call log_info (packet_log,
                              'But ASCII file type will initially be assumed.');
                    end;
              end;
            /* Acknowledge the file header packet. */
            num_retries = 0;
           do_flush = false;
           msg_number = mod (msg_number + 1, 64);
            call send_packet (msg_ack, length (snd_msg), rec_seq);
            if loc_file_attrib then    /* Get the file attributes if we can. */
               return (state_ra);
            else
              do;
                  tab_first = msg_number;
                  return (state_rdw);
               end;
         end;
      when (msg_eof, msg_snd_init)
        if rec_seq = mod (msg_number - 1, 64) then
           do;
              if bump_retry () then
                  if rec_pkt_type = msg_eof then
                    call send_packet (msg_ack, 0, rec_seq);
                  else
                    call ack_send_init;
               return (state);
           end;
         else
            do;
               snd_msg = 'Protocol error detected.';
              call send_packet (msg_error, length (snd_msg), msg_number);
               return (state_a);
           end;
      when (msg_break)
        do;
            call send_packet (msg_ack, 0, rec_seq);
            return (state_c);
         end;
      when (msg_error)
        return (state_a);
      otherwise
         do;
           snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
                     '" received on remote system.';
           call send_packet (msg_error, length (snd_msg), msg_number);
           return (state_a);
        end;
   end;      /* Select */
   end;    /* Rec_file */
/* ****************************** Rec_attrib ******************************* */
Rec_attrib : proc returns (fixed bin);
Dcl avail_disk_space fixed bin (31),
   code fixed bin,
   1 quota_info,
     2 (record_size, dir_used, max_quota, quota_used) fixed bin (31),
      2 (duff1, duff2, duff3, duff4) fixed bin (31),
   inf_array (8) fixed bin (31) based;
/* ************************************************************************* */
   if ^rec_message () then                 /* Get a packet. */
     return (state_a);
   select (rec_pkt_type);
      when (msg_attrib)
         do;
           call q$read (dir_name, addr (quota_info) -> inf_array, 4, temp,
                        code);
           if code ^= 0 | temp = 1 then
               avail_disk_space = -1;
            else
              do;
                  avail_disk_space = quota_info.max_quota -
                                     quota_info.quota_used;
                  if quota_info.record_size ^= 1024 then
                    avail_disk_space = divide ((avail_disk_space *
                                    quota_info.record_size) + 1023, 1024, 31);
              end;
            call decode_attrs;
            if avail_disk_space = -1 | rec_file_size <= 0 | rec_file_size <=
                                                         avail_disk_space then
              snd_msg = 'Y';
           else               /* ONLY reject the file if we run out of room. */
               do;
                 call discard_output (temp);
                  if fs_attr_type = 0 then
                    snd_msg = 'N!';
                  else
                    snd_msg = 'N1';
               end;
            if rec_file_dtc = 0 then
              snd_msg = snd_msg || '#';
            if file_type = illegal_ft then
              do;
                  rec_file_type = automatic_ft;
                  file_type = ascii_ft;       /* Reset this, but let the */
                  snd_msg = snd_msg || '"';   /* other side know. */
              end;
            num_retries = 0;
           msg_number = mod (msg_number + 1, 64);
            call send_packet (msg_ack, length (snd_msg), rec_seq);
            if substr (snd_msg, 1, 1) = 'N' then
              call log_info (packet_log, 'Unable to receive the file ' ||
                                          file_name || '. File too big.');
           return (state);
        end;
      when (msg_data)
         do;
           if rec_seq ^= msg_number then    /* Out of sequence messages. */
               if rec_seq = mod (msg_number - 1, 64) then
                  do;
                     if bump_retry () then
                       call send_packet (msg_ack, 0, rec_seq);
                    return (state);
                  end;
              else
                 do;
                    snd_msg = 'Protocol error detected.';
                     call send_packet (msg_error, length (snd_msg), msg_number);
                    return (state_a);
                  end;
            temp = write_output ();
            if temp ^= 0 then
               do;
                 call get_error_msg (temp);
                  snd_msg = 'Unable to write to output file. ' || errmsg;
                  call send_packet (msg_error, length (snd_msg), msg_number);
                  return (state_a);
               end;
            num_retries = 0;
           msg_number = mod (msg_number + 1, 64);
            call send_packet (msg_ack, 0, rec_seq);
            tab_first = msg_number;
            return (state_rdw);
         end;
      when (msg_file)
         if rec_seq = mod (msg_number - 1, 64) then
            do;
               if bump_retry () then
                 call send_packet (msg_ack, 0, rec_seq);
              return (state);
            end;
        else
           do;
              snd_msg = 'Protocol error detected.';
               call send_packet (msg_error, length (snd_msg), msg_number);
              return (state_a);
            end;
      when (msg_eof)
        if rec_seq = msg_number then
           do;
              i = close_output ();
              call set_path ('');    /* Knock out the file_name for later. */
               if i ^= 0 then
                  do;
                     call get_error_msg (i);
                    snd_msg = 'Unable to close output file on remote system. '
                              || errmsg;
                    call send_packet (msg_error, length (snd_msg), msg_number);
                     return (state_a);
                 end;
               num_retries = 0;
               msg_number = mod (msg_number + 1, 64);
               call send_packet (msg_ack, 0, rec_seq);
               return (state_rf);
            end;
        else
           do;
              snd_msg = 'Protocol error detected.';
               call send_packet (msg_error, length (snd_msg), msg_number);
              return (state_a);
            end;
      when (msg_error)
        return (state_a);
      otherwise
         do;
           snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
                     '" received on remote system.';
           call send_packet (msg_error, length (snd_msg), msg_number);
           return (state_a);
        end;
   end;         /* select */
   end;     /* Rec_attrib */
/* ***************************** Rec_windowing ***************************** */
Rec_windowing : proc returns (fixed bin);
/* ************************************************************************* */
   call rec_packet;             /* Get input. */
   select (rec_pkt_type);
      when (msg_data)
         do;
           call update_table;
            if tab_first = eof_rec_seq then
               do;
                 rec_seq = eof_rec_seq;
                  goto eof;
               end;
            else
              return (state);
         end;
      when (msg_eof)
        do;
            eof_rec_seq = rec_seq;
            if length (rec_msg) > pkt_msg then
              rec_msg = substr (rec_msg, pkt_msg, 1);
            else
              rec_msg = '';
            discard = (rec_msg = 'D');
            if discard then
               call discard_output (i);
            else
              do;
                  if tab_first ^= eof_rec_seq then
                    do;
                        call nak_all;
                        return (state);
                     end;
Eof :
                  i = close_output ();
              end;
            do_flush = true;                /* Okay, we can do this now, */
            call set_path ('');             /* and do this for later. */
            if i ^= 0 then
              do;
                  call get_error_msg (i);
                  if discard then
                     snd_msg =
                         'Unable to discard the output file on remote system. '
                          || errmsg;
                 else
                     snd_msg = 'Unable to close output file on remote system. '
                               || errmsg;
                  call send_packet (msg_error, length (snd_msg), msg_number);
                  return (state_a);
               end;
            num_retries = 0;
           msg_number = mod (rec_seq + 1, 64);
           call send_packet (msg_ack, 0, rec_seq);
            return (state_rf);
         end;
      when (msg_error)
        return (state_a);
      when (msg_timeout)
        do;
            if bump_retry () then
               do;
                 num_retries = num_retries - 1;   /* Don't increase this. */
                 call log_info (packet_log,
                                      'Timeout : NAK for most desired packet.');
                 call nak_oldest (true);
              end;
            return (state);
         end;
      when (msg_check_err)
        do;
            if bump_retry () then
               do;
                 num_retries = num_retries - 1;   /* Don't increase this. */
                 call log_info (packet_log,
                            'Checksum error : NAK for oldest unACKed packet.');
                  call nak_oldest (false);
              end;
            return (state);
         end;
      otherwise
         do;
           snd_msg = 'Unexpected packet type "' || rec_pkt_type ||
                     '" received on remote system.';
           call send_packet (msg_error, length (snd_msg), msg_number);
           return (state_a);
        end;
   end;      /* Select */
   end;   /* Rec_windowing */
/* ****************************** Rec_message ****************************** */
Rec_message : proc returns (bit (1) aligned);
/* ************************************************************************* */
   test_flag = false;
   do until (test_flag);
      call rec_packet;
      if rec_pkt_type = msg_timeout | rec_pkt_type = msg_check_err then
         if bump_retry () then
           call send_packet (msg_nak, 0, msg_number);
         else
            return (false);
      else
        test_flag = true;
   end;
   return (true);
   end;       /* Rec_message */
/* ***************************** Update_table ****************************** */
Update_table : proc;
/* ************************************************************************* */
   if ^between (rec_seq, tab_first, mod (tab_first + window_size - 1, 64)) then
      do;
         if between (rec_seq, mod (tab_first - window_size, 64),
                             mod (tab_first - 1, 64)) then
           call send_packet (msg_ack, 0, rec_seq);
         return;
     end;
   /* Add the new data packet to the table. */
   if rec_seq ^= eof_rec_seq then     /* Don't mark the EOF packet as ACKed. */
      do;
         msg_table.slot(rec_seq).msg = rec_msg;
         msg_table.slot(rec_seq).acked = true;
     end;
   if msg_table.slot(tab_first).acked then
     do;
        i = tab_first;
         do until (^msg_table.slot(i).acked);
            rec_msg = msg_table.slot(i).msg;
            temp = write_output ();
            if temp ^= 0 then
               do;
                 call get_error_msg (temp);
                  snd_msg = 'Unable to write to output file. ' || errmsg;
                  call send_packet (msg_error, length (snd_msg), msg_number);
                  state = state_a;
                 return;
              end;
           else
               msg_table.slot(i).acked = false;
            i = mod (i + 1, 64);
        end;
         tab_first = i;
      end;
   num_retries = 0;
   msg_number = mod (rec_seq + 1, 64);
   call send_packet (msg_ack, 0, rec_seq);    /* Acknowledge the packet. */
   return;
   end;      /* Update_table */
/* ****************************** Nak_oldest ******************************* */
Nak_oldest : proc (desire);
Dcl desire bit (1) aligned;
/* ************************************************************************* */
   i = tab_first;
   temp = mod (tab_first + window_size, 64);
   do until (i = temp);
      if ^msg_table.slot(i).acked then
        do;
            call send_packet (msg_nak, 0, i);
            return;
         end;
      i = mod (i + 1, 64);
  end;
   /* No packets to NAK, so NAK for next in hope of unblocking
     sender if a NAK for the most desired packet is required. */
   if desire then
      call send_packet (msg_nak, 0, temp);
   return;
   end;      /* Nak_oldest */
/* ******************************* Nak_all ********************************* */
Nak_all : proc;
/* ************************************************************************* */
   i = tab_first;
   do until (i = eof_rec_seq);
     if ^msg_table.slot(i).acked then
         call send_packet (msg_nak, 0, i);
      i = mod (i + 1, 64);
  end;
   return;
   end;       /* Nak_all */
/* ******************************* Bump_retry ****************************** */
Bump_retry : proc returns (bit (1) aligned);
/* ************************************************************************* */
   if num_retries > max_retries then
     do;
        snd_msg = 'Retry limit exceeded on remote system.';
         call send_packet (msg_error, length (snd_msg), msg_number);
        state = state_a;
        return (false);
      end;
   num_retries = num_retries + 1;
   return (true);
   end;          /* Bump_retry */
/* ****************************** Decode_attrs ***************************** */
Decode_attrs : proc;
Dcl (str, data) char (max_msg) var,
    attr char (1),
   (len, found, code) fixed bin;
/* ************************************************************************* */
   rec_file_size = -1;    /* -1 = Unknown, 0 = Illegal, > 0 = Legal value. */
   rec_file_dtc = -1;
   found = 0;
   str = substr (rec_msg, pkt_msg, length (rec_msg) - pkt_msg);
   str = set8str (str);
   do while (length (str) > 0 & found < 5);
      attr = substr (str, 1, 1);
      len = knum (substr (str, 2, 1));
      data = substr (str, 3, len);
     str = substr (str, len + 3);
      select (attr);
         when ('!')             /* File size in Kbytes. */
           do;
              fs_attr_type = 0;
               rec_file_size = bin (trim (data, '11'b), 31);
           end;
         when ('1')             /* File size in bytes. */
            do;
               fs_attr_type = 1;
              rec_file_size = bin (trim (data, '11'b), 31);
               rec_file_size = divide (rec_file_size + 1023, 1024, 31);
            end;
         when ('#')             /* Date/Time file created (DTC). */
            do;
               if substr (data, 1, 2) = '19' then
                  data = substr (data, 3);    /* Knock off the century. */
               data = substr (data, 1, 2) || '-' || substr (data, 3, 2) ||
                     '-' || substr (data, 5, 2) || '.' ||
                      after (data, space_8bit_asc);
               call cv$dtb (data, rec_file_dtc, code);
              if code ^= 0 then
                  rec_file_dtc = 0;
            end;
         when ('.')             /* Machine and OS. */
            if ^explicit_pound_set &
              (data = 'U8' | substr (data, 1, 1) = 'K') then
              pound_conversion = true;    /* U8 = MS-DOS, K = Atari. */
         when ('"')             /* Indication of file type. */
           if ^explicit_ft_set then     /* Might as well use this if we can. */
               do;
                 select (substr (data, 1, 1));
                     when ('A')
                        do;
                           rec_file_type = ascii_ft;    /* ASCII file. */
                           call log_info (packet_log,
    'The received file type attribute is ASCII, this file type will be used.');
                        end;
                     when ('B')
                        do;
                           rec_file_type = binary_ft;   /* BINARY file. */
                          call log_info (packet_log,
  'The received file type attribute is BINARY, this file type will be used.');
                       end;
                     when ('I')
                        do;
                           rec_file_type = binary_ft; /* IMAGE file (BINARY). */
                          call log_info (packet_log,
'The received file type attribute is IMAGE, but BINARY file type will be used.'
                                          );
                       end;
                     otherwise
                       do;
                          rec_file_type = illegal_ft;  /* ILLEGAL file type. */
                           call log_info (packet_log,
                               'The received file type attribute is ILLEGAL.');
                           call log_info (packet_log, 'The file type will be '
               || 'automatically detected, but ASCII will initially be used.');
                        end;
                  end;
                  file_type = rec_file_type;
               end;
         otherwise
           found = found - 1;        /* Didn't find one we wanted. */
      end;
      found = found + 1;        /* Assume that we did find one. */
   end;
   return;
   end;          /* Decode_attrs */
   end;       /* Rec_switch */

------------END OF CODE-----------