unit client; interface {Change log: 13 May 89, V1.1: Misc. cleanups to debug messages RTC 30 Apr 89, V1.1: Fixed failure to terminate on maxtry bug RTC 26 Apr 89, V1.1: minor cleanups RTC 16 Apr 89, V1.1: Fixed "garbage in buffer" bug RTC 16 Apr 89, V1.1: Adapted CLIENT Unit from RECEIVE Unit RTC } procedure clientsw(var cli_ok: boolean; ptype: char; data: string); procedure cli_version; implementation uses screenops, {RTC, 10 Jul 88} {$U kermglob.code} kermglob, {$U kermutil.code} kermutil, {$U kermpack.code} kermpack; const my_version = ' Client Unit V1.1, 13 May 89'; var f_save : boolean; { save area for f_is_binary } procedure clientsw{(var cli_ok: boolean; ptype: char; data: string)}; function cdata: char; (* client text data *) var dummy, num, len: integer; ch: char; i: integer; begin repeat debugwrite('cdata'); if numtry > maxtry then begin currstate := 'a'; exit(cdata) end; num_try := num_try + 1; ch := rpack(len,num,recpkt); (* receive a packet *) refresh_screen(numtry,n); if (ch = 'D') then (* got data packet *) begin if (num <> (n mod 64)) then (* wrong packet *) begin if (oldtry > maxtry) then begin cdata := 'a'; (* too many tries, abort *) exit(cdata) end; (* if *) if (num = (pred(n) mod 64)) then (* previous packet again *) begin (* so re-ACK it *) spack('Y',num,0,packet); numtry := 0; (* reset try counter *) (* stay in same state *) end (* if *) else (* wrong number *) currstate := 'a' (* so abort *) end (* if *) else (* right packet *) begin bufemp(recpkt,len); (* write data to file *) if read_ch(keyport, ch) then {check if user wants to can} packet[0] := ctl(ch); spack('Y',(n mod 64),ord(ord(ch) in [can_cur,can_all]), packet); (* ACK packet *) oldtry := numtry; (* reset try counters *) numtry := 0; n := n + 1 (* bump packet number *) (* stay in data receive state *) end (* else *) end (* if 'D' *) else if (ch = 'X') then (* text header *) begin if (oldtry > maxtry) then begin cdata := 'a'; (* too many tries, abort *) exit(cdata) end; (* if *) if (num = (pred(n) mod 64)) then (* previous packet again *) begin (* so re-ACK it *) spack('Y',num,0,packet); numtry := 0; (* reset try counter *) (* stay in same state *) end (* if *) else currstate := 'a' (* not previous packet, abort *) end (* if 'X' *) else if (ch = 'Z') then (* end of file *) begin if (num <> (n mod 64)) then(* wrong packet, abort *) begin cdata := 'a'; exit(cdata) end; (* if *) spack('Y',n mod 64,0,packet); (* ok, ACK it *) close(t_file); n := n + 1; (* bump packet counter *) currstate := 'f'; (* go to complete state *) end (* else if 'Z' *) else if (ch = 'E') then (* error packet *) begin error(recpkt,len); (* display error *) currstate := 'a' (* and abort *) end (* if 'E' *) else if (ch <> chr(0)) then (* some other packet type, *) currstate := 'a' (* abort *) until (currstate <> 'd'); cdata := currstate end; (* cdata *) function cfile: char; (* client text header *) var num, len: integer; ch: char; i: integer; begin (* cfile *) debugwrite('cfile'); if (numtry > maxtry) then (* if too many tries, give up *) begin cfile := 'a'; exit(cfile) end; numtry := numtry + 1; ch := rpack(len,num,recpkt); (* receive a packet *) refresh_screen(numtry,n); if ch = 'S' then (* send init, maybe our ACK lost *) begin if (oldtry > maxtry) then (* too many tries, abort *) begin cfile := 'a'; exit(cfile) end; (* if *) if num = (pred(n) mod 64) then (* previous packet mod 64? *) begin (* yes, ACK it again *) spar(packet); (* with our send init params *) spack('Y',num,10,packet); numtry := 0; (* reset try counter *) cfile := currstate; (* stay in same state *) end (* if *) else (* not previous packet, abort *) cfile := 'a' end (* if 'S' *) else if (ch = 'Z') then (* end of file *) begin if (oldtry > maxtry) then (* too many tries, abort *) begin cfile := 'a'; exit(cfile) end; (* if *) if num = (pred(n) mod 64) then (* previous packet mod 64? *) begin (* yes, ACK it again *) spack('Y',num,0,packet); numtry := 0; cfile := currstate (* stay in same state *) end (* if *) else cfile := 'a' (* no, abort *) end (* else if *) else if (ch = 'X') then (* text header *) begin (* which is what we really want *) if (num <> (n mod 64)) then (* if wrong packet, abort *) begin cfile := 'a'; exit(cfile) end; if not getfil('console:') then { try to open console output } begin ioerror(ioresult); { if unsuccessful, tell them } cfile := 'a'; { and abort } exit(cfile) end; spack('Y',n mod 64,0,packet); (* ACK file header *) oldtry := numtry; (* reset try counters *) numtry := 0; n := n + 1; (* bump packet number *) cfile := 'd'; (* switch to data state *) end (* else if *) else if ch = 'B' then (* break transmission *) begin if (num <> (n mod 64)) then (* wrong packet, abort *) begin cfile := 'a'; exit(cfile) end; spack('Y',n mod 64,0,packet); (* say ok *) cfile := 'c' (* go to complete state *) end (* else if *) else if (ch = 'E') then begin error(recpkt,len); cfile := 'a' end else if (ch = chr(0)) then (* returned false *) cfile := currstate (* so stay in same state *) else (* some weird state, so abort *) cfile := 'a' end; (* cfile *) function cinit: char; (* client initialization *) var num, len: integer; (* packet number and length *) ch: char; cmdpkt : packettype; begin debugwrite('cinit'); if (numtry > maxtry) then (* if too many tries, give up *) begin cinit := 'a'; exit(cinit) end; numtry := numtry + 1; len := length(data); moveleft(data[1],cmdpkt[0],len); spack(ptype, n mod 64, len, cmdpkt); ch := rpack(len,num,recpkt); (* receive a packet *) refresh_screen(num_try,n); if (ch = 'S') then (* send init packet *) begin rpar(recpkt,len); (* get other side's init data *) spar(packet); (* fill packet with my init data *) ctl_set := [chr(0)..chr(31),chr(del),quote]; if en_qbin then ctl_set := ctl_set + [qbin]; spack('Y',n mod 64,10,packet); (* ACK with my params *) oldtry := numtry; (* save old try count *) numtry := 0; (* start a new counter *) n := n + 1; (* bump packet number *) cinit := 'f'; (* enter file receive state *) end (* if 'S' *) else if ch = 'Y' then begin cinit := 'c'; if n mod 64 = num then {we have the right ACK} begin numtry := 0; n := n + 1 end end {if 'Y'} else if (ch = 'N') then cinit := 'r' else if (ch = 'E') then begin cinit := 'a'; error(recpkt,len) end (* if 'E' *) else if (ch = chr(0)) then cinit := 'r' (* stay in same state *) else cinit := 'a' (* abort *) end; (* cinit *) (* state table switcher for receiving packets *) begin (* clientsw *) cli_ok := false; writescreen('Talking to Server'); f_save := f_is_binary; {save for later restore} f_is_binary := false; {client ONLY recieves text} currstate := 'r'; (* initial state is receive *) n := 0; (* set packet # *) numtry := 0; (* no tries yet *) flush_comm; {flush any garbage in buffer} while true do if currstate in ['d', 'f', 'r', 'c', 'a'] then case currstate of 'd': currstate := cdata; 'f': currstate := cfile; 'r': currstate := cinit; 'c': begin f_is_binary := f_save; cli_ok := true; exit(clientsw) end; (* case c *) 'a': begin f_is_binary := f_save; exit(clientsw) end (* case a *) end (* case *) else (* state not in legal states *) begin debugwrite('Unknown State'); f_is_binary := f_save; exit(clientsw) end (* else *) end; (* clientsw *) procedure cli_version; begin writeln(my_version) end {cli_version}; end. { client }