Columbia Kermit/kermit.zip/norskdata/ndkrea.pas

Pascal/Delphi Source File | 2020-01-01 | 13KB | 350 lines

(*
 *
 *
 *      Routines for reading packets
 *      and files.
 *
*)

    function    ReadData( idev, odev    : integer ;
                          var OutFile   : ByteFile ) : KermitStates;
    var     Len    : integer;
            Num    : integer;
            RetVal : KermitStates;
            Pack   : Packet;
    begin
        if Debug then begin
            DbgWrite( ' Entering ReadData ..... ' );
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            case ReadPacket ( Num , Len , Pack , Idev ) of
                DataPack :
                    begin
                        if Num <> n then
                        begin
                            OldTry := OldTry + 1;
                            if OldTry > MaxTry then
                                RetVal := Abort
                            else
                            begin
                                if  Num = Prev ( n ) then
                                begin
                                    SendAck( Num, Odev );
                                    NumTry := 0;
                                    RetVal := CurrState;
                                end
                                else
                                    RetVal := Abort;
                            end;
                        end
                        else
                        begin
                            EmptyBuffer ( OutFile , Pack ) ;
                            SendACK( n, Odev );
                            OldTry := NumTry;
                            NumTry := 0;
                            n := ( n + 1 ) mod 64;
                            RetVal := CurrState;
                        end;
                    end;

                FHeadPack   :
                    begin
                        OldTry := OldTry + 1;
                        if OldTry > MaxTry then
                            RetVal := Abort
                        else
                            if Num = Prev ( n ) then
                            begin
                                SendACK( num, Odev );
                                NumTry := 0;
                                RetVal := CurrState;
                            end
                            else
                                RetVal := Abort;
                    end;

                EOFPack     :
                    begin
                        if Num <> n then
                            RetVal := Abort
                        else
                        begin
                            SendAck( n, Odev );
                            Disconnect ( OutFile );
                            n := ( n + 1 ) mod 64;
                            RetVal := FileHeader;
                        end;
                    end;

                ACKPack, NAKPack, SInitPack,
                ErrPack, IllPack    :
                    begin
                        RetVal := Abort;
                    end;

                ChkIllPack :
                    begin
                        if Debug then begin
                            DbgWrite ( 'Illegal CheckSum received - Sending NAK$' );
                            DbgNL;
                        end;
                        SendNAK ( n , ODev );
                        RetVal := CurrState;
                    end;

                TimOutPack  :
                    begin
                        if Debug then begin
                            DbgWrite ( 'Timed out waiting for packet number:$' );
                            DbgInt ( n );
                            DbgNL;
                        end;
                        SendNAK ( n , ODev );
                        RetVal := CurrState;
                    end;
            end;  (* case *)
        end;
        ReadData := RetVal;
    end;


    function    ReadFile    ( idev, odev  : integer ;
                              var OutFile : ByteFile ) : KermitStates;

    var     num         : integer;
            len         : integer;
            Pack        : Packet;
            RetVal      : KermitStates;
            FileName    : NameType;
    begin
        if Debug then begin
            DbgWrite( 'Entering ReadFile ...... ');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            case ReadPacket ( Num , len , Pack , Idev ) of
                SInitPack   :   (* May be our ACK lost *)
                    begin
                        OldTry := OldTry + 1;
                        if OldTry > MaxTry then
                            RetVal := Abort     (* abort on too many errors *)
                        else
                        begin
                            if num = Prev ( n ) then
                            (* Previous packet? *)
                            begin
                                ReadPars ( Pack );       (* yes - re-ACK *)
                                SendPack (  NoChangePack,
                                            num,
                                            -1,
                                            Pack,
                                            odev    );
                                NumTry := 0;
                                RetVal := CurrState;
                            end;
                        end;
                    end;

                EOFPack   :
                    begin
                        OldTry := OldTry + 1;
                        if OldTry > MaxTry then
                            RetVal := Abort
                        else
                        begin
                            if  num = Prev ( n )  then
                            begin
                                SendACK( num, Odev );
                                NumTry := 0;
                                RetVal := CurrState;
                            end
                            else
                                RetVal := Abort;
                        end;
                    end;

                FHeadPack   :   (* which is what we really want *)
                    begin
                        if  num <> n then
                            RetVal := Abort
                        else
                        begin
                            GetFilename ( Filename, Pack );
                            Status := OpenWrite( OutFile, Filename );
                            if Status < 0 then
                            begin
                                if Debug then begin
                                    DbgWrite( 'Could not open file :   $' );
                                    DbgFilename( Filename );
                                    DbgNL;
                                end;
                                RetVal := Abort;
                            end
                            else
                            begin
                                if Debug then begin
                                    DbgWrite( 'Receiving : $' );
                                    DbgFilename( Filename );
                                    DbgNL;
                                end;
                                SendACK( n, Odev );
                                OldTry := NumTry;
                                NumTry := 0;
                                n := ( n + 1 ) mod 64;
                                RetVal := FileData;
                            end;
                        end;
                    end;

                BrkPack :
                    begin
                        if  num <> n then
                            RetVal := Abort
                        else
                        begin
                            SendACK( n, Odev );
                            RetVal := Complete;
                        end;
                    end;

                DataPack, ACKPack, NAKPack,
                ErrPack, IllPack :
                    begin
                        RetVal := Abort;
                    end;

                ChkIllPack :
                    begin
                        if Debug then begin
                            DbgWrite('Wrong checksum - sending NAK$');
                            DbgNL;
                        end;
                        SendNAK( n , ODev );
                        RetVal := CurrState;
                    end;

                TimOutPack  :
                    begin
                        if Debug then begin
                            DbgWrite('Timed out waiting for FHeadPacket$');
                            DbgNL;
                        end;
                        SendNAK( n , ODev );
                        RetVal := CurrState;
                    end;
            end;
        end;
        ReadFile := RetVal;
    end;



    function    ReadInit(   IDev, Odev : integer ): KermitStates;
    var     num     : integer;
            len     : integer;
            Pack    : Packet;
            RetVal  : KermitStates;
            Answer  : PacketType;
    begin
        if Debug then begin
            DbgWrite( 'Entering ReadInit ...... ');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            Answer := ReadPacket( Num, len, Pack, Idev );
            if Answer = SInitPack then
            begin
                ReadPars( Pack );
                SendPacket(     NoChangePack,
                                n,
                                -1,
                                Pack,
                                ODev    );
                OldTry := NumTry;
                NumTry := 0;
                n := (n + 1) mod 64;
                RetVal := FileHeader;
            end
            else
                if Answer = TimOutPack then begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for Send-init - Retrying$');
                        DbgNL;
                    end;
                    SendNAK ( n , ODev );
                    RetVal := CurrState;
                end else
                    if Answer = ChkIllPack then begin
                        if Debug then begin
                            DbgWrite('Illegal checksum - retrying$');
                            DbgNL;
                        end;
                        SendNAK ( n , ODev );
                        RetVal := CurrState;
                    end else begin
                        if Debug then begin
                            DbgWrite('Unable to receive send-init-packet$');
                            DbgNL;
                            DbgPacket( Pack );
                        end;
                        RetVal := Abort;
                    end;

        end;
        ReadInit := RetVal;
    end;

    function   ReadSwitch( VAR OutFile      : ByteFile;
                               Idev, Odev   : integer ) : KermitStates;
    (*  This is the state table switcher for the receive file function *)
    begin
        xhold( SUnits, Delay );
        CurrState := Init;
        n := 0;
        NumTry := 0;
        while (CurrState <> Abort) and (CurrState <> Complete) do
        begin
            case CurrState of
                FileData    :   CurrState := ReadData( IDev, Odev, OutFile );
                FileHeader  :   CurrState := ReadFile( IDev, Odev, OutFile );
                Init        :
                    begin
                        CurrState := ReadInit( IDev, Odev );
                        if RTSet then
                            TimeOut := RcvTimeOut;
                    end;
                Complete    :   ;
                EOFile, Break   :
                                begin
                                    if Debug then begin
                                        DbgWrite('Unexpected packet read - EOFile or Break$');
                                        DbgNL;
                                    end;
                                    CurrState := Abort;
                                end;
            end;

            if Debug then begin
                DbgWrite ( 'ReadSwitch :  State transition to --> $' );
                DbgState ( CurrState );
                DbgNL;
            end;
        end;
        ReadSwitch := CurrState;
    end;