home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / ucsdibmpc.zip / sender.text < prev    next >
Text File  |  1984-05-23  |  12KB  |  435 lines

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