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