home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
perqb
/
pq2rea.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
18KB
|
570 lines
Module KermitRead;
{ This module exports routines for receiving files from a remote machine }
{========================} exports {=========================================}
imports KermitFile from KermitFile;
imports KermitGlobals from KermitGlobals;
function ReadSwitch : KermitStates;
function ReceiveInit( VAR RFile : FNameType ) : KermitStates;
{========================} private {=========================================}
const
SenderAborted = 'Transfer was aborted by sender error packet';
imports KermitParameters from KermitParameters;
imports KermitLineIO from KermitLineIO;
imports System from System;
imports UtilProgress from UtilProgress;
VAR Mess : String; { Last file error message }
{----------------------------------------------------------------------------}
function ReceiveInit( VAR RFile : FNameType ) : KermitStates;
{ Prod the server to make it send us a file }
VAR Pack : Packet;
begin
PutFileName( RFile, Pack );
SendPacket( RinitPack, 0, -1, Pack );
ReceiveInit := Init;
end;
{----------------------------------------------------------------------------}
function ReadData : KermitStates;
const
DataExp = '?Illegal packet type received - expected data packet';
var Len, Num, Dummy : integer;
RetVal : KermitStates;
Pack : Packet;
ErrCode : FileErrs;
handler CtlC;
begin
CtrlCPending := false;
ReadData := AbortCtlC;
exit( ReadData );
end;
begin
if Debug then begin
DbgWrite( ' Entering ReadData ..... ' );
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
Mess := '?Unable to receive data';
writeln( Mess );
RetVal := Abort1;
end
else
begin
case ReadPacket ( Num , Len , Pack ) of
DataPack :
begin
if Num <> n then
begin
OldTry := OldTry + 1;
if OldTry > MaxTryPack then begin
Mess := '?Unable to acknowledge data packet';
writeln( Mess );
SendErrPack( Mess );
RetVal := AbortAll;
end
else
begin
if Num = Prev ( n ) then
begin
SendAck( Num );
NumTry := 0;
RetVal := CurrState;
end
else begin
Mess := '?Data packet out of sequence';
writeln( Mess );
SendErrPack( Mess );
RetVal := AbortAll;
end;
end;
end
else
begin
ErrCode := EmptyBuffer ( Pack );
if ErrCode >=FNoError then begin
SendACK( n );
Succeeded;
RetVal := CurrState;
end else begin
FileError( '', ErrCode, Mess );
writeln( Mess );
RetVal := Abort1;
end
end;
end;
FHeadPack :
begin
OldTry := OldTry + 1;
if OldTry > MaxTryPack then begin
LocalError
( '?Unable to acknowledge file header packet' );
RetVal := AbortAll;
end
else
if Num = Prev ( n ) then
begin
SendACK( num );
NumTry := 0;
RetVal := CurrState;
end
else begin
LocalError( DataExp );
RetVal := Abort1;
end;
end;
EOFPack :
begin
if Num <> n then begin
LocalError( '?EOF packet out of sequence' );
RetVal := Abort1;
end
else
begin
if (Len > 0) and (Pack.Data[1] = 'D') then
ErrCode := DiscardFile
else
ErrCode := KeepFile;
if ErrCode>=FNoError then begin
SendAck( n );
Succeeded;
RetVal := FileHeader;
end else begin
FileError( '', ErrCode, Mess );
SendErrPack( Mess );
writeln( Mess );
RetVal := AbortAll;
end;
end;
end;
ErrPack:
begin
TreatErrPack( Pack, Num );
RetVal := AbortAll;
end;
NAKPack :
begin
SendNAK( n );
RetVal := CurrState;
end;
ACKPack, SInitPack,
IllPack :
begin
writeln( DataExp );
RetVal := Abort1;
end;
ChkIllPack :
begin
if Debug then begin
DbgWrite ( 'Illegal CheckSum - Sending NAK' );
DbgNL;
end;
SendNAK ( n );
RetVal := CurrState;
end;
TimOutPack :
begin
if Debug then begin
DbgWrite ( 'Timed out waiting for pack. number:' );
DbgInt ( n );
DbgNL;
end;
SendAck ( Prev(n) );
{ SendNAK ( n ); }
RetVal := CurrState;
end;
end; { case }
end;
ReadData := RetVal;
end;
{----------------------------------------------------------------------------}
Const OnlyFile = False; TextReply = True;
function ReadFile( ReplyExpected : Boolean ) : KermitStates;
const FHeadExp =
'?Illegal packet type received - expected file header packet';
var num : integer;
len : integer;
Status : integer;
Pack : Packet;
RetVal : KermitStates;
FileName : FNameType;
FE : FileErrs;
handler CtlC;
begin
CtrlCPending := false;
ReadFile := AbortCtlC;
exit( ReadFile );
end;
begin
if Debug then begin
DbgWrite( 'Entering ReadFile ...... ');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryPack then begin
LocalError( '?Unable to receive file header' );
RetVal := AbortAll;
end
else
begin
case ReadPacket ( Num , len , Pack ) of
SInitPack : { May be our ACK lost }
if ReplyExpected then begin
Mess := '?Illegal packet type received';
writeln( Mess );
SendErrPack( Mess );
RetVal := AbortAll;
end else begin
OldTry := OldTry + 1;
if OldTry > MaxTryPack then begin
writeln
( '?Unable to acknowledge send initiate packet');
RetVal := AbortAll; { abort on too many errors }
end
else
begin
if num = Prev ( n ) then
{ Previous packet? }
begin
ReadPars ( Pack ); { yes - re-ACK }
SendPacket( NoChangePack,
num,
-1,
Pack );
NumTry := 0;
RetVal := CurrState;
end;
end;
end;
EOFPack :
if ReplyExpected then begin
writeln( '?Illegal packet type received' );
RetVal := Abort1;
end else begin
OldTry := OldTry + 1;
if OldTry > MaxTryPack then begin
writeln( '?Unable to acknowledge EOF packet' );
RetVal := Abort1;
end
else
begin
if num = Prev ( n ) then
begin
SendACK( num );
NumTry := 0;
RetVal := CurrState;
end
else begin
writeln( FHeadExp );
RetVal := Abort1;
end;
end;
end;
THeadPack :
begin
if num<> n then
RetVal := Abort1
else
begin
WriteScreen;
RetVal := FileData;
end;
end;
FHeadPack : { which is what we really want }
begin
if num <> n then
RetVal := Abort1
else
begin
GetFilename ( Filename, Pack );
FE := NextWriteFile( FileName );
repeat
case FE of
FNoError, FRenamed:
begin
SendACK( n );
if Debug then begin
DbgWrite( 'Receiving : ' );
DbgFilename( FileName );
DbgNL;
end;
Succeeded;
RetVal := FileData;
FE := FNoError;
end;
otherwise: { Retry - error closing prev. file }
begin
FileError( '', FE, Mess );
writeln( Mess );
FE := NextWriteFile( FileName );
end;
end;
until FE=FNoError;
end;
end;
BrkPack :
begin
if num <> n then begin
writeln
( '?Break packet received out of sequence' );
RetVal := Abort1;
end
else
begin
SendACK( n );
RetVal := Complete;
end;
end;
ErrPack:
begin
TreatErrPack( Pack, Num );
writeln( SenderAborted );
RetVal := AbortAll;
end;
AckPack :
if ReplyExpected then begin
if N <> Num then begin
RetVal := AbortAll;
end else begin
WriteScreen;
Pack.PType := PackToCh( DataPack );
FE := EmptyBuffer( Pack );
FE := FileIdle;
RetVal := Complete;
end;
end else begin
RetVal := Abort1;
writeln( FHeadExp );
end;
DataPack, NAKPack,
IllPack :
begin
RetVal := Abort1;
writeln( FHeadExp );
end;
ChkIllPack :
begin
if Debug then begin
DbgWrite('Wrong checksum - sending NAK');
DbgNL;
end;
SendNAK( n );
RetVal := CurrState;
end;
TimOutPack :
begin
if Debug then begin
DbgWrite('Timed out waiting for FHeadPacket');
DbgNL;
end;
SendNAK( n );
RetVal := CurrState;
end;
end;
end;
ReadFile := RetVal;
end;
{----------------------------------------------------------------------------}
function ReadInit : KermitStates;
const SInitExp =
'?Illegal packet type received - expected send initiate packet';
var num : integer;
len : integer;
Pack : Packet;
RetVal : KermitStates;
Answer : PacketType;
handler CtlC;
begin
CtrlCPending := false;
ReadInit := AbortCtlC;
exit( ReadInit );
end;
begin
if Debug then begin
DbgWrite( 'Entering ReadInit ...... ');
DbgNL;
end;
NumTry := NumTry + 1;
if NumTry>1 then
TotTry := TotTry + 1;
if NumTry > MaxTryInit then begin
LocalError( '?Unable to receive initiate' );
RetVal := AbortAll;
end
else
begin
Answer := ReadPacket( Num, len, Pack );
if Answer = SInitPack then
begin
ReadPars( Pack );
SendPacket( NoChangePack,
n,
-1,
Pack );
Succeeded;
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 );
RetVal := CurrState;
end else
if Answer = ChkIllPack then begin
if Debug then begin
DbgWrite('Illegal checksum - retrying');
DbgNL;
end;
SendNAK ( n );
RetVal := CurrState;
end else
if Answer = ErrPack then begin
TreatErrPack( Pack, Num );
writeln( SenderAborted );
RetVal := AbortAll;
end else begin
if Debug then begin
DbgWrite('Unable to receive send-init-packet');
DbgNL;
DbgPacket( Pack );
end;
writeln( SInitExp );
SendErrPack( SInitExp );
RetVal := AbortAll;
end;
end;
ReadInit := RetVal;
end;
{----------------------------------------------------------------------------}
function ReadSwitch : KermitStates;
var Dummy : FileErrs;
handler CtlCAbort;
begin
CtrlCPending := false;
end;
{ This is the state table switcher for the receive file function }
begin
if (CurrState <> RemoteReply) then
CurrState := Init;
n := 0;
nn := 0;
NumTry := 0;
OldTry := 0;
TotTry := 0;
InitProgress;
LoadBusy; { From UtilProgress - load Busy bee }
ShowPackNum;
while (CurrState <> AbortAll) and (CurrState <> Complete)
and (CurrState <> AbortCtlC) do
begin
ShowPackNum;
case CurrState of
FileData :
CurrState := ReadData;
FileHeader :
CurrState := ReadFile( OnlyFile );
RemoteReply :
CurrState := ReadFile( TextReply );
Init :
CurrState := ReadInit;
EOFile, Break :
begin
LocalError
('?Unexpected packet read - EOFile or Break');
CurrState := Abort1;
end;
Abort1 :
begin
FileAbort;
CurrState := FileHeader;
end;
end;
ShowProgress( ProgressLines );
if Debug then begin
DbgWrite ( 'ReadSwitch : State transition to --> ' );
DbgState ( CurrState );
DbgNL;
end;
end;
if CurrState = AbortCtlC then begin
writeln( AbortedByCtlC );
SendErrPack( AbortedByCtlC );
end;
ReadSwitch := CurrState;
Dummy := FileIdle;
QuitProgress;
end.
