home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
extra
/
ndkrea.pas
< prev
next >
Wrap
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;