home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / ucsdappleii / receiver.text < prev    next >
Text File  |  2020-01-01  |  13KB  |  424 lines

  1. (* >>>> RECEIVER.TEXT  *************************************************)
  2.  
  3. $I-
  4. $R-
  5. $S+
  6. $V-
  7.  
  8. UNIT receiver;    INTRINSIC CODE 25   ;
  9.  
  10. INTERFACE
  11.  
  12. USES  kermglob,
  13.       kermutil,
  14.       kermpack;
  15.  
  16.  
  17. PROCEDURE recsw( VAR rec_ok: BOOLEAN );
  18.  
  19.  
  20. IMPLEMENTATION
  21.  
  22.  
  23. PROCEDURE recsw{ var rec_ok: boolean };
  24.  
  25. var  oldtry, numtry, spnum, rpnum, len : integer;
  26.      ch : char;
  27.      host_fname : string;
  28.      ready : boolean;
  29.  
  30.  
  31.  
  32. FUNCTION open_file( var fn : string ) : boolean;
  33.  
  34. var i : integer;
  35.  
  36. begin
  37.   rewrite( rec_file , concat( prefix_vol, fn ) );
  38.   iostatus := ioresult;
  39.   if iostatus = 0 then
  40.       if text_file then begin
  41.                           fillchar( filebuf[1], page_size, chr(0) );
  42.                           i := blockwrite( rec_file, filebuf[1], 2);
  43.                           iostatus := ioresult;
  44.                           if i <> 2 then io_status := 8;
  45.                         end;
  46.   open_file := ( io_status = 0 );
  47.   bufpos := 1;
  48.   crpos  := page_size - 1;
  49.   dle_flag := false;
  50. end;   { open_file }
  51.  
  52.  
  53. FUNCTION close_file : boolean;
  54.  
  55. var file_end, num_block, i : integer;
  56.  
  57. begin
  58.   if text_file then begin
  59.                       file_end := page_size;
  60.                       num_block := 2;
  61.                     end
  62.                else begin
  63.                       file_end := blk_size;
  64.                       num_block := 1;
  65.                     end;
  66.   fillchar( filebuf[bufpos], (file_end - bufpos), chr(0) );
  67.   i := blockwrite( rec_file, filebuf[1], num_block );
  68.   iostatus := ioresult;
  69.   if i <> num_block then io_status := 8;
  70.   close_file := ( io_status = 0 );
  71.   close( rec_file, lock );
  72. end;  { close_file }
  73.  
  74.  
  75.  
  76.  
  77. FUNCTION exist( var fn : string ) : boolean;
  78.  
  79. begin
  80.   reset( rec_file, concat( prefix_vol, fn ) );
  81.   exist := ( ioresult = 0 );
  82.   close( rec_file )
  83. end; { exist }
  84.  
  85.  
  86. PROCEDURE check_name( var fn : string );
  87.  
  88. var ch : char;
  89.      i : integer;
  90.  
  91. begin
  92.   i := 1;
  93.   while ( i <= length( fn ) ) and exist( fn ) do
  94.     begin
  95.       ch := 'A';
  96.       while ( ch in [ 'A'..'Z' ] ) and exist( fn ) do
  97.         begin
  98.           fn[ i ] := ch;
  99.           ch := succ( ch );
  100.         end;
  101.       i := i + 1;
  102.     end;
  103. end;  { check_name }
  104.  
  105.  
  106. PROCEDURE make_name( var rpkt: packettype; var fn : string; len : integer );
  107.  
  108.  change the received filename into a legal apple ucsd filename 
  109.  
  110. var i : integer;
  111.  
  112. begin
  113.   host_fname[0] := chr( min( 80, len ) );
  114.   moveleft( rpkt[0], host_fname[1], min( 80, len ) );
  115.   fn := copy( host_fname, 1, min( 15, len ) );
  116.   { take left part of received filename, max 15 long }
  117.   uppercase( fn );
  118.   if  text_file
  119.     then begin
  120.            if ( length(fn) < 5 ) or ( pos('.TEXT',fn) <> length(fn) - 4 )
  121.              then begin
  122.                     if length(fn) > 10 then fn := copy(fn,1,10);
  123.                     fn := concat( fn, '.TEXT' );
  124.                   end;
  125.          end;
  126.   { add .TEXT if the expected file is a textfile }
  127.   for i := 1 to length( fn ) do
  128.     if fn[i] in [ chr(0)..chr(31),':','$',',','=','?','[' ] then fn[i] := 'X';
  129.   { replace apple ucsd incompatible char's in filename with 'X' }
  130.   if fwarn then checkname( fn );
  131. end;  { make_name }
  132.  
  133.  
  134.  
  135.  
  136. FUNCTION rdata: char;
  137.  
  138. (* send file data *)
  139.  
  140.  
  141. begin
  142.   if debug then debug_write( 'rdata' );
  143.   repeat
  144.     currstate := 'a';
  145.     if interrupt(int_key) or (numtry > maxtry) then
  146.       begin
  147.         rdata := 'a';
  148.         send_errpack( spnum );
  149.         exit( rdata )
  150.       end;
  151.     num_try := num_try + 1;
  152.     unitclear( inport );
  153.     ch := rpack(spnum, len, rpnum, recpkt, xtime, sohchar );{ receive a packet }
  154.     refresh_screen( numtry, spnum );
  155.     if debug then ack_write( ch, len, rpnum, recpkt );
  156.     case ch of
  157.     'D' : { got data packet. if wrong packet number : abort. }
  158.           { if previous packet : ack it again but not more than maxtry times }
  159.           begin
  160.             if spnum = rpnum
  161.               then begin
  162.                      if text_file then bufemp_t( len )
  163.                                   else bufemp_i( len );
  164.                      if io_status <> 0
  165.                        then begin
  166.                               io_error( io_status );
  167.                               send_errpack( spnum );
  168.                             end
  169.                        else begin
  170.                               spack( 'Y', spnum, 4 );
  171.                               numtry := 0;
  172.                               spnum := ( spnum + 65 ) mod 64;
  173.                               currstate := 'd';
  174.                             end;
  175.                    end
  176.               else begin
  177.                      if ( (spnum-1) mod 64 ) = rpnum
  178.                        then begin
  179.                               if oldtry > maxtry then begin
  180.                                                         rdata := 'a';
  181.                                                         exit( rdata );
  182.                                                       end;
  183.                               spack( 'Y', rpnum, 4 );
  184.                               numtry := 0;
  185.                               oldtry := oldtry + 1;
  186.                               currstate := 'd';
  187.                             end;
  188.                    end;
  189.           end;  { case 'D' }
  190.     'F' : { got file header packet again: if it was previous packet }
  191.           { ack it again but not more than maxtry times. any other  }
  192.           { packet number : abort }
  193.           begin
  194.             if ( (spnum-1) mod 64 ) = rpnum
  195.               then begin
  196.                      if oldtry > maxtry then begin
  197.                                                rdata := 'a';
  198.                                                exit( rdata );
  199.                                              end;
  200.                      spack ( 'Y', rpnum, 4 );
  201.                      numtry := 0;
  202.                      oldtry := oldtry + 1;
  203.                      currstate := 'd';
  204.                    end;
  205.           end;  { case 'F' }
  206.     'E' : { error packet received : write it to screen and abort }
  207.           error( recpkt, len );
  208.     '@' : { in case of receive failure send nack and stay in this state }
  209.           begin
  210.             spack( 'N', spnum, 4 );
  211.             currstate := 'd';
  212.           end;
  213.     'Z' : { end-of-file packet received : if it has the right packet number }
  214.           { close the current file and go to rfile state to check whether   }
  215.           { another file haeder packet is coming or an end-of-transmission  }
  216.           { packet. }
  217.           begin
  218.             if spnum = rpnum
  219.               then begin
  220.                      if debug then debugwrite( 'reof' );
  221.                      if not close_file
  222.                        then begin
  223.                               io_error( io_status );
  224.                               send_errpack( spnum );
  225.                             end
  226.                        else begin
  227.                               spack( 'Y', spnum, 4 );
  228.                               spnum := ( spnum + 65 ) mod 64;
  229.                               numtry := 0;
  230.                               oldtry := 0;
  231.                               currstate := 'f';
  232.                             end;
  233.                    end;
  234.           end;  { case 'Z' }
  235.     end;  { case ch }
  236.   until (currstate <> 'd');
  237.   rdata := currstate
  238. end;  { rdata }
  239.  
  240.  
  241.  
  242.  
  243. FUNCTION rfile: char;
  244.  
  245. (* receive file header *)
  246.  
  247. begin (* rfile *)
  248.   currstate := 'a';                 (* set default state for rfile to abort *)
  249.   if debug then debug_write( 'rfile' );
  250.   if interrupt(int_key) or (numtry > maxtry) then
  251.     begin
  252.       rfile := 'a';
  253.       send_errpack( spnum );
  254.       exit( rfile )
  255.     end;
  256.   numtry := numtry + 1;
  257.   unitclear( inport );
  258.   ch := rpack(spnum, len, rpnum, recpkt, xtime, sohchar); (* receive a packet *)
  259.   refresh_screen( numtry, spnum );
  260.   if debug then ack_write( ch, len, rpnum, recpkt );
  261.  
  262.   case ch of
  263.   'S' : { maybe our ack for packet 0 was lost: send it again, but not more }
  264.         { than maxtry times }
  265.         begin
  266.           if ((spnum-1) mod 64) = rpnum
  267.             then begin
  268.                    if oldtry > maxtry then begin rfile := 'a'; exit(rfile) end;
  269.                    spar;
  270.                    spack( 'Y', rpnum, 10 );
  271.                    numtry := 0;
  272.                    oldtry := oldtry + 1;
  273.                    currstate := 'f';   { stay in same state }
  274.                  end;                  { for any other packet num: abort }
  275.         end;  { case 'S' }
  276.   'Z' : { maybe our ack for the eof packet was lost: ack it again }
  277.         begin
  278.           if ((spnum-1) mod 64) = rpnum
  279.             then begin
  280.                    if oldtry > maxtry then begin rfile := 'a'; exit(rfile) end;
  281.                    spack( 'Y', rpnum, 4 );
  282.                    numtry := 0;
  283.                    oldtry := oldtry + 1;
  284.                    currstate := 'f';     { stay in same state }
  285.                  end;                    { for any other packet num: abort }
  286.         end;  { case 'Z' }
  287.   'B' : { if the right packet num for the eot packet then ack it and go }
  288.         { to the complete state; else abort }
  289.         begin
  290.           if spnum = rpnum
  291.             then begin
  292.                    if debug then debug_write( 'rbreak' );
  293.                    spack( 'Y', spnum, 4 );
  294.                    currstate := 'c';
  295.                  end;                { if not the right num: abort }
  296.         end;  { case 'B' }
  297.   '@' : { in case of receive failure send nack and stay in this state }
  298.         begin
  299.           spack( 'N', spnum, 4 );
  300.           currstate := 'f';
  301.         end;  { case '@' }
  302.   'E' : { error packet received: write it on screen and abort }
  303.         error( recpkt, len );
  304.   'F' : { fileheader packet received which is what we really want: }
  305.         { if not the right packetnumber : abort }
  306.         { if a new file cannot be opened : send error packet to host and abort}
  307.         { if new file is opened : go to receive data state }
  308.         begin
  309.           if spnum = rpnum
  310.             then begin
  311.                    makename( recpkt, xfilename, len );
  312.                    gotoxy( file_pos, file_line );
  313.                    write( host_fname, ' ==> ', concat(prefix_vol, xfilename));
  314.                    if not open_file( xfilename )
  315.                      then begin
  316.                             io_error( io_status );
  317.                             send_errpack( spnum );
  318.                           end
  319.                      else begin
  320.                             spack( 'Y', spnum, 4 );
  321.                             numtry := 0;
  322.                             oldtry := 0;
  323.                             spnum := ( spnum + 65 ) mod 64;
  324.                             currstate := 'd';
  325.                           end;
  326.                  end;
  327.         end; { case 'F' }
  328.   end;  { case ch }
  329.   rfile := currstate;
  330. end; (* rfile *)
  331.  
  332.  
  333.  
  334.  
  335. FUNCTION rinit: char;
  336.  
  337. (* receive initialization *)
  338.  
  339. begin
  340.   rinit := 'r';   { stay in 'r' in case reception failed: ptype = '@'  }
  341.   if debug then debug_write( 'rinit' );
  342.   if interrupt(int_key) or (numtry > init_try) then
  343.     begin
  344.       rinit := 'a';
  345.       send_errpack( spnum );
  346.       exit( rinit )
  347.     end;
  348.  
  349.   { too many tries : abort. inittry is five times maxtry in case other }
  350.   { side waits before starting to send.                                }
  351.  
  352.   numtry := numtry + 1;
  353.   unitclear( inport );
  354.   ch := rpack(spnum, len, rpnum, recpkt, mytime, sohchar);(* receive a packet *)
  355.   refresh_screen(num_try, spnum);
  356.   if debug then ack_write( ch, len, rpnum, recpkt );
  357.  
  358.   if (ch = 'S') then                        (* send init packet *)
  359.     begin
  360.       rpar;                         (* get other side's init data *)
  361.       spar;                         (* fill packet with my init data *)
  362.       numtry := 0;                          (* start a new counter *)
  363.       oldtry := 0;                          (* start oldtry for rfile *)
  364.       spack( 'Y', spnum, 10 );       (* send my init parameters *)
  365.       spnum := (spnum + 65) mod 64;         (* bump packet number *)
  366.       rinit := 'f';                         (* enter file send state *)
  367.     end { if 'S' }
  368.   else if (ch <> '@') then                  (* abort for every other packet *)
  369.          begin                              (* except when rec failed, then *)
  370.            rinit := 'a';
  371.            if ch = 'E' then error( recpkt, len )
  372.          end
  373.          else spack( 'N', spnum, 4);        (* send a NACK packet *)
  374. end; (* rinit *)
  375.  
  376.  
  377.    PROCEDURE RECSW   
  378.  
  379. (* state table switcher for receiving packets *)
  380.  
  381.  
  382. begin (* recsw *)
  383.   unitclear(inport);
  384.   writescreen('Receiving');
  385.   if not text_file then check_apple_char( no_mask_msbit_remin );
  386.   { for image transfer leave msbit unchanged }
  387.   check_apple_char( sfb_char );
  388.   { restore action of ^S, ^F, ^@ keys during receive }
  389.   ready := false;
  390.   currstate := 'r';            (* initial state is send *)
  391.   spnum := 0;                  (* set packet # *)
  392.   numtry := 0;                 (* no tries yet *)
  393.  
  394.   while not ready do
  395.     begin
  396.       if currstate in ['d', 'f', 'r', 'c', 'a'] then
  397.         case currstate of
  398.           'd': currstate := rdata;
  399.           'f': currstate := rfile;
  400.           'r': currstate := rinit;
  401.           'c': begin
  402.                  rec_ok := true;
  403.                  ready := true;
  404.                end; (* case c *)
  405.           'a': begin
  406.                  rec_ok := false;
  407.                  ready := true;
  408.                end (* case a *)
  409.         end (* case *)
  410.       else (* state not in legal states *)
  411.       begin
  412.         rec_ok := false;
  413.         ready := true;
  414.       end; (* else *)
  415.     end; { while }
  416.   check_apple_char( mask_msbit_remin );
  417.   check_apple_char( no_sfb_char );
  418. end; (* recsw *)
  419.  
  420.  
  421. begin
  422. end. { receiver }
  423.  
  424.