home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
perqa.tar.gz
/
perqa.tar
/
kermitrecv.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1984-12-04
|
23KB
|
706 lines
MODULE KermitRecv ;
(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
(* 30-Nov-83 During a receive clear the screen and show characters *)
(* and packets received. [pgt002] *)
EXPORTS
FUNCTION ReceiveACK : (* Returning *) Boolean;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
PRIVATE
IMPORTS KermitGlobals FROM KermitGlobals ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitError FROM KermitError ;
IMPORTS KermitSend FROM KermitSend ; (* for sending ACKs and NAKs, etc *)
IMPORTS Screen FROM Screen ; (* screen control [pgt002] *)
VAR
OldChInFile: Stats ; (* Characters in file [pgt002]*)
BadPackets: Integer ; (* Bad packet count for this recv [pgt002]*)
{$RANGE-} (* Range checks off to see if it runs faster (16-Jan-84)*)
PROCEDURE Field1; (* Count *)
VAR
test: Boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
Buf[InputPacket].count := t;
count := UnChar(t);
test := (count >= 3) OR (count <= SizeRecv-2);
(* IF (NOT test) AND Debug THEN ErrorMsg('Bad count'); *)
good := good AND test;
END;
END;
END;
PROCEDURE Field2; (* Packet Number *)
VAR
test : Boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
Buf[InputPacket].seq := t;
seq := UnChar(t);
test := (seq >= 0) OR (seq <= 63);
(* IF (NOT test) AND Debug THEN ErrorMsg('Bad seq number'); *)
good := test AND good;
END;
END;
END;
PROCEDURE Field3; (* Packet Type *)
VAR
test : Boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
ptype := t;
Buf[InputPacket].ptype := t;
test := IsValidPType(ptype);
(* IF (NOT test) AND Debug THEN ErrorMsg('Bad Packet Type'); *)
good := test AND good;
END;
END;
END;
PROCEDURE Field4; (* Data *)
BEGIN
WITH PackControl DO
BEGIN
PacketPtr := PacketPtr+1;
Buf[InputPacket].data[PacketPtr] := t;
WITH Buf[NextPacket] DO
BEGIN
IF (t = MyQuote) THEN (* character is quote *)
BEGIN
IF control THEN (* quote ,quote *)
BEGIN
data[i] := MyQuote;
i := i+1;
control := False;
END
ELSE (* set control on *)
control := True
END
ELSE (* not quote *)
IF control THEN (* convert to control *)
BEGIN
data[i] := ctl(t);
i := i+1;
control := False
END
ELSE (* regular data *)
BEGIN
data[i] := t;
i := i+1;
END;
END;
END;
END;
PROCEDURE Field5; (* Check Sum *)
VAR
test : Boolean;
BEGIN
WITH PackControl DO
BEGIN
PacketPtr := PacketPtr +1;
Buf[InputPacket].data[PacketPtr] := t;
Buf[InputPacket].data[PacketPtr + 1] := ENDSTR;
check := CheckFunction(check);
check := MakeChar(check);
test := (t=check);
IF (NOT test) AND Debug THEN ErrorMsg('Bad CheckSum');
good := test AND good;
Buf[NextPacket].data[i] := ENDSTR;
finished := True; (* set finished *)
END;
END;
PROCEDURE BuildPacket;
(* receive packet & validate checksum *)
VAR
temp : Ppack;
BEGIN
WITH PackControl DO
BEGIN
WITH Buf[NextPacket] DO
BEGIN
IF (t <> ENDSTR) THEN
IF restart THEN
BEGIN
(* read until get SOH marker *)
IF (t = SOH) THEN
BEGIN
finished := False; (* set varibles *)
control := False;
good := True;
seq := -1; (* set return values to bad packet *)
ptype := QUESTION;
data[1] := ENDSTR;
data[MAXSTR] := ENDSTR;
restart := False;
fld := 0;
i := 1;
PacketPtr := 0;
check := 0;
END;
END
ELSE (* Not restart -pt*) (* have started packet *)
BEGIN
IF (t = SOH) THEN (* check for restart or EOL *)
restart := True
ELSE
IF (t = myEOL) THEN
BEGIN
finished := True;
good := False;
END
ELSE
BEGIN
CASE fld OF
(* increment field number *)
0: fld := 1;
1: fld := 2;
2: fld := 3;
3:
IF (count = 3) (* no data *)
THEN fld := 5
ELSE fld := 4;
4:
IF (PacketPtr>=count-3) (* end of data *)
THEN fld := 5;
END (* case *);
IF (fld <> 5)
THEN check := check+t; (* add into checksum *)
CASE fld OF
1: Field1;
2: Field2;
3: Field3;
4: Field4;
5: Field5;
END;
(* case *)
END;
END;
IF finished THEN
BEGIN
IF (ptype = TYPEE) AND good THEN (* error_packets *)
BEGIN
SendACK(n); (* send ACK *)
RAISE GotErrorPacket( data ) ; (* ********** *)
END;
NumRecvPacks := NumRecvPacks+1;
IF Debug THEN
BEGIN
DebugPacket('Received: ',InputPacket);
IF good THEN ErrorMsg('Is Good');
END;
temp := CurrentPacket;
CurrentPacket := NextPacket;
NextPacket := temp;
END;
END;
END;
END;
FUNCTION ReceivePacket: Boolean;
BEGIN
WITH PackControl DO
BEGIN
StartTimer;
good := False ;
finished := False;
restart := True;
(* No Keyboard Interupt - Set by ^C handler -pt*)
FromConsole := nothing;
REPEAT
t := GetIn;
CheckTimer ;
IF (FromConsole = abortnow) THEN
BEGIN
State := ABORT ;
ReceivePacket := False ;
EXIT( ReceivePacket )
END;
BuildPacket;
UNTIL finished OR (TimeLeft <= 0);
IF (TimeLeft <= 0) THEN
BEGIN
Buf[CurrentPacket] := TOPacket;
restart := True;
IF NOT ((RunType=Transmit) AND (State=Init)) THEN
BEGIN
ErrorInt('%Timed out ', n)
END;
END;
StopTimer;
IF NOT good THEN BadPackets := BadPackets + 1 ;
ReceivePacket := good;
END;
END;
FUNCTION ReceiveACK : (* Returning *) Boolean;
(* receive ACK with correct number *)
VAR
Ok: Boolean;
BEGIN
Ok := ReceivePacket;
WITH Buf[CurrentPacket] DO
BEGIN
IF (ptype = TYPEY) THEN NumACKrecv := NumACKrecv+1
ELSE
IF (ptype = TYPEN) THEN NumNAKrecv := NumNAKrecv+1
ELSE
NumBadrecv := NumBadrecv +1;
(* got right one ? *)
ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
END;
END;
PROCEDURE GetFile((* Using *) data:istring);
(* create file from fileheader packet *)
VAR
len: Integer;
PROCEDURE Strip( var name: istring ) ;
(* Strip off any blanks (usually trailing) from the file name *)
VAR i, newpos: integer ;
BEGIN (*-Strip-*)
newpos := 1 ; (* this is the new character position for non-blanks *)
FOR i := 1 TO ilength(name) DO
IF (name[i] = blank) THEN (* skip it by not incrementing "newpos" *)
ELSE
BEGIN (* restore character *)
name[newpos] := name[i] ;
newpos := newpos + 1
END ;
name[newpos] := ENDSTR
END ; (*-Strip-*)
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
IF (DiskFile = StdIOError) THEN (* check if we already have a file *)
BEGIN
Strip( data ) ; (* remove any blanks *)
IF Verbosity THEN
BEGIN
ErrorMsg ('Creating file: ');
ErrorStr(data);
END;
IF Exists(data) AND FileWarning THEN
BEGIN
ErrorMsg('File already exists ');
ErrorStr(data);
ErrorMsg('Creating: ');
(* Make it <file>.A *)
len := ilength(data) + 1 ; (* first free char pos *)
data[len] := PERIOD ;
data[len+1] := leta ;
data[len+2] := ENDSTR;
ErrorStr(data)
END;
IF EightBitFile THEN
DiskFile := Sopen(data,StdIO8Write)
ELSE
DiskFile := Sopen(data,StdIOWrite);
END;
IF (Diskfile <= StdIOError) THEN ErrorPack('Cannot create file ');
END;
END;
PROCEDURE ReceiveInit;
(* receive init packet *)
(* respond with ACK and our parameters *)
BEGIN
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort;
ErrorMsg('Cannot receive init');
END
ELSE
BEGIN
Verbose('Receiving Init');
NumTry := NumTry+1;
IF ReceivePacket
AND (Buf[CurrentPacket].ptype = TYPES) THEN
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
n := seq;
DeCodeParm(data);
END;
(* now send mine *)
WITH Buf[ThisPacket] DO
BEGIN
count := NUMPARAM;
seq := n;
Ptype := TYPEY;
EnCodeParm(data);
END;
SendPacket;
NumACK := NumACK+1;
State := FileHeader;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64
END
ELSE
BEGIN
IF Debug THEN ErrorMsg('Received Bad init');
SendNAK(n);
END;
END;
END;
PROCEDURE DataToFile; (* output to file *)
VAR
len,i : Integer;
temp : istring;
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
len := ilength(data);
ChInFile := ChInFile + len ;
PutStr(data,DiskFile)
END;
END;
PROCEDURE Dodata; (* Process Data packet *)
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
IF ( seq = ((n + 63) MOD 64)) THEN
BEGIN (* data last one *)
IF (OldTry > MaxTry) THEN (* number of tries? *)
BEGIN
State := Abort;
ErrorMsg('Old data - Too many');
END
ELSE
BEGIN
SendACK(seq);
NumTry := 0;
END;
END
ELSE
BEGIN (* data - this one *)
IF (n <> seq) THEN SendNAK(n)
ELSE
BEGIN
SendACK(n); (* ACK *)
DataToFile;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64;
END;
END;
END;
END;
PROCEDURE DoFileLast; (* Process File Packet *)
BEGIN (* File header - last one *)
IF (OldTry > MaxTry) THEN (* tries ? *)
BEGIN
State := Abort;
ErrorMsg('Old file - Too many ');
END
ELSE
BEGIN
OldTry := OldTry+1;
WITH Buf[CurrentPacket] DO
BEGIN
IF (seq = ((n + 63) MOD 64)) THEN (* packet number *)
BEGIN (* send ACK *)
SendACK(seq);
NumTry := 0
END
ELSE
BEGIN
SendNAK(n); (* NAK *)
END;
END;
END;
END;
PROCEDURE DoEOF; (* Process EOF packet *)
BEGIN (* EOF - this one *)
IF (Buf[CurrentPacket].seq <> n) THEN (* packet number ? *)
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
Sclose(DiskFile); (* close file *)
DiskFile := StdIOError;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64; (* next packet *)
State := FileHeader; (* change state *)
END;
END;
PROCEDURE ReceiveData; (* Receive data packets *)
VAR
strend: Integer;
packetnum: istring;
good : Boolean;
BEGIN
IF (NumTry > MaxTry) THEN (* check number of tries *)
BEGIN
State := Abort;
ErrorInt('Recv data -Too many ', n)
END
ELSE
BEGIN
NumTry := NumTry+1; (* increase number of tries *)
good := ReceivePacket; (* get packet *)
WITH Buf[CurrentPacket] DO
BEGIN
IF Verbosity THEN
BEGIN
ErrorInt('Receiving (Data) ', Buf[CurrentPacket].seq);
END ;
IF ((ptype = TYPED) OR (ptype=TYPEZ)
OR (ptype=TYPEF)) AND good THEN (* check type *)
CASE ptype OF
TYPED: DoData;
TYPEF: DoFileLast;
TYPEZ: DoEOF;
END (* case *)
ELSE
BEGIN
Verbose('Expected data pack');
SendNAK(n);
END;
END;
END;
END;
PROCEDURE DoBreak; (* Process Break packet *)
BEGIN (* Break transmission *)
IF (Buf[CurrentPacket].seq <> n) THEN (* packet number ? *)
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n) ;
State := Complete (* change state *)
END
END;
PROCEDURE DoFile; (* Process file packet *)
BEGIN (* File Header *)
WITH Buf[CurrentPacket] DO
BEGIN
IF (seq <> n) THEN (* packet number ? *)
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
ChInFile := ChInFile + ilength(data) ;
GetFile(data); (* get file name *)
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64; (* next packet *)
State := FileData; (* change state *)
END;
END;
END;
PROCEDURE DoEOFLast; (* Process EOF Packet *)
BEGIN (* End Of File Last One*)
IF (OldTry > MaxTry) THEN (* tries ? *)
BEGIN
State := Abort;
ErrorMsg('Old EOF - Too many');
END
ELSE
BEGIN
OldTry := OldTry+1;
WITH Buf[CurrentPacket] DO
BEGIN
IF (seq =((n + 63 ) MOD 64)) THEN (* packet number *)
BEGIN (* send ACK *)
SendACK(seq);
Numtry := 0
END
ELSE
BEGIN
SendNAK(n); (* NAK *)
END
END;
END;
END;
PROCEDURE DoInitLast;
BEGIN (* Init Packet - last one *)
IF (OldTry > MaxTry) THEN (* number of tries? *)
BEGIN
State := Abort;
ErrorMsg('Old init - Too many');
END
ELSE
BEGIN
OldTry := OldTry+1;
(* packet number *)
IF (Buf[CurrentPacket].seq = ((n + 63) MOD 64)) THEN
BEGIN (* send ACK *)
WITH Buf[ThisPacket] DO
BEGIN
count := NUMPARAM;
seq := Buf[CurrentPacket].seq;
ptype := TYPEY;
EnCodeParm(data);
END;
SendPacket;
NumACK := NumACK+1;
NumTry := 0;
END
ELSE
BEGIN
SendNAK(n); (* NAK *)
END;
END;
END;
PROCEDURE ReceiveFile; (* receive file packet *)
VAR
good: Boolean;
BEGIN
IF (NumTry > MaxTry) THEN (* check number of tries *)
BEGIN
State := Abort;
ErrorMsg('Recv file - Too many');
END
ELSE
BEGIN
NumTry := NumTry+1; (* increase number of tries *)
good := ReceivePacket; (* get packet *)
WITH Buf[CurrentPacket] DO
BEGIN
IF Verbosity THEN BEGIN
ErrorInt('Receiving (File) ', seq)
END;
(* Set up for new file [pgt002] *)
OldChInFile := ChInFile ; (* Start value *)
BadPackets := 0 ;
SSetCursor(250, 100) ;
Write('File: ');
PutStr(data,stdout);
Write(' ':10) ; (* blank the end of any other names *)
IF ((ptype = TYPES) OR (ptype=TYPEZ)
OR (ptype=TYPEF) OR (ptype=TYPEB)) (* check type *)
AND good THEN
CASE ptype OF
TYPES: DoInitLast;
TYPEZ: DoEOFLast;
TYPEF: DoFile;
TYPEB: DoBreak;
END (* case *)
ELSE
BEGIN
IF Debug THEN ErrorMsg('Expected File Pack');
SendNAK(n);
END;
END;
END;
END;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
HANDLER GotErrorPacket( VAR msg: istring ) ;
(* Handle any error packets reveived. Write msg and exit *)
BEGIN
Inverse( TRUE ) ;
Writeln ;
Writeln('?RECV received error packet from other Host');
putstr(msg, STDOUT) ;
Writeln ;
Inverse( FALSE ) ;
SClose( DiskFile ) ; (* Close the file, if open *)
State := Abort ;
EXIT( RecvSwitch )
END ;
BEGIN
State := Init;
NumTry := 0;
OldChInFile := ChInFile ; (* Start value *)
BadPackets := 0 ;
(* set up the progress reports (c.f. ReceiveFile too) [pgt002] *)
IF NOT Verbosity THEN
BEGIN
SPutChr(FF) ; (* clear the screen *)
SSetCursor(200, 150); Write( 'Current Packet' );
SSetCursor(200, 170); Write( 'Characters received' );
SSetCursor(200, 190); Write( 'Bad packets received' )
END ;
REPEAT
(* Each time thru' the loop print the values [pgt002] *)
IF NOT Verbosity THEN
BEGIN
SSetCursor(410, 150); Write( n:8 ) ;
SSetCursor(410, 170); Write( (ChInFile-OldChInFile):10:0 ) ;
SSetCursor(410, 190); Write( BadPackets:8 )
END ;
CASE State OF
FileData: ReceiveData;
Init: ReceiveInit;
Break: (* nothing *);
FileHeader: ReceiveFile;
EOFile: (* nothing *);
Complete: (* nothing *);
Abort: (* nothing *);
END; (* case *)
UNTIL ( State = Abort ) OR ( State = Complete );
SSetCursor(10, 250) ;
Writeln
END.
