home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
lilith
/
m2recv.mod
< prev
next >
Wrap
Text File
|
2020-01-01
|
20KB
|
691 lines
IMPLEMENTATION MODULE KermRecv;
(************************************************************************)
(* Receive one or more files from remote Kermit *)
(* written: 15.10.85 Matthias Aebi *)
(* last modification: 18.03.86 Matthias Aebi *)
(************************************************************************)
FROM Terminal IMPORT WriteString, WriteLn, Write;
FROM FileSystem IMPORT File, Create, Close, WriteChar, Response, Rename,
Lookup;
FROM KermMisc IMPORT RecvChar, BitAND, UnChar, ToChar, Ctl, ReadChar,
PrtErrPacket, IncPackNum, DecPackNum,
DispInit, DispFile, DispPack, DispTry, DispMsg,
CardToString;
FROM KermParam IMPORT LPackSize, LTimeOut, LNumOfPad, LPadChar, LDebug,
LEOLChar, LQuoteChar, LStartChar, LFileType,
LCurrPort, LTimer, LMaxRetries, LFilNamConv,
LWarning,
RPackSize, RTimeOut, RNumOfPad, RPadChar,
REOLChar, RQuoteChar, FileTyp, ParityTyp, Packet;
FROM KermSend IMPORT SendPacket;
FROM OutTerminal IMPORT WriteC;
FROM FileMessage IMPORT WriteResponse;
FROM TextScreen IMPORT SetPos, ClearLines;
FROM String IMPORT Length, Insert;
FROM M2Kermit IMPORT Param1;
CONST
ESC = 33C;
EOL = 36C;
CR = 15C;
VAR
sendPack : Packet; (* globally defined local variables *)
recvPack : Packet;
num : CARDINAL;
len : CARDINAL;
typ : CHAR;
theFile : File;
msgNum : CARDINAL; (* Packet number *)
numTry : CARDINAL; (* Number of retries *)
oldTry : CARDINAL; (* save Number of retries *)
numOfPacks : CARDINAL; (* Total number of packets *)
numOfTries : CARDINAL; (* Total number of retries *)
(************************************************************************)
PROCEDURE RecvPacket(VAR typ: CHAR; VAR num, len: CARDINAL;
VAR Data: ARRAY OF CHAR);
(************************************************************************)
VAR
i : CARDINAL;
ch : CHAR;
cState : CHAR;
cChkSum : CARDINAL;
rChkSum : CARDINAL;
(*------------------------------------------------------------------*)
PROCEDURE GetChar(VAR ch: CHAR): CHAR;
(*------------------------------------------------------------------*)
CONST
Factor = 3300; (* 3300 retries equal 1 second *)
VAR
counter : CARDINAL;
BEGIN
counter := 0;
LOOP
IF RecvChar(ch, LCurrPort)
THEN
IF LFileType = text
THEN (* strip parity bit *)
ch := CHAR(BitAND(CARDINAL(ch),7FH));
END;
IF ch <> LStartChar
THEN
RETURN "C";
ELSE
RETURN "L";
END;
END;
IF LTimer
THEN
IF (counter DIV Factor) > LTimeOut
THEN
DispMsg("Timer Timeout (M2-Kermit)");
RETURN "T"; (* Time Out interrupt *)
ELSE
INC(counter);
END;
END;
IF ReadChar(ch)
THEN
IF ch = EOL
THEN
DispMsg("User Timeout (M2-Kermit)");
RETURN "T"; (* User interrupt *)
ELSIF ch = ESC
THEN
RETURN "A"; (* User abort *)
END;
END;
END;
END GetChar;
BEGIN (* RecvPacket *)
cState := "S";
LOOP
CASE cState OF
"S": (* wait for SOH *)
cState := GetChar(ch);
IF cState = "C"
THEN
cState := "S";
END; |
"L": (* get packet length *)
cState := GetChar(ch);
IF cState = "C"
THEN
cChkSum := ORD(ch);
len := UnChar(ch) - 3;
cState := "N";
END; |
"N": (* get packet number *)
cState := GetChar(ch);
IF cState = "C"
THEN
cChkSum := cChkSum + ORD(ch);
num := UnChar(ch);
cState := "Y";
END; |
"Y": (* get packet type *)
cState := GetChar(ch);
IF cState = "C"
THEN
cChkSum := cChkSum + ORD(ch);
typ := ch;
i := 0;
END; |
"C": (* get packet body character *)
cState := GetChar(ch);
IF cState = "C"
THEN
IF i < len
THEN
cChkSum := cChkSum + ORD(ch);
Data[i] := ch;
INC(i);
ELSE
rChkSum := UnChar(ch);
cState := "E";
END;
END; |
"E":
cState := GetChar(ch);
IF cState = "C"
THEN
cChkSum := BitAND(((BitAND(cChkSum,192) DIV 64)+cChkSum),63);
IF LDebug (* if debugging on *)
THEN
SetPos(13,0);
ClearLines(5);
WriteString("Length: ");
WriteC(len,2); WriteLn;
WriteString("Number: ");
WriteC(num,2); WriteLn;
WriteString("Type: ");
Write(typ); WriteLn;
WriteString("Packet: ");
FOR i := 1 TO len DO
Write(Data[i-1]);
END;
END;
IF cChkSum <> rChkSum
THEN
DispMsg("Checksum Error (M2-Kermit)");
END;
EXIT;
END; |
"A","T": (* user abort / timeout *)
typ := cState;
EXIT;
END;
END;
END RecvPacket;
(************************************************************************)
PROCEDURE BufEmp(data: Packet; len: CARDINAL);
(************************************************************************)
VAR
i : CARDINAL;
ch : CHAR;
BEGIN
i := 0;
WHILE i < len DO
ch := data[i]; INC(i);
IF ch = LQuoteChar
THEN
ch := data[i]; INC(i);
IF CHAR(BitAND(CARDINAL(ch),7FH)) <> LQuoteChar
THEN
ch := Ctl(ch);
END;
END;
IF (ch = CHR(10)) AND (LFileType = text)
THEN
ch := EOL;
END;
IF (ch <> CR) OR (LFileType <> text)
THEN
WriteChar(theFile, ch);
END;
END;
END BufEmp;
(************************************************************************)
PROCEDURE SwitchRecv(saveName: ARRAY OF CHAR): BOOLEAN;
(************************************************************************)
(* SwitchRecv calls the different routines depending on the current *)
(* receive state. For a description of all states see Kermit protocol *)
(* manual. Returns TRUE if receive was successful. *)
VAR
state : CHAR; (* current receive state *)
fileName : ARRAY [0..63] OF CHAR; (* received filename *)
(*------------------------------------------------------------------*)
PROCEDURE ErrorExit(errMessage: ARRAY OF CHAR);
(*------------------------------------------------------------------*)
(* close file, display error message, send error packet *)
BEGIN
Close(theFile);
DispMsg(errMessage);
SendPacket("E",0,Length(errMessage), errMessage);
END ErrorExit;
(*------------------------------------------------------------------*)
PROCEDURE RecvInit(VAR state: CHAR);
(*------------------------------------------------------------------*)
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"S":
RPackSize := UnChar(recvPack[0]);
RTimeOut := UnChar(recvPack[1]);
RNumOfPad := UnChar(recvPack[2]);
RPadChar := Ctl(recvPack[3]);
REOLChar := CHR(UnChar(recvPack[4]));
RQuoteChar := recvPack[5];
sendPack[0] := ToChar(LPackSize); (* Maximum packet lemgth *)
sendPack[1] := ToChar(LTimeOut); (* seconds before timeot *)
sendPack[2] := ToChar(LNumOfPad); (* number of padding chars *)
sendPack[3] := Ctl(LPadChar); (* padding character *)
sendPack[4] := ToChar(ORD(LEOLChar));(* end of line/packet char *)
sendPack[5] := LQuoteChar; (* control character quote *)
oldTry := numTry;
numTry := 0;
DispPack;
state := "F";
SendPacket("Y",msgNum,0,"");
msgNum := IncPackNum(msgNum); |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry;
SendPacket("N",msgNum,0,""); |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END RecvInit;
(*------------------------------------------------------------------*)
PROCEDURE RecvFile(VAR state: CHAR);
(*------------------------------------------------------------------*)
VAR
i : CARDINAL;
j : CARDINAL;
ch : CHAR;
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"S":
INC(oldTry);
IF (oldTry > LMaxRetries)
THEN
state := "T";
RETURN;
END;
IF num = DecPackNum(msgNum)
THEN
sendPack[0] := ToChar(LPackSize);(* Maximum packet lemgth *)
sendPack[1] := ToChar(LTimeOut); (* seconds before timeot *)
sendPack[2] := ToChar(LNumOfPad);(* number of padding chars *)
sendPack[3] := Ctl(LPadChar); (* padding character *)
sendPack[4] := ToChar(ORD(LEOLChar)); (* end of line/packet char *)
sendPack[5] := LQuoteChar; (* control character quote *)
numTry := 0;
DispPack;
SendPacket("Y",msgNum,6,sendPack);
ELSE
state := "P";
END; |
"Z":
INC(oldTry);
IF oldTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
IF num = DecPackNum(msgNum)
THEN
numTry := 0;
DispPack;
SendPacket("Y",num,0,"");
ELSE
state := "P";
END; |
"F":
IF num <> msgNum
THEN
state := "P";
RETURN;
END;
j := 0;
FOR i:=0 TO len-1 DO
ch := recvPack[i];
IF LFilNamConv
THEN
IF j = 0
THEN
fileName[0] := "D";
fileName[1] := "K";
fileName[2] := ".";
IF (ch>="0") AND (ch<="9")
THEN
fileName[3] := "X";
j := 4;
ELSE
j := 3;
END;
END;
IF (ch>="a") AND (ch<="z")
THEN
ch := CAP(ch);
END;
IF ((ch>="A") AND (ch<="Z")) OR
((ch>="0") AND (ch<="9")) OR
(ch=".")
THEN
fileName[j] := ch;
ELSE
fileName[j] := "X";
END;
INC(j);
ELSE
fileName[j] := ch;
INC(j);
END;
END;
IF fileName[j-1] = "."
THEN
DEC(j);
END;
fileName[j] := 0C;
Create(theFile, "DK."); (* create a temporary file *)
IF theFile.res # done
THEN
DispMsg("Could not create temporary file");
WriteResponse(theFile.res);
Close(theFile);
state := "E";
ELSE
DispFile(fileName);
oldTry := numTry;
numTry := 0;
IF saveName[0] # 0C
THEN
DispMsg("Receiving as ");
WriteString(saveName);
END;
DispPack;
state := "D";
SendPacket("Y",msgNum,0,"");
msgNum := IncPackNum(msgNum);
END; |
"B":
IF num <> msgNum
THEN
state := "P";
RETURN;
END;
DispPack;
state := "C";
SendPacket("Y",msgNum,0,""); |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry;
SendPacket("N",msgNum,0,""); |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END RecvFile;
(*------------------------------------------------------------------*)
PROCEDURE RecvData(VAR state: CHAR);
(*------------------------------------------------------------------*)
VAR
fNameStr : ARRAY [0..63] OF CHAR;
numStr : ARRAY [0..15] OF CHAR;
pos : CARDINAL;
fCounter : CARDINAL;
delFile : File;
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"D":
IF num <>msgNum
THEN
INC(oldTry);
IF (oldTry > LMaxRetries)
THEN
state := "T";
RETURN;
END;
IF num = DecPackNum(msgNum)
THEN
numTry := 0;
SendPacket("Y",msgNum,0,"");
ELSE
state := "P";
END;
ELSE
BufEmp(recvPack, len);
oldTry := numTry;
numTry := 0;
DispPack;
SendPacket("Y",msgNum,0,"");
msgNum := IncPackNum(msgNum);
END; |
"F":
INC(oldTry);
IF oldTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
IF num = DecPackNum(msgNum)
THEN
numTry := 0;
DispPack;
SendPacket("Y",num,0,"");
ELSE
state := "P";
END; |
"Z":
IF (num <> msgNum)
THEN
state := "P";
ELSE
fCounter := 1;
REPEAT
fNameStr[0] := 0C;
IF saveName[0] # 0C
THEN
Insert(fNameStr, 0, saveName);
ELSE
Insert(fNameStr, 0, fileName);
END;
Rename(theFile, fNameStr);
IF theFile.res = notdone
THEN
IF LWarning
THEN
pos := Length(fNameStr);
Insert(fNameStr, pos, ".V");
CardToString(fCounter, numStr);
Insert(fNameStr, pos+2, numStr);
INC(fCounter);
Rename(theFile, fNameStr);
IF theFile.res = done
THEN
DispMsg("File saved as ");
WriteString(fNameStr);
END;
ELSE
(* delete the old file *)
Lookup(delFile, fNameStr, FALSE);
Rename(delFile, "DK.");
Close(delFile);
Rename(theFile, fNameStr);
IF theFile.res = done
THEN
DispMsg("Old file replaced");
END;
END;
END; (* THEN *)
UNTIL theFile.res <> notdone;
IF saveName[0] <> 0C
THEN
saveName[0] := 0C;
END;
IF theFile.res <> done
THEN
DispMsg("Could not save the file ");
WriteString(fNameStr);
WriteResponse(theFile.res);
state := "E";
RETURN;
END;
Close(theFile);
DispPack;
state := "F";
SendPacket("Y",msgNum,0,"");
DispInit; (* reinitialize Status display *)
msgNum := IncPackNum(msgNum);
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry;
SendPacket("N",msgNum,0,""); |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END RecvData;
BEGIN (* SwitchRecv *)
msgNum := 0; (* First packet has # 0 *)
numTry := 0; (* No retries so far *)
DispInit; (* Initialize Status display *)
state := "R"; (* First state is receive init pack *)
LOOP
CASE state OF
"R":
RecvInit(state); |
"F":
RecvFile(state); |
"D":
RecvData(state); |
"C":
RETURN TRUE; |
"P":
ErrorExit("Packet sequence error (M2-Kermit)");
RETURN FALSE; |
"U":
ErrorExit("Undefined packet type (M2-Kermit)");
RETURN FALSE; |
"T":
ErrorExit("Too many retries (M2-Kermit)");
RETURN FALSE; |
"A":
ErrorExit("User aborted transmission (M2-Kermit)");
RETURN FALSE; |
"E": (* Any other Problem *);
Close(theFile);
RETURN FALSE;
ELSE
ErrorExit("Undefined State (M2-Kermit)");
RETURN FALSE;
END;
END;
END SwitchRecv;
(************************************************************************)
PROCEDURE Receive;
(************************************************************************)
BEGIN
IF SwitchRecv(Param1)
THEN
DispMsg("Receive successful");
END;
SetPos(27,0);
END Receive;
END KermRecv.