home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
extra
/
ndksen.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-08-16
|
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;
