Columbia Kermit/kermit.zip/archives/ucsdpecan.zip/client.text

Text File | 1990-08-05 | 11KB | 332 lines

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 }