kermit.columbia.edu/kermit.columbia.edu.tar/kermit.columbia.edu/ucsdwdme/sendsw.text

Text File | 1984-12-02 | 12KB | 449 lines

(* Send Section *)
UCSD Pascal KERMIT for the Terak p-System, from Kate MacGregor, Cornell U

segment 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,filename);
    (*$I+*) (* turn compiler i/o checking back on *)
    io_status := io_result;
    if (iostatus = 0) then
      if (pos('.TEXT',filename) = length(filename) - 4) then
                                          (* is a text file, so *)
          i := blockread(oldf,filebuf,2); (* skip past 2 block header *)
  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);

    if istbrr then ch:=rcvbbt; (* clear modem buffer *)

    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 := state;
            exit(sinit)
          end;
        rpar(recpkt);
        if (eol = chr(0)) then   (* if they didn't spec eol *)
            eol := 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 := state
    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 (state = 'd') do
      begin
        if (numtry > maxtry) then             (* if too many tries, give up *)
            state := '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, which *)
                sdata := state
            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 := state;         (* stay in same state *)
                 exit(sdata);            (* get out of here *)
               end; (* if *)
             if numtry > 1 then          (* if anything in buffer, flush it *)
                 if istbrr then begin
                   ch:=rcvbbt;
                   ch:='Y';
                   end;
             numtry := 0;
             n := n + 1;
             current := b;
             if sizearray[current] = ateof then
                 state := 'z'            (* set state to eof *)
             else
                 state := 'd'            (* else stay in data state *)
           end (* if *)
          else if (ch = 'E') then
            begin
              error(recpkt,len);
              state := 'a'
            end (* if 'E' *)
          else if (ch = chr(0)) then      (* receive failure, so stay in d *)
            begin
            end
          else if (ch <> 'N') then
            state := 'a'                  (* on any other goto abort state *)
      end; (* while *)
    size := sizearray[current];
    packet := packarray[current];
    sdata := state
  end; (* sdata *)

function sfile: char;

(* send file header *)

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

procedure legalize(var fn: string);

(* make sure file name will be legal to other computer *)

var count, i, j, l: integer;

procedure uppercase(var s: string);

var i: integer;

  begin
    for i := 1 to length(s) do
        if s[i] in ['a'..'z'] then
            s[i] := chr(ord('A') + ord(s[i]) - ord('a'))
  end; (* uppercase *)

  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;
            delete(fn,j,1);l := l - 1
      end; (* for i *)
    l := length(fn);
    i := pos(':',fn);
    if (i <> 0) then
      begin
        fn := copy(fn,i,l-i);
        l := length(fn)
      end;
    i := 1;
    while (i <= length(fn)) do
        if not(fn[i] in ['a'..'z','A'..'Z','.','0'..'9']) then
            delete(fn,i,1)
        else
            i := i + 1;
    uppercase(fn)
  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 := filename;
    legalize(filename);                (* make filename acceptable to remote *)
    len := length(filename);

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

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

    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 ',filename));

    openfile;
    if io_status <> 0 then
      begin
        writeln(chr(esc),'E'{clear_screen});
        io_error(io_status);
        send_ok := false;
        exit(sendsw)
      end;

    write_screen('Sending');
    state := 's';
    n := 0;       (* set packet # *)
    numtry := 0;
    while true do
        if state in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
          case state of
              'd': state := sdata;
              'f': state := sfile;
              'z': state := seof;
              's': state := sinit;
              'b': state := 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 *)