Columbia Kermit/kermit.zip/perqa/kermitrecv.pas

Pascal/Delphi Source File | 2020-01-01 | 23KB | 706 lines

MODULE KermitRecv ;

(* 29-Nov-83  Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
(* 30-Nov-83  During a receive clear the screen and show characters    *)
(*            and packets received.      [pgt002]                      *)


EXPORTS

FUNCTION ReceiveACK : (* Returning *) Boolean;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)


PRIVATE

IMPORTS KermitGlobals   FROM KermitGlobals ;
IMPORTS KermitUtils     FROM KermitUtils ;
IMPORTS Stdio           FROM Stdio ;
IMPORTS KermitError     FROM KermitError ;
IMPORTS KermitSend      FROM KermitSend ;  (* for sending ACKs and NAKs, etc *)
IMPORTS Screen          FROM Screen ;  (* screen control [pgt002] *)


VAR
   OldChInFile: Stats ;  (* Characters in file [pgt002]*)
   BadPackets: Integer ; (* Bad packet count for this recv [pgt002]*)


{$RANGE-}     (* Range checks off to see if it runs faster   (16-Jan-84)*)


PROCEDURE Field1; (* Count *)
   VAR
      test: Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  Buf[InputPacket].count := t;
                  count := UnChar(t);
                  test := (count >= 3) OR (count <= SizeRecv-2);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad count'); *)
                  good := good AND test;
               END;
         END;
   END;

PROCEDURE Field2; (* Packet Number *)
   VAR
      test : Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  Buf[InputPacket].seq := t;
                  seq := UnChar(t);
                  test := (seq >= 0) OR (seq <= 63);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad seq number'); *)
                  good := test AND good;
               END;
         END;
   END;

PROCEDURE Field3; (* Packet Type *)
   VAR
      test : Boolean;
   BEGIN
      WITH Buf[NextPacket] DO
         BEGIN
            WITH PackControl DO
               BEGIN
                  ptype := t;
                  Buf[InputPacket].ptype := t;
                  test := IsValidPType(ptype);
                  (* IF (NOT test) AND Debug THEN ErrorMsg('Bad Packet Type'); *)
                  good := test AND good;
               END;
         END;
   END;

PROCEDURE Field4; (* Data *)
   BEGIN
      WITH PackControl DO
         BEGIN
            PacketPtr := PacketPtr+1;
            Buf[InputPacket].data[PacketPtr] := t;
            WITH Buf[NextPacket] DO
               BEGIN
                  IF (t = MyQuote) THEN    (* character is quote *)
                     BEGIN
                        IF control THEN        (* quote ,quote  *)
                           BEGIN
                              data[i] := MyQuote;
                              i := i+1;
                              control := False;
                           END
                        ELSE      (* set control on *)
                           control := True
                     END
                  ELSE                 (* not quote *)
                     IF control THEN      (* convert to control *)
                        BEGIN
                           data[i] := ctl(t);
                           i := i+1;
                           control := False
                        END
                     ELSE      (* regular data *)
                        BEGIN
                           data[i] := t;
                           i := i+1;
                        END;
               END;
         END;
   END;

PROCEDURE Field5; (* Check Sum *)
   VAR
      test : Boolean;
   BEGIN
      WITH PackControl DO
         BEGIN
            PacketPtr := PacketPtr +1;
            Buf[InputPacket].data[PacketPtr] := t;
            Buf[InputPacket].data[PacketPtr + 1] := ENDSTR;
            check := CheckFunction(check);
            check := MakeChar(check);
            test := (t=check);
            IF (NOT test) AND Debug THEN ErrorMsg('Bad CheckSum');
            good := test AND good;
            Buf[NextPacket].data[i] := ENDSTR;
            finished := True;  (* set finished *)
         END;
   END;

