home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / lilith / m2send.mod < prev    next >
Text File  |  2020-01-01  |  18KB  |  662 lines
  1. IMPLEMENTATION MODULE KermSend;
  2. (************************************************************************)
  3. (*  Send one or more files to remote Kermit                             *)
  4. (*  written:            10.10.85     Matthias Aebi                      *)
  5. (*  last modification:  18.03.86     Matthias Aebi                      *)
  6. (************************************************************************)
  7.  
  8. FROM Terminal    IMPORT WriteString, WriteLn, Write;
  9. FROM OutTerminal IMPORT WriteC;
  10. FROM FileSystem  IMPORT Lookup, Close, ReadChar, File, Response;
  11. FROM KermMisc    IMPORT SendChar, AddBits, BitAND, BitOR, BitXOR,
  12.                         UnChar, ToChar, Ctl, PrtErrPacket, IncPackNum,
  13.                         DecPackNum, DispInit, DispFile, DispPack, DispTry,
  14.                         DispMsg;
  15. FROM KermParam   IMPORT LBaudRate, LCheckType, LCurrPort, LEcho, LEOLChar,
  16.                         LEscChar, LFileType, LMaxRetries, LNumOfPad,
  17.                         LPackSize, LPadChar, LParity, LQuoteChar, LDebug,
  18.                         LStartChar, LTimeOut, LFilNamConv, REOLChar,
  19.                         RNumOfPad, RPackSize, RPadChar, RQuoteChar,
  20.                         RTimeOut, FileTyp, ParityTyp, Packet;
  21. FROM KermRecv    IMPORT RecvPacket;
  22. FROM FileMessage IMPORT WriteResponse;
  23. FROM TextScreen  IMPORT SetPos, ClearLines;
  24. FROM NameSearch  IMPORT FindNames, NextName;
  25. FROM String      IMPORT Insert, Delete, Length;
  26. FROM M2Kermit    IMPORT Param1, Param2;
  27.  
  28.  
  29. CONST
  30.     EOL = 36C;
  31.     FF  = 14C;
  32.  
  33. VAR
  34.     sendPack  : Packet; (* globally defined local variables *)
  35.     recvPack  : Packet;
  36.     num       : CARDINAL;
  37.     len       : CARDINAL;
  38.     typ       : CHAR;
  39.     theFile   : File;
  40.     msgNum    : CARDINAL;  (* Packet number *)
  41.     numTry    : CARDINAL;  (* Number of retries *)
  42.     fileOpen  : BOOLEAN;   (* File to send is already open *)
  43.     size      : CARDINAL;  (* Size of the next data pack (0 = EOF) *)
  44.  
  45.  
  46. (************************************************************************)
  47.                PROCEDURE BufFill(VAR buffer: Packet): CARDINAL;
  48. (************************************************************************)
  49. (* return the number of data characters written to buffer or 0 if EOF   *)
  50. (* found                                                                *)
  51. VAR
  52.     i   : CARDINAL;
  53.     ch  : CHAR;
  54.     ch7 : CHAR;
  55.  
  56. BEGIN
  57.     i := 0;
  58.     LOOP
  59.         IF i >= (LPackSize - 6)  (* Seq, typ, Check1 -> 3 Bytes + 3 Bytes grow *)
  60.         THEN
  61.             EXIT;
  62.         END;
  63.  
  64.         ReadChar(theFile, ch);
  65.  
  66.         IF theFile.eof
  67.         THEN
  68.             EXIT;
  69.         END;
  70.  
  71.         ch7 := CHAR(BitAND(CARDINAL(ch),7FH));
  72.  
  73.         IF (ch7 < " ") OR (ch7 = CHR(127)) OR (ch7 = LQuoteChar)
  74.         THEN
  75.             IF (ch7 = EOL) AND (LFileType <> binary)
  76.             THEN
  77.                 buffer[i] := LQuoteChar; INC(i);
  78.                 buffer[i] := Ctl(CHR(13)); INC(i);
  79.                 ch  := CHR(10);
  80.                 ch7 := CHR(10);
  81.             END;
  82.             buffer[i] := LQuoteChar; INC(i);
  83.             IF ch7 <> LQuoteChar
  84.             THEN
  85.                 ch  := Ctl(ch);
  86.                 ch7 := Ctl(ch7);
  87.             END;
  88.         END;
  89.  
  90.         IF (LFileType = binary)
  91.         THEN
  92.             buffer[i] := ch;
  93.         ELSE
  94.             buffer[i] := ch7;
  95.         END;
  96.         INC(i);
  97.     END;
  98.  
  99.     RETURN(i);
  100. END BufFill;
  101.  
  102.  
  103. (************************************************************************)
  104. PROCEDURE SendPacket(type: CHAR; num, len: CARDINAL; data: ARRAY OF CHAR);
  105. (************************************************************************)
  106. VAR
  107.     buffer : ARRAY [0..100] OF CHAR;
  108.     chkSum : CARDINAL;
  109.     i      : CARDINAL;
  110.     ch     : CHAR;
  111.  
  112. BEGIN
  113.     IF LDebug   (* if debugging on *)
  114.     THEN
  115.         SetPos(21,0);
  116.         ClearLines(5);
  117.  
  118.         WriteString("Length: ");
  119.         WriteC(len,2); WriteLn;
  120.  
  121.         WriteString("Number: ");
  122.         WriteC(num,2); WriteLn;
  123.  
  124.         WriteString("Type: ");
  125.         Write(type); WriteLn;
  126.  
  127.         WriteString("Packet: ");
  128.         FOR i := 1 TO len DO
  129.             Write(data[i-1]);
  130.         END;
  131.     END;
  132.  
  133.     FOR i:=1 TO LNumOfPad DO
  134.         SendChar(LPadChar, LCurrPort);
  135.     END;
  136.  
  137.     buffer[0] := LStartChar;
  138.     buffer[1] := ToChar(len+3);
  139.     chkSum    := ORD(ToChar(len+3));
  140.     buffer[2] := ToChar(num);
  141.     chkSum    := chkSum + ORD(ToChar(num));
  142.     buffer[3] := type;
  143.     chkSum    := chkSum + ORD(type);
  144.  
  145.     i := 0;
  146.     WHILE i < len DO
  147.         buffer[i+4] := data[i];
  148.         chkSum := chkSum + ORD(data[i]);
  149.         INC(i);
  150.     END;
  151.  
  152.     chkSum := BitAND(((BitAND(chkSum,192) DIV 64)+chkSum),63);
  153.     buffer[len+4] := ToChar(chkSum);
  154.  
  155.     FOR i:=0 TO len+4 DO
  156.         ch := buffer[i];
  157.         CASE LParity OF
  158.         none:
  159.             ; |
  160.  
  161.         mark:
  162.             ch := CHAR(BitOR(CARDINAL(ch),80H)); |
  163.  
  164.         space:
  165.             ch := CHAR(BitAND(CARDINAL(ch),7FH)); |
  166.  
  167.         odd:
  168.             IF NOT ODD(AddBits(ch))
  169.             THEN
  170.                 ch := CHAR(BitOR(CARDINAL(ch),80H));
  171.             END; |
  172.  
  173.         even:
  174.             IF ODD(AddBits(ch))
  175.             THEN
  176.                 ch := CHAR(BitOR(CARDINAL(ch),80H));
  177.             END;
  178.  
  179.         END;
  180.  
  181.         SendChar(ch, LCurrPort);
  182.     END;
  183.  
  184.     SendChar(REOLChar, LCurrPort); (* send EOL character *)
  185.  
  186. END SendPacket;
  187.  
  188.  
  189. (************************************************************************)
  190.      PROCEDURE SwitchSend(fileName, sendName: ARRAY OF CHAR): BOOLEAN;
  191. (************************************************************************)
  192. (* SwitchSend calls the different routines depending on the current send*)
  193. (* state. For a description of all states see Kermit protocol manual.   *)
  194. (* Returns TRUE if send was successful.                                 *)
  195.  
  196. VAR
  197.     state : CHAR;   (* current send state *)
  198.  
  199.     (*------------------------------------------------------------------*)
  200.                   PROCEDURE ErrorExit(ErrMessage: ARRAY OF CHAR);
  201.     (*------------------------------------------------------------------*)
  202.     (* close file, display error message, send error packet             *)
  203.     BEGIN
  204.         Close(theFile);
  205.         fileOpen := FALSE;
  206.  
  207.         DispMsg(ErrMessage);
  208.         SendPacket("E",0,Length(ErrMessage), ErrMessage);
  209.     END ErrorExit;
  210.  
  211.  
  212.  
  213.     (*------------------------------------------------------------------*)
  214.                     PROCEDURE SendInit(VAR state: CHAR);
  215.     (*------------------------------------------------------------------*)
  216.     BEGIN
  217.         INC(numTry);
  218.         IF numTry > LMaxRetries
  219.         THEN
  220.             state := "T";
  221.             RETURN;
  222.         END;
  223.  
  224.         sendPack[0] := ToChar(LPackSize);     (* Maximum packet lemgth    *)
  225.         sendPack[1] := ToChar(LTimeOut);      (* seconds before timeot    *)
  226.         sendPack[2] := ToChar(LNumOfPad);     (* number of padding char's *)
  227.         sendPack[3] := Ctl(LPadChar);         (* padding character        *)
  228.         sendPack[4] := ToChar(ORD(LEOLChar)); (* end of line/packet char  *)
  229.         sendPack[5] := LQuoteChar;            (* control character quote  *)
  230.  
  231.         SendPacket("S",msgNum,6,sendPack);
  232.  
  233.         RecvPacket(typ, num, len, recvPack);
  234.         CASE typ OF
  235.         "N":
  236.             DispTry; | (* leave state unchanged *)
  237.  
  238.         "Y":
  239.             IF num = msgNum
  240.             THEN
  241.                 RPackSize   := UnChar(recvPack[0]);
  242.                 RTimeOut    := UnChar(recvPack[1]);
  243.                 RNumOfPad   := UnChar(recvPack[2]);
  244.                 RPadChar    := Ctl(recvPack[3]);
  245.                 REOLChar    := CHR(UnChar(recvPack[4]));
  246.                 RQuoteChar  := recvPack[5];
  247.  
  248.                 IF ORD(REOLChar) = 0
  249.                 THEN
  250.                     REOLChar := 13C;
  251.                 END;
  252.  
  253.                 IF ORD(RQuoteChar) = 0
  254.                 THEN
  255.                     RQuoteChar := "#";
  256.                 END;
  257.  
  258.                 numTry := 0;  (* reset try counter *)
  259.                 msgNum := IncPackNum(msgNum);
  260.                 DispPack;
  261.                 state  := "F";
  262.             END; |
  263.  
  264.         "E": (* got error packet *)
  265.             PrtErrPacket(recvPack, len);
  266.             state := "E"; |
  267.  
  268.         "T": (* timeout *)
  269.             DispTry; |
  270.  
  271.         "A": (* user abort *)
  272.             state := "A";
  273.  
  274.         ELSE (* undefined packet type *)
  275.             state := "U";
  276.  
  277.         END;
  278.  
  279.     END SendInit;
  280.  
  281.  
  282.     (*------------------------------------------------------------------*)
  283.                     PROCEDURE SendFile(VAR state: CHAR);
  284.     (*------------------------------------------------------------------*)
  285.     VAR
  286.         i    : CARDINAL;
  287.         j    : CARDINAL;
  288.         ch   : CHAR;
  289.  
  290.     BEGIN
  291.         INC(numTry);
  292.         IF numTry > LMaxRetries
  293.         THEN
  294.             state := "T";
  295.             RETURN;
  296.         END;
  297.  
  298.         IF NOT fileOpen
  299.         THEN
  300.             Lookup(theFile, fileName, FALSE);
  301.             IF theFile.res <> done
  302.             THEN
  303.                 DispMsg("Error on open file: ");
  304.                 WriteString(fileName);   (* add filename & reason *)
  305.                 WriteResponse(theFile.res);
  306.                 Close(theFile);
  307.                 state := "E";
  308.                 RETURN;
  309.             ELSE
  310.                 fileOpen := TRUE;
  311.             END;
  312.  
  313.             IF LFilNamConv
  314.             THEN
  315.                 Delete(fileName,0,3); (* strip device name *)
  316.             END;
  317.         END;
  318.  
  319.         i := 0;             (* move file name to packet *)
  320.         j := 0;
  321.  
  322.         IF sendName[0] # 0C
  323.         THEN
  324.             ch := sendName[i];
  325.         ELSE
  326.             ch := fileName[i];
  327.         END;
  328.  
  329.         WHILE (ch <> 0C) AND (ch <> " ") DO
  330.             IF LFilNamConv AND (sendName[0] = 0C)
  331.             THEN
  332.                 IF (ch>="a") AND (ch<="z")
  333.                 THEN
  334.                     ch := CAP(ch);
  335.                 END;
  336.  
  337.                 IF ((ch>="A") AND (ch<="Z")) OR
  338.                    ((ch>="0") AND (ch<="9")) OR
  339.                     (ch=".")
  340.                 THEN
  341.                     sendPack[j] := ch;
  342.                     INC(j);
  343.                 END;
  344.             ELSE
  345.                 sendPack[j] := ch;
  346.                 INC(j);
  347.             END;
  348.             INC(i);
  349.             IF sendName[0] # 0C
  350.             THEN
  351.                 ch := sendName[i];
  352.             ELSE
  353.                 ch := fileName[i];
  354.             END;
  355.         END;
  356.  
  357.         DispFile(fileName);
  358.         IF sendName[0] # 0C
  359.         THEN
  360.             DispMsg("Sending as ");
  361.             WriteString(sendName);
  362.             sendName[0] := 0C;  (* reset sendName *)
  363.         END;
  364.         SendPacket("F",msgNum,j,sendPack);
  365.  
  366.         RecvPacket(typ, num, len, recvPack);
  367.         CASE typ OF
  368.         "Y","N":
  369.             IF typ = "N"
  370.             THEN
  371.                 num := DecPackNum(num); (* NAK for msgNum+1 is the *)
  372.             END;                        (* same as ACK for msgNum  *)
  373.  
  374.             IF num = msgNum
  375.             THEN
  376.                 numTry := 0;
  377.                 msgNum := IncPackNum(msgNum);
  378.                 size := BufFill(sendPack);
  379.                 state  := "D";
  380.                 DispPack;
  381.             ELSE
  382.                 DispTry;
  383.             END; |
  384.  
  385.         "E": (* got error packet *)
  386.             PrtErrPacket(recvPack, len);
  387.             state := "E"; |
  388.  
  389.         "T": (* timeout *)
  390.             DispTry; |
  391.  
  392.         "A": (* user abort *)
  393.             state := "A";
  394.  
  395.         ELSE (* undefined packet type *)
  396.             state := "U";
  397.  
  398.         END;
  399.     END SendFile;
  400.  
  401.  
  402.     (*------------------------------------------------------------------*)
  403.                     PROCEDURE SendData(VAR state: CHAR);
  404.     (*------------------------------------------------------------------*)
  405.     BEGIN
  406.         INC(numTry);
  407.         IF numTry > LMaxRetries
  408.         THEN
  409.             state := "T";
  410.             RETURN;
  411.         END;
  412.  
  413.         SendPacket("D",msgNum,size,sendPack);
  414.  
  415.         RecvPacket(typ, num, len, recvPack);
  416.         CASE typ OF
  417.         "Y","N":
  418.             IF typ = "N"
  419.             THEN
  420.                 num := DecPackNum(num); (* NAK for msgNum+1 is the *)
  421.             END;                        (* same as ACK for msgNum  *)
  422.  
  423.             IF num = msgNum
  424.             THEN
  425.                 numTry := 0;
  426.                 msgNum := IncPackNum(msgNum);
  427.                 size := BufFill(sendPack);
  428.                 IF size = 0  (* -> EOF *)
  429.                 THEN
  430.                         state  := "Z";
  431.                 END;
  432.                 DispPack;
  433.             ELSE
  434.                 DispTry;
  435.             END; |
  436.  
  437.         "E": (* got error packet *)
  438.             PrtErrPacket(recvPack, len);
  439.             state := "E"; |
  440.  
  441.         "T": (* timeout *)
  442.             DispTry; |
  443.  
  444.         "A": (* user abort *)
  445.             state := "A";
  446.  
  447.         ELSE (* undefined packet type *)
  448.             state := "U";
  449.  
  450.         END;
  451.  
  452.     END SendData;
  453.  
  454.  
  455.     (*------------------------------------------------------------------*)
  456.                     PROCEDURE SendEOF(VAR state: CHAR);
  457.     (*------------------------------------------------------------------*)
  458.     VAR
  459.         foundOne   : BOOLEAN;
  460.         fileNo     : CARDINAL;
  461.         versionNo  : CARDINAL;
  462.         done       : BOOLEAN;
  463.  
  464.     BEGIN
  465.         INC(numTry);
  466.         IF numTry > LMaxRetries
  467.         THEN
  468.             state := "T";
  469.             RETURN;
  470.         END;
  471.  
  472.         SendPacket("Z",msgNum,0,"");
  473.  
  474.         RecvPacket(typ, num, len, recvPack);
  475.         CASE typ OF
  476.         "Y","N":
  477.             IF typ = "N"
  478.             THEN
  479.                 num := DecPackNum(num); (* NAK for msgNum+1 is the *)
  480.             END;                        (* same as ACK for msgNum  *)
  481.  
  482.             IF num = msgNum
  483.             THEN
  484.                 numTry := 0;
  485.                 msgNum := IncPackNum(msgNum);
  486.                 Close(theFile);
  487.                 fileOpen := FALSE;
  488.                 DispPack;
  489.  
  490.                 NextName(foundOne, fileName, fileNo, versionNo);
  491.                 (* search next file *)
  492.                 Insert(fileName, 0, "DK.");  (* add device name *)
  493.  
  494.                 IF foundOne
  495.                 THEN
  496.                     state := "F";
  497.                         DispInit;
  498.                 ELSE
  499.                     state := "B";
  500.                 END;
  501.  
  502.             ELSE
  503.                 DispTry;
  504.             END; |
  505.  
  506.         "E": (* got error packet *)
  507.             PrtErrPacket(recvPack, len);
  508.             state := "E"; |
  509.  
  510.         "T": (* timeout *)
  511.             DispTry; |
  512.  
  513.         "A": (* user abort *)
  514.             state := "A";
  515.  
  516.         ELSE (* undefined packet type *)
  517.             state := "U";
  518.  
  519.         END;
  520.  
  521.     END SendEOF;
  522.  
  523.  
  524.     (*------------------------------------------------------------------*)
  525.                      PROCEDURE SendBreak(VAR state: CHAR);
  526.     (*------------------------------------------------------------------*)
  527.     BEGIN
  528.         INC(numTry);
  529.         IF numTry > LMaxRetries
  530.         THEN
  531.             state := "T";
  532.             RETURN;
  533.         END;
  534.  
  535.         SendPacket("B",msgNum,0,"");
  536.  
  537.         RecvPacket(typ, num, len, recvPack);
  538.         CASE typ OF
  539.         "Y","N":
  540.             IF typ = "N"
  541.             THEN
  542.                 num := DecPackNum(num); (* NAK for msgNum+1 is the *)
  543.             END;                        (* same as ACK for msgNum  *)
  544.  
  545.             IF num = msgNum
  546.             THEN
  547.                 numTry := 0;
  548.                 msgNum := IncPackNum(msgNum);
  549.                 state := "C";
  550.                 DispPack;
  551.             ELSE
  552.                 DispTry;
  553.             END; |
  554.  
  555.         "E": (* got error packet *)
  556.             PrtErrPacket(recvPack, len);
  557.             state := "E"; |
  558.  
  559.         "T": (* timeout *)
  560.             DispTry; |
  561.  
  562.         "A": (* user abort *)
  563.             state := "A";
  564.  
  565.         ELSE (* undefined packet type *)
  566.             state := "U";
  567.  
  568.         END;
  569.  
  570.     END SendBreak;
  571.  
  572.  
  573. BEGIN (* SwitchSend *)
  574.     msgNum   := 0;       (* First packet has # 0 *)
  575.     numTry   := 0;       (* No retries so far *)
  576.     DispInit;
  577.     fileOpen := FALSE;   (* no open file *)
  578.     state    := "S";     (* Send init is the start state *)
  579.  
  580.  
  581.     LOOP
  582.         CASE state OF
  583.         "S":
  584.             SendInit(state); |
  585.  
  586.         "F":
  587.             SendFile(state); |
  588.  
  589.         "D":
  590.             SendData(state); |
  591.  
  592.         "Z":
  593.             SendEOF(state); |
  594.  
  595.         "B":
  596.             SendBreak(state); |
  597.  
  598.         "C":
  599.             RETURN TRUE; |
  600.  
  601.         "U":
  602.             ErrorExit("Undefined packet type (M2-Kermit)");
  603.             RETURN FALSE; |
  604.  
  605.         "T":
  606.             ErrorExit("Too many retries (M2-Kermit)");
  607.             RETURN FALSE; |
  608.  
  609.         "A":
  610.             ErrorExit("User aborted transmission (M2-Kermit)");
  611.             RETURN FALSE; |
  612.  
  613.         "E":  (* Any other Problem *);
  614.             Close(theFile);
  615.             fileOpen := FALSE;
  616.             RETURN FALSE;
  617.  
  618.         ELSE
  619.             ErrorExit("Undefined state (M2-Kermit)");
  620.             RETURN FALSE;
  621.  
  622.         END;
  623.     END;
  624. END SwitchSend;
  625.  
  626.  
  627. (************************************************************************)
  628.                             PROCEDURE Send;
  629. (************************************************************************)
  630. CONST
  631.     UpLowEqual = TRUE;
  632.  
  633. VAR
  634.     fileName   : ARRAY [0..31] OF CHAR;
  635.     foundOne   : BOOLEAN;
  636.     fileNo     : CARDINAL;
  637.     versionNo  : CARDINAL;
  638.  
  639. BEGIN
  640.     IF Param1[0] = "?"
  641.     THEN
  642.         WriteString("Specify filename (including wildcards)");
  643.     ELSE
  644.         FindNames("DK", Param1, UpLowEqual);
  645.         NextName(foundOne, fileName, fileNo, versionNo);
  646.         Insert(fileName, 0, "DK.");  (* add device name *)
  647.  
  648.         IF foundOne
  649.         THEN
  650.             IF SwitchSend(fileName, Param2)
  651.             THEN
  652.                 DispMsg("Send successful");
  653.             END;
  654.         ELSE
  655.             DispMsg("No file(s) found (Snd)");
  656.         END;
  657.         SetPos(27,0);
  658.     END;
  659. END Send;
  660.  
  661. END KermSend.
  662.