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

  1. unit receiver;
  2.  
  3. interface
  4.  
  5.    procedure recsw(var rec_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 recsw{(var rec_ok: boolean)};
  17.  
  18. function rdata: char;
  19.  
  20. (* send file data *)
  21.  
  22. var num, len: integer;
  23.     ch: char;
  24.     i: integer;
  25.  
  26.   begin
  27.  
  28.     repeat
  29.         if numtry > maxtry then
  30.           begin
  31.             currstate := 'a';
  32.             exit(rdata)
  33.           end;
  34.  
  35.         num_try := num_try + 1;
  36.  
  37.         ch := rpack(len,num,recpkt);   (* receive a packet *)
  38.  
  39.         refresh_screen(numtry,n);
  40.  
  41.         if (ch = 'D') then             (* got data packet *)
  42.           begin
  43.             if (num <> (n mod 64)) then (* wrong packet *)
  44.               begin
  45.                 if (oldtry > maxtry) then
  46.                   begin
  47.                     rdata := 'a';      (* too many tries, abort *)
  48.                     exit(rdata)
  49.                   end; (* if *)
  50.  
  51.                 n := n - 1;
  52.  
  53.                 if (num = (n mod 64)) then (* previous packet again *)
  54.                   begin                (* so re-ACK it *)
  55.                     spack('Y',num,6,packet);
  56.                     numtry := 0;       (* reset try counter *)
  57.                                        (* stay in same state *)
  58.                   end (* if *)
  59.                 else                   (* wrong number *)
  60.                     currstate := 'a'       (* so abort *)
  61.               end (* if *)
  62.             else                       (* right packet *)
  63.               begin
  64.                 bufemp(recpkt,f,len);  (* write data to file *)
  65.                 spack('Y',(n mod 64),0,packet); (* ACK packet *)
  66.                 oldtry := numtry;      (* reset try counters *)
  67.                 numtry := 0;
  68.                 n := n + 1             (* bump packet number *)
  69.                                        (* stay in data send state *)
  70.               end (* else *)
  71.           end (* if 'D' *)
  72.         else if (ch = 'F') then        (* file header *)
  73.           begin
  74.             if (oldtry > maxtry) then
  75.               begin
  76.                 rdata := 'a';          (* too many tries, abort *)
  77.                 exit(rdata)
  78.               end; (* if *)
  79.  
  80.             n := n - 1;
  81.  
  82.             if (num = (n mod 64)) then (* previous packet again *)
  83.               begin                    (* so re-ACK it *)
  84.                 spack('Y',num,0,packet);
  85.                 numtry := 0;           (* reset try counter *)
  86.                 currstate := currstate;        (* stay in same state *)
  87.               end (* if *)
  88.             else
  89.                 currstate := 'a'           (* not previous packet, abort *)
  90.           end (* if 'F' *)
  91.         else if (ch = 'Z') then        (* end of file *)
  92.           begin
  93.             if (num <> (n mod 64)) then(* wrong packet, abort *)
  94.               begin
  95.                 rdata := 'a';
  96.                 exit(rdata)
  97.               end; (* if *)
  98.             spack('Y',n mod 64,0,packet); (* ok, ACK it *)
  99.             close(f,lock);             (* close up the file *)
  100.             n :=  n + 1;               (* bump packet counter *)
  101.             currstate := 'f';              (* go to complete state *)
  102.           end (* else if 'Z' *)
  103.         else if (ch = 'E') then        (* error packet *)
  104.           begin
  105.             error(recpkt,len);         (* display error *)
  106.             currstate := 'a'               (* and abort *)
  107.           end (* if 'E' *)
  108.         else if (ch <> chr(0)) then    (* some other packet type, *)
  109.             currstate := 'a'               (* abort *)
  110.     until (currstate <> 'd');
  111.     rdata := currstate
  112.   end; (* rdata *)
  113.  
  114. function rfile: char;
  115.  
  116. (* receive file header *)
  117.  
  118. var num, len: integer;
  119.     ch: char;
  120.     oldfn: string255;
  121.     i: integer;
  122.  
  123. procedure makename(recpkt: packettype; var fn: string255; l: integer);
  124.  
  125. function exist(fn: string255): boolean;
  126.  
  127. (* returns true if file named fn exists *)
  128.  
  129. var f: file;
  130.     isthere: boolean;
  131.   begin
  132.     (*$I-*) (* turn off i/o checking *)
  133.     reset(f,fn);
  134.     isthere := (ioresult = 0);
  135.     if isthere then    { added by SP }
  136.        close( f );
  137.     (*$I+*)
  138.     exist := isthere
  139.   end; (* exist *)
  140.  
  141. procedure checkname(var fn: string255);
  142.  
  143. (* if file fn exists, makes a new name which doesn't *)
  144. (* does this by changing letters in file name until it *)
  145. (* finds some combination which doesn't exitst *)
  146.  
  147. var ch: char;
  148.     i: integer;
  149.  
  150.   begin
  151.     i := 1;
  152.     while (i <= length(fn)) and exist(fn) do
  153.       begin
  154.         ch := 'A';
  155.         while (ch in ['A'..'Z']) and exist(fn) do
  156.           begin
  157.             fn[i] := ch;
  158.             ch := succ(ch);
  159.           end; (* while *)
  160.         i := i + 1
  161.       end; (* while *)
  162.     end; (* checkname *)
  163.  
  164.   begin (* makename *)
  165.     fn := copy('               ',1,15);    (* stretch length *)
  166.     moveleft(recpkt[0],fn[1],l);           (* get filename from packet *)
  167.     oldfn := copy(fn, 1,l);                (* save fn sent to show user *)
  168.     fn := copy(fn,1,min(15,l));            (* set length of filename *)
  169.                                            (* and make sure <= 15 *)
  170.     uppercase(fn);
  171.     if pos('.TEXT',fn) <> length(fn)-4 then
  172.       begin
  173.         if length(fn) > 10 then
  174.             fn := copy(fn,1,10);           (* can only be 15 long in all *)
  175.         fn := concat(fn,'.TEXT');          (* and we'll add .TEXT *)
  176.       end; (* if *)
  177.     if fwarn then                          (* if file warning is on *)
  178.         checkname(fn);                       (* must check that name unique *)
  179.   end; (* makename *)
  180.  
  181.   begin (* rfile *)
  182.     if debug then
  183.         debugwrite('rfile');
  184.  
  185.     if (numtry > maxtry) then         (* if too many tries, give up *)
  186.       begin
  187.         rfile := 'a';
  188.         exit(rfile)
  189.       end;
  190.     numtry := numtry + 1;
  191.  
  192.     ch := rpack(len,num,recpkt);      (* receive a packet *)
  193.  
  194.     refresh_screen(numtry,n);
  195.  
  196.     if ch = 'S' then                  (* send init, maybe our ACK lost *)
  197.       begin
  198.         if (oldtry > maxtry) then     (* too many tries, abort *)
  199.           begin
  200.             rfile := 'a';
  201.             exit(rfile)
  202.           end; (* if *)
  203.  
  204.         n := n - 1;
  205.  
  206.         if num = (n mod 64) then      (* previous packet mod 64? *)
  207.           begin                       (* yes, ACK it again *)
  208.             spar(packet);             (* with our send init params *)
  209.             spack('Y',num,6,packet);
  210.             numtry := 0;              (* reset try counter *)
  211.             rfile := currstate;           (* stay in same state *)
  212.           end (* if *)
  213.         else                          (* not previous packet, abort *)
  214.           currstate := 'a'
  215.       end (* if 'S' *)
  216.     else if (ch = 'Z') then           (* end of file *)
  217.       begin
  218.         if (oldtry > maxtry) then     (* too many tries, abort *)
  219.           begin
  220.             rfile := 'a';
  221.             exit(rfile)
  222.           end; (* if *)
  223.  
  224.         n := n - 1;
  225.  
  226.         if num = (n mod 64) then       (* previous packet mod 64? *)
  227.           begin                       (* yes, ACK it again *)
  228.             spack('Y',num,0,packet);
  229.             numtry := 0;
  230.             rfile := currstate            (* stay in same state *)
  231.           end (* if *)
  232.         else
  233.             rfile := 'a'              (* no, abort *)
  234.       end (* else if *)
  235.     else if (ch = 'F') then           (* file header *)
  236.       begin                           (* which is what we really want *)
  237.         if (num <> (n mod 64)) then   (* if wrong packet, abort *)
  238.           begin
  239.             rfile := 'a';
  240.             exit(rfile)
  241.           end;
  242.  
  243.         makename(recpkt,xfilename,len); (* get filename, make unique if filew *)
  244.         gotoxy(filepos,fileline);
  245.         write(oldfn,' ==> ',xfilename);
  246.  
  247.         if not getfil(xfilename) then  (* try to open new file *)
  248.           begin
  249.             ioerror(ioresult);        (* if unsuccessful, tell them *)
  250.             rfile := 'a';             (* and abort *)
  251.             exit(rfile)
  252.           end; (* if *)
  253.  
  254.         spack('Y',n mod 64,0,packet); (* ACK file header *)
  255.         oldtry := numtry;             (* reset try counters *)
  256.         numtry := 0;
  257.         n := n + 1;                   (* bump packet number *)
  258.         rfile := 'd';                 (* switch to data state *)
  259.       end (* else if *)
  260.     else if ch = 'B' then             (* break transmission *)
  261.       begin
  262.         if (num <> (n mod 64)) then            (* wrong packet, abort *)
  263.           begin
  264.             rfile := 'a';
  265.             exit(rfile)
  266.           end;
  267.         spack('Y',n mod 64,0,packet); (* say ok *)
  268.         rfile := 'c'                  (* go to complete state *)
  269.       end (* else if *)
  270.     else if (ch = 'E') then
  271.       begin
  272.         error(recpkt,len);
  273.         rfile := 'a'
  274.       end
  275.     else if (ch = chr(0)) then        (* returned false *)
  276.         rfile := currstate                (* so stay in same state *)
  277.     else                              (* some weird state, so abort *)
  278.         rfile := 'a'
  279.   end; (* rfile *)
  280.  
  281. function rinit: char;
  282.  
  283. (* receive initialization *)
  284.  
  285. var num, len: integer;  (* packet number and length *)
  286.     ch: char;
  287.  
  288.   begin
  289.     if debug then
  290.         debugwrite('rinit');
  291.  
  292.     numtry := numtry + 1;
  293.  
  294.     ch := rpack(len,num,recpkt); (* receive a packet *)
  295.     refresh_screen(num_try,n);
  296.  
  297.     if (ch = 'S') then           (* send init packet *)
  298.       begin
  299.         rpar(recpkt);            (* get other side's init data *)
  300.         spar(packet);            (* fill packet with my init data *)
  301.         ctl_set := [chr(1)..chr(31),chr(del),quote];
  302.         spack('Y',n mod 64,6,packet); (* ACK with my params *)
  303.         oldtry := numtry;        (* save old try count *)
  304.         numtry := 0;             (* start a new counter *)
  305.         n := n + 1;              (* bump packet number *)
  306.         rinit := 'f';            (* enter file send state *)
  307.       end (* if 'S' *)
  308.     else if (ch = 'E') then
  309.       begin
  310.         rinit := 'a';
  311.         error(recpkt,len)
  312.       end (* if 'E' *)
  313.     else if (ch = chr(0)) then
  314.         rinit := 'r'             (* stay in same state *)
  315.     else
  316.         rinit := 'a'             (* abort *)
  317.   end; (* rinit *)
  318.  
  319. (* state table switcher for receiving packets *)
  320.  
  321.   begin (* recswok *)
  322.     writescreen('Receiving');
  323.     currstate := 'r';            (* initial state is send *)
  324.     n := 0;                  (* set packet # *)
  325.     numtry := 0;             (* no tries yet *)
  326.  
  327.     while true do
  328.         if currstate in ['d', 'f', 'r', 'c', 'a'] then
  329.           case currstate of
  330.               'd': currstate := rdata;
  331.               'f': currstate := rfile;
  332.               'r': currstate := rinit;
  333.               'c': begin
  334.                      rec_ok := true;
  335.                      exit(recsw)
  336.                    end; (* case c *)
  337.               'a': begin
  338.                      rec_ok := false;
  339.                      exit(recsw)
  340.                    end (* case a *)
  341.             end (* case *)
  342.         else (* state not in legal states *)
  343.           begin
  344.             rec_ok := false;
  345.             exit(recsw)
  346.           end (* else *)
  347.   end; (* recsw *)
  348.  
  349.   end. { receiver }
  350.  
  351.