PROCEDURE BuildPacket;
   (* receive packet & validate checksum *)
   VAR
      temp : Ppack;
   BEGIN
      WITH PackControl DO
         BEGIN
            WITH Buf[NextPacket] DO
               BEGIN
                  IF (t <> ENDSTR) THEN
                     IF restart THEN
                        BEGIN
                           (* read until get SOH marker *)
                           IF (t = SOH) THEN
                              BEGIN
                                 finished := False;    (* set varibles *)
                                 control := False;
                                 good := True;
                                 seq := -1;        (* set return values to bad packet *)
                                 ptype := QUESTION;
                                 data[1] := ENDSTR;
                                 data[MAXSTR] := ENDSTR;
                                 restart := False;
                                 fld := 0;
                                 i := 1;
                                 PacketPtr := 0;
                                 check := 0;
                              END;
                        END
                     ELSE  (* Not restart -pt*)    (* have started packet *)
                        BEGIN
                           IF (t = SOH) THEN    (* check for restart or EOL *)
                              restart := True
                           ELSE
                              IF (t = myEOL) THEN
                                 BEGIN
                                    finished := True;
                                    good := False;
                                 END
                              ELSE
                                 BEGIN
                                    CASE fld OF
                                       (* increment field number *)
                                       0:   fld := 1;
                                       1:   fld := 2;
                                       2:   fld := 3;
                                       3:
                                          IF (count = 3)  (* no data *)
                                          THEN fld := 5
                                          ELSE fld := 4;
                                       4:
                                          IF (PacketPtr>=count-3) (* end of data *)
                                          THEN fld := 5;
                                       END (* case *);
                                    IF (fld <> 5)
                                    THEN  check := check+t; (* add into checksum *)

                                    CASE fld OF
                                       1:      Field1;
                                       2:      Field2;
                                       3:      Field3;
                                       4:      Field4;
                                       5:      Field5;
                                    END;
                                    (* case *)
                                 END;
                        END;

                  IF finished THEN
                     BEGIN
                        IF (ptype = TYPEE) AND good THEN (* error_packets *)
                           BEGIN
                              SendACK(n);          (* send ACK *)

                              RAISE GotErrorPacket( data ) ; (* ********** *)

                           END;
                        NumRecvPacks := NumRecvPacks+1;
                        IF Debug THEN
                           BEGIN
                              DebugPacket('Received: ',InputPacket);
                              IF good THEN ErrorMsg('Is Good');
                           END;

                        temp := CurrentPacket;
                        CurrentPacket := NextPacket;
                        NextPacket := temp;
                     END;
               END;
         END;
   END;

FUNCTION ReceivePacket: Boolean;
   BEGIN
      WITH PackControl DO
         BEGIN
            StartTimer;
            good := False ;
            finished := False;
            restart := True;
            (* No Keyboard Interupt - Set by ^C handler -pt*)
            FromConsole := nothing;
            REPEAT
               t := GetIn;

               CheckTimer ;
               IF (FromConsole = abortnow) THEN
                  BEGIN
                     State := ABORT ;
                     ReceivePacket := False ;
                     EXIT( ReceivePacket )
                  END;

               BuildPacket;
            UNTIL finished  OR (TimeLeft <= 0);
            IF (TimeLeft <= 0) THEN
               BEGIN
                  Buf[CurrentPacket] := TOPacket;
                  restart := True;
                  IF NOT ((RunType=Transmit) AND (State=Init)) THEN
                     BEGIN
                        ErrorInt('%Timed out ', n)
                     END;
               END;
            StopTimer;
            IF NOT good THEN BadPackets := BadPackets + 1 ;
            ReceivePacket := good;
         END;
   END;

FUNCTION ReceiveACK : (* Returning *) Boolean;
   (* receive ACK with correct number *)
   VAR
      Ok: Boolean;
   BEGIN
      Ok := ReceivePacket;
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF (ptype = TYPEY) THEN   NumACKrecv := NumACKrecv+1
            ELSE
               IF (ptype = TYPEN) THEN  NumNAKrecv := NumNAKrecv+1
               ELSE
                    NumBadrecv := NumBadrecv +1;
            (* got right one ? *)
            ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
         END;
   END;


