home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
lilith.tar.gz
/
lilith.tar
/
m2send.mod
< prev
next >
Wrap
Text File
|
1988-08-16
|
18KB
|
662 lines
IMPLEMENTATION MODULE KermSend;
(************************************************************************)
(* Send one or more files to remote Kermit *)
(* written: 10.10.85 Matthias Aebi *)
(* last modification: 18.03.86 Matthias Aebi *)
(************************************************************************)
FROM Terminal IMPORT WriteString, WriteLn, Write;
FROM OutTerminal IMPORT WriteC;
FROM FileSystem IMPORT Lookup, Close, ReadChar, File, Response;
FROM KermMisc IMPORT SendChar, AddBits, BitAND, BitOR, BitXOR,
UnChar, ToChar, Ctl, PrtErrPacket, IncPackNum,
DecPackNum, DispInit, DispFile, DispPack, DispTry,
DispMsg;
FROM KermParam IMPORT LBaudRate, LCheckType, LCurrPort, LEcho, LEOLChar,
LEscChar, LFileType, LMaxRetries, LNumOfPad,
LPackSize, LPadChar, LParity, LQuoteChar, LDebug,
LStartChar, LTimeOut, LFilNamConv, REOLChar,
RNumOfPad, RPackSize, RPadChar, RQuoteChar,
RTimeOut, FileTyp, ParityTyp, Packet;
FROM KermRecv IMPORT RecvPacket;
FROM FileMessage IMPORT WriteResponse;
FROM TextScreen IMPORT SetPos, ClearLines;
FROM NameSearch IMPORT FindNames, NextName;
FROM String IMPORT Insert, Delete, Length;
FROM M2Kermit IMPORT Param1, Param2;
CONST
EOL = 36C;
FF = 14C;
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 *)
fileOpen : BOOLEAN; (* File to send is already open *)
size : CARDINAL; (* Size of the next data pack (0 = EOF) *)
(************************************************************************)
PROCEDURE BufFill(VAR buffer: Packet): CARDINAL;
(************************************************************************)
(* return the number of data characters written to buffer or 0 if EOF *)
(* found *)
VAR
i : CARDINAL;
ch : CHAR;
ch7 : CHAR;
BEGIN
i := 0;
LOOP
IF i >= (LPackSize - 6) (* Seq, typ, Check1 -> 3 Bytes + 3 Bytes grow *)
THEN
EXIT;
END;
ReadChar(theFile, ch);
IF theFile.eof
THEN
EXIT;
END;
ch7 := CHAR(BitAND(CARDINAL(ch),7FH));
IF (ch7 < " ") OR (ch7 = CHR(127)) OR (ch7 = LQuoteChar)
THEN
IF (ch7 = EOL) AND (LFileType <> binary)
THEN
buffer[i] := LQuoteChar; INC(i);
buffer[i] := Ctl(CHR(13)); INC(i);
ch := CHR(10);
ch7 := CHR(10);
END;
buffer[i] := LQuoteChar; INC(i);
IF ch7 <> LQuoteChar
THEN
ch := Ctl(ch);
ch7 := Ctl(ch7);
END;
END;
IF (LFileType = binary)
THEN
buffer[i] := ch;
ELSE
buffer[i] := ch7;
END;
INC(i);
END;
RETURN(i);
END BufFill;
(************************************************************************)
PROCEDURE SendPacket(type: CHAR; num, len: CARDINAL; data: ARRAY OF CHAR);
(************************************************************************)
VAR
buffer : ARRAY [0..100] OF CHAR;
chkSum : CARDINAL;
i : CARDINAL;
ch : CHAR;
BEGIN
IF LDebug (* if debugging on *)
THEN
SetPos(21,0);
ClearLines(5);
WriteString("Length: ");
WriteC(len,2); WriteLn;
WriteString("Number: ");
WriteC(num,2); WriteLn;
WriteString("Type: ");
Write(type); WriteLn;
WriteString("Packet: ");
FOR i := 1 TO len DO
Write(data[i-1]);
END;
END;
FOR i:=1 TO LNumOfPad DO
SendChar(LPadChar, LCurrPort);
END;
buffer[0] := LStartChar;
buffer[1] := ToChar(len+3);
chkSum := ORD(ToChar(len+3));
buffer[2] := ToChar(num);
chkSum := chkSum + ORD(ToChar(num));
buffer[3] := type;
chkSum := chkSum + ORD(type);
i := 0;
WHILE i < len DO
buffer[i+4] := data[i];
chkSum := chkSum + ORD(data[i]);
INC(i);
END;
chkSum := BitAND(((BitAND(chkSum,192) DIV 64)+chkSum),63);
buffer[len+4] := ToChar(chkSum);
FOR i:=0 TO len+4 DO
ch := buffer[i];
CASE LParity OF
none:
; |
mark:
ch := CHAR(BitOR(CARDINAL(ch),80H)); |
space:
ch := CHAR(BitAND(CARDINAL(ch),7FH)); |
odd:
IF NOT ODD(AddBits(ch))
THEN
ch := CHAR(BitOR(CARDINAL(ch),80H));
END; |
even:
IF ODD(AddBits(ch))
THEN
ch := CHAR(BitOR(CARDINAL(ch),80H));
END;
END;
SendChar(ch, LCurrPort);
END;
SendChar(REOLChar, LCurrPort); (* send EOL character *)
END SendPacket;
(************************************************************************)
PROCEDURE SwitchSend(fileName, sendName: ARRAY OF CHAR): BOOLEAN;
(************************************************************************)
(* SwitchSend calls the different routines depending on the current send*)
(* state. For a description of all states see Kermit protocol manual. *)
(* Returns TRUE if send was successful. *)
VAR
state : CHAR; (* current send state *)
(*------------------------------------------------------------------*)
PROCEDURE ErrorExit(ErrMessage: ARRAY OF CHAR);
(*------------------------------------------------------------------*)
(* close file, display error message, send error packet *)
BEGIN
Close(theFile);
fileOpen := FALSE;
DispMsg(ErrMessage);
SendPacket("E",0,Length(ErrMessage), ErrMessage);
END ErrorExit;
(*------------------------------------------------------------------*)
PROCEDURE SendInit(VAR state: CHAR);
(*------------------------------------------------------------------*)
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
sendPack[0] := ToChar(LPackSize); (* Maximum packet lemgth *)
sendPack[1] := ToChar(LTimeOut); (* seconds before timeot *)
sendPack[2] := ToChar(LNumOfPad); (* number of padding char's *)
sendPack[3] := Ctl(LPadChar); (* padding character *)
sendPack[4] := ToChar(ORD(LEOLChar)); (* end of line/packet char *)
sendPack[5] := LQuoteChar; (* control character quote *)
SendPacket("S",msgNum,6,sendPack);
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"N":
DispTry; | (* leave state unchanged *)
"Y":
IF num = msgNum
THEN
RPackSize := UnChar(recvPack[0]);
RTimeOut := UnChar(recvPack[1]);
RNumOfPad := UnChar(recvPack[2]);
RPadChar := Ctl(recvPack[3]);
REOLChar := CHR(UnChar(recvPack[4]));
RQuoteChar := recvPack[5];
IF ORD(REOLChar) = 0
THEN
REOLChar := 13C;
END;
IF ORD(RQuoteChar) = 0
THEN
RQuoteChar := "#";
END;
numTry := 0; (* reset try counter *)
msgNum := IncPackNum(msgNum);
DispPack;
state := "F";
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry; |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END SendInit;
(*------------------------------------------------------------------*)
PROCEDURE SendFile(VAR state: CHAR);
(*------------------------------------------------------------------*)
VAR
i : CARDINAL;
j : CARDINAL;
ch : CHAR;
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
IF NOT fileOpen
THEN
Lookup(theFile, fileName, FALSE);
IF theFile.res <> done
THEN
DispMsg("Error on open file: ");
WriteString(fileName); (* add filename & reason *)
WriteResponse(theFile.res);
Close(theFile);
state := "E";
RETURN;
ELSE
fileOpen := TRUE;
END;
IF LFilNamConv
THEN
Delete(fileName,0,3); (* strip device name *)
END;
END;
i := 0; (* move file name to packet *)
j := 0;
IF sendName[0] # 0C
THEN
ch := sendName[i];
ELSE
ch := fileName[i];
END;
WHILE (ch <> 0C) AND (ch <> " ") DO
IF LFilNamConv AND (sendName[0] = 0C)
THEN
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
sendPack[j] := ch;
INC(j);
END;
ELSE
sendPack[j] := ch;
INC(j);
END;
INC(i);
IF sendName[0] # 0C
THEN
ch := sendName[i];
ELSE
ch := fileName[i];
END;
END;
DispFile(fileName);
IF sendName[0] # 0C
THEN
DispMsg("Sending as ");
WriteString(sendName);
sendName[0] := 0C; (* reset sendName *)
END;
SendPacket("F",msgNum,j,sendPack);
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"Y","N":
IF typ = "N"
THEN
num := DecPackNum(num); (* NAK for msgNum+1 is the *)
END; (* same as ACK for msgNum *)
IF num = msgNum
THEN
numTry := 0;
msgNum := IncPackNum(msgNum);
size := BufFill(sendPack);
state := "D";
DispPack;
ELSE
DispTry;
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry; |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END SendFile;
(*------------------------------------------------------------------*)
PROCEDURE SendData(VAR state: CHAR);
(*------------------------------------------------------------------*)
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
SendPacket("D",msgNum,size,sendPack);
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"Y","N":
IF typ = "N"
THEN
num := DecPackNum(num); (* NAK for msgNum+1 is the *)
END; (* same as ACK for msgNum *)
IF num = msgNum
THEN
numTry := 0;
msgNum := IncPackNum(msgNum);
size := BufFill(sendPack);
IF size = 0 (* -> EOF *)
THEN
state := "Z";
END;
DispPack;
ELSE
DispTry;
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry; |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END SendData;
(*------------------------------------------------------------------*)
PROCEDURE SendEOF(VAR state: CHAR);
(*------------------------------------------------------------------*)
VAR
foundOne : BOOLEAN;
fileNo : CARDINAL;
versionNo : CARDINAL;
done : BOOLEAN;
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
SendPacket("Z",msgNum,0,"");
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"Y","N":
IF typ = "N"
THEN
num := DecPackNum(num); (* NAK for msgNum+1 is the *)
END; (* same as ACK for msgNum *)
IF num = msgNum
THEN
numTry := 0;
msgNum := IncPackNum(msgNum);
Close(theFile);
fileOpen := FALSE;
DispPack;
NextName(foundOne, fileName, fileNo, versionNo);
(* search next file *)
Insert(fileName, 0, "DK."); (* add device name *)
IF foundOne
THEN
state := "F";
DispInit;
ELSE
state := "B";
END;
ELSE
DispTry;
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry; |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END SendEOF;
(*------------------------------------------------------------------*)
PROCEDURE SendBreak(VAR state: CHAR);
(*------------------------------------------------------------------*)
BEGIN
INC(numTry);
IF numTry > LMaxRetries
THEN
state := "T";
RETURN;
END;
SendPacket("B",msgNum,0,"");
RecvPacket(typ, num, len, recvPack);
CASE typ OF
"Y","N":
IF typ = "N"
THEN
num := DecPackNum(num); (* NAK for msgNum+1 is the *)
END; (* same as ACK for msgNum *)
IF num = msgNum
THEN
numTry := 0;
msgNum := IncPackNum(msgNum);
state := "C";
DispPack;
ELSE
DispTry;
END; |
"E": (* got error packet *)
PrtErrPacket(recvPack, len);
state := "E"; |
"T": (* timeout *)
DispTry; |
"A": (* user abort *)
state := "A";
ELSE (* undefined packet type *)
state := "U";
END;
END SendBreak;
BEGIN (* SwitchSend *)
msgNum := 0; (* First packet has # 0 *)
numTry := 0; (* No retries so far *)
DispInit;
fileOpen := FALSE; (* no open file *)
state := "S"; (* Send init is the start state *)
LOOP
CASE state OF
"S":
SendInit(state); |
"F":
SendFile(state); |
"D":
SendData(state); |
"Z":
SendEOF(state); |
"B":
SendBreak(state); |
"C":
RETURN TRUE; |
"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);
fileOpen := FALSE;
RETURN FALSE;
ELSE
ErrorExit("Undefined state (M2-Kermit)");
RETURN FALSE;
END;
END;
END SwitchSend;
(************************************************************************)
PROCEDURE Send;
(************************************************************************)
CONST
UpLowEqual = TRUE;
VAR
fileName : ARRAY [0..31] OF CHAR;
foundOne : BOOLEAN;
fileNo : CARDINAL;
versionNo : CARDINAL;
BEGIN
IF Param1[0] = "?"
THEN
WriteString("Specify filename (including wildcards)");
ELSE
FindNames("DK", Param1, UpLowEqual);
NextName(foundOne, fileName, fileNo, versionNo);
Insert(fileName, 0, "DK."); (* add device name *)
IF foundOne
THEN
IF SwitchSend(fileName, Param2)
THEN
DispMsg("Send successful");
END;
ELSE
DispMsg("No file(s) found (Snd)");
END;
SetPos(27,0);
END;
END Send;
END KermSend.