(* * * 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;