PROCEDURE GetFile((* Using *) data:istring);
   (* create file from fileheader packet *)
   VAR
      len: Integer;

   PROCEDURE Strip( var name: istring ) ;
   (* Strip off any blanks (usually trailing) from the file name *)
   VAR i, newpos: integer ;
   BEGIN (*-Strip-*)
      newpos := 1 ;  (* this is the new character position for non-blanks *)
      FOR i := 1 TO ilength(name) DO
        IF (name[i] = blank) THEN (* skip it by not incrementing "newpos"  *)
        ELSE
           BEGIN (* restore character *)
              name[newpos] := name[i] ;
              newpos := newpos + 1
           END ;

      name[newpos] := ENDSTR
   END ; (*-Strip-*)

   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF (DiskFile = StdIOError) THEN (* check if we already have a file *)
               BEGIN
                  Strip( data ) ;  (* remove any blanks *)
                  IF Verbosity THEN
                     BEGIN
                        ErrorMsg ('Creating file: ');
                        ErrorStr(data);
                     END;
                  IF Exists(data) AND FileWarning THEN
                     BEGIN
                        ErrorMsg('File already exists ');
                        ErrorStr(data);
                        ErrorMsg('Creating: ');
                        (* Make it <file>.A *)
                        len := ilength(data) + 1 ; (* first free char pos *)
                        data[len] := PERIOD ;
                        data[len+1] := leta ;
                        data[len+2] := ENDSTR;
                        ErrorStr(data)
                     END;
                  IF EightBitFile THEN
                     DiskFile := Sopen(data,StdIO8Write)
                  ELSE
                     DiskFile := Sopen(data,StdIOWrite);
               END;
            IF (Diskfile <= StdIOError) THEN ErrorPack('Cannot create file  ');
         END;
   END;

PROCEDURE ReceiveInit;
   (* receive init packet *)
   (* respond with ACK and  our parameters *)
   BEGIN
      IF (NumTry > MaxTry) THEN
         BEGIN
            State := Abort;
            ErrorMsg('Cannot receive init');
         END
      ELSE
         BEGIN
            Verbose('Receiving Init');
            NumTry := NumTry+1;
            IF ReceivePacket
               AND (Buf[CurrentPacket].ptype = TYPES) THEN
               BEGIN
                  WITH Buf[CurrentPacket] DO
                     BEGIN
                        n := seq;
                        DeCodeParm(data);
                     END;

                  (* now send mine *)
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        count := NUMPARAM;
                        seq := n;
                        Ptype := TYPEY;
                        EnCodeParm(data);
                     END;

                  SendPacket;

                  NumACK := NumACK+1;
                  State := FileHeader;
                  OldTry := NumTry;
                  NumTry := 0;
                  n := (n+1) MOD 64
               END
            ELSE
               BEGIN
                  IF Debug THEN ErrorMsg('Received Bad init');
                  SendNAK(n);
               END;
         END;
   END;

PROCEDURE DataToFile; (* output to file *)
   VAR
      len,i : Integer;
      temp : istring;
   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            len := ilength(data);
            ChInFile := ChInFile + len ;
            PutStr(data,DiskFile)
         END;
   END;

PROCEDURE Dodata;  (* Process Data packet *)

   BEGIN
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF ( seq = ((n + 63) MOD 64)) THEN
               BEGIN                (* data last one *)
                  IF (OldTry > MaxTry) THEN     (* number of tries? *)
                     BEGIN
                        State := Abort;
                        ErrorMsg('Old data - Too many');
                     END
                  ELSE
                     BEGIN
                        SendACK(seq);
                        NumTry := 0;
                     END;
               END
            ELSE
               BEGIN            (* data - this one *)
                  IF (n <> seq) THEN  SendNAK(n)
                  ELSE
                     BEGIN
                        SendACK(n); (* ACK *)
                        DataToFile;
                        OldTry := NumTry;
                        NumTry := 0;
                        n := (n+1) MOD 64;
                     END;
               END;
         END;
   END;

PROCEDURE DoFileLast;   (* Process File Packet *)
   BEGIN          (* File header - last one  *)
      IF (OldTry > MaxTry) THEN   (* tries ? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old file - Too many ');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF (seq = ((n + 63) MOD 64)) THEN     (* packet number *)
                     BEGIN  (* send ACK *)
                        SendACK(seq);
                        NumTry := 0
                     END
                  ELSE
                     BEGIN
                        SendNAK(n);   (* NAK *)
                     END;
               END;
         END;
   END;

PROCEDURE DoEOF;  (* Process EOF packet *)
   BEGIN                 (* EOF - this one *)
      IF (Buf[CurrentPacket].seq <> n) THEN   (* packet number ? *)
         SendNAK(n) (* NAK *)
      ELSE
         BEGIN               (* send ACK *)
            SendACK(n);
            Sclose(DiskFile);  (* close file *)
            DiskFile := StdIOError;
            OldTry := NumTry;
            NumTry := 0;
            n := (n+1) MOD 64; (* next packet  *)
            State := FileHeader;   (* change state *)
         END;
   END;

PROCEDURE ReceiveData;  (* Receive data packets *)
   VAR
      strend: Integer;
      packetnum: istring;
      good : Boolean;

   BEGIN
      IF (NumTry > MaxTry) THEN    (* check number of tries *)
         BEGIN
            State := Abort;
            ErrorInt('Recv data -Too many ', n)
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;                (* increase number of tries *)
            good := ReceivePacket;        (* get packet *)
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF Verbosity THEN
                     BEGIN
                        ErrorInt('Receiving (Data) ', Buf[CurrentPacket].seq);
                     END ;

                  IF ((ptype = TYPED) OR (ptype=TYPEZ)
                      OR (ptype=TYPEF)) AND good  THEN   (* check type *)
                     CASE ptype OF
                        TYPED:  DoData;
                        TYPEF:  DoFileLast;
                        TYPEZ:  DoEOF;
                        END (* case *)
                  ELSE
                     BEGIN
                        Verbose('Expected data pack');
                        SendNAK(n);
                     END;
               END;
         END;
   END;

PROCEDURE DoBreak; (* Process Break packet *)
   BEGIN                    (* Break transmission *)
      IF (Buf[CurrentPacket].seq <> n) THEN  (* packet number ? *)
         SendNAK(n) (* NAK *)
      ELSE
         BEGIN            (* send  ACK *)
            SendACK(n) ;
            State := Complete  (* change state *)
         END
   END;

PROCEDURE DoFile; (* Process file packet *)
   BEGIN                 (* File Header *)
      WITH Buf[CurrentPacket] DO
         BEGIN
            IF (seq <> n) THEN         (* packet number ? *)
               SendNAK(n)  (* NAK *)
            ELSE
               BEGIN               (* send ACK *)
                  SendACK(n);
                  ChInFile := ChInFile + ilength(data) ;
                  GetFile(data);   (* get file name *)
                  OldTry := NumTry;
                  NumTry := 0;
                  n := (n+1) MOD 64; (* next packet  *)
                  State := FileData;   (* change state *)
               END;
         END;
   END;

PROCEDURE DoEOFLast; (* Process EOF Packet *)
   BEGIN               (* End Of File Last One*)
      IF (OldTry > MaxTry) THEN (* tries ? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old EOF - Too many');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF (seq =((n + 63 ) MOD 64)) THEN   (* packet number *)
                     BEGIN  (* send ACK *)
                        SendACK(seq);
                        Numtry := 0
                     END
                  ELSE
                     BEGIN
                        SendNAK(n);  (* NAK *)
                     END
               END;
         END;
   END;

PROCEDURE DoInitLast;
   BEGIN                (* Init Packet - last one *)
      IF (OldTry > MaxTry) THEN  (* number of tries? *)
         BEGIN
            State := Abort;
            ErrorMsg('Old init - Too many');
         END
      ELSE
         BEGIN
            OldTry := OldTry+1;
            (* packet number *)
            IF (Buf[CurrentPacket].seq = ((n + 63) MOD  64)) THEN
               BEGIN   (* send ACK *)
                  WITH Buf[ThisPacket] DO
                     BEGIN
                        count := NUMPARAM;
                        seq := Buf[CurrentPacket].seq;
                        ptype := TYPEY;
                        EnCodeParm(data);
                     END;
                  SendPacket;
                  NumACK := NumACK+1;
                  NumTry := 0;
               END
            ELSE
               BEGIN
                  SendNAK(n);  (* NAK *)
               END;
         END;
   END;

PROCEDURE ReceiveFile; (* receive file packet *)
   VAR
      good: Boolean;

   BEGIN
      IF (NumTry > MaxTry) THEN     (* check number of tries *)
         BEGIN
            State := Abort;
            ErrorMsg('Recv file - Too many');
         END
      ELSE
         BEGIN
            NumTry := NumTry+1;                (* increase number of tries *)
            good := ReceivePacket;             (* get packet *)
            WITH Buf[CurrentPacket] DO
               BEGIN
                  IF Verbosity THEN BEGIN
                     ErrorInt('Receiving (File) ', seq)
                  END;

                  (* Set up for new file [pgt002] *)
                  OldChInFile := ChInFile ; (* Start value *)
                  BadPackets := 0 ;

                  SSetCursor(250, 100) ;
                  Write('File: ');
                  PutStr(data,stdout);
                  Write(' ':10) ; (* blank the end  of any other names *)

                  IF ((ptype = TYPES) OR (ptype=TYPEZ)
                      OR (ptype=TYPEF) OR (ptype=TYPEB)) (* check type *)
                  AND good    THEN
                     CASE ptype OF
                        TYPES:  DoInitLast;
                        TYPEZ:  DoEOFLast;
                        TYPEF:  DoFile;
                        TYPEB:  DoBreak;
                        END (* case *)
                  ELSE
                     BEGIN
                        IF Debug THEN   ErrorMsg('Expected File Pack');
                        SendNAK(n);
                     END;
               END;
         END;
   END;


PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)

   HANDLER GotErrorPacket( VAR msg: istring ) ;
     (* Handle any error packets reveived. Write msg and exit *)
     BEGIN
        Inverse( TRUE ) ;
        Writeln ;
        Writeln('?RECV received error packet from other Host');
        putstr(msg, STDOUT) ;
        Writeln ;
        Inverse( FALSE ) ;
        SClose( DiskFile ) ;  (* Close the file, if open *)
        State := Abort ;
        EXIT( RecvSwitch )
     END ;

   BEGIN
      State := Init;
      NumTry := 0;

      OldChInFile := ChInFile ; (* Start value *)
      BadPackets := 0 ;

      (* set up the progress reports (c.f. ReceiveFile too) [pgt002] *)
      IF NOT Verbosity THEN
         BEGIN
           SPutChr(FF) ; (* clear the screen *)
           SSetCursor(200, 150);   Write( 'Current Packet' );
           SSetCursor(200, 170);   Write( 'Characters received' );
           SSetCursor(200, 190);   Write( 'Bad packets received' )
         END ;


      REPEAT

         (* Each time thru' the loop print the values [pgt002] *)
         IF NOT Verbosity THEN
            BEGIN
              SSetCursor(410, 150);  Write( n:8 ) ;
              SSetCursor(410, 170);  Write( (ChInFile-OldChInFile):10:0 ) ;
              SSetCursor(410, 190);  Write( BadPackets:8 )
            END ;


         CASE State OF
            FileData:       ReceiveData;
            Init:           ReceiveInit;
            Break:          (* nothing *);
            FileHeader:     ReceiveFile;
            EOFile:         (* nothing *);
            Complete:       (* nothing *);
            Abort:          (* nothing *);
         END; (* case *)

      UNTIL ( State = Abort ) OR ( State = Complete );

      SSetCursor(10, 250) ;
      Writeln
   END.