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

Pascal/Delphi Source File | 2020-01-01 | 16KB | 466 lines

(*
 *
 *      Routines for sending files.
 *      Low-level routines (send a packet etc.) are in the file Kermit-PacketLvl
 *
 *      Globals: ( among others )
 *          CurrState : KermitStates    - the state Kermit is in.
 *
 *
*)

    function    GetNewFile( VAR FileList   :   NListPtr;
                            VAR InFile     :   ByteFile;
                            VAR FNPacket   :   Packet  ): KermitStates;
    (*
     * Get (possibly) a new file from FileList, build fileheader packet
     * and open InFile. Return Abort (Could not open file), FileHeader(OK) or
     * Break(No more files in list).
     *)
    var     RetVal  :   KermitStates;
            Status  :   integer;
            p       :   NListPtr;
    begin
        if FileList <> NIL then begin
            with FileList^ do begin
                if Debug then begin
                    DbgWrite('Opening file: $');
                    DbgFileName( Name ); DbgNL;
                end;
                Status := OpenRead( InFile, Name );
                if Status <> 0 then begin
                    if Debug then begin
                        DbgWrite('Error opening file: $');
                        DbgFileName( Name ); DbgNL;
                    end;
                    RetVal := Abort;
                end else begin
                    if AltUsed then begin
                        if Debug then begin
                            DbgWrite('Sending as: $');
                            DbgFileName( AltName ); DbgNL;
                        end;
                        PutFileName( AltName, FNPacket, NoTranslate);
                    end else
                        PutFileName( Name, FNPacket, DoTranslate);
                    RetVal := FileHeader;
                    (* Dispose of first filename-pair in list *)
                    p := FileList;
                    FileList := FileList^.Next;
                    dispose(p);
                end;
            end;
        end else RetVal := Break;
        GetNewFile := RetVal;
    end;

    function SendInitiate(  idev, odev  : integer;
                        VAR FileList    : NListPtr;
                        VAR InFile      : ByteFile;
                        VAR FNPacket    : Packet        ) : KermitStates;

    var     RetVal   : KermitStates;
            Pack     : Packet;
            num      : integer;
            len      : integer;
            p        : NListPtr;
    begin
        if Debug then begin
            DbgWrite('Enter SendInit$');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else begin
            SetInitPars ( Pack );
            if Debug then begin
                DbgWrite(' n =$');
                DbgInt( n );
                DbgNL;
            end;
            SendPacket (    SInitPack,
                            n,
                            -1,
                            Pack,
                            ODev );
            case ReadPacket( num, len, Pack, idev ) of
                NAKPack :
                    begin
                        RetVal := CurrState;
                    end;

                ACKPack :
                    begin
                        if num <> n then     (* Wrong ACK ? *)
                            RetVal := CurrState     (* Stay in current state *)
                        else begin
                            ReadPars( Pack );
                            NumTry := 0;
                            n := (n + 1) mod 64;
                            RetVal := GetNewFile( FileList, InFile, FNPacket );
                        end;
                    end;

                DataPack, SInitPack, BrkPack,
                FHeadPack, EOFPack, ErrPack,
                IllPack :
                    begin
                        RetVal := Abort;
                    end;

                ChkIllPack :
                    begin
                        if Debug then begin
                            DbgWrite('Illegal checksum read - retrying$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end;

                TimOutPack  :
                    begin
                        if Debug then begin
                            DbgWrite('Timed out waiting for ACK for SendInit$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end;

            end;
        end;
        SendInitiate := RetVal;
    end;

    function    SendFileHeader(     idev, odev  : integer;
                                VAR FNPacket    : Packet;
                                VAR FDPacket    : Packet;
                                VAR INFile      : ByteFile    ) : KermitStates;

    var     RetVal  : KermitStates;
            len, i  : integer;
            num     : integer;
            Treated : boolean;
            Pack    : Packet;
            Answer  : PacketType;
            SaveTime: integer;
    begin
        if Debug then begin
            DbgWrite('Enter SendFileHeader$');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            SendPacket( FHeadPack,
                        n,
                        -1,
                        FNPacket,
                        Odev    );

            SaveTime := TimeOut;
            TimeOut := TimeOut * LongWait;
            Answer := ReadPacket( num, len, Pack, idev );
            TimeOut := SaveTime;
            Treated := false;
            if Answer = NAKPack then
            begin
                Treated := True;
                Num := Prev( Num );
                if n <> Num then         (* is it a NAK for the next packet? *)
                    RetVal := CurrState  (* NO - stay in current state       *)
                else
                    Answer := ACKPack;   (* YES - treat as ACK for current   *)
            end;
            if Answer = ACKPack then
            begin
                Treated := true;
                if n <> num then
                    RetVal := CurrState
                else
                begin
                    NumTry := 0;
                    n := (n + 1) mod 64;
                    FillBuffer( FDPacket, InFile );
                    RetVal := FileData;
                end;
            end;
            if not Treated then
            begin
                if Answer = TimOutPack then
                begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for ACK for File-header$');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ChkIllPack then begin
                        if Debug then begin
                            DbgWrite('Illegal checksum read - retrying$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end else begin
                        if Debug then begin
                            DbgWrite('Illegal packet-type received-aborting$');
                            DbgNL;
                        end;
                        RetVal := Abort;
                    end;
            end;
        end;
        SendFileHeader := RetVal;
    end;

    function   SendData( idev, odev    : integer ;
                          var Pack      : Packet ;
                          var InFile    : ByteFile ) : KermitStates;
    var     RetVal : KermitStates;
            RecPack: Packet;
            Answer : PacketType;
            len    : integer;
            num    : integer;
            Treated: boolean;
    begin
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else begin
            SendPacket( DataPack,
                        n,
                        -1,
                        Pack,
                        ODev    );
            Answer := ReadPacket( Num, Len, RecPack, Idev );
            Treated := false;
            if Answer = NAKPack then begin
                Treated := true;
                Num := Prev( Num );
                if n <> Num then
                    RetVal := CurrState
                else
                    Answer := ACKPack;
            end;
            if Answer = ACKPack then begin
                Treated := true;
                if n <> Num then
                    RetVal := CurrState
                else begin
                    NumTry := 0;
                    n := (n + 1) mod 64;
                    if EOF( infile ) then
                        RetVal := EOFile
                    else begin
                        FillBuffer( Pack, InFile );
                        RetVal := CurrState;
                    end;
                end;
            end;
            if not Treated then begin
                if Answer = TimOutPack then begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for ACK for FileData$');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ChkIllPack then begin
                        if Debug then begin
                            DbgWrite('Illegal checksum read - retrying$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end else
                        RetVal := Abort;
            end;
        end;
        SendData := RetVal;
    end; (* SendData *)

    function    SendEof( idev, odev     : integer;
                         VAR NameList   : NListPtr;
                         VAR InFile     : ByteFile;
                         VAR FNPack     : Packet ) : KermitStates;
    var     Pack   : Packet;
            Len    : integer;
            Num    : integer;
            RetVal : KermitStates;
            Treated: boolean;
            Answer : PacketType;
    begin
        if Debug then begin
            DbgWrite('Enter SendEof$');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            SendPacket (    EOFPack,
                            n,
                            0,
                            Pack,   (* Dummy *)
                            ODev    );
            Answer := ReadPacket( Num , Len, Pack, IDev );
            Treated := false;
            if Answer = NAKPack then
            begin
                Treated := true;
                Num := Prev( Num );
                if Num <> n then
                    RetVal := CurrState
                else
                    Answer := ACKPack;
            end;
            if Answer = ACKPack then begin
                Treated := true;
                if n <> Num then
                    RetVal := CurrState
                else begin
                    NumTry := 0;
                    n := (n + 1) mod 64;
                    if Debug then begin
                        DbgWrite('Closing input-file$');
                        DbgNL;
                    end;
                    if ( CloseFile( InFile )<>0 ) and Debug then begin
                        DbgWrite(' Unable to close input file$');
                        DbgNL;
                    end;
                    RetVal := GetNewFile( NameList, InFile, FNPack );
                end;
            end;
            if not Treated then
            begin
                if Answer = TimOutPack then begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for ACK for EOF-packet$');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ChkIllPack then begin
                        if Debug then begin
                            DbgWrite('Illegel checksum read - retrying$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end else
                        RetVal := Abort;
            end;
        end;
        SendEOF := RetVal;
    end;

    function    SendBreak( idev, odev : integer ) : KermitStates;
    var     Answer : PacketType;
            Treated: boolean;
            Pack   : Packet;
            Len    : integer;
            Num    : integer;
            RetVal : KermitStates;
    begin
        if Debug then begin
            DbgWrite('Enter Send-break$');
            DbgNL;
        end;
        NumTry := NumTry + 1;
        if NumTry > MaxTry then
            RetVal := Abort
        else
        begin
            SendPacket (    BrkPack,
                            n,
                            0,
                            Pack,   (* dummy *)
                            ODev    );
            Answer := ReadPacket ( Num, Len, Pack, Idev );
            Treated := false;
            if Answer = NAKPack then
            begin
                Treated := true;
                Num := Prev( Num );
                if Num <> n then
                    RetVal := CurrState
                else
                    Answer := ACKPack;
            end;
            if Answer = ACKPack then
            begin
                Treated := true;
                if n <> ord(Num) then
                    RetVal := CurrState
                else
                begin
                    NumTry := 0;
                    n := (n + 1) mod 64;
                    RetVal := Complete;
                end;
            end;
            if not Treated then
            begin
                if Answer = TimOutPack then begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for ACK for Brk-packet$');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ChkIllPack then begin
                        if Debug then begin
                            DbgWrite('Illegal checksum read - retrying$');
                            DbgNL;
                        end;
                        RetVal := CurrState;
                    end else
                        RetVal := Abort;
            end;
        end;
        SendBreak := RetVal;
    end;

    function    SendSwitch( VAR NameList : NListPtr;
                            VAR InFile   : ByteFile ;
                            Idev, Odev   : integer      ) :  KermitStates;
    var     FNPack, FDPack  : Packet;
    begin
        CurrState := Init;
        xhold( SUnits, Delay );
        n := 0;
        NumTry := 0;
        while (CurrState <> Complete) and (CurrState <> Abort) do
        begin
            case CurrState of
                FileData    :   CurrState := SendData( Idev, Odev,
                                                FDPack, InFile );
                FileHeader  :   CurrState := SendFileHeader( Idev, Odev,
                                                FNPack, FDPack, InFile );
                EOFile      :   CurrState := SendEof( Idev, Odev,
                                                NameList, InFile, FNPack );
                Init        :
                    begin
                        CurrState := SendInitiate( Idev, Odev,
                                                NameList, InFile, FNPack );
                        if STSet then
                            TimeOut := SendTimeOut;
                    end;
                Break       :   CurrState := SendBreak( Idev, Odev );
                Complete,
                Abort       :   ;
            end; (* case *)
            if Debug then begin
                DbgWrite ( 'SendSwitch :  State transition to --> $' );
                DbgState ( CurrState );
                DbgNL;
            end;
        end; (* while *)
        SendSwitch := CurrState;
    end;