Columbia Kermit/kermit.zip/perqa/kermitsend

Text File | 2020-01-01 | 14KB | 459 lines

module KermitSend ;

(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)


EXPORTS

PROCEDURE SendPacket;
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
PROCEDURE SendSwitch;




PRIVATE

IMPORTS KermitGlobals   FROM KermitGlobals ;
IMPORTS KermitUtils     FROM KermitUtils ;
IMPORTS Stdio           FROM Stdio ;
IMPORTS KermitError     FROM KermitError ;
IMPORTS KermitRecv      FROM KermitRecv ;    (* for receiving ACKs and NAKs *)
IMPORTS UtilProgress    FROM UtilProgress ;
IMPORTS Sleep           FROM Sleep ;


{$RANGE-}    (* Range checks off   16-Jan-84 *)




VAR
   DataSendCount: Integer ; (* counter for progress *)


PROCEDURE PutOut( p : Ppack); (* Output Packet *)
   (* Use direct calls to XmtChar to send the characters -pt*)
   VAR
      i : Integer;
   BEGIN
      IF (NumPad > 0) THEN
         FOR i := 1 TO NumPad DO
            XmtChar( Chr(PadChar) );
      WITH Buf[p] DO
         BEGIN
            XmtChar( Chr(mark) );
            XmtChar( Chr(count) );
            XmtChar( Chr(seq) );
            XmtChar( Chr(ptype) );
            FOR i := 1 TO ilength(data) DO
               XmtChar( Chr(data[i]) );
         END;
   END;


PROCEDURE ReSendPacket;
   (* re -sends previous packet *)
   BEGIN
      NumSendPacks := NumSendPacks+1;
      ChInPack := ChInPack + NumPad + UnChar(Buf[LastPacket].count) + 3 ;
      IF Debug
      THEN DebugPacket('Re-Sending: ',LastPacket);
      PutOut(LastPacket);
   END;

PROCEDURE SendPacket;

   (* expects count as length of data portion *)
   (* and seq as number of packet *)
   (* builds & sends packet *)
   VAR
      i,len,chksum : Integer;
      temp : Ppack;
   BEGIN
      IF (NumTry <> 1) AND (RunType = Transmit) THEN
         ReSendPacket
      ELSE
         BEGIN
            WITH Buf[ThisPacket] DO
               BEGIN
                  mark :=SOH;               (* mark *)
                  len := count;             (* save length *)
                  count := MakeChar(len+3); (* count = 3+length of data *)
                  seq := MakeChar(seq);     (* seq number *)
                  chksum := count + seq + ptype;
                  IF (len > 0) THEN      (* is there data ? *)
                     FOR i:= 1 TO len DO
                        chksum := chksum + data[i];       (* loop for data *)
                  chksum := CheckFunction(chksum);  (* calculate  checksum *)
                  data[len+1] := MakeChar(chksum);  (* make printable & output *)
                  data[len+2] := SendEOL;                    (* EOL *)
                  data[len+3] := ENDSTR;
               END;

            NumSendPacks := NumSendPacks+1;
            IF Debug
            THEN DebugPacket('Sending: ',ThisPacket);
            PutOut(ThisPacket);

            IF (RunType = Transmit) THEN
               BEGIN
                  ChInPack := ChInPack + NumPad + len + 6;
                  temp := LastPacket;
                  LastPacket := ThisPacket;
                  ThisPacket := temp;
               END;
         END

   END;

PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
   BEGIN
      WITH Buf[ThisPacket] DO
         BEGIN
            count := 0;
            seq := n;
            ptype := TYPEY;
         END;
      SendPacket;
      NumACK := NumACK+1;
   END;

PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
   BEGIN
      WITH Buf[ThisPacket] DO
         BEGIN
            count := 0;
            seq := n;
            ptype := TYPEN;
         END;
      SendPacket;
      NumNAK := NumNAK+1;
   END;



PROCEDURE GetData((* Returning *)   VAR newstate:KermitStates);
   (* get data from file into ThisPacket *)
   VAR
      (* and return next state - data &  EOF *)
      x,c : CharBytes;
      i: Integer;
   BEGIN
      IF (NumTry = 1) THEN
         BEGIN
            i := 1;
            x := ENDSTR;
            WITH Buf[ThisPacket] DO
               BEGIN
                  WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
                  (* leave room for quote  & NEWLINE *)
                  DO
                     BEGIN
                        x := getcf(c,DiskFile);
                        IF (x <> ENDFILE) THEN
                           IF IsControl(x) OR (x = SendQuote) THEN
                              BEGIN           (* control char -- quote *)
                                 IF (x = LF) THEN  (* use proper EOL *)
                                   BEGIN
                                      data[i] := SendQuote;
                                      i := i+1;
                                      data[i] := Ctl(CR);
                                      i := i+1;
                                      (* LF will sent below *)
                                   END;
                                 data[i] := SendQuote;
                                 i := i+1;
                                 IF (x <> SendQuote) THEN  data[i] := Ctl(x)
                                 ELSE  data[i] := SendQuote;
                              END
                           ELSE               (* regular char *)
                              data[i] := x;

                        IF (x <> ENDFILE) THEN
                           BEGIN
                              i := i+1;    (* increase count for next char *)
                              ChInFile := ChInFile + 1 ;
                           END;
                     END;

                  data[i] := ENDSTR;   (* to terminate string *)

                  count := i -1;       (* length *)
                  seq := n;
                  ptype := TYPED;

                  IF (x = ENDFILE) THEN
                     BEGIN
                        newstate := EOFile;
                        Sclose(DiskFile);
                        DiskFile := StdIOError;
                     END
                  ELSE
                     newstate := FileData;
                  SaveState := newstate;        (* save state *)
               END
         END
      ELSE
         newstate := SaveState;        (* get old state *)
   END;

FUNCTION GetNextFile: (* Returning *) Boolean;
   (* get next file to send in ThisPacket *)
   (* returns true if no more *)
   (*         ----    --      -pt*)
   VAR
      result: Boolean;
   BEGIN
      result := True;
      IF (NumTry = 1) THEN
         WITH Buf[ThisPacket] DO
            BEGIN
               IF GetArgument(data) THEN
                  BEGIN            (* open file  *)
                     IF Exists(data) THEN
                        BEGIN
                           (* Initialise counter for each file to be sent *)
                           DataSendCount := 0 ;

                           IF EightBitFile THEN  (* [pgt001] *)
                              DiskFile := Sopen(data,StdIO8Read)
                           ELSE
                              DiskFile := Sopen(data,StdIORead);

                           count := ilength(data);
                           ChInFile := ChInFile + count ;
                           seq := n;
                           ptype := TYPEF;
                           Write('[Sending ');
                           PutStr(data,stdout);
                           Writeln(']') ;
                           IF (DiskFile <= StdIOError) THEN
                              ErrorMsg('?Can''t open file');
                           result := False;
                        END
                     ELSE (* file does not exist *)
                        BEGIN
                           ErrorMsg('?Can''t find file: ') ;
                           ErrorStr( data ) ;
                           result := True  (* I.e. fail: state -> abort *)
                        END
                  END;
            END
      ELSE
         result := False; (* for saved packet *)
      GetNextFile := result;
   END;

PROCEDURE SendFile; (* send file name packet *)
   BEGIN
      Verbose( 'Sending ');
      IF (NumTry > MaxTry) THEN
         BEGIN
            ErrorMsg ('Send file - Too Many');
            State := Abort;      (* too many tries, abort *)
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            IF GetNextFile THEN
               BEGIN
                  State := Break;
                  NumTry := 0;
               END
            ELSE
               BEGIN
                  IF Verbosity THEN
                     IF (NumTry = 1)
                     THEN ErrorStr(Buf[ThisPacket].data)
                     ELSE ErrorStr(Buf[LastPacket].data);
                  SendPacket;     (* send this packet *)
                  IF ReceiveACK THEN
                     BEGIN
                        State := FileData;
                        NumTry := 0;
                        n := (n+1) MOD 64;
                     END
               END;
         END;
   END;

PROCEDURE SendData;  (* send file data packets *)
   VAR
      newstate: KermitStates;
   BEGIN
      IF (Land(DataSendCount, #03) = 0) THEN
        WITH OpenList[DiskFile] DO
         StreamProgress( FileVar ) ;
      DataSendCount := DataSendCount + 1 ;  (* next "SendData" *)

      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg ('Send data - Too many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            GetData(newstate);
            SendPacket;
            IF ReceiveACK THEN
               BEGIN
                  State := newstate;
                  NumTry := 0;
                  n := (n+1) MOD 64;
               END
         END;
   END;

PROCEDURE SendEOF;    (* send EOF  packet *)
   BEGIN
      Verbose ('Sending EOF');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg('Send EOF - Too Many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        ptype := TYPEZ;
                        seq := n;
                        count := 0;
                     END
               END;
            SendPacket;
            IF ReceiveACK THEN
               BEGIN
                  State := FileHeader;
                  NumTry := 0;
                  n := (n+1) MOD 64;
               END
         END;
   END;

PROCEDURE SendBreak; (* send break packet *)
   BEGIN
      Verbose ('Sending break');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;       (* too many tries, abort *)
            ErrorMsg('Send break -Too Many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            (* make up packet  *)
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        ptype := TYPEB;
                        seq := n;
                        count := 0;
                     END
               END;
            SendPacket; (* send this packet *)
            IF ReceiveACK THEN
               BEGIN
                  State := Complete;
               END
         END;
   END;

PROCEDURE SendInit;  (* send init packet *)
   BEGIN
      Verbose ('Sending Init');
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;      (* too many tries, abort *)
            ErrorMsg('Cannot Initialize');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;
            IF (NumTry = 1) THEN
               BEGIN
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        EnCodeParm(data);
                        count := NUMPARAM;
                        seq := n;
                        ptype := TYPES;
                     END
               END;

            SendPacket; (* send this packet *)
            IF ReceiveACK THEN
               BEGIN
                  WITH Buf[CurrentPacket] DO
                     BEGIN
                        SizeSend := UnChar(data[1]);
                        TheirTimeOut := UnChar(data[2]);
                        NumPad := UnChar(data[3]);
                        PadChar := Ctl(data[4]);
                        SendEOL := CR;  (* default to CR *)
                        IF (ilength(data) >= 5) THEN
                           IF (data[5] <> 0) THEN  SendEOL := UnChar(data[5]);
                        SendQuote := SHARP;  (* default # *)
                        IF (ilength(data) >= 6) THEN
                           IF (data[6] <> 0) THEN  SendQuote := data[6];
                     END;

                  State := FileHeader;
                  NumTry := 0;
                  n := (n+1) MOD 64;
               END;
         END;
   END;


PROCEDURE SendSwitch;
   (* Send-switch is the state table switcher for sending files.
    * It loops until either it is finished or a fault is encountered.
    * Routines called by sendswitch are responsible for changing the state.
    *)

   HANDLER GotErrorPacket(VAR msg: istring) ;
      (* We got an error packet when trying to receive another packet. *)
      (* (possibly an ACK). Write the packet data and exit SEND command *)
      BEGIN
         Inverse( TRUE ) ;
         Writeln ;
         Writeln('?SEND received an error packet from the other Host') ;
         putstr(msg, STDOUT) ;
         Writeln ;
         Inverse( FALSE ) ;
         SClose( DiskFile ) ; (* close the disk file if its open *)
         State := Abort ;
         EXIT( SendSwitch )
      END ;


   BEGIN
      LoadCurs ; (* Load the progress cursors *)
      State := Init;              (* send initiate is the start state *)
      NumTry := 0;                (* say no tries yet *)
      IF (Delay > 0) THEN Sleep(Delay);
      REPEAT
         CASE State OF
            FileData:     SendData;         (* data-send state *)
            FileHeader:   SendFile;         (* send file name *)
            EOFile:       SendEOF;          (* send end-of-file *)
            Init:         SendInit;         (* send initialize *)
            Break:        SendBreak;        (* send break *)
            Complete:     (* nothing *);
            Abort:        (* nothing *);
            END (* case *);
      UNTIL ( (State = Abort) OR (State=Complete) );

      QuitProgress ;  (* Remove progress cursors *)

   END.