kermit.columbia.edu/kermit.columbia.edu.tar/kermit.columbia.edu/archives/ucsdibmpc.zip/sender.text

Text File | 1984-05-23 | 12KB | 435 lines

unit sender;

interface

   procedure sendsw(var send_ok: boolean);


implementation

uses
   {$U kermglob.code} kermglob,
   {$U kermutil.code} kermutil,
   {$U kermpack.code} kermpack;


procedure sendsw{(var send_ok: boolean)};

var io_status: integer;

procedure openfile;

(* resets file & gets past first 2 blocks *)

  begin
    (*$I-*) (* turn off compiler i/o checking temporarily *)
    reset(oldf,xfilename);
    (*$I+*) (* turn compiler i/o checking back on *)
    io_status := io_result;
    if (iostatus = 0) then
      if (pos('.TEXT',xfilename) = length(xfilename) - 4) then
        begin                             (* is a text file, so *)
          i := blockread(oldf,filebuf,1); (* skip past 2 block header *)
          i := blockread(oldf,filebuf,1);
        end; (* if *)
  end; (* openfile *)

function sinit: char;

(* send init packet & receive other side's *)

var num, len, i: integer;  (* packet number and length *)
    ch: char;

  begin
    if debug then
        debugwrite('sinit');

    if numtry > maxtry then
      begin
        sinit := 'a';
        exit(sinit)
      end;

    num_try := num_try + 1;
    spar(packet);

    clear_buf(inport);

    refresh_screen(numtry,n);

    spack('S',n mod 64,6,packet);

    ch := rpack(len,num,recpkt);

    if (ch = 'N') then
      begin
        sinit := 's';
        exit(sinit)
      end (* if 'N' *)
    else if (ch = 'Y') then
      begin
        if ((n mod 64) <> num) then       (* not the right ack *)
          begin
            sinit := currstate;
            exit(sinit)
          end;
        rpar(recpkt);
        if (xeol = chr(0)) then   (* if they didn't spec eol *)
            xeol := chr(my_eol);    (* use mine *)
        if (quote = chr(0)) then (* if they didn't spec quote *)
            quote := my_quote;     (* use mine *)
        ctl_set := [chr(1)..chr(31),chr(del),quote];
        numtry := 0;
        n := n + 1;              (* increase packet number *)
        sinit := 'f';
        exit(sinit)
      end (* else if 'Y' *)
    else if (ch = 'E') then
      begin
        error(recpkt,len);
        sinit := 'a'
      end (* if 'E' *)
    else if (ch = chr(0)) then
        sinit := currstate
    else if (ch <> 'N') then
        sinit := 'a'
  end; (* sinit *)

function sdata: char;

(* send file data *)

var num, len: integer;
    ch: char;
    packarray: array[false..true] of packettype;
    sizearray: array[false..true] of integer;
    current: boolean;
    b: boolean;

function other(b: boolean): boolean;

(* complements a boolean which is used as array index *)

  begin
    if b then
        other := false
    else
        other := true
  end; (* other *)

  begin
    current := true;
    packarray[current] := packet;
    sizearray[current] := size;
    while (currstate = 'd') do
      begin
        if (numtry > maxtry) then             (* if too many tries, give up *)
            currstate := 'a';

        b := other(current);
        numtry := numtry + 1;

                                          (* send a data packet *)
        spack('D',n mod 64,sizearray[current],packarray[current]);

        refresh_screen(numtry,n);
                                          (* set up next packet *)
        sizearray[b] := bufill(packarray[b]);

        ch := rpack(len,num,recpkt);      (* receive a packet *)
        if ch = 'N' then                  (* NAK, so just stay in this state *)
            if ((n+1) mod 64 <> num) then (* unless NAK for next packet, which *)
                sdata := currstate
            else                          (* is just like ACK for this packet *)
              begin
                if num > 0 then
                    num := (num - 1)      (* in which case, decrement num *)
                else
                    num := 63;
                ch := 'Y';                (* and indicate an ACK *)
              end; (* else *)

        if (ch = 'Y') then
           begin
             if ((n mod 64) <> num) then (* if wrong ACK *)
               begin
                 sdata := currstate;         (* stay in same state *)
                 exit(sdata);            (* get out of here *)
               end; (* if *)
             numtry := 0;
             n := n + 1;
             current := b;
             if sizearray[current] = ateof then
                 currstate := 'z'            (* set state to eof *)
             else
                 currstate := 'd'            (* else stay in data state *)
           end (* if *)
          else if (ch = 'E') then
            begin
              error(recpkt,len);
              currstate := 'a'
            end (* if 'E' *)
          else if (ch = chr(0)) then      (* receive failure, so stay in d *)
            begin
            end
          else if (ch <> 'N') then
            currstate := 'a'                  (* on anything else goto abort state *)
      end; (* while *)
    size := sizearray[current];
    packet := packarray[current];
    sdata := currstate
  end; (* sdata *)

function sfile: char;

(* send file header *)

var num, len, i: integer;
    ch: char;
    fn: packettype;
    oldfn: string255;

procedure legalize(var fn: string255);

(* make sure we send only 1 '.' in filename *)

var count, i, j, l: integer;

  begin
    count := 0;
    l := length(fn);
    for i := 1 to l do                                  (* count '.'s in fn *)
        if fn[i] = '.' then
            count := count + 1;
    for i := 1 to count-1 do                            (* remove all but 1 *)
      begin
        j := 1;
        while (j < l) and (fn[j] <> '.') do
            j := j + 1;                                 (* by finding it *)
        fn := concat(copy(fn,1,j-1),copy(fn,j+1,l-j));  (* and copying around it *)
        l := l - 1
      end (* for i *)
  end; (* legalize *)

  begin
    if debug then
        debugwrite('sfile');

    if (numtry > maxtry) then          (* if too many tries, give up *)
      begin
        sfile := 'a';
        exit(sfile)
      end;
    numtry := numtry + 1;

    oldfn := xfilename;
    legalize(xfilename);                (* make filename acceptable to remote *)
    len := length(xfilename);

    moveleft(xfilename[1],fn[0],len);   (* move filename into a packettype *)

    gotoxy(filepos,fileline);
    write(oldfn,' ==> ',xfilename);

    refresh_screen(numtry,n);

    spack('F',n mod 64,len,fn);               (* send file header packet *)

    size := bufill(packet);            (* get first data from file *)
                                       (* while waiting for response *)

    ch := rpack(len,num,recpkt);
    if ch = 'N' then                   (* NAK, so just stay in this state *)
        if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
            exit(sfile)                (* is just like ACK for this packet *)
        else
          begin
            if (num > 0) then
                num := (num - 1)       (* in which case, decrement num *)
            else
                num := 63;
            ch := 'Y';                 (* and indicate an ACK *)
          end; (* else *)

    if (ch = 'Y') then
      begin
        if ((n mod 64) <> num) then  (* if wrong ACK, stay in F state *)
            exit(sfile);
        numtry := 0;
        n := n + 1;
        sfile := 'd';
      end (* if *)
    else if (ch = 'E') then
      begin
        error(recpkt,len);
        sfile := 'a'
      end (* if 'E' *)
    else if (ch <> chr(0)) and (ch <> 'N') then (* don't recognize it *)
        sfile := 'a'
  end; (* sfile *)

function seof: char;

(* send end of file *)

var num, len: integer;
    ch: char;

  begin
    if debug then
        debugwrite('seof');

    if (numtry > maxtry) then          (* if too many tries, give up *)
      begin
        seof := 'a';
        exit(seof)
      end;
    numtry := numtry + 1;

    refresh_screen(numtry,n);

    spack('Z',(n mod 64),0,packet);    (* send end of file packet *)

    if debug then
        debugwrite('seof1');

    ch := rpack(len,num,recpkt);
    if ch = 'N' then                   (* NAK, so just stay in this state *)
        if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
            exit(seof)                 (* is just like ACK for this packet *)
        else
          begin
            if num > 0 then
                num := (num - 1)       (* in which case, decrement num *)
            else
                num := 63;
            ch := 'Y';                 (* and indicate an ACK *)
          end; (* else *)

    if (ch = 'Y') then
      begin
        if debug then
            debugwrite('seof2');
        if ((n mod 64) <> num) then     (* if wrong ACK, stay in F state *)
            exit(seof);
        numtry := 0;
        n := n + 1;
        if debug then
            debugwrite(concat('closing ',s));
        close(oldf);
        seof := 'b'
      end (* if *)
    else if (ch = 'E') then
      begin
        error(recpkt,len);
        seof := 'a'
      end (* if 'E' *)
    else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
      begin
      end
    else if (ch <> 'N') then           (* other error, just abort *)
        seof := 'a'
  end; (* seof *)

function sbreak: char;

var num, len: integer;
    ch: char;

(* send break (end of transmission) *)

  begin
    if debug then
        debugwrite('sbreak');

    if (numtry > maxtry) then          (* if too many tries, give up *)
      begin
        sbreak := 'a';
        exit(sbreak)
      end;
    numtry := numtry + 1;

    refresh_screen(numtry,n);

    spack('B',(n mod 64),0,packet);    (* send end of file packet *)

    ch := rpack(len,num,recpkt);
    if ch = 'N' then                   (* NAK, so just stay in this state *)
        if ((n+1) mod 64 <> num) then  (* unless NAK for next packet, which *)
            exit(sbreak)               (* is just like ACK for this packet *)
        else
          begin
            if num > 0 then
                num := (num - 1)       (* in which case, decrement num *)
            else
                num := 63;
            ch := 'Y';                 (* and indicate an ACK *)
          end; (* else *)

    if (ch = 'Y') then
      begin
        if ((n mod 64) <> num) then    (* if wrong ACK, stay in B state *)
            exit(sbreak);
        numtry := 0;
        n := n + 1;
        sbreak := 'c'                  (* else, switch state to complete *)
      end (* if *)
    else if (ch = 'E') then
      begin
        error(recpkt,len);
        sbreak := 'a'
      end (* if 'E' *)
    else if (ch = chr(0)) then         (* receive failed, so stay in z state *)
      begin
      end
    else if (ch <> 'N') then           (* other error, just abort *)
        sbreak := 'a'
  end; (* sbreak *)

(* state table switcher for sending *)

  begin (* sendsw *)

    if debug then
        debugwrite(concat('Opening ',xfilename));

    openfile;
    if io_status <> 0 then
      begin
        io_error(io_status);
        send_ok := false;
        exit(sendsw)
      end;

    write_screen('Sending');
    currstate := 's';
    n := 0;       (* set packet # *)
    numtry := 0;
    while true do
        if currstate in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
          case currstate of
              'd': currstate := sdata;
              'f': currstate := sfile;
              'z': currstate := seof;
              's': currstate := sinit;
              'b': currstate := sbreak;
              'c': begin
                     send_ok := true;
                     exit(sendsw)
                   end; (* case c *)
              'a': begin
                     send_ok := false;
                     exit(sendsw)
                   end (* case a *)
            end (* case *)
        else (* state not in legal states *)
          begin
            send_ok := false;
            exit(sendsw)
          end (* else *)
  end; (* sendsw *)

  end. { sender }