Columbia Kermit/kermit.zip/pub/ucsdappleii/receiver.text

Text File | 2020-01-01 | 13KB | 424 lines

(* >>>> RECEIVER.TEXT  *************************************************)

$I-
$R-
$S+
$V-

UNIT receiver;    INTRINSIC CODE 25   ;

INTERFACE

USES  kermglob,
      kermutil,
      kermpack;


PROCEDURE recsw( VAR rec_ok: BOOLEAN );


IMPLEMENTATION


PROCEDURE recsw{ var rec_ok: boolean };

var  oldtry, numtry, spnum, rpnum, len : integer;
     ch : char;
     host_fname : string;
     ready : boolean;



FUNCTION open_file( var fn : string ) : boolean;

var i : integer;

begin
  rewrite( rec_file , concat( prefix_vol, fn ) );
  iostatus := ioresult;
  if iostatus = 0 then
      if text_file then begin
                          fillchar( filebuf[1], page_size, chr(0) );
                          i := blockwrite( rec_file, filebuf[1], 2);
                          iostatus := ioresult;
                          if i <> 2 then io_status := 8;
                        end;
  open_file := ( io_status = 0 );
  bufpos := 1;
  crpos  := page_size - 1;
  dle_flag := false;
end;   { open_file }


FUNCTION close_file : boolean;

var file_end, num_block, i : integer;

begin
  if text_file then begin
                      file_end := page_size;
                      num_block := 2;
                    end
               else begin
                      file_end := blk_size;
                      num_block := 1;
                    end;
  fillchar( filebuf[bufpos], (file_end - bufpos), chr(0) );
  i := blockwrite( rec_file, filebuf[1], num_block );
  iostatus := ioresult;
  if i <> num_block then io_status := 8;
  close_file := ( io_status = 0 );
  close( rec_file, lock );
end;  { close_file }




FUNCTION exist( var fn : string ) : boolean;

begin
  reset( rec_file, concat( prefix_vol, fn ) );
  exist := ( ioresult = 0 );
  close( rec_file )
end; { exist }


PROCEDURE check_name( var fn : string );

var ch : char;
     i : integer;

begin
  i := 1;
  while ( i <= length( fn ) ) and exist( fn ) do
    begin
      ch := 'A';
      while ( ch in [ 'A'..'Z' ] ) and exist( fn ) do
        begin
          fn[ i ] := ch;
          ch := succ( ch );
        end;
      i := i + 1;
    end;
end;  { check_name }


PROCEDURE make_name( var rpkt: packettype; var fn : string; len : integer );

 change the received filename into a legal apple ucsd filename

var i : integer;

begin
  host_fname[0] := chr( min( 80, len ) );
  moveleft( rpkt[0], host_fname[1], min( 80, len ) );
  fn := copy( host_fname, 1, min( 15, len ) );
  { take left part of received filename, max 15 long }
  uppercase( fn );
  if  text_file
    then begin
           if ( length(fn) < 5 ) or ( pos('.TEXT',fn) <> length(fn) - 4 )
             then begin
                    if length(fn) > 10 then fn := copy(fn,1,10);
                    fn := concat( fn, '.TEXT' );
                  end;
         end;
  { add .TEXT if the expected file is a textfile }
  for i := 1 to length( fn ) do
    if fn[i] in [ chr(0)..chr(31),':','$',',','=','?','[' ] then fn[i] := 'X';
  { replace apple ucsd incompatible char's in filename with 'X' }
  if fwarn then checkname( fn );
end;  { make_name }




FUNCTION rdata: char;

(* send file data *)


begin
  if debug then debug_write( 'rdata' );
  repeat
    currstate := 'a';
    if interrupt(int_key) or (numtry > maxtry) then
      begin
        rdata := 'a';
        send_errpack( spnum );
        exit( rdata )
      end;
    num_try := num_try + 1;
    unitclear( inport );
    ch := rpack(spnum, len, rpnum, recpkt, xtime, sohchar );{ receive a packet }
    refresh_screen( numtry, spnum );
    if debug then ack_write( ch, len, rpnum, recpkt );
    case ch of
    'D' : { got data packet. if wrong packet number : abort. }
          { if previous packet : ack it again but not more than maxtry times }
          begin
            if spnum = rpnum
              then begin
                     if text_file then bufemp_t( len )
                                  else bufemp_i( len );
                     if io_status <> 0
                       then begin
                              io_error( io_status );
                              send_errpack( spnum );
                            end
                       else begin
                              spack( 'Y', spnum, 4 );
                              numtry := 0;
                              spnum := ( spnum + 65 ) mod 64;
                              currstate := 'd';
                            end;
                   end
              else begin
                     if ( (spnum-1) mod 64 ) = rpnum
                       then begin
                              if oldtry > maxtry then begin
                                                        rdata := 'a';
                                                        exit( rdata );
                                                      end;
                              spack( 'Y', rpnum, 4 );
                              numtry := 0;
                              oldtry := oldtry + 1;
                              currstate := 'd';
                            end;
                   end;
          end;  { case 'D' }
    'F' : { got file header packet again: if it was previous packet }
          { ack it again but not more than maxtry times. any other  }
          { packet number : abort }
          begin
            if ( (spnum-1) mod 64 ) = rpnum
              then begin
                     if oldtry > maxtry then begin
                                               rdata := 'a';
                                               exit( rdata );
                                             end;
                     spack ( 'Y', rpnum, 4 );
                     numtry := 0;
                     oldtry := oldtry + 1;
                     currstate := 'd';
                   end;
          end;  { case 'F' }
    'E' : { error packet received : write it to screen and abort }
          error( recpkt, len );
    '@' : { in case of receive failure send nack and stay in this state }
          begin
            spack( 'N', spnum, 4 );
            currstate := 'd';
          end;
    'Z' : { end-of-file packet received : if it has the right packet number }
          { close the current file and go to rfile state to check whether   }
          { another file haeder packet is coming or an end-of-transmission  }
          { packet. }
          begin
            if spnum = rpnum
              then begin
                     if debug then debugwrite( 'reof' );
                     if not close_file
                       then begin
                              io_error( io_status );
                              send_errpack( spnum );
                            end
                       else begin
                              spack( 'Y', spnum, 4 );
                              spnum := ( spnum + 65 ) mod 64;
                              numtry := 0;
                              oldtry := 0;
                              currstate := 'f';
                            end;
                   end;
          end;  { case 'Z' }
    end;  { case ch }
  until (currstate <> 'd');
  rdata := currstate
end;  { rdata }




FUNCTION rfile: char;

(* receive file header *)

begin (* rfile *)
  currstate := 'a';                 (* set default state for rfile to abort *)
  if debug then debug_write( 'rfile' );
  if interrupt(int_key) or (numtry > maxtry) then
    begin
      rfile := 'a';
      send_errpack( spnum );
      exit( rfile )
    end;
  numtry := numtry + 1;
  unitclear( inport );
  ch := rpack(spnum, len, rpnum, recpkt, xtime, sohchar); (* receive a packet *)
  refresh_screen( numtry, spnum );
  if debug then ack_write( ch, len, rpnum, recpkt );

  case ch of
  'S' : { maybe our ack for packet 0 was lost: send it again, but not more }
        { than maxtry times }
        begin
          if ((spnum-1) mod 64) = rpnum
            then begin
                   if oldtry > maxtry then begin rfile := 'a'; exit(rfile) end;
                   spar;
                   spack( 'Y', rpnum, 10 );
                   numtry := 0;
                   oldtry := oldtry + 1;
                   currstate := 'f';   { stay in same state }
                 end;                  { for any other packet num: abort }
        end;  { case 'S' }
  'Z' : { maybe our ack for the eof packet was lost: ack it again }
        begin
          if ((spnum-1) mod 64) = rpnum
            then begin
                   if oldtry > maxtry then begin rfile := 'a'; exit(rfile) end;
                   spack( 'Y', rpnum, 4 );
                   numtry := 0;
                   oldtry := oldtry + 1;
                   currstate := 'f';     { stay in same state }
                 end;                    { for any other packet num: abort }
        end;  { case 'Z' }
  'B' : { if the right packet num for the eot packet then ack it and go }
        { to the complete state; else abort }
        begin
          if spnum = rpnum
            then begin
                   if debug then debug_write( 'rbreak' );
                   spack( 'Y', spnum, 4 );
                   currstate := 'c';
                 end;                { if not the right num: abort }
        end;  { case 'B' }
  '@' : { in case of receive failure send nack and stay in this state }
        begin
          spack( 'N', spnum, 4 );
          currstate := 'f';
        end;  { case '@' }
  'E' : { error packet received: write it on screen and abort }
        error( recpkt, len );
  'F' : { fileheader packet received which is what we really want: }
        { if not the right packetnumber : abort }
        { if a new file cannot be opened : send error packet to host and abort}
        { if new file is opened : go to receive data state }
        begin
          if spnum = rpnum
            then begin
                   makename( recpkt, xfilename, len );
                   gotoxy( file_pos, file_line );
                   write( host_fname, ' ==> ', concat(prefix_vol, xfilename));
                   if not open_file( xfilename )
                     then begin
                            io_error( io_status );
                            send_errpack( spnum );
                          end
                     else begin
                            spack( 'Y', spnum, 4 );
                            numtry := 0;
                            oldtry := 0;
                            spnum := ( spnum + 65 ) mod 64;
                            currstate := 'd';
                          end;
                 end;
        end; { case 'F' }
  end;  { case ch }
  rfile := currstate;
end; (* rfile *)




FUNCTION rinit: char;

(* receive initialization *)

begin
  rinit := 'r';   { stay in 'r' in case reception failed: ptype = '@'  }
  if debug then debug_write( 'rinit' );
  if interrupt(int_key) or (numtry > init_try) then
    begin
      rinit := 'a';
      send_errpack( spnum );
      exit( rinit )
    end;

  { too many tries : abort. inittry is five times maxtry in case other }
  { side waits before starting to send.                                }

  numtry := numtry + 1;
  unitclear( inport );
  ch := rpack(spnum, len, rpnum, recpkt, mytime, sohchar);(* receive a packet *)
  refresh_screen(num_try, spnum);
  if debug then ack_write( ch, len, rpnum, recpkt );

  if (ch = 'S') then                        (* send init packet *)
    begin
      rpar;                         (* get other side's init data *)
      spar;                         (* fill packet with my init data *)
      numtry := 0;                          (* start a new counter *)
      oldtry := 0;                          (* start oldtry for rfile *)
      spack( 'Y', spnum, 10 );       (* send my init parameters *)
      spnum := (spnum + 65) mod 64;         (* bump packet number *)
      rinit := 'f';                         (* enter file send state *)
    end { if 'S' }
  else if (ch <> '@') then                  (* abort for every other packet *)
         begin                              (* except when rec failed, then *)
           rinit := 'a';
           if ch = 'E' then error( recpkt, len )
         end
         else spack( 'N', spnum, 4);        (* send a NACK packet *)
end; (* rinit *)


   PROCEDURE RECSW

(* state table switcher for receiving packets *)


begin (* recsw *)
  unitclear(inport);
  writescreen('Receiving');
  if not text_file then check_apple_char( no_mask_msbit_remin );
  { for image transfer leave msbit unchanged }
  check_apple_char( sfb_char );
  { restore action of ^S, ^F, ^@ keys during receive }
  ready := false;
  currstate := 'r';            (* initial state is send *)
  spnum := 0;                  (* set packet # *)
  numtry := 0;                 (* no tries yet *)

  while not ready do
    begin
      if currstate in ['d', 'f', 'r', 'c', 'a'] then
        case currstate of
          'd': currstate := rdata;
          'f': currstate := rfile;
          'r': currstate := rinit;
          'c': begin
                 rec_ok := true;
                 ready := true;
               end; (* case c *)
          'a': begin
                 rec_ok := false;
                 ready := true;
               end (* case a *)
        end (* case *)
      else (* state not in legal states *)
      begin
        rec_ok := false;
        ready := true;
      end; (* else *)
    end; { while }
  check_apple_char( mask_msbit_remin );
  check_apple_char( no_sfb_char );
end; (* recsw *)


begin
end. { receiver }