MODULA - M2PROT.ZIP - QCKERMIT.MOD

 
Output of file : QCKERMIT.MOD contained in archive : M2PROT.ZIP

(*# call(o_a_copy => off) *)
(*%F _fdata *)
(*# call(seg_name => null) *)
(*%E *)
(*# module(implementation=>on) *)
(*# data(seg_name => null) *)
IMPLEMENTATION MODULE QCkermit;

(* This JPI Modula-2 module is part of *)

(* QC -- a communications program *)
(* by Carl Neiburger *)
(* 169 N. 25th St.*)
(* San Jose, Calif. 95116 *)

(* CompuServe No. 72336,2257 *)

FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM NFIO IMPORT Close, Create, File, OK, Open, PathStr, PathTail, Size,
RdChar, WrBin;
FROM Str IMPORT Append, CHARSET, Concat, Copy, Insert, Length;
FROM QCdisp IMPORT DataBytes, DataLeft, DataRegisters, DisplayData, Errs,
PromptForChar, ShowErrorType, ShowFileName, ShowPacketSize, IncrDataBytes,
ShowTransferTime, ShowTimeLeft, StartDisplay, StatusMessage, StopDisplay,
CloseError, CreateError, OpenError, TimeoutMsg, TimeoutAbortMsg,
Kermit, WriteErrorMsg;
FROM Lib IMPORT Fill, Move, SetJmp, LongJmp, LongLabel;
FROM QCkpack IMPORT GetDefinitions, SendDefaults, MyExtControls, PackPtr,
RecvBuf, RecvCount, RecvPacket, RecvSeq, RecvType, SendBuf, SendCount,
SendPacket, SendPacketType, SendSeq, SendType, PacketSize, CtlChar,
TheirDefs, InitDefinitions;
FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
FROM UTIL IMPORT NUMSET, SBITSET, str2, str3, str6;
FROM PathFind IMPORT ParsePath;

CONST
BUFFERSIZE = 1024;
QuotedChars = NUMSET{63..96,63+128..96+128};
ControlChars = CHARSET{0C..37C,177C..237C,377C};
KAbortMsg = 'Sending files aborted';
TransferAborted = 'File transfer aborted.';

TYPE
AbortType = (NoSoh, BadSf, NotS, NotSFBZ, NotDZ);
BreakType = (NoBreak, BX, BZ, BC, BE);

VAR
AbortState : AbortType;
AbortLbl : LongLabel; (* return point for abort exit *)
BreakState : BreakType;

PROCEDURE DisplayErrMsg;
VAR Msg: PathStr;
BEGIN
Move( RecvBuf, ADR(Msg), RecvCount );
IF RecvCount < SIZE(Msg) THEN
Msg[RecvCount] := 0C
END;
Insert(Msg, 'Error: ', 0);
StatusMessage(Msg, TRUE);
END DisplayErrMsg;

PROCEDURE BreakAck (Achar : CHAR);
BEGIN (* SEND ACK or NAK *)
SendPacket( 1, (SendSeq + 1) MOD 64, 'Y', ADR(Achar) );
END BreakAck;

PROCEDURE SendKermit( FileList: FilePtr );

TYPE
SendStateType = (SendStart,
SendHdr,
SendData,
SendZPkt,
SendBPkt,
SendDone,
SendAbort);
VAR
SendState : SendStateType;
Data : PackPtr; (* Where data is stored before being sent *)
abyte : SHORTCARD;
ThisChar,
PrevChar : CHAR;
Msg : PathStr;
FileName : PathTail;
ChrLen,
TCount, (* to update DataBytes *)
MaxOutData,
RepCount : CARDINAL;
BytesToGo : LONGINT;
WeInitiatedAbort,
LastFile : BOOLEAN;
FileBuffer : ARRAY [1..BUFFERSIZE] OF CHAR;
Fi : File;
SaveStr : str6;

PROCEDURE ResendIt ( Retries : SHORTINT );
(* resends packet; if it gets a nak, it repeats for up to Retries times.
If it fails, it sets SendState to Abort. *)
BEGIN
REPEAT
INC(DataRegisters[FALSE, Errs]);
DisplayData( Errs, FALSE );
SendPacket( SendCount, SendSeq, SendType, SendBuf );
CASE RecvPacket() OF
'Y': RETURN;
|'N': IF (RecvSeq = (SendSeq+1) MOD 64) THEN
SendSeq := RecvSeq;
RETURN
ELSE
DEC(Retries)
END;
|'E': DisplayErrMsg;
SendState := SendAbort;
WeInitiatedAbort := FALSE;
RETURN;
|'@': WeInitiatedAbort := TRUE;
SendState := SendAbort;
|'T': DEC(Retries, 2);
|ELSE DEC(Retries)
END;
UNTIL Retries < 1;
StatusMessage (TimeoutAbortMsg, FALSE);
SendState := SendAbort;
WeInitiatedAbort := TRUE;
END ResendIt;

PROCEDURE QuotedChar(ch: CHAR; VAR i: CARDINAL): str3;
VAR chrstr: str3;
BEGIN
Fill( ADR(chrstr), SIZE(chrstr), 0);
IF (7 IN SBITSET(ch)) AND (TheirDefs.Bit8Quote <> ' ') THEN
chrstr[0] := TheirDefs.Bit8Quote;
EXCL( SBITSET(ch), 7 );
i := 1
ELSE
i := 0
END;
IF (ch IN ControlChars) THEN
ch := CHR( SBITSET(ch)/SBITSET(40H));
chrstr[i] := '#';
INC(i);
ELSIF ch IN MyExtControls THEN
chrstr[i] := '#';
INC(i);
END; (* CONTROL QUOTING *)
chrstr[i] := ch;
INC(i);
RETURN chrstr
END QuotedChar;

PROCEDURE RepChar(count: CARDINAL): str2;
VAR repstr: str2;
BEGIN
repstr[0] := TheirDefs.RepChar;
repstr[1] := CHR(count + 21H); (* cq, to increment counter *)
RETURN repstr
END RepChar;


PROCEDURE SendChar;
BEGIN
Move(ADR(SaveStr), ADR(Data^[SendCount+1]), ChrLen);
INC(SendCount, ChrLen);
SaveStr[0] := 0C;
PrevChar := ThisChar;
RepCount := 0
END SendChar;

BEGIN (* SendKermit *)
NEW(Data);
NEW(RecvBuf);
InitDefinitions;
SendState := SendStart;
BreakState := NoBreak;
LastFile := FALSE;
StartDisplay( TRUE, Kermit, FALSE );
LOOP
IF SetJmp ( AbortLbl ) <> 0 THEN
EXIT
END;
CASE SendState OF
SendStart: SendDefaults( 'S' );
INC(SendState);
|SendHdr: IF SendType = 'S' THEN
GetDefinitions;
ShowPacketSize(PacketSize);
ShowErrorType(TheirDefs.CheckType = '3');
END;
ShowFileName( FileList^.Name, FALSE );
FileName := '*.*';
Fi := Open(FileList^.Name);
IF (Fi = MAX(CARDINAL)) OR
NOT ParsePath(FileList^.Name, FileName) THEN
StatusMessage(OpenError, FALSE);
WeInitiatedAbort := TRUE;
SendState := SendAbort
ELSE
Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
BytesToGo := VAL(LONGINT, Size(Fi));
DataRegisters[FALSE,DataLeft]:=VAL(LONGCARD,BytesToGo);
StartTimer(ForPacket);
StartTimer(ForTransfer);
ShowTimeLeft( FALSE );
SaveStr[0] := 0C; (* Initialize for SendData *);
SendPacket( Length(FileName), (SendSeq + 1) MOD 64,
'F', ADR(FileName) );
INC(SendState);
MaxOutData := PacketSize+30H-ORD(TheirDefs.CheckType);
IF PacketSize <= 94 THEN
DEC(MaxOutData, 2)
END;
PrevChar := RdChar(Fi); (* initialize for SendData *)
END;
|SendData: SendCount := 0;
TCount := 0;
RepCount := 0;
IF SaveStr[0] > 0C THEN
SendChar
END;
LOOP
IF (SendCount >= MaxOutData) OR (BytesToGo = 0) THEN
EXIT
END;
ThisChar := RdChar(Fi);
DEC(BytesToGo);
INC(TCount);
IF (PrevChar=ThisChar) AND (TheirDefs.RepChar>' ')
AND ( BytesToGo > 0) AND (RepCount < 94) THEN
INC(RepCount);
ELSE (* different char *)
IF RepCount < 2 THEN
Copy( SaveStr, QuotedChar(PrevChar, ChrLen));
IF RepCount = 1 THEN
Append( SaveStr, SaveStr);
ChrLen := ChrLen * 2
END;
ELSE
Concat( SaveStr, RepChar(RepCount),
QuotedChar(PrevChar, ChrLen));
INC( ChrLen, 2 );
END;
IF SendCount + ChrLen <= MaxOutData THEN
SendChar
ELSE
EXIT
END;
END; (* different char *)
END; (* WHILE Read a char *)
IncrDataBytes(TCount, FALSE);
DisplayData ( DataBytes, FALSE );
IF BytesToGo = 0 THEN
SendState := SendZPkt
END;
SendPacket( SendCount, (SendSeq + 1) MOD 64, 'D', Data );
CASE BreakState OF
|BC : EXIT;
|BE : SendState := SendAbort;
WeInitiatedAbort := TRUE;
|BX : SendState := SendZPkt;
|BZ : SendState := SendZPkt;
LastFile := TRUE;
END;
|SendZPkt: Close(Fi); (* End of File *)
Concat(Msg, 'File ', FileName);
IF BreakState = NoBreak THEN
Append(Msg, ' sent.');
ELSE
Append(Msg, ' partly sent.');
END;
StatusMessage(Msg, FALSE );
IF LastFile OR (FileList^.Next = NIL) THEN
INC(SendState)
ELSE
FileList := FileList^.Next;
SendState := SendHdr
END; (* Get next file *)
IF BreakState = BX THEN
BreakState := NoBreak
END;
SendPacketType('Z');
ShowTransferTime;
|SendBPkt: SendPacketType('B'); (* Last file sent *)
SendState := SendDone;

|SendDone: IF BreakState <> NoBreak THEN (* Completed Sending *)
StatusMessage(TransferAborted, FALSE);
END;
EXIT;

|SendAbort: Close(Fi);
IF WeInitiatedAbort THEN
StatusMessage(KAbortMsg, FALSE);
AbortState := BadSf;
SendPacket( Length(KAbortMsg), 0, 'E', ADR(KAbortMsg));
ELSE
SendPacketType('Y')
END;
ShowTransferTime;
EXIT;
END; (* CASE of SendState *)
WHILE (RecvPacket() IN CHARSET{'Q','T'}) OR
((RecvSeq <> SendSeq) AND (RecvPacket() IN CHARSET{'Q','T'}))
AND (SendState <> SendAbort) DO
ResendIt(10)
END;
IF (SendState <> SendAbort) THEN
CASE RecvType OF
'Y': IF RecvCount > 1 THEN
CASE CHR(RecvBuf^[1]) OF
'X': SendState := SendZPkt;
|'Z': SendState := SendZPkt;
LastFile := TRUE;
END
END;
|'N': ResendIt(10);
|'R': SendState := SendStart;
|'E': DisplayErrMsg;
SendState := SendAbort;
WeInitiatedAbort := FALSE;
ELSE SendState := SendAbort;
WeInitiatedAbort := TRUE;
END
END
END; (* LOOP *)
StopDisplay;
DISPOSE(RecvBuf);
DISPOSE(Data);
END SendKermit;

PROCEDURE ReceiveKermit( Path, GetFile : ARRAY OF CHAR);
(* If GetFile > 0C, R packet will be sent *)
CONST buffersize = 1280; (* must be a multiple of 128 *)
TYPE
RecvStateType = ( RecvGet,
RecvStart,
RecvHdr,
RecvData,
RecvDone,
RecvAbort);

VAR
RecvState : RecvStateType;
ReplaceFile : BOOLEAN;
Bit8,
LastSeqNum : SHORTCARD;
Retries : SHORTINT;
RCount,
i, j,
CharCount : CARDINAL;
FileName,
Msg : PathStr;
Fi : File;
FileBuffer : ARRAY [1..BUFFERSIZE] OF CHAR;

PROCEDURE SendNak;
BEGIN
IF Retries > 0 THEN (* Ask for a retransmission *)
SendPacketType('N');
INC(DataRegisters[TRUE, Errs]);
DisplayData( Errs, TRUE );
DEC(SendSeq);
DEC(Retries);
ELSE
RecvState := RecvAbort;
StatusMessage(TimeoutMsg, FALSE);
END;
END SendNak;

PROCEDURE Resend;
BEGIN
IF RecvType = 'T' THEN (* get it over twice as fast *)
DEC(Retries)
END;
IF Retries > 0 THEN
INC(DataRegisters[FALSE, Errs]);
DisplayData( Errs, FALSE );
SendPacket( SendCount, SendSeq, SendType, SendBuf );
DEC(Retries)
ELSE
StatusMessage (TimeoutAbortMsg, FALSE);
RecvState := RecvAbort;
END
END Resend;

PROCEDURE SetAbort;
VAR ch : CHAR;
BEGIN
IF RecvState = RecvData THEN
PromptForChar('Abort (A)ll, (F)ile, (T)ransfer), (Panic)', ch);
ELSE
PromptForChar('Abort (A)ll, (Panic)', ch);
END;
CASE CAP(ch) OF
'A': RecvState := RecvAbort;
BreakState := BE;
|'F': BreakState := BX;
|'T': BreakState := BZ;
|'P': BreakState := BC;
LongJmp( AbortLbl, MAX(CARDINAL) ); (* TRY to do without this *)
ELSE BreakState := BE;
END;
END SetAbort;

BEGIN (* ReceiveKermit *)
NEW(RecvBuf);
RecvType := ' '; (* initialize to inconsequential value *)
ReplaceFile := FALSE;
InitDefinitions;
LastSeqNum := 0;
IF GetFile[0] > 0C THEN
RecvState := RecvGet;
ELSE
RecvState := RecvStart;
END;
BreakState := NoBreak;
Retries := 10;
StartDisplay( TRUE, Kermit, TRUE );
LOOP
IF SetJmp ( AbortLbl ) <> 0 THEN
EXIT
END;
CASE RecvState OF
RecvGet: SendDefaults( 'I' );
CASE RecvPacket() OF
'Y': GetDefinitions;
Concat( Msg, 'Receiving ', GetFile );
SendPacket( Length(GetFile), 0, 'R', ADR(GetFile) );
INC(RecvState);
|'N', 'Q', 'T': Resend;
|'@': SetAbort;
ELSE
IF RecvType = 'E' THEN (* Error Packet *)
DisplayErrMsg;
END;
RecvState := RecvAbort; (* Abort if not INIT packet *)
AbortState := NotS;
END; (* CASE *)
|RecvStart: CASE RecvPacket() OF
'N', 'Q', 'T': Resend;
|'S': SendDefaults( 'Y' );
GetDefinitions; (* Init packet *)
SendSeq := 0;
INC(RecvState);
ShowPacketSize(PacketSize);
ShowErrorType(TheirDefs.CheckType = '3');
|'@': SetAbort;
ELSE
IF RecvType = 'E' THEN (* Error Packet *)
DisplayErrMsg;
END;
RecvState := RecvAbort; (* Abort if not INIT packet *)
AbortState := NotS;
END; (* CASE *)
(* Receive FileName; Valid received msg type : S,Z,F,B *)
|RecvHdr: CASE RecvPacket() OF
'N', 'Q', 'T': Resend;
|'S': RecvState:= RecvStart;
|'Z': SendPacketType('N');
|'B': RecvState := RecvDone;
|'@': SetAbort;
|'F': Move(RecvBuf, ADR(FileName), RecvCount);
FileName[RecvCount] := 0C;
Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
ShowFileName( FileName, TRUE );
INC(RecvState);
Fi := Create(FileName);
IF Fi = MAX(CARDINAL) THEN
Msg := 'Error creating file';
SendPacket(Length(Msg),(SendSeq+1) MOD 64,'E',ADR(Msg));
RecvState := RecvAbort;
StatusMessage(CreateError, FALSE)
END;
SendPacketType('Y');
StartTimer(ForPacket);
StartTimer(ForTransfer);
|ELSE (* Not S,F,B,Z packet *)
IF RecvType = 'E' THEN (* Error Packet *)
DisplayErrMsg;
END;
RecvState := RecvAbort;
AbortState := NotSFBZ;
END; (* CASE RecvType *)
|RecvData: IF RecvPacket() IN CHARSET{'N', 'Q', 'T'} THEN
SendNak (* Receive Data -- Valid msg type : D,Z *)
ELSIF RecvType = '@' THEN
SetAbort;
CASE BreakState OF
|BC : EXIT;
|BE : RecvState := RecvAbort;
|BX : BreakAck('X');
BreakState := NoBreak;
|BZ : BreakAck('Z');
END;
Concat(Msg, ' Receiving file ', FileName );
Append(Msg, ' Interrupted');
StatusMessage( Msg, FALSE );
ELSIF LastSeqNum = RecvSeq THEN
SendPacketType('Y')
ELSE
Retries := 10;
LastSeqNum := RecvSeq;
CASE RecvType OF
'D': i := 1;
RCount := 0;
WHILE i <= RecvCount DO (* Write Data to file *)
IF (TheirDefs.RepChar <> ' ')
AND (CHR(RecvBuf^[i]) = TheirDefs.RepChar) THEN
INC(i);
CharCount := ORD(RecvBuf^[i]) - 20H;
INC(i);
ELSE
CharCount := 1
END;
IF (TheirDefs.Bit8Quote<>' ') AND (* 8th bit quoting *)
(CHR(RecvBuf^[i]) = TheirDefs.Bit8Quote) THEN
INC(i);
Bit8 := 80H;
ELSE
Bit8 := 0
END;
IF RecvBuf^[i] = SHORTCARD(TheirDefs.CntrlQuote) THEN
INC(i); (* control char *)
IF RecvBuf^[i] IN QuotedChars THEN
RecvBuf^[i] := SHORTCARD(
SBITSET(RecvBuf^[i])/SBITSET(40H));
END
END; (* CONTROL character *)
INC(RecvBuf^[i], Bit8);
FOR j := 1 TO CharCount DO
WrBin( Fi, RecvBuf^[i], 1 )
END;
IF NOT OK THEN
StatusMessage(WriteErrorMsg, FALSE);
RecvState := RecvAbort;
Msg := WriteErrorMsg;
SendPacket( Length(Msg), (SendSeq+1) MOD 64,
'E', ADR(Msg) );
SendPacketType('N');
END; (* IO error *)
INC(RCount, CharCount);
INC(i);
END; (* WHILE *)
IncrDataBytes(RCount, TRUE);
DisplayData ( DataBytes, TRUE );
SendPacketType('Y');
|'F': DEC( SendSeq ); (* repeat *)
SendPacketType('Y');
|'Z': Close(Fi); (* End of Incoming File *)
ShowTransferTime;
IF NOT OK THEN
StatusMessage(CloseError, TRUE)
END;
RecvState := RecvHdr;
SendPacketType('Y');
ELSE (* Not D,Z packet *)
IF RecvType = 'E' THEN (* Error Packet *)
DisplayErrMsg;
END;
RecvState := RecvAbort; (* Abort if not init packet *)
AbortState := NotDZ;
END; (* CASE RecvType *)
END; (* Got a good packet *)
|RecvDone: SendPacketType('Y'); (* Completed Receiving *)
IF BreakState <> NoBreak THEN
StatusMessage(TransferAborted, FALSE);
END;
EXIT;
|RecvAbort: Msg := 'Receiving file(s) aborted';
StatusMessage(TransferAborted, FALSE);
SendPacket( Length(TransferAborted), 0, 'E',
ADR(TransferAborted) );
ShowTransferTime;
Close(Fi);
EXIT;
END; (* CASE of RecvState *)
END; (* LOOP *)
StopDisplay;
DISPOSE(RecvBuf)
END ReceiveKermit;

PROCEDURE KermitCmd( Cmd: CHAR );
TYPE
CmdStateType = (CmdInit,
CmdSend,
CmdDone);
VAR
CmdState : CmdStateType;
Retries : SHORTINT;

BEGIN (* KermitCmd *)
NEW(RecvBuf);
InitDefinitions;
CmdState := CmdInit;
BreakState := NoBreak;
Retries := 10;
LOOP
IF SetJmp ( AbortLbl ) <> 0 THEN
EXIT
END;
CASE CmdState OF
CmdInit: SendDefaults( 'I' );
|CmdSend: GetDefinitions;
SendPacket( 1, 0, 'G', ADR(Cmd) );
|CmdDone: EXIT;
END; (* CASE of CmdState *)
CASE RecvPacket() OF
'Y': INC(CmdState);
Retries := 10;
|'N': ;
|'E': DisplayErrMsg;
EXIT;
|'@': Retries := 0;
|'T': DEC(Retries, 2);
|ELSE DEC(Retries)
END;
IF Retries < 1 THEN
StatusMessage('Command not acknowledged.', TRUE);
EXIT
END;
END; (* LOOP *)
DISPOSE(RecvBuf);
END KermitCmd;

END QCkermit.