Columbia Kermit/kermit.zip/lilith/m2recv.mod

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.