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.