home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / ucsdappleii / sender.text < prev    next >
Text File  |  1986-04-07  |  12KB  |  377 lines
  1. (* >>>> SENDER.TEXT  ***************************************************)
  2.  
  3. (*$I-*)
  4. (*$R-*)
  5. (*$S+*)
  6. (*$V-*)
  7.  
  8. UNIT sender;    INTRINSIC CODE 26   ;
  9.  
  10. INTERFACE
  11.  
  12. USES  kermglob,
  13.       kermutil,
  14.       kermpack;
  15.  
  16. PROCEDURE sendsw( VAR send_ok: BOOLEAN );
  17.  
  18.  
  19. IMPLEMENTATION
  20.  
  21.  
  22. PROCEDURE  sendsw{ var send_ok : boolean };
  23.  
  24. VAR size, numtry, spnum, rpnum, len : INTEGER;
  25.     ch : CHAR;
  26.     leg_fname : STRING;
  27.     ready : boolean;
  28.  
  29.  
  30.  
  31. FUNCTION  openfile : BOOLEAN;
  32.  
  33. (* resets file & gets past first 2 blocks in case of textfile *)
  34.  
  35. var b : integer;
  36.  
  37. begin
  38.   reset( apple_file,  xfile_name );
  39.   io_status := ioresult;
  40.   if io_status = 0 then
  41.     begin
  42.       if text_file then
  43.         b := blockread( apple_file, filebuf[1], 2 );
  44.         { for a textfile skip past the first two blocks }
  45.         io_status := ioresult;
  46.         bufend := 0;
  47.         bufpos := 1;
  48.     end;
  49.   openfile := ( io_status = 0 );
  50.  
  51. end; { open_file }
  52.  
  53.  
  54. PROCEDURE legalize( var fn : string );
  55.  
  56.  make filename acceptable to host 
  57.  filename is already uppercase and cannot contain a ':' as last char. 
  58.  
  59. var i, point_pos, len : integer;
  60.  
  61. begin
  62.   delete( fn, 1, pos( ':', fn ) );   { strip off volumename }
  63.   len := length( fn );
  64.   i := 1; point_pos := 1;
  65.   repeat
  66.     if fn[i] = '.' then point_pos := i; { save last occurrence of '.' }
  67.     if not ( fn[i] in [ '0'..'9', 'A'..'Z' ] )  then fn[i] := 'X';
  68.     { replace every non alphanumeric character with a 'X' }
  69.     i := i + 1;
  70.   until i > len;
  71.   if point_pos > 1 then fn[point_pos] := '.';
  72.   { restore last encountered '.', except when '.' was in first position }
  73. end; { legalize }
  74.  
  75.  
  76.  
  77.  
  78. FUNCTION sinit: char;
  79.  
  80. (* send init packet & receive other side's *)
  81.  
  82. begin
  83.   sinit := 's';    { default state remains 's' }
  84.   if debug then debugwrite('sinit');
  85.   if interrupt(int_key) or (num_try > init_try) then
  86.     begin
  87.       sinit := 'a';
  88.       send_errpack( spnum );
  89.       exit( sinit )
  90.     end;
  91.   num_try := num_try + 1;
  92.   spar;
  93.   refresh_screen( numtry, spnum );
  94.   spack( 'S', spnum, 10 );
  95.   unitclear( inport );            { clear remin buffer }
  96.   ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  97.   if debug then ack_write(  ch, len, rpnum, recpkt );
  98.   if ch = 'Y' then begin
  99.                      if spnum <> rpnum then exit( sinit );  { stay in 's' }
  100.                      rpar;  { get other side init package }
  101.                      if xeol_char = chr(0) then xeol_char := eoln_char;
  102.                      if quote= chr(0) then quote:= my_quote;
  103.                      if xtime= 0 then xtime:= my_time;
  104.                      if xtime>32 then xtime:= 31;
  105.                      { use my parameters if other side did not specify them }
  106.                      if text_file then ctlq_set := ctl_set + [quote] - [chr(0)]
  107.                                   else
  108.                      ctlq_set := ctl_set + [quote,chr(128)..chr(159),chr(255)];
  109.                      { for image transfer add msbit control chars to set }
  110.                      numtry := 0;
  111.                      spnum := 1;
  112.                      sinit := 'f';  { go to next state }
  113.                    end  { then }
  114.               else if ( ch <> 'N' ) and ( ch <> '@' ) then
  115.                 begin
  116.                   sinit := 'a';   { for nack or receive failure stay in 's' }
  117.                                   { for every other state : abort }
  118.                   if ch = 'E' then error( recpkt, len );
  119.                 end;  { else }
  120. end; (* sinit *)
  121.  
  122.  
  123.  
  124.  
  125. FUNCTION sdata: char;
  126.  
  127. (* send file data *)
  128.  
  129. begin
  130.   if debug then debug_write( 'sdata' );
  131.   if text_file then size := bufill_t
  132.                else size := bufill_i;
  133.   if io_status <> 0 then begin
  134.                            io_error( io_status );
  135.                            send_errpack( spnum );
  136.                            sdata := 'a';
  137.                            exit( sdata );
  138.                          end;
  139.   while ( currstate = 'd' ) do
  140.     begin
  141.       if interrupt(int_key) or (numtry > maxtry) then
  142.         begin
  143.           sdata := 'a';
  144.           send_errpack( spnum );
  145.           exit( sdata )
  146.         end;
  147.       numtry := numtry + 1;
  148.       refresh_screen( numtry, spnum );
  149.       spack( 'D', spnum, size );
  150.       unitclear( inport );
  151.       ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  152.       if debug then ack_write( ch, len, rpnum, recpkt );
  153.       if ch = 'N'
  154.         then if ((spnum+1) mod 64 ) <> rpnum
  155.                then ch := '@'   { if a nack and not the right num: stay in 'd'}
  156.                else begin
  157.                       rpnum := (rpnum+63) mod 64;  { if a nack for the next }
  158.                       ch := 'Y';                   { packet: same as ack for}
  159.                     end;   { this packet: indicate an ack. }
  160.       if ch = 'Y'
  161.         then begin
  162.                if spnum = rpnum   { right ack received }
  163.                  then begin
  164.                         if text_file then size := bufill_t
  165.                                      else size := bufill_i;
  166.                         if io_status <> 0
  167.                           then begin
  168.                                  io_error( io_status );
  169.                                  send_errpack( spnum );
  170.                                  sdata := 'a';
  171.                                  exit( sdata );
  172.                                end;
  173.                         if size = at_eof then currstate := 'z';
  174.                         spnum := (spnum+65) mod 64;
  175.                         numtry := 0;
  176.                         { go to next state if data is exhausted, else }
  177.                         { stay in the same state and send next packet }
  178.                       end;
  179.               end
  180.          else if ch <> '@'
  181.                 then begin
  182.                        currstate := 'a';
  183.                        if ch = 'E' then error( recpkt, len );
  184.                      end;
  185.     end;  { while }
  186.   sdata := currstate;
  187. end; (* sdata *)
  188.  
  189.  
  190.  
  191.  
  192. FUNCTION sfile: char;
  193.  
  194. (* send file header *)
  195.  
  196. begin
  197.   sfile := 'f';
  198.   if debug then debugwrite('sfile');
  199.   if interrupt(int_key) or ( numtry > maxtry ) then
  200.     begin
  201.       sfile := 'a';
  202.       send_errpack( spnum );
  203.       exit( sfile )
  204.     end;
  205.   numtry := numtry + 1;
  206.   len := length( leg_fname );
  207.   moveleft( leg_fname[1], packet[4], len ); (* move filename into  packet *)
  208.   gotoxy( filepos, fileline );
  209.   write( xfile_name, ' ==> ', leg_fname );
  210.   refresh_screen( numtry, spnum );
  211.   spack( 'F', spnum , len + 4 );          (* send file header packet *)
  212.   unitclear( inport );
  213.   ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  214.   if debug then ack_write( ch, len, rpnum, recpkt );
  215.   if ch = 'N' then begin
  216.                      if ((spnum + 1 ) mod 64) <> rpnum
  217.                        then exit( sfile )  { a nack for the next packet is an }
  218.                        else begin          { ack for the current packet       }
  219.                               rpnum := (rpnum+63) mod 64; { r = r - 1 }
  220.                               ch := 'Y';
  221.                             end;
  222.                    end;
  223.    if ch = 'Y' then begin
  224.                       if spnum <> rpnum then exit( sfile );  { stay in 'f' }
  225.                       numtry := 0;
  226.                       spnum := ( spnum + 65 ) mod 64; { s = s + 1 }
  227.                       sfile := 'd';  { go to next state }
  228.                     end
  229.                 else if ch <> '@' then begin
  230.                                          sfile := 'a';
  231.                                          if ch = 'E' then error( recpkt, len );
  232.                                        end;
  233.                { for rec. failure stay in 'f', other states : abort }
  234. end; (* sfile *)
  235.  
  236.  
  237.  
  238.  
  239. FUNCTION seof: char;
  240.  
  241. (* send end of file *)
  242.  
  243. begin
  244.   seof := 'z';
  245.   if debug then debugwrite('seof');
  246.   if interrupt(int_key) or (numtry > maxtry) then (*if too many tries, give up*)
  247.     begin
  248.       seof := 'a';
  249.       send_errpack( spnum );
  250.       exit(seof)
  251.     end;
  252.   numtry := numtry + 1;
  253.   refresh_screen( numtry, spnum );
  254.   spack( 'Z', spnum, 4 );    (* send end of file packet *)
  255.   unitclear( inport );
  256.   ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  257.   if debug then ack_write( ch, len, rpnum, recpkt );
  258.   if ch = 'N' then
  259.     if ((spnum+1) mod 64) <> rpnum then exit( seof )
  260.                                    else begin
  261.                                           rpnum := (rpnum+63) mod 64;
  262.                                           ch := 'Y';
  263.                                         end;
  264.   if ch = 'Y'
  265.     then begin
  266.            if spnum <> rpnum then exit( seof )
  267.                              else begin
  268.                                     numtry := 0;
  269.                                     spnum := (spnum+65) mod 64;
  270.                                     seof := 'b';
  271.                                   end;
  272.          end
  273.     else if ch <> '@' then begin
  274.                              seof := 'a';
  275.                              if ch = 'E' then error( recpkt, len );
  276.                            end;
  277. end; (* seof *)
  278.  
  279.  
  280.  
  281. FUNCTION sbreak: char;
  282.  
  283. (* send break (end of transmission) *)
  284.  
  285. begin
  286.   sbreak := 'b';
  287.   if debug then debugwrite('sbreak');
  288.   if interrupt(int_key) or (numtry > maxtry) then (*if too many tries, give up*)
  289.     begin
  290.       sbreak := 'a';
  291.       send_errpack( spnum );
  292.       exit(sbreak)
  293.     end;
  294.   numtry := numtry + 1;
  295.   refresh_screen(numtry, spnum);
  296.   spack( 'B', spnum, 4);    (* send end of file packet *)
  297.   unitclear( inport );
  298.   ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  299.   if debug then ack_write( ch, len, rpnum, recpkt );
  300.   if ch = 'N' then
  301.     if ((spnum+1) mod 64) <> rpnum then exit( sbreak )
  302.                                    else begin
  303.                                           rpnum := (rpnum+63) mod 64;
  304.                                           ch := 'Y';
  305.                                         end;
  306.   if ch = 'Y'
  307.     then begin
  308.            if spnum <> rpnum then exit( sbreak );
  309.            sbreak := 'c';
  310.          end
  311.     else if ch <> '@' then begin
  312.                              sbreak := 'a';
  313.                              if ch = 'E' then error( recpkt, len );
  314.                            end;
  315. end; (* sbreak *)
  316.  
  317.  
  318.  
  319.    PROCEDURE sendsw   
  320.  
  321. (* state table switcher for sending *)
  322.  
  323. begin (* sendsw *)
  324.   unitclear( inport );
  325.   write_screen('Sending ');
  326.   if text_file and ( pos( '.TEXT', xfile_name ) = 0 )
  327.     then xfile_name := concat( xfile_name, '.TEXT' );
  328.   gotoxy( filepos, fileline ); write( xfile_name );
  329.   if not openfile then
  330.     begin
  331.       io_error(io_status);
  332.       send_ok := false;
  333.       exit(sendsw)
  334.     end;
  335.   leg_fname := xfile_name;
  336.   legalize( leg_fname );
  337.   if not text_file then check_apple_char( no_mask_msbit_remin );
  338.   { for image transfer leave msbit unchanged }
  339.   check_apple_char( sfb_char );
  340.   { restore action of ^S, ^F, ^@ keys during send }
  341.   currstate := 's';
  342.   spnum:= 0;       (* set packet # *)
  343.   numtry := 0;
  344.   ready := false;
  345.   while not ready do
  346.     begin
  347.       if currstate in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
  348.         case currstate of
  349.             'd': currstate := sdata;
  350.             'f': currstate := sfile;
  351.             'z': currstate := seof;
  352.             's': currstate := sinit;
  353.             'b': currstate := sbreak;
  354.             'c': begin
  355.                    send_ok := true;
  356.                    ready := true;
  357.                  end; (* case c *)
  358.             'a': begin
  359.                    send_ok := false;
  360.                    ready := true;
  361.                  end (* case a *)
  362.           end (* case *)
  363.       else (* state not in legal states *)
  364.         begin
  365.           send_ok := false;
  366.           ready := true;
  367.         end (* else *)
  368.     end; { of while }
  369.   check_apple_char( mask_msbit_remin );
  370.   check_apple_char( no_sfb_char );
  371. end; (* sendsw *)
  372.  
  373.  
  374. begin
  375. end. { sender }
  376.  
  377.