home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
perqb
/
pq2sen.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
20KB
|
719 lines
module KermitSend;
{ the module contains routines for sending files to a remote kermit }
{=========================} exports {========================================}
imports KermitGlobals from KermitGlobals;
function SendSwitch : KermitStates;
{=========================} private {========================================}
const
ACKExp = '?Illegal packet type received - expected ACK packet';
RecvrAborted = 'Transfer aborted by error packet from receiver';
imports KermitFile from KermitFile;
imports KermitParameters from KermitParameters;
imports KermitLineIO from KermitLineIO;
imports System from System;
imports UtilProgress from UtilProgress;
{-----------------------------------------------------------------------------}
var FNPacket, FDPacket : Packet;
FileName : FNameType;
{-----------------------------------------------------------------------------}
function SendInitiate : KermitStates;
var RetVal : KermitStates;
Pack : Packet;
num : integer;
len : integer;
status : integer;
message : string;
handler CtlC;
begin
CtrlCPending := false;
SendInitiate := AbortCtlC;
exit( SendInitiate );
end;
begin
if Debug then begin
DbgWrite('Enter SendInit');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryInit then begin
LocalError( '?Unable to send initiate' );
RetVal := AbortAll
end
else
begin
if Debug then begin
DbgWrite(' n =');
DbgInt( n );
DbgNL;
end;
SetInitPars ( Pack );
SendPacket ( SInitPack,
n,
-1,
Pack );
case ReadPacket( num, len, Pack ) of
NAKPack :
begin
RetVal := CurrState;
end;
ACKPack :
begin
if num <> n then (* Wrong ACK ? *)
RetVal := CurrState (* Stay in current state *)
else
begin
ReadPars( Pack );
Succeeded;
case NextReadFile(FileName) of
FNoFile, FNoReadPriv, FReadErr, FCantOpen:
begin
Message := concat('?Cannot open: ',FileName );
SendErrPack( Message );
Writeln( Message );
RetVal := AbortAll;
end;
FEndDir:
begin
Message := Concat('?No files matching: ',
FileName );
Writeln( Message );
RetVal := Break;
end;
FNoError:
begin
RetVal := FileHeader;
PutFileName( FileName, FNPacket );
end;
end;
end;
end;
ErrPack:
begin
RetVal := AbortAll;
TreatErrPack( Pack, Num );
writeln( RecvrAborted );
end;
DataPack, SInitPack, BrkPack,
FHeadPack, EOFPack,
IllPack :
begin
RetVal := AbortAll;
LocalError( ACKExp );
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 : KermitStates;
var RetVal : KermitStates;
len, i : integer;
num : integer;
Treated : boolean;
Pack : Packet;
Answer : PacketType;
SaveTime: integer;
handler CtlC;
begin
CtrlCPending := false;
SendFileHeader := AbortCtlC;
exit( SendFileHeader );
end;
begin
if Debug then begin
DbgWrite('Enter SendFileHeader');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
LocalError( '?Unable to receive an ACK for file header' );
RetVal := AbortAll; { No use trying a new file header }
end
else
begin
SendPacket( FHeadPack,
n,
-1,
FNPacket );
SaveTime := SendTimeOut;
SendTimeOut := SendTimeOut * LongWait;
Answer := ReadPacket( num, len, Pack );
SendTimeOut := 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
Succeeded;
if FillBuffer( FDPacket ) >= FNoError then
RetVal := FileData
else
RetVal := Abort1;
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
if Answer = ErrPack then begin
RetVal := AbortAll;
TreatErrPack( Pack, Num );
writeln( RecvrAborted );
end else
begin
writeln( ACKExp );
SendErrPack( ACKExp );
RetVal := AbortAll;
end;
end;
end;
SendFileHeader := RetVal;
end;
{-----------------------------------------------------------------------------}
function SendData : KermitStates;
var RetVal : KermitStates;
RecPack: Packet;
Answer : PacketType;
len : integer;
num : integer;
Treated: boolean;
handler CtlC;
begin
CtrlCPending := false;
SendData := AbortCtlC;
exit( SendData );
end;
begin
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
if LocalKermit then
LocalError( '?Unable to receive an ACK for data packet' );
RetVal := Abort1;
end
else
begin
SendPacket( DataPack,
n,
-1,
FDPacket );
Answer := ReadPacket( Num, Len, RecPack );
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
Succeeded;
if EndFile then
RetVal := EOFile
else
begin
if FillBuffer( FDPacket ) >= FNoError then
RetVal := CurrState
else
RetVal := Abort1;
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
if Answer = ErrPack then begin
RetVal := AbortAll;
TreatErrPack( RecPack, Num );
writeln( RecvrAborted );
end else
begin
SendErrPack( ACKExp );
writeln( ACKExp );
RetVal := Abort1;
end;
end;
end;
SendData := RetVal;
end; (* SendData *)
{-----------------------------------------------------------------------------}
function SendEof : KermitStates;
var Pack : Packet;
Len : integer;
Num : integer;
RetVal : KermitStates;
Treated: boolean;
Answer : PacketType;
FE : FileErrs;
handler CtlC;
begin
CtrlCPending := false;
SendEOF := AbortCtlC;
exit( SendEOF );
end;
begin
if Debug then begin
DbgWrite('Enter SendEof');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
if LocalKermit then
LocalError( '?Unable to receive an ACK for EOF packet' );
RetVal := Abort1;
end
else
begin
SendPacket ( EOFPack,
n,
0,
Pack (* Dummy *) );
Answer := ReadPacket( Num , Len, Pack );
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
Succeeded;
FileName := '';
FE := NextReadFile( FileName );
repeat
if FE=FNoError then begin
RetVal := FileHeader;
PutFileName( FileName, FNPacket );
end else if FE=FEndDir then begin
RetVal := Break;
FE := FNoError;
end else if FE IN [FCantOpen,FNoReadPriv] then begin
SendErrPack(
'?File open error, terminating file group');
writeln(
'?File open error, terminating file group');
FE := FNoError;
end else { Error closing prev. file, retry NextReadFile }
FE := NextReadFile( FileName );
until FE=FNoError;
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('Illegal checksum read - retrying');
DbgNL;
end;
RetVal := CurrState;
end else
if Answer = ErrPack then begin
RetVal := AbortAll;
TreatErrPack( Pack, Num );
writeln( RecvrAborted );
end else
begin
writeln( ACKExp );
RetVal := Abort1;
end;
end;
end;
SendEOF := RetVal;
end;
{-----------------------------------------------------------------------------}
function SendBrkP : KermitStates;
var Answer : PacketType;
Treated: boolean;
Pack : Packet;
Len : integer;
Num : integer;
RetVal : KermitStates;
handler CtlC;
begin
CtrlCPending := false;
SendBrkP := AbortCtlC;
exit( SendBrkP );
end;
begin
FileName := '';
if Debug then begin
DbgWrite('Enter Send-break');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
LocalError( '?Unable to receive an ACK for break packet' );
RetVal := AbortAll;
end
else
begin
SendPacket ( BrkPack,
n,
0,
Pack (* dummy *) );
Answer := ReadPacket ( Num, Len, Pack );
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
Succeeded;
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
if Answer = ErrPack then begin
RetVal := AbortAll;
TreatErrPack( Pack, Num );
writeln( RecvrAborted );
end else
begin
writeln( ACKExp );
SendErrPack( ACKExp );
RetVal := AbortAll;
end;
end;
end;
SendBrkP := RetVal;
end;
{-----------------------------------------------------------------------------}
function SendDiscard : KermitStates;
var Answer : PacketType;
Treated: boolean;
Pack : Packet;
Len : integer;
Num : integer;
RetVal : KermitStates;
handler CtlC;
begin
CtrlCPending := false;
SendDiscard := AbortCtlC;
exit( SendDiscard );
end;
begin
if Debug then begin
DbgWrite('Enter SendDiscard');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
LocalError( '?Unable to receive an ACK for EOF discard packet' );
RetVal := AbortAll;
end
else
begin
Pack.Data := 'D '; { EOF discard }
SendPacket ( EOFPack,
n,
0,
Pack (* dummy *) );
Answer := ReadPacket ( Num, Len, Pack );
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
Succeeded;
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 EOF-discard 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
if Answer = ErrPack then begin
RetVal := AbortAll;
TreatErrPack( Pack, Num );
writeln( RecvrAborted );
end else
begin
writeln( ACKExp );
SendErrPack( ACKExp );
RetVal := AbortAll;
end;
end;
end;
SendDiscard := RetVal;
end;
{-----------------------------------------------------------------------------}
function SendSwitch : KermitStates;
var Dummy : FileErrs;
handler CtlCAbort;
begin
CtrlCPending := false;
end;
begin
FileName := '';
CurrState := Init;
n := 0;
nn := 0;
NumTry := 0;
TotTry := 0;
InitProgress;
LoadBusy;
ShowPackNum;
while (CurrState <> Complete) and (CurrState <> AbortAll) and
(CurrState <> AbortCtlC) do
begin
case CurrState of
FileData:
CurrState := SendData;
FileHeader:
CurrState := SendFileHeader;
Abort1:
CurrState := SendDiscard;
EOFile:
CurrState := SendEof;
Init:
CurrState := SendInitiate;
Break:
CurrState := SendBrkP;
end; (* case *)
ShowPackNum; { Show last packet number }
ShowProgress( ProgressLines );
if Debug then begin
DbgWrite ( 'SendSwitch : State transition to --> ' );
DbgState ( CurrState );
DbgNL;
end;
end; (* while *)
if CurrState = AbortAll then
Writeln( 'Transfer was aborted at ', FileName )
else
if CurrState = AbortCtlC then begin
writeln( AbortedByCtlC );
SendErrPack( AbortedByCtlC );
end;
SendSwitch := CurrState;
Dummy := FileIdle;
QuitProgress;
end.
