home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / ucsdterak / sendsw.text < prev    next >
Text File  |  2020-01-01  |  12KB  |  444 lines

  1.  
  2. (* Send Section *)
  3.  
  4. segment procedure sendsw(var send_ok: boolean);
  5.  
  6. var io_status: integer;
  7.  
  8. procedure openfile;
  9.  
  10. (* resets file & gets past first 2 blocks *)
  11.  
  12.   begin
  13.     (*$I-*) (* turn off compiler i/o checking temporarily *)
  14.     reset(oldf,filename);
  15.     (*$I+*) (* turn compiler i/o checking back on *)
  16.     io_status := io_result;
  17.     if (iostatus = 0) then
  18.       if (pos('.TEXT',filename) = length(filename) - 4) then
  19.                                           (* is a text file, so *)
  20.           i := blockread(oldf,filebuf,2); (* skip past 2 block header *)
  21.   end; (* openfile *)
  22.  
  23. function sinit: char;
  24.  
  25. (* send init packet & receive other side's *)
  26.  
  27. var num, len, i: integer;  (* packet number and length *)
  28.     ch: char;
  29.  
  30.   begin
  31.     if debug then
  32.         debugwrite('sinit');
  33.  
  34.     if numtry > maxtry then
  35.       begin
  36.         sinit := 'a';
  37.         exit(sinit)
  38.       end;
  39.  
  40.     num_try := num_try + 1;
  41.     spar(packet);
  42.  
  43.     clear_buf(rq);
  44.  
  45.     refresh_screen(numtry,n);
  46.  
  47.     spack('S',n mod 64,6,packet);
  48.  
  49.     ch := rpack(len,num,recpkt);
  50.  
  51.     if (ch = 'N') then
  52.       begin
  53.         sinit := 's';
  54.         exit(sinit)
  55.       end (* if 'N' *)
  56.     else if (ch = 'Y') then
  57.       begin
  58.         if ((n mod 64) <> num) then       (* not the right ack *)
  59.           begin
  60.             sinit := state;
  61.             exit(sinit)
  62.           end;
  63.         rpar(recpkt);
  64.         if (eol = chr(0)) then   (* if they didn't spec eol *)
  65.             eol := chr(my_eol);    (* use mine *)
  66.         if (quote = chr(0)) then (* if they didn't spec quote *)
  67.             quote := my_quote;     (* use mine *)
  68.         ctl_set := [chr(1)..chr(31),chr(del),quote];
  69.         numtry := 0;
  70.         n := n + 1;              (* increase packet number *)
  71.         sinit := 'f';
  72.         exit(sinit)
  73.       end (* else if 'Y' *)
  74.     else if (ch = 'E') then
  75.       begin
  76.         error(recpkt,len);
  77.         sinit := 'a'
  78.       end (* if 'E' *)
  79.     else if (ch = chr(0)) then
  80.         sinit := state
  81.     else if (ch <> 'N') then
  82.         sinit := 'a'
  83.   end; (* sinit *)
  84.  
  85. function sdata: char;
  86.  
  87. (* send file data *)
  88.  
  89. var num, len: integer;
  90.     ch: char;
  91.     packarray: array[false..true] of packettype;
  92.     sizearray: array[false..true] of integer;
  93.     current: boolean;
  94.     b: boolean;
  95.  
  96. function other(b: boolean): boolean;
  97.  
  98. (* complements a boolean which is used as array index *)
  99.  
  100.   begin
  101.     if b then
  102.         other := false
  103.     else
  104.         other := true
  105.   end; (* other *)
  106.  
  107.   begin
  108.     current := true;
  109.     packarray[current] := packet;
  110.     sizearray[current] := size;
  111.     while (state = 'd') do
  112.       begin
  113.         if (numtry > maxtry) then             (* if too many tries, give up *)
  114.             state := 'a';
  115.  
  116.         b := other(current);
  117.         numtry := numtry + 1;
  118.  
  119.                                           (* send a data packet *)
  120.         spack('D',n mod 64,sizearray[current],packarray[current]);
  121.  
  122.         refresh_screen(numtry,n);
  123.                                           (* set up next packet *)
  124.         sizearray[b] := bufill(packarray[b]);
  125.  
  126.         ch := rpack(len,num,recpkt);      (* receive a packet *)
  127.         if ch = 'N' then                  (* NAK, so just stay in this state *)
  128.             if ((n+1) mod 64 <> num) then (* unless NAK for next, which *)
  129.                 sdata := state
  130.             else                          (* is just like ACK for this packet *)
  131.               begin
  132.                 if num > 0 then
  133.                     num := (num - 1)      (* in which case, decrement num *)
  134.                 else
  135.                     num := 63;
  136.                 ch := 'Y';                (* and indicate an ACK *)
  137.               end; (* else *)
  138.  
  139.         if (ch = 'Y') then
  140.            begin
  141.              if ((n mod 64) <> num) then (* if wrong ACK *)
  142.                begin
  143.                  sdata := state;         (* stay in same state *)
  144.                  exit(sdata);            (* get out of here *)
  145.                end; (* if *)
  146.              if numtry > 1 then
  147.                  clear_buf(rq);          (* if anything in buffer, flush it *)
  148.              numtry := 0;
  149.              n := n + 1;
  150.              current := b;
  151.              if sizearray[current] = ateof then
  152.                  state := 'z'            (* set state to eof *)
  153.              else
  154.                  state := 'd'            (* else stay in data state *)
  155.            end (* if *)
  156.           else if (ch = 'E') then
  157.             begin
  158.               error(recpkt,len);
  159.               state := 'a'
  160.             end (* if 'E' *)
  161.           else if (ch = chr(0)) then      (* receive failure, so stay in d *)
  162.             begin
  163.             end
  164.           else if (ch <> 'N') then
  165.             state := 'a'                  (* on any other goto abort state *)
  166.       end; (* while *)
  167.     size := sizearray[current];
  168.     packet := packarray[current];
  169.     sdata := state
  170.   end; (* sdata *)
  171.  
  172. function sfile: char;
  173.  
  174. (* send file header *)
  175.  
  176. var num, len, i: integer;
  177.     ch: char;
  178.     fn: packettype;
  179.     oldfn: string;
  180.  
  181. procedure legalize(var fn: string);
  182.  
  183. (* make sure file name will be legal to other computer *)
  184.  
  185. var count, i, j, l: integer;
  186.  
  187. procedure uppercase(var s: string);
  188.  
  189. var i: integer;
  190.  
  191.   begin
  192.     for i := 1 to length(s) do
  193.         if s[i] in ['a'..'z'] then
  194.             s[i] := chr(ord('A') + ord(s[i]) - ord('a'))
  195.   end; (* uppercase *)
  196.  
  197.   begin
  198.     count := 0;
  199.     l := length(fn);
  200.     for i := 1 to l do                                  (* count '.'s in fn *)
  201.         if fn[i] = '.' then
  202.             count := count + 1;
  203.     for i := 1 to count-1 do                            (* remove all but 1 *)
  204.       begin
  205.         j := 1;
  206.         while (j < l) and (fn[j] <> '.') do
  207.             j := j + 1;
  208.             delete(fn,j,1);l := l - 1
  209.       end; (* for i *)
  210.     l := length(fn);
  211.     i := pos(':',fn);
  212.     if (i <> 0) then
  213.       begin
  214.         fn := copy(fn,i,l-i);
  215.         l := length(fn)
  216.       end;
  217.     i := 1;
  218.     while (i <= length(fn)) do
  219.         if not(fn[i] in ['a'..'z','A'..'Z','.','0'..'9']) then
  220.             delete(fn,i,1)
  221.         else
  222.             i := i + 1;
  223.     uppercase(fn)
  224.   end; (* legalize *)
  225.  
  226.   begin
  227.     if debug then
  228.         debugwrite('sfile');
  229.  
  230.     if (numtry > maxtry) then          (* if too many tries, give up *)
  231.       begin
  232.         sfile := 'a';
  233.         exit(sfile)
  234.       end;
  235.     numtry := numtry + 1;
  236.  
  237.     oldfn := filename;
  238.     legalize(filename);                (* make filename acceptable to remote *)
  239.     len := length(filename);
  240.  
  241.     moveleft(filename[1],fn[0],len);   (* move filename into a packettype *)
  242.  
  243.     gotoxy(filepos,fileline);
  244.     write(oldfn,' ==> ',filename);
  245.  
  246.     refresh_screen(numtry,n);
  247.  
  248.     spack('F',n mod 64,len,fn);               (* send file header packet *)
  249.  
  250.     size := bufill(packet);            (* get first data from file *)
  251.                                        (* while waiting for response *)
  252.  
  253.     ch := rpack(len,num,recpkt);
  254.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  255.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  256.             exit(sfile)                (* is just like ACK for this packet *)
  257.         else
  258.           begin
  259.             if (num > 0) then
  260.                 num := (num - 1)       (* in which case, decrement num *)
  261.             else
  262.                 num := 63;
  263.             ch := 'Y';                 (* and indicate an ACK *)
  264.           end; (* else *)
  265.  
  266.     if (ch = 'Y') then
  267.       begin
  268.         if ((n mod 64) <> num) then  (* if wrong ACK, stay in F state *)
  269.             exit(sfile);
  270.         numtry := 0;
  271.         n := n + 1;
  272.         sfile := 'd';
  273.       end (* if *)
  274.     else if (ch = 'E') then
  275.       begin
  276.         error(recpkt,len);
  277.         sfile := 'a'
  278.       end (* if 'E' *)
  279.     else if (ch <> chr(0)) and (ch <> 'N') then (* don't recognize it *)
  280.         sfile := 'a'
  281.   end; (* sfile *)
  282.  
  283. function seof: char;
  284.  
  285. (* send end of file *)
  286.  
  287. var num, len: integer;
  288.     ch: char;
  289.  
  290.   begin
  291.     if debug then
  292.         debugwrite('seof');
  293.  
  294.     if (numtry > maxtry) then          (* if too many tries, give up *)
  295.       begin
  296.         seof := 'a';
  297.         exit(seof)
  298.       end;
  299.     numtry := numtry + 1;
  300.  
  301.     refresh_screen(numtry,n);
  302.  
  303.     spack('Z',(n mod 64),0,packet);    (* send end of file packet *)
  304.  
  305.     if debug then
  306.         debugwrite('seof1');
  307.  
  308.     ch := rpack(len,num,recpkt);
  309.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  310.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  311.             exit(seof)                 (* is just like ACK for this packet *)
  312.         else
  313.           begin
  314.             if num > 0 then
  315.                 num := (num - 1)       (* in which case, decrement num *)
  316.             else
  317.                 num := 63;
  318.             ch := 'Y';                 (* and indicate an ACK *)
  319.           end; (* else *)
  320.  
  321.     if (ch = 'Y') then
  322.       begin
  323.         if debug then
  324.             debugwrite('seof2');
  325.         if ((n mod 64) <> num) then     (* if wrong ACK, stay in F state *)
  326.             exit(seof);
  327.         numtry := 0;
  328.         n := n + 1;
  329.         if debug then
  330.             debugwrite(concat('closing ',s));
  331.         close(oldf);
  332.         seof := 'b'
  333.       end (* if *)
  334.     else if (ch = 'E') then
  335.       begin
  336.         error(recpkt,len);
  337.         seof := 'a'
  338.       end (* if 'E' *)
  339.     else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
  340.       begin
  341.       end
  342.     else if (ch <> 'N') then           (* other error, just abort *)
  343.         seof := 'a'
  344.   end; (* seof *)
  345.  
  346. function sbreak: char;
  347.  
  348. var num, len: integer;
  349.     ch: char;
  350.  
  351. (* send break (end of transmission) *)
  352.  
  353.   begin
  354.     if debug then
  355.         debugwrite('sbreak');
  356.  
  357.     if (numtry > maxtry) then          (* if too many tries, give up *)
  358.       begin
  359.         sbreak := 'a';
  360.         exit(sbreak)
  361.       end;
  362.     numtry := numtry + 1;
  363.  
  364.     refresh_screen(numtry,n);
  365.  
  366.     spack('B',(n mod 64),0,packet);    (* send end of file packet *)
  367.  
  368.     ch := rpack(len,num,recpkt);
  369.     if ch = 'N' then                   (* NAK, so just stay in this state *)
  370.         if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
  371.             exit(sbreak)               (* is just like ACK for this packet *)
  372.         else
  373.           begin
  374.             if num > 0 then
  375.                 num := (num - 1)       (* in which case, decrement num *)
  376.             else
  377.                 num := 63;
  378.             ch := 'Y';                 (* and indicate an ACK *)
  379.           end; (* else *)
  380.  
  381.     if (ch = 'Y') then
  382.       begin
  383.         if ((n mod 64) <> num) then    (* if wrong ACK, stay in B state *)
  384.             exit(sbreak);
  385.         numtry := 0;
  386.         n := n + 1;
  387.         sbreak := 'c'                  (* else, switch state to complete *)
  388.       end (* if *)
  389.     else if (ch = 'E') then
  390.       begin
  391.         error(recpkt,len);
  392.         sbreak := 'a'
  393.       end (* if 'E' *)
  394.     else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
  395.       begin
  396.       end
  397.     else if (ch <> 'N') then           (* other error, just abort *)
  398.         sbreak := 'a'
  399.   end; (* sbreak *)
  400.  
  401. (* state table switcher for sending *)
  402.  
  403.   begin (* sendsw *)
  404.  
  405.     if debug then
  406.         debugwrite(concat('Opening ',filename));
  407.  
  408.     openfile;
  409.     if io_status <> 0 then
  410.       begin
  411.         writeln(chr(clear_screen));
  412.         io_error(io_status);
  413.         send_ok := false;
  414.         exit(sendsw)
  415.       end;
  416.  
  417.     write_screen('Sending');
  418.     state := 's';
  419.     n := 0;       (* set packet # *)
  420.     numtry := 0;
  421.     while true do
  422.         if state in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
  423.           case state of
  424.               'd': state := sdata;
  425.               'f': state := sfile;
  426.               'z': state := seof;
  427.               's': state := sinit;
  428.               'b': state := sbreak;
  429.               'c': begin
  430.                      send_ok := true;
  431.                      exit(sendsw)
  432.                    end; (* case c *)
  433.               'a': begin
  434.                      send_ok := false;
  435.                      exit(sendsw)
  436.                    end (* case a *)
  437.             end (* case *)
  438.         else (* state not in legal states *)
  439.           begin
  440.             send_ok := false;
  441.             exit(sendsw)
  442.           end (* else *)
  443.   end; (* sendsw *)
  444.