home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / mtspascal.tar.gz / mtspascal.tar / mtsker.pas < prev    next >
Pascal/Delphi Source File  |  1984-01-06  |  40KB  |  1,121 lines
  1. (* 12/14/83 - Time out on first packet added *)
  2. (* 12/14/83 - MTS system calls silenced *)
  3. (* 12/05/83 - Carriage control option implemented *)
  4. (* 12/03/83 - Tape mode and IBM mode established *)
  5. (* 11/21/83 - Program commented *)
  6. (* 11/19/83 - History line begun *)
  7. (* 11/16/83 - complete working version in place *)
  8.  
  9. PROGRAM kermit;
  10. (*
  11. KERMIT file transfer utility for the Michigan Terminal System (MTS).
  12. Version 1.0 written by William S. Hall, Mathematical Reviews,
  13. Ann Arbor, MI in PASCAL/VS.
  14.  
  15. For program usage and limitations see SJ1K:kermit.doc
  16. *)
  17. %page
  18.     CONST
  19.     (*
  20.     Ordinal values of control characters.  Where values differ between
  21.     the EBCDEC and ASCII control characters, then are so noted.
  22.     *)
  23.     NUL = 00; SOH  = 01; STX = 2; ETX = 03;
  24.     EOT = 55;    (* A/E = 04/55 *)
  25.     ENQ = 45;    (* A/E = 05/45 *)
  26.     ACK = 46;    (* A/E = 06/46 *)
  27.     BEL = 47;    (* A/E = 07/47 *)
  28.     BS = 22;    (* A/E = 08/22 *)
  29.     HT = 05;    (* A/E = 09/05 *)
  30.     LF = 37;    (* A/E = 10/37 *)
  31.     VT = 11;  FF = 12;  CR = 13;  SO = 14;
  32.     SI = 15; DLE = 16; DC1 = 17; DC2 = 18;
  33.     DC3 = 19;
  34.     DC4 = 60;    (* A/E = 20/60 *)
  35.     NAK = 61;    (* A/E = 21/61 *)
  36.     SYN = 50;    (* A/E = 22/50 *)
  37.     ETB = 38;    (* A/E = 23/38 *)
  38.     CAN = 24;
  39.     EM = 25;
  40.     SUB = 63;    (* A/E = 26/63 *)
  41.     ESC = 39;    (* A/E = 27/39 *)
  42.     FS = 28;
  43.     GS = 29;
  44.     RS = 30;
  45.     US = 31;
  46.     SP = 64;    (* A/E = 32/64 *)
  47.     DEL = 7;    (* A/E = 127/7 *)
  48.  
  49.     (* Other program constants needed in the program *)
  50.     MAXPACK = 94;    (* Maximum packet size *)
  51.     MAXTRY = 5;    (* Times to retry a packet *)
  52.     MYQUOTE = '#';    (* Quote character I will use *)
  53.     MYPAD = 0;    (* Number of padding characters I need *)
  54.     MYPCHAR = NUL;    (* Ordinal value of padding character I need *)
  55.     MYEOL = CR;    (* Ordinal value of end of line char I need *)
  56.     MYTIME = 5;    (* Seconds after which I should be timed out *)
  57.     NAMESIZE = 40;    (* Maximum size of file name *)
  58.     MAXFILES = 20;    (* Maximum number of files to send *)
  59.     SNDINIT_DLY = 8000000; (* Delay in microseconds before first packet *)
  60. %page
  61.     TYPE
  62.     (* These types are used to call MTS procedures *)
  63.     char255 = packed array[1..255] of char;
  64.     halfword = packed -32768..32767;
  65.     (* This type holds a packet being received or sent *)
  66.     packet_type = packed array[1..MAXPACK] of char;
  67.     (* This points to a packet *)
  68.     packet_ptr = @packet_type;
  69.     (* Timeout variable for system time-out call *)
  70.     intpair = array[1..2] of integer;
  71.  
  72.     VAR
  73.     date : alfa;        (* used for running date and time call *)
  74.     time : alfa;
  75.     delay : intpair;    (* used for calling twait procedure *)
  76.     cc : boolean;        (* Carriage control char in column 1? *)
  77.     ccinfo : char;        (* used to set value of cc from input *)
  78.     col : integer;        (* Marks column position *)
  79.     cmdstr : char255;    (* used to issue commands to MTS *)
  80.     ascii : boolean;    (* ascii char set in use *)
  81.     i : integer;        (* Utility integer *)
  82.     size : integer;     (* Size of present data *)
  83.     n : integer;        (* Message number *)
  84.     rpsiz : integer;    (* Maximum receive packet size *)
  85.     spsiz : integer;    (* Maximum send packet size *)
  86.     pad : integer;        (* How much padding to send *)
  87.     timint : integer;    (* Timeout for foreign host on sends *)
  88.     numtry : integer;    (* Times this packet tried *)
  89.     oldtry : integer;    (* Times previous packet retried *)
  90.     debug : boolean;    (* true means debugging *)
  91.     state : char;        (* Present state of the automaton *)
  92.     padchar : char;     (* Padding character to send *)
  93.     eol : char;        (* End of line character to send *)
  94.     quote : char;        (* Quote character in incoming data *)
  95.     recpkt : packet_ptr;    (* Receive packet buffer pointer *)
  96.     packet : packet_ptr;    (* Send packet buffer pointer *)
  97.     command : char;     (* Command - receive or send *)
  98.     filnam : array[1..MAXFILES] of string(NAMESIZE); (* holds file names *)
  99.     nfiles : integer;    (* number of files to send *)
  100.     numsent : integer;    (* number already send *)
  101.     bugfil : text;        (* debug file *)
  102.     sndfil : text;        (* file to be sent *)
  103.     rcvfil : text;        (* file to be received *)
  104. %page
  105.     PROCEDURE cmdnoe(const cmd : char255; const len : halfword); fortran;
  106.     (* Makes MTS calls *)
  107.  
  108.     PROCEDURE twait(const code : integer; const val : intpair); fortran;
  109.     (* Executes delays *)
  110.  
  111.     PROCEDURE setsys;
  112.     (*
  113.     Set the terminal for file transfer so that no packets are wrapped
  114.     and the terminal is not paged.  Also MTS must not echo characters
  115.     during the transfer, and control characters, especially control A,
  116.     must be allowed to pass unintercepted by the front end (Hermes).
  117.     Finally, reader mode allows XON-XOFF flow control.
  118.     *)
  119.     BEGIN
  120.         cmdnoe('$control *msink* width=255', 26);
  121.         cmdnoe('$control *msink* outlen=255', 27);
  122.         cmdnoe('$control *msink* reader=on', 26);
  123.         cmdnoe('$control *msink* echo=off', 25);
  124.         cmdnoe('$control *msink* npc=off', 24);
  125.         cmdnoe('$control *msink* pagewait=off', 29);
  126.     END; {setsys}
  127.  
  128.     PROCEDURE resetsys;
  129.     (* Restore the user's system after completion of run *)
  130.     BEGIN
  131.         cmdnoe('$control *msink* reset', 22);
  132.     END; {resetsys}
  133.  
  134.     FUNCTION toupper(c : char) : char;
  135.     (* Convert lower to upper case *)
  136.     BEGIN
  137.         if ((c >= 'a') and (c <= 'i')) or ((c >= 'j') and (c <= 'r'))
  138.         or ((c >= 's') and (c <= 'z')) then
  139.             BEGIN
  140.             if ascii
  141.                 then toupper := chr(ord(c) - 32)
  142.             else
  143.                 toupper := chr(ord(c) + 64)
  144.             END
  145.         else toupper := c;
  146.     END;  {toupper}
  147.  
  148.     FUNCTION checksum(c : INTEGER) : INTEGER; (* checksum based on ASCII sum *)
  149.     (*
  150.     Compute a checksum in the range 0 to 63.  This is a Pascal version
  151.     of the formula (sum + (sum & 192) div 64) & 63, where & is bitwise 'and'
  152.     *)
  153.     VAR
  154.         x : INTEGER;
  155.     BEGIN
  156.         x := (c MOD 256) DIV 64;
  157.         x := x + c;
  158.         checksum := x MOD 64;
  159.     END; {checksum}
  160. %page
  161.     FUNCTION tochar(ch : integer) : char;
  162.     (*
  163.     Converts an integer in the range 0 to 94 to a printing character.
  164.     If ASCII is the underlying character set, this is trivial.    For
  165.     EBCDEC, the internal representation of characters in Pascal/VS,
  166.     a case statement is appropriate.  Note that three characters,
  167.     namely, "^", "`", and "\" cannot be represented in quotes and
  168.     chr(ordinal value) is used instead.  This seems to be a pecularity
  169.     of the MTS operating system and not EBCDEC in general.
  170.     *)
  171.     BEGIN
  172.         if ascii then
  173.         tochar := chr(ch + 32)
  174.         else case ch of
  175.          0 : tochar := ' ';  1 : tochar := '!';  2 : tochar := '"';
  176.          3 : tochar := '#';  4 : tochar := '$';  5 : tochar := '%';
  177.          6 : tochar := '&';  7 : tochar := ''''; 8 : tochar := '(';
  178.          9 : tochar := ')'; 10 : tochar := '*'; 11 : tochar := '+';
  179.         12 : tochar := ','; 13 : tochar := '-'; 14 : tochar := '.';
  180.         15 : tochar := '/'; 16 : tochar := '0'; 17 : tochar := '1';
  181.         18 : tochar := '2'; 19 : tochar := '3'; 20 : tochar := '4';
  182.         21 : tochar := '5'; 22 : tochar := '6'; 23 : tochar := '7';
  183.         24 : tochar := '8'; 25 : tochar := '9'; 26 : tochar := ':';
  184.         27 : tochar := ';'; 28 : tochar := '<'; 29 : tochar := '=';
  185.         30 : tochar := '>'; 31 : tochar := '?'; 32 : tochar := '@';
  186.         33 : tochar := 'A'; 34 : tochar := 'B'; 35 : tochar := 'C';
  187.         36 : tochar := 'D'; 37 : tochar := 'E'; 38 : tochar := 'F';
  188.         39 : tochar := 'G'; 40 : tochar := 'H'; 41 : tochar := 'I';
  189.         42 : tochar := 'J'; 43 : tochar := 'K'; 44 : tochar := 'L';
  190.         45 : tochar := 'M'; 46 : tochar := 'N'; 47 : tochar := 'O';
  191.         48 : tochar := 'P'; 49 : tochar := 'Q'; 50 : tochar := 'R';
  192.         51 : tochar := 'S'; 52 : tochar := 'T'; 53 : tochar := 'U';
  193.         54 : tochar := 'V'; 55 : tochar := 'W'; 56 : tochar := 'X';
  194.         57 : tochar := 'Y'; 58 : tochar := 'Z'; 59 : tochar := '[';
  195.         60 : tochar := chr(186);
  196.         61 : tochar := ']';
  197.         62 : tochar := chr(170);
  198.         63 : tochar := '_';
  199.         64 : tochar := chr(154);
  200.         65 : tochar := 'a';
  201.         66 : tochar := 'b'; 67 : tochar := 'c'; 68 : tochar := 'd';
  202.         69 : tochar := 'e'; 70 : tochar := 'f'; 71 : tochar := 'g';
  203.         72 : tochar := 'h'; 73 : tochar := 'i'; 74 : tochar := 'j';
  204.         75 : tochar := 'k'; 76 : tochar := 'l'; 77 : tochar := 'm';
  205.         78 : tochar := 'n'; 79 : tochar := 'o'; 80 : tochar := 'p';
  206.         81 : tochar := 'q'; 82 : tochar := 'r'; 83 : tochar := 's';
  207.         84 : tochar := 't'; 85 : tochar := 'u'; 86 : tochar := 'v';
  208.         87 : tochar := 'w'; 88 : tochar := 'x'; 89 : tochar := 'y';
  209.         90 : tochar := 'z'; 91 : tochar := '{'; 92 : tochar := '|';
  210.         93 : tochar := '}'; 94 : tochar := '~';
  211.         otherwise
  212.             if debug then writeln(bugfil, 'tochar error');
  213.         END; {case}
  214.     END; {tochar}
  215. %page
  216.     FUNCTION unchar(ch : char) : integer; (* Undoes tochar *)
  217.     (*
  218.     Converts a printing character to an integer in the range 0-94.
  219.     This procedure undoes the action of "tochar".
  220.     *)
  221.     BEGIN
  222.         if ascii then
  223.         unchar := ord(ch) - 32
  224.         else case ch of
  225.         ' ' : unchar := 0;  '!' : unchar := 1;    '"' : unchar := 2;
  226.         '#' : unchar := 3;  '$' : unchar := 4;     '%' : unchar := 5;
  227.         '&' : unchar := 6;  '''': unchar := 7;    '(' : unchar := 8;
  228.         ')' : unchar := 9;  '*' : unchar := 10; '+' : unchar := 11;
  229.         ',' : unchar := 12; '-' : unchar := 13; '.' : unchar := 14;
  230.         '/' : unchar := 15; '0' : unchar := 16; '1' : unchar := 17;
  231.         '2' : unchar := 18; '3' : unchar := 19; '4' : unchar := 20;
  232.         '5' : unchar := 21; '6' : unchar := 22; '7' : unchar := 23;
  233.         '8' : unchar := 24; '9' : unchar := 25; ':' : unchar := 26;
  234.         ';' : unchar := 27; '<' : unchar := 28; '=' : unchar := 29;
  235.         '>' : unchar := 30; '?' : unchar := 31; '@' : unchar := 32;
  236.         'A' : unchar := 33; 'B' : unchar := 34; 'C' : unchar := 35;
  237.         'D' : unchar := 36; 'E' : unchar := 37; 'F' : unchar := 38;
  238.         'G' : unchar := 39; 'H' : unchar := 40; 'I' : unchar := 41;
  239.         'J' : unchar := 42; 'K' : unchar := 43; 'L' : unchar := 44;
  240.         'M' : unchar := 45; 'N' : unchar := 46; 'O' : unchar := 47;
  241.         'P' : unchar := 48; 'Q' : unchar := 49; 'R' : unchar := 50;
  242.         'S' : unchar := 51; 'T' : unchar := 52; 'U' : unchar := 53;
  243.         'V' : unchar := 54; 'W' : unchar := 55; 'X' : unchar := 56;
  244.         'Y' : unchar := 57; 'Z' : unchar := 58; '[' : unchar := 59;
  245.         chr(186) : unchar := 60;
  246.         ']' : unchar := 61;
  247.         chr(170) : unchar := 62;
  248.         '_' : unchar := 63;
  249.         chr(154) : unchar := 64;
  250.         'a' : unchar := 65;
  251.         'b' : unchar := 66; 'c' : unchar := 67; 'd' : unchar := 68;
  252.         'e' : unchar := 69; 'f' : unchar := 70; 'g' : unchar := 71;
  253.         'h' : unchar := 72; 'i' : unchar := 73; 'j' : unchar := 74;
  254.         'k' : unchar := 75; 'l' : unchar := 76; 'm' : unchar := 77;
  255.         'n' : unchar := 78; 'o' : unchar := 79; 'p' : unchar := 80;
  256.         'q' : unchar := 81; 'r' : unchar := 82; 's' : unchar := 83;
  257.         't' : unchar := 84; 'u' : unchar := 85; 'v' : unchar := 86;
  258.         'w' : unchar := 87; 'x' : unchar := 88; 'y' : unchar := 89;
  259.         'z' : unchar := 90; '{' : unchar := 91; '|' : unchar := 92;
  260.         '}' : unchar := 93; '~' : unchar := 94;
  261.         otherwise
  262.             if debug then writeln(bugfil, 'unchar error');
  263.         END; {case}
  264.     END; {unchar}
  265. %page
  266.     FUNCTION ctl(ch : char) : char;
  267.     (*
  268.     Changes the printing characters shown below to control characters.
  269.     Used to unquote a quoted control character in a packet.
  270.     *)
  271.     BEGIN
  272.         if ascii then
  273.         ctl := chr(ord(ch) - 64)
  274.         else case ch of
  275.         '@' : ctl := chr(NUL); 'A' : ctl := chr(SOH);
  276.         'B' : ctl := chr(STX); 'C' : ctl := chr(ETX);
  277.         'D' : ctl := chr(EOT); 'E' : ctl := chr(ENQ);
  278.         'F' : ctl := chr(ACK); 'G' : ctl := chr(BEL);
  279.         'H' : ctl := chr(BS);  'I' : ctl := chr(HT);
  280.         'J' : ctl := chr(LF);  'K' : ctl := chr(VT);
  281.         'L' : ctl := chr(FF);  'M' : ctl := chr(CR);
  282.         'N' : ctl := chr(SO);  'O' : ctl := chr(SI);
  283.         'P' : ctl := chr(DLE); 'Q' : ctl := chr(DC1);
  284.         'R' : ctl := chr(DC2); 'S' : ctl := chr(DC3);
  285.         'T' : ctl := chr(DC4); 'U' : ctl := chr(NAK);
  286.         'V' : ctl := chr(SYN); 'W' : ctl := chr(ETB);
  287.         'X' : ctl := chr(CAN); 'Y' : ctl := chr(EM);
  288.         'Z' : ctl := chr(SUB); '[' : ctl := chr(ESC);
  289.         chr(186) : ctl := chr(FS);
  290.         ']' : ctl := chr(GS);
  291.         chr(170) : ctl := chr(RS);
  292.         '_' : ctl := chr(US);
  293.         '?' : ctl := chr(DEL);
  294.         otherwise
  295.             if debug then writeln(bugfil, 'ctl error');
  296.         END; {case}
  297.     END; {ctl}
  298. %page
  299.     FUNCTION unctl(ch : char) : char;
  300.     (* Changes a control character to its corresponding printing form *)
  301.     VAR
  302.         i : integer;
  303.     BEGIN
  304.         i := ord(ch);
  305.         if ascii then
  306.         unctl := chr(i + 64)
  307.         else case i of
  308.         NUL : unctl := '@'; SOH : unctl := 'A';
  309.         STX : unctl := 'B'; ETX : unctl := 'C';
  310.         EOT : unctl := 'D'; ENQ : unctl := 'E';
  311.         ACK : unctl := 'F'; BEL : unctl := 'G';
  312.          BS : unctl := 'H';  HT : unctl := 'I';
  313.          LF : unctl := 'J';  VT : unctl := 'K';
  314.          FF : unctl := 'L';  CR : unctl := 'M';
  315.          SO : unctl := 'N';  SI : unctl := 'O';
  316.         DLE : unctl := 'P'; DC1 : unctl := 'Q';
  317.         DC2 : unctl := 'R'; DC3 : unctl := 'S';
  318.         DC4 : unctl := 'T'; NAK : unctl := 'U';
  319.         SYN : unctl := 'V'; ETB : unctl := 'W';
  320.         CAN : unctl := 'X';  EM : unctl := 'Y';
  321.         SUB : unctl := 'Z'; ESC : unctl := '[';
  322.          FS : unctl := chr(186);
  323.          GS : unctl := ']';
  324.          RS : unctl := chr(170);
  325.          US : unctl := '_';
  326.         DEL : unctl := '?';
  327.         otherwise
  328.             if debug then writeln(bugfil, 'unctl error');
  329.         END; {case}
  330.     END; {unctl}
  331. %page
  332.     FUNCTION aord(ch : char) : integer;
  333.     (* Convert a character to its ASCII ordinal value *)
  334.     BEGIN
  335.         if ascii then aord := ord(ch)
  336.         else aord := unchar(ch) + 32;
  337.     END; {aord}
  338.  
  339.     FUNCTION writeopn(nampkt : packet_ptr; len : integer) : boolean;
  340.     (*
  341.     Open a file for writing during receive mode.  The filename itself
  342.     is obtained from the sending Kermit in a file name packet.    The
  343.     name is extracted and concatenated to dynamically create and open
  344.     it.  Pascal/VS does not presently return error codes, but by
  345.     declaring the function as boolean, this feature can be readily
  346.     implemented when return codes become available.  Use of column
  347.     1 for carriage control is an option.
  348.     *)
  349.     VAR
  350.         filnam : string(NAMESIZE);
  351.         crname : string(NAMESIZE + 20);
  352.     BEGIN
  353.         filnam := substr(str(nampkt@), 1, len);
  354.         crname := '$create '||filnam;
  355.         cmdnoe(crname, length(crname));
  356.         if debug then writeln(bugfil, 'Opening ', filnam);
  357.         if cc then
  358.         rewrite(rcvfil, 'FILE='||filnam|| ' MAXLEN=255 ')
  359.         else
  360.         rewrite(rcvfil, 'FILE='||filnam|| ' MAXLEN=255 NOCC');
  361.         col := 1;
  362.         writeopn := true;
  363.     END; {writeopn}
  364.  
  365.     FUNCTION getnxt : boolean;
  366.     (*
  367.     Gen next file for reading when in send mode.  No error codes are
  368.     returned by Pascal/VS at present, but the function returns a
  369.     boolean value, allowing implementation of such when available.
  370.     *)
  371.     BEGIN
  372.         if debug then writeln(bugfil, 'Opening ', filnam[numsent]);
  373.         reset(sndfil, 'FILE='||filnam[numsent]||' MAXLEN=255');
  374.         col := 1;
  375.         getnxt := true;
  376.     END; {getnxt}
  377. %page
  378.     PROCEDURE rpar(data : packet_ptr);
  379.     (* Get the other side's sent-init packet.  The time-out is N/A *)
  380.     BEGIN
  381.         spsiz := unchar(data@[1]);    (* Maximum send packet size *)
  382.         timint := unchar(data@[2]); (* When I should time out *)
  383.         pad := unchar(data@[3]);    (* Number of pads to send *)
  384.         padchar := ctl(data@[4]);    (* padding char to send *)
  385.         eol := chr(unchar(data@[5])); (* end-of-line char to send *)
  386.         quote := data@[6];        (* incoming data quote char *)
  387.         if debug then        (* write this to trace file *)
  388.         writeln(bugfil, 'sendinit data from other side - ',
  389.             spsiz:3, timint:3, pad:3, ord(padchar):3,
  390.             ord(eol):3, quote);
  391.     END; {rpar}
  392.  
  393.     PROCEDURE spar(data : packet_ptr);
  394.     (* Fill data array with my send-init parameters *)
  395.     BEGIN
  396.         data@[1] := tochar(MAXPACK);    (* my max packet size *)
  397.         data@[2] := tochar(MYTIME);     (* when I should be timed out *)
  398.         data@[3] := tochar(MYPAD);        (* how much padding I need *)
  399.         data@[4] := unctl(chr(MYPCHAR));    (* my pad char *)
  400.         data@[5] := tochar(MYEOL);        (* my end of line *)
  401.         data@[6] := MYQUOTE;        (* quote char I send *)
  402.     END; {spar}
  403. %page
  404.     FUNCTION bufill(bufptr : packet_ptr) : integer;
  405.     (*
  406.     Get a buffer full of data from the file that is being sent.
  407.     Control characters are quoted (preceded by a '#').
  408.     *)
  409.     VAR
  410.     i : integer;        (* loop index *)
  411.     t : char;        (* utility character *)
  412.     BEGIN
  413.     i := 1;
  414.     while (not eof(sndfil)) and ( i < spsiz - 8) do
  415.     (* spsiz - 8 keeps the buffer from overflowing *)
  416.         BEGIN
  417.         if eoln(sndfil) then    (* end of line.  Quote CR and LF *)
  418.             BEGIN
  419. (* quote the char *)    bufptr@[i] := quote;
  420. (* uncontrollify it *)    bufptr@[i + 1] := unctl(chr(CR));
  421. (* do the same for *)    bufptr@[i + 2] := quote;
  422. (* the line feed *)    bufptr@[i + 3] := unctl(chr(LF));
  423. (* bump loop ctr *)    i := i + 4;
  424.             readln(sndfil);     (* reset file pointer *)
  425.             col := 1;        (* reset column position *)
  426.             END {if}
  427.         else
  428.             BEGIN
  429.             read(sndfil,t);     (* get the next char *)
  430.             if ((col = 1) and cc) then
  431.                 BEGIN
  432.                 if t = '1' then    (* ignore unless FF *)
  433.                     BEGIN
  434. (* quote the form feed *)         bufptr@[i] := quote;
  435. (* put char in buffer *)         bufptr@[i + 1] := unctl(chr(FF));
  436. (* bump counter *)             i := i + 2;
  437.                      END
  438.                 END {col = 1}
  439. (* control char or *)    else if (ord(t) < SP) or (t = chr(DEL))
  440.                  or (t = quote) then
  441. (* quote? *)            BEGIN
  442. (* yes, so quote it *)        bufptr@[i] := quote;
  443. (* uncontrollify it *)        if t <> quote then t := unctl(t);
  444. (* put char in buffer *)    bufptr@[i + 1] := t;
  445. (* bump counter *)        i := i + 2;
  446.                 END
  447.             else
  448.                 BEGIN
  449.                 bufptr@[i] := t;  (* put char in buffer *)
  450.                 i := i + 1;      (* bump counter *)
  451.                 END;
  452.            col := col + 1;          (* advance column counter *)
  453.            END; {else}
  454.          END; {while}
  455.          bufill := i - 1;              (* return count *)
  456.     END; {bufill}
  457. %page
  458.     PROCEDURE bufemp(buffer : packet_ptr; len : integer);
  459.     (* Get data from incoming packet into a file *)
  460.     VAR
  461.         i : integer;        (* counter *)
  462.         t : char;            (* utility character *)
  463.     BEGIN
  464.         i := 1;
  465.         while i <= len do        (* loop thru character field *)
  466.         BEGIN
  467.             t := buffer@[i];    (* get character *)
  468.             if t = MYQUOTE then (* next char must be unquoted *)
  469.             BEGIN
  470.                 i := i + 1;     (* bump counter *)
  471.                 t := buffer@[i];    (* get quoted char *)
  472.                 case t of
  473. (* it was a real quote *)    MYQUOTE : write(rcvfil, t);
  474. (* CR, so assume newline *)    'M' : begin
  475.                       writeln(rcvfil);
  476. (* reset column marker *)          col := 1;
  477.                       end;
  478. (* LF, don't pass *)        'J' : ;
  479. (* FF, so make new page *)    'L' : begin
  480.                       page(rcvfil);
  481.                       col := col + 1;
  482.                       end;
  483. (* expand the tabs *)        'I' : repeat
  484. (* assume stops at 1, 9, 17, etc. *)      write(rcvfil, ' ');
  485.                       col := col + 1;
  486.                       until (col mod 8 = 1);
  487.                 otherwise
  488. (* make a control character *)        begin
  489.                     write(rcvfil, ctl(t));
  490. (* increment column marker *)        col := col + 1;
  491.                     end;
  492.                 END; {case}
  493.             END {if}
  494.             else
  495.             begin
  496.                 write(rcvfil, t);    (* put character into file *)
  497.                 col := col + 1;    (* increment column marker *)
  498.             end;
  499.             i := i + 1;
  500.         END; {while}
  501.     END; {bufemp}
  502. %page
  503.     FUNCTION rpack(var len, num : integer; data : packet_ptr) : char;
  504.     (* Read a packet being sent.  Compute check sum, return packet type *)
  505.     LABEL 10;    (* Heavens! a GOTO - for resynchronization *)
  506.     VAR
  507.         i, chksum : integer;    (* counter, check sum *)
  508.         done : boolean;        (* packet read if true *)
  509.         t, class : char;        (* utility char, packet type *)
  510.     BEGIN
  511.         if debug then writeln(bugfil, 'rpack');    (* debug, trace file *)
  512.         while t <> chr(SOH) do read(t);    (* look for synch char SOH *)
  513.         if debug then write(bugfil, t);    (* save in debugging file *)
  514.         done := false;            (* not yet done *)
  515.     10: while not done do
  516.         BEGIN
  517.             read(t);                (* get char *)
  518.             if debug then write(bugfil, t);    (* save in trace file *)
  519.             if t = chr(SOH) then goto 10;  (* if synch, start again *)
  520.             chksum := aord(t);        (* accumulate check sum *)
  521.             len := unchar(t) - 3;    (* get length of packet *)
  522.  
  523.             read(t);                (* get char *)
  524.             if debug then write(bugfil, t);    (* save in trace file *)
  525.             if t = chr(SOH) then goto 10;    (* resynchronize *)
  526.             chksum := chksum + aord(t); (* accumulate check sum *)
  527.             num := unchar(t);        (* get packet number *)
  528.  
  529.             read(t);                (* get char *)
  530.             if debug then write(bugfil, t);    (* save in trace file *)
  531.             if t = chr(SOH) then goto 10;    (* resynchronize *)
  532.             chksum := chksum + aord(t);     (* accumulate sum *)
  533.             class := t;             (* get packet type *)
  534.  
  535.             for i := 1 to len do    (* get the actual data *)
  536.             BEGIN
  537. (* get char *)            read(t);
  538. (* save in trace file *)    if debug then write(bugfil, t);
  539. (* resynchronize *)        if t = chr(SOH) then goto 10;
  540. (* accumulate check sum *)  chksum := chksum + aord(t);
  541. (* store data *)        data@[i] := t;
  542.             END;
  543.  
  544.             read(t);            (* get sender's check sum *)
  545. (* resynchronize *) if t = chr(SOH) then goto 10;
  546. (* save in trace *) if debug then write(bugfil, t);
  547.             done := true;        (* end of packet *)
  548.         END; {while}
  549.         if t = tochar(checksum(chksum)) then rpack := class else
  550.         rpack := 'E';    (* compare check sums, return 'E' if bad *)
  551.         if debug then writeln(bugfil);    (* flush line to trace file *)
  552.     END; {rpack}
  553. %page
  554.     PROCEDURE spack(class : char; num, len : integer; data : packet_ptr);
  555.     (* Send a packet to the other side *)
  556.     TYPE
  557.         buffer = packed array[1..100] of char;
  558.     VAR
  559.         i : integer;    (* counter *)
  560.         chksum : integer;    (* packet checksum *)
  561.         bufp : @buffer;    (* pointer to buffer *)
  562.     BEGIN
  563.         if debug then writeln(bugfil, 'spack');    (* save in trace *)
  564.         if pad > 0 then            (* send padding if needed *)
  565.         for i := 1 to pad do write(padchar);
  566.         new(bufp);                (* make space *)
  567.         bufp@[1] := chr(SOH);        (* synch character *)
  568.         bufp@[2] := tochar(len + 3);   (* char representation of length *)
  569.         chksum := aord(bufp@[2]);    (* char representation of check sum *)
  570.         bufp@[3] := tochar(num); (* char representation of packet number *)
  571.         chksum := chksum + aord(bufp@[3]);    (* accumulate check sum *)
  572.         bufp@[4] := class;            (* packet type *)
  573.         chksum := chksum + aord(class);    (* accumulate check sum *)
  574.         for i := 1 to len do    (* accumulate data and check sum *)
  575.         BEGIN
  576.             bufp@[4 + i] := data@[i];
  577.             chksum := chksum + aord(data@[i]);
  578.         END;
  579.         bufp@[len + 4 + 1] := tochar(checksum(chksum));
  580.                 (* char representation of check sum *)
  581.         bufp@[len + 4 + 2] := eol;    (* end of line wanted by other end *)
  582.         for i := 1 to (len+4+1) do write(bufp@[i]);
  583.                 (* send it out to other side *)
  584.         writeln(bufp@[len+4+2]);  (* IMPORTANT! Must flush output in MTS *)
  585.         if debug then    (* save the packet in the trace file *)
  586.         BEGIN
  587.             for i := 1 to (len+4+2) do write(bugfil, bufp@[i]);
  588.             writeln(bugfil);    (* flush to file *)
  589.         END;
  590.     END; {spack}
  591. %page
  592.     FUNCTION recsw : boolean;
  593.     (* State table switcher for receiving files *)
  594.     VAR
  595.         done : boolean;    (* no more files to receive if true *)
  596.  
  597.     FUNCTION rinit : char;
  598.     (* Receive initialization from sender *)
  599.         VAR
  600.         len, num : integer;    (* packet length, number *)
  601.         BEGIN
  602.         if debug then writeln(bugfil, 'rinit');
  603.         if numtry > MAXTRY then (* too many tries, so abort *)
  604.             rinit := 'A'
  605.         else
  606.             BEGIN
  607. (* bump try count *)    numtry := numtry + 1;
  608. (* get a packet *)    case rpack(len, num, recpkt) of
  609. (* got a send-init *)        'S' : BEGIN
  610. (* retrieve parameters from sender *) rpar(recpkt);
  611. (* fill up packet with my info *)     spar(packet);
  612. (* ACK with my packet *)          spack('Y', n, 6, packet);
  613. (* save old try count *)          oldtry := numtry;
  614. (* start a new counter *)          numtry := 0;
  615. (* bump count, mod 64 *)          n := (n + 1) mod 64;
  616. (* return file-send state *)          rinit := 'F';
  617.                   END; {S}
  618. (* didn't get packet *)      'E' : rinit := state;    (* keep waiting *)
  619. (* some other type, abort *) otherwise
  620.                   rinit := 'A';
  621.             END; {case}
  622.             END; {else}
  623.         END; {rinit}
  624. %page
  625.     FUNCTION rfile : char;
  626.     (* Receive file name *)
  627.         VAR
  628.         num, len : integer;    (* packet number, length *)
  629.         k : integer;     (* utility integer *)
  630.         BEGIN
  631.         if debug then writeln(bugfil, 'rfile');
  632.         if numtry > MAXTRY then (* abort if too many tries *)
  633.             rfile := 'A'
  634.         else
  635.             BEGIN
  636. (* bump count *)    numtry := numtry + 1;
  637. (* get a packet *)    case rpack(len, num, recpkt) of
  638. (* send-init, maybe ACK *)  'S' : BEGIN
  639. (* has been lost *)              if oldtry > MAXTRY then
  640. (* if too many tries, abort *)          rfile := 'A'
  641.                       else
  642.                       BEGIN
  643. (* bump oldtry count as well *)           oldtry := oldtry + 1;
  644. (* previous packet mod 64 ? *)              k := n - 1;
  645.                           if k < 0 then k := 63;
  646. (* yes, so ACK it again *)              if num = k then
  647.                           BEGIN
  648. (* send our send-init packet *)               spar(packet);
  649.                               spack('Y', num,
  650.                                 6, packet);
  651. (* reset try counter *)                   numtry := 0;
  652. (* stay in this state *)                  rfile := state;
  653.                           END
  654.                           else
  655. (* not previous packet, abort *)          rfile := 'A';
  656.                       END; {else}
  657.                   END; {S}
  658. (* end-of-file *)        'Z' : BEGIN
  659.                       if oldtry > MAXTRY then
  660.                       rfile := 'A'
  661.                       else
  662.                       BEGIN
  663.                           oldtry := oldtry + 1;
  664. (* previous packet, mod 64 ? *)           k := n - 1;
  665.                           if k < 0 then k := 63;
  666. (* yes, so ACK it again *)              if num = k then
  667.                           BEGIN
  668.                               spack('Y', num, 0,
  669.                                 packet);
  670.                               numtry := 0;
  671. (* stay in this state *)                  rfile := state;
  672.                           END
  673.                           else
  674. (* not previous packet, abort *)          rfile := 'A';
  675.                       END
  676.                   END; {Z}
  677. (* file-header *)        'F' : BEGIN
  678. (* what we really want so the *)      if num <> n then
  679. (* packet number must be correct *)      rfile := 'A'
  680.                       else
  681.                       BEGIN
  682. (* try to open a new file *)              if not writeopn(recpkt, len) then
  683.                           rfile := 'A'
  684.                           else
  685. (* if OK then *)                  BEGIN
  686. (* ACK the file header *)                  spack('Y', n, 0, packet);
  687. (* reset counters *)                      oldtry := numtry;
  688.                               numtry := 0;
  689. (* bump packet number mod 64 *)               n := (n + 1) mod 64;
  690. (* switch to data packet *)                  rfile := 'D';
  691.                           END;
  692.                       END;
  693.                   END; {F}
  694. (* break transmission *)    'B' : BEGIN
  695. (* need correct packet number *)      if num <> n then
  696.                       rfile := 'A'
  697.                       else
  698.                       BEGIN
  699. (* say OK *)                      spack('Y', n, 0, packet);
  700. (* switch to complete state *)              rfile := 'C';
  701.                       END;
  702.                   END; {B}
  703. (* souldn't get packet *)   'E' : rfile := state;    (* keep trying *)
  704. (* something else, abort *)  otherwise
  705.                    rfile := 'A';
  706.             END; {case}
  707.             END;
  708.         END; {rfile}
  709.  
  710.     FUNCTION rdata : char;
  711.     (* Receive data *)
  712.         VAR
  713.         num, len : integer;        (* packet number, length *)
  714.         k : integer;     (* utility integer *)
  715.         BEGIN
  716.         if debug then writeln(bugfil, 'rdata');
  717.         if numtry > MAXTRY then     (* abort if too many tries *)
  718.             rdata := 'A'
  719.         else
  720.             BEGIN
  721.             numtry := numtry + 1;    (* bump try counter *)
  722. (* get packet *)    case rpack(len, num, recpkt) of
  723. (* got a data packet *)     'D' : BEGIN
  724. (* looks like wrong number *)          if num <> n then
  725.                       BEGIN
  726. (* if too many tries, then quit *)          if oldtry > MAXTRY then
  727.                           rdata := 'A'
  728.                           else
  729.                           BEGIN
  730. (* bump oldtry counter *)                  oldtry := oldtry + 1;
  731. (* see if we have previous packet again *)          k := n - 1;
  732.                               if k < 0 then k := 63;
  733. (* yes, got previous one *)                  if num = k then
  734.                               BEGIN
  735. (* re-ACK the packet *)                       spack('Y', num,
  736.                                     0, packet);
  737. (* reset try counter *)                       numtry := 0;
  738. (* stay in D, don't write out data *)                  rdata := state;
  739.                               END
  740.                               else
  741. (* Sorry, wrong number *)                  rdata := 'A';
  742.                           END;
  743.                       END; { num <> n }
  744. (* write the packet to file *)          bufemp(recpkt, len);
  745. (* acknowledge the packet *)          spack('Y', n, 0, packet);
  746. (* reset the counters *)          oldtry := numtry;
  747.                       numtry := 0;
  748. (* count packets, mod 64 *)          n := (n + 1) mod 64;
  749. (* stay in this state *)          rdata := 'D';
  750.                   END; {D}
  751. (* got a file header *)    'F' :  BEGIN
  752. (* too many, so quit *)           if oldtry > MAXTRY then
  753.                       rdata := 'A'
  754.                       else
  755.                       BEGIN
  756. (* bump try counter *)                  oldtry := oldtry + 1;
  757. (* see if previous packet *)              k := n - 1;
  758.                           if k < 0 then k := 63;
  759. (* yes, so ACK it again *)              if num = k then
  760.                           BEGIN
  761.                               spack('Y', num, 0,
  762.                                 packet);
  763.                               numtry := 0;
  764. (* stay in data state *)                  rdata := state;
  765.                           END
  766.                           else
  767. (* not previous packet so abort *)          rdata := 'A';
  768.                       END;
  769.                   END; {Z}
  770.                 'Z' : BEGIN
  771. (* must have right packet *)          if num <> n then
  772.                       rdata := 'A'
  773.                       else
  774.                       BEGIN
  775. (* OK, so ACK it *)                  spack('Y', n, 0, packet);
  776. (* close the file *)                  close(rcvfil);
  777. (* bump packet counter *)              n := (n + 1) mod 64;
  778. (* go back to receive file state *)          rdata := 'F';
  779.                       END;
  780.                   END;
  781. (* nothing, keep waiting *) 'E' : rdata := state;
  782. (* some other type, *)        otherwise
  783. (* so abort *)              rdata := 'A';
  784.             END; {case}
  785.           END;
  786.         END; {rdata}
  787.  
  788.     BEGIN {recsw}
  789.         done := false;    (* initialize *)
  790.         state := 'R';    (* always start in receive state *)
  791.         n := 0;        (* initialize message number *)
  792.         numtry := 0;    (* no tries yet *)
  793.         while not done do    (* do until done *)
  794.            case state of
  795.            'D' : state := rdata;    (* data receive state *)
  796.            'F' : state := rfile;    (* file receive state *)
  797.            'R' : state := rinit;    (* send initiate state *)
  798.            'C' : BEGIN            (* completed state *)
  799.                  recsw := true;
  800.                  done := true;
  801.              END;
  802.            'A' : BEGIN            (* abort state *)
  803.                  recsw := false;
  804.                  done := true;
  805.              END;
  806.            END; {case}
  807.     END; {recsw}
  808. %page
  809.     FUNCTION sendsw : boolean;
  810.     (* State table switcher for sending files *)
  811.     VAR
  812.         done : boolean;    (* indicates that sending is finished *)
  813.  
  814.     FUNCTION sinit : char;
  815.     (* Send my parameters and get other side's back *)
  816.         VAR
  817.         num, len : integer;        (* packet number, length *)
  818.         BEGIN {function sinit}
  819.         if debug then writeln(bugfil, 'sinit');
  820.         if numtry > MAXTRY then sinit := 'A'    (* too many tries *)
  821.         else
  822.             BEGIN
  823.             numtry := numtry + 1;    (* bump try counter *)
  824.             spar(packet);        (* fill up with init info *)
  825.             spack('S', n, 6, packet);    (* send it out *)
  826.             case rpack(len, num, recpkt) of (* get reply *)
  827. (* NAK packet *)        'N', 'E' : sinit := state;    (* just stay in state *)
  828. (* ACK packet *)        'Y' : BEGIN
  829. (* wrong ACK, stay in state *)          if n <> num then
  830.                       sinit := state
  831.                       else
  832.                       BEGIN
  833. (* get other side's init info *)          rpar(recpkt);
  834. (* check and set defaults *)              if eol = chr(NUL)
  835.                           then eol := chr(CR);
  836.                           if quote = chr(NUL)
  837.                           then quote := MYQUOTE;
  838. (* reset try counter *)               numtry := 0;
  839. (* bump packet count *)               n := (n + 1) mod 64;
  840. (* open file to be sent *)              if getnxt then
  841. (* if open OK go to next state *)          sinit := 'F'
  842. (* no good, so give up *)              else sinit := 'A';
  843.                       END; {else}
  844.                   END; {'Y'}
  845. (* unknown, abort *)        otherwise
  846.                 sinit := 'A';
  847.                END; {case}
  848.         END; {else}
  849.         END; {sinit}
  850. %page
  851.     FUNCTION sfile : char;
  852.     (* Send file name *)
  853.         VAR
  854.         num, len, l : integer;    (* packet number, len, stringlength *)
  855.         c : char;        (* utility character *)
  856.         BEGIN
  857.         if debug then writeln(bugfil, 'sfile');
  858.         if numtry > MAXTRY    (* too many tries, give up *)
  859.             then sfile := 'A'
  860.         else
  861.             BEGIN
  862.             numtry := numtry + 1;    (* bump try counter *)
  863.             len := 0;    (* set packet length to zero *)
  864.             l := length(filnam[numsent]);    (* length of filename *)
  865.             while (len < l) and (len < NAMESIZE) do
  866.                   BEGIN
  867.                   len := len + 1;    (* accumulate length *)
  868. (* stash away the name itself *)  packet@[len] :=
  869. (* in upper case *)               toupper(filnam[numsent][len]);
  870.                   END;
  871. (* send it out *)    spack('F', n, len, packet);
  872. (* get reply *)     c := rpack(len, num, recpkt);
  873.             case c of
  874. (* NAK or ACK *)         'N', 'Y' : BEGIN
  875.                         if c = 'N' then
  876. (* as before, stay in this state *)        BEGIN
  877. (* unless NAK for next packet *)            num := num - 1;
  878. (* which is like an ACK for this packet *)        if num < 0 then num := 63;
  879.                         END;
  880. (* wrong count so stay in this state *)     if n <> num then sfile := state
  881.                         else
  882.                         BEGIN
  883. (* reset counters *)                    numtry := 0;
  884. (* bump packet count *)                 n := (n + 1) mod 64;
  885. (* get first data from file *)                size := bufill(packet);
  886. (* switch to data state *)                sfile := 'D';
  887.                         END;
  888.                     END;
  889. (* receive failure *)         'E' : sfile := state;    (* just stay here *)
  890.                  otherwise
  891. (* unknown, abort *)         sfile := 'A';
  892.             END; {case}
  893.             END; {else}
  894.         END;  {sinit}
  895. %page
  896.     FUNCTION sdata : char;
  897.         VAR
  898.             num, len : integer;     (* packet number, length *)
  899.             c : char;            (* utility character *)
  900.         BEGIN
  901.         if debug then writeln(bugfil, 'sdata');
  902.         if numtry > MAXTRY then sdata := 'A'    (* abort if too many *)
  903.         else
  904.             BEGIN
  905.             numtry := numtry + 1;        (* bump try counter *)
  906.             spack('D', n, size, packet);    (* send a data packet *)
  907.             c := rpack(len, num, recpkt);    (* get the reply *)
  908.             case c of
  909.                 'N', 'Y' : BEGIN        (* NAK or ACK *)
  910. (* respond to NAK *)               if c = 'N' then
  911.                            BEGIN
  912.                            num := num - 1;
  913.                            if num < 0 then num := 63;
  914.                            END;
  915. (* just stay in this state *)           if n <> num then sdata := state
  916. (* unless NAK is for next packet *)       else
  917. (* which is like an ACK for this one *)        BEGIN
  918. (* reset try counter *)                 numtry := 0;
  919. (* bump packet count *)                 n := (n + 1) mod 64;
  920.                             if not eof(sndfil) then
  921.                             BEGIN
  922. (* get data from file if not at end *)                size :=
  923.                                    bufill(packet);
  924. (* stay in data state *)                       sdata := 'D';
  925.                                END
  926.                             else
  927. (* EOF, so switch to that state *)               sdata := 'Z';
  928.                            END;
  929.                    END;
  930. (* receive failure *)         'E' : sdata := state;    (* stay in state *)
  931.                  otherwise
  932. (* anything else, abort *)     sdata := 'A';
  933.             END; {case}
  934.             END; {else}
  935.         END;  {sdata}
  936. %page
  937.     FUNCTION seof : char;
  938.     (* Send enf-of-file *)
  939.         VAR
  940.         num, len : integer;    (* packet number, length *)
  941.         c : char;        (* utility char *)
  942.         BEGIN
  943.         if debug then writeln(bugfil, 'seof');
  944.         if numtry > MAXTRY then     (* too many, quit *)
  945.             seof := 'A'
  946.         else
  947.             BEGIN
  948.             numtry := numtry + 1;    (* bump counter *)
  949.             spack('Z', n, 0, packet);    (* send Z packet *)
  950.             c := rpack(len, num, recpkt);    (* get reply *)
  951.             case c of
  952. (* ACK or NAK *)         'N', 'Y' : BEGIN
  953. (* NAK, fail unless for *)            if c = 'N' then
  954. (* previous packet *)                BEGIN
  955. (* then fall thru *)                    num := num - 1;
  956.                             if num < 0 then num := 63;
  957.                         END;
  958. (* wrong, so stay in state *)            if n <> num then seof := state
  959.                         else
  960.                         BEGIN
  961. (* reset counter *)                    numtry := 0;
  962. (* increment count *)                    n := (n + 1) mod 64;
  963.                             if debug then
  964.                             writeln(bugfil,
  965.                             'closing - ',
  966.                              filnam[numsent]);
  967. (* close the file *)                    close(sndfil);
  968. (* increment number of files sent *)            numsent := numsent + 1;
  969. (* get new one if more to go *)             if numsent < nfiles then
  970.                             BEGIN
  971. (* and go back to filename state *)                if getnxt then
  972.                                 seof := 'F'
  973.                                 else
  974. (* unless failure in file open *)                seof := 'B'
  975.                             END
  976. (* no more files, so set break state *)         else seof := 'B';
  977.                           END; {else}
  978.                    END; {N, Y}
  979. (* error, stay in state *)   'E' : seof := state;
  980. (* unknown, abort *)         otherwise
  981.                  seof := 'A';
  982.             END; {case}
  983.             END; { else }
  984.         END; {seof}
  985. %page
  986.     FUNCTION sbreak : char;
  987.     (* send a break *)
  988.         VAR
  989.         num, len : integer;    (* packet number, length *)
  990.         c : char;        (* utility char *)
  991.         BEGIN
  992.         if debug then writeln(bugfil, 'sbreak');
  993.         if numtry > MAXTRY then
  994.             sbreak := 'A'   (* abort if too many *)
  995.         else
  996.             BEGIN
  997. (* bump counter *)    numtry := numtry + 1;
  998. (* send a break *)    spack('B', n, 0, packet);
  999. (* look at reply *)    c := rpack(len, num, recpkt);
  1000.             case c of
  1001. (* see if ACK for this *)   'N', 'Y' : BEGIN
  1002. (* packet or NAK for previous *)       if c = 'N' then
  1003.                            BEGIN
  1004.                            num := num - 1;
  1005.                            if num < 0 then num := 63;
  1006.                            END;
  1007. (* if wrong, then stay in state *)       if n <> num then sbreak := state
  1008.                        else
  1009.                            BEGIN
  1010. (* reset counter *)                   numtry := 0;
  1011. (* bump packet count *)                n := (n + 1) mod 64;
  1012. (* switch to complete state *)               sbreak := 'C';
  1013.                            END;
  1014.                        END;
  1015. (* receive failure *)         'E' : sbreak := state;    (* stay in state *)
  1016.                  otherwise
  1017. (* unknown, abort *)         sbreak := 'A';
  1018.             END; {case}
  1019.             END; { else }
  1020.         END; {sbreak}
  1021. %page
  1022.     BEGIN {sendsw}
  1023.         done := false;        (* not done yet *)
  1024.         state := 'S';        (* send initiate is the start state *)
  1025.         n := 0;            (* initialize message number *)
  1026.         numtry := 0;        (* no tries yet *)
  1027.         while not done do
  1028.         case state of
  1029.             'D' : state := sdata;    (* data send state *)
  1030.             'F' : state := sfile;    (* send file name *)
  1031.             'Z' : state := seof;    (* end of file *)
  1032.             'S' : state := sinit;    (* send-init *)
  1033.             'B' : state := sbreak;    (* break-send *)
  1034.             'C' : BEGIN sendsw := true; done := true END;
  1035.                     (* complete *)
  1036.             'A' : BEGIN sendsw := false; done := true END;
  1037.                     (* abort *)
  1038.             otherwise
  1039.             BEGIN sendsw := false; done := true END;
  1040.                     (* unknown, so fail *)
  1041.         END; {case}
  1042.     END; {sendsw}
  1043. %page
  1044.     PROCEDURE init;    (* Initialize parameters *)
  1045.     BEGIN
  1046.         delay[1] := 0;        (* set up initial packet delay *)
  1047.         delay[2] := SNDINIT_DLY;
  1048.         ascii := false;        (* We are using ASCII if true *)
  1049.         debug := false;        (* For program development *)
  1050.         if debug then        (* creating temporary debug file *)
  1051.         BEGIN
  1052.         (*  cmdnoe('$create -debug', 14);  *)
  1053.             rewrite(bugfil, 'FILE=-debug');
  1054.         END;
  1055.         reset(input, 'FILE=*msource* Interactive MAXLEN=255');
  1056.         rewrite(output, 'FILE=*msink* MAXLEN=255');
  1057.                 (* make wide as possible *)
  1058.         new(packet);        (* Point to packet *)
  1059.         new(recpkt);        (* make the space needed *)
  1060.         eol := chr(CR);        (* EOL for outgoing packets *)
  1061.         quote := MYQUOTE;        (* Standard control-quote char *)
  1062.         pad := 0;            (* No padding *)
  1063.         padchar := chr(NUL);    (* Use null if any padding wanted *)
  1064.     END;
  1065. %page
  1066.     BEGIN {main}
  1067.     datetime(date, time);
  1068.     writeln('Mathematical Reviews - Kermit on MTS.');
  1069.     writeln('The date is ', date, '.  The time is ', time, '.');
  1070.     writeln;
  1071.     writeln('For help see the file SJ1K:KERMIT.DOC.');
  1072.     writeln;
  1073.     init;                (* initialize all parameters *)
  1074.     writeln('Enter command - (r)eceive/(s)end:');
  1075.     readln(command);        (* get the command *)
  1076.     command := toupper(command);    (* convert to upper case *)
  1077.     writeln('Is column 1 reserved for carriage control (y/n)?');
  1078.     readln(ccinfo);
  1079.     cc := (toupper(ccinfo) = 'Y');
  1080.     if command = 'S' then        (* get the files to send *)
  1081.         BEGIN
  1082.         nfiles := 0;
  1083.         writeln('Enter file names one at a time.');
  1084.         writeln('Terminate list with carriage return.');
  1085.         writeln;
  1086.         repeat
  1087.             writeln('File to send:');
  1088.             nfiles := nfiles + 1;
  1089.             readln(filnam[nfiles]);
  1090.         until (nfiles >= MAXFILES) or (filnam[nfiles] = '')
  1091.         END;
  1092.     setsys;     (* set the terminal so Kermit will work *)
  1093.     case command of
  1094.          'S' : BEGIN    (* send files *)
  1095.                writeln;
  1096.                write('Exit to your system, set IBM mode ON,');
  1097.                writeln(' and initiate RECEIVE-FILE mode.');
  1098.                writeln(chr(DC1));    (* write an XON *)
  1099.                twait(0, delay);     (* wait a while *)
  1100.                numsent := 1;        (* none sent yet *)
  1101.                if sendsw = false then    (* now go to send switcher *)
  1102.                if debug then
  1103.                    writeln(bugfil, 'Send failed at - ',
  1104.                        filnam[numsent])
  1105.                else if debug then writeln(bugfil, 'Send OK');
  1106.            END;
  1107.          'R' : BEGIN    (* receive files *)
  1108.                writeln;
  1109.                write('Exit to your system, set IBM mode ON,');
  1110.                writeln(' and initiate SEND-FILE mode.');
  1111.                if recsw = false then (* go to receive state switcher *)
  1112.                if debug then writeln(bugfil, 'Receive failed.')
  1113.                else if debug then writeln(bugfil, 'Receive OK.');
  1114.             END;
  1115.          otherwise    (* not a valid command *)
  1116.          writeln('Invalid command given.');
  1117.     END; {case}
  1118.     close(bugfil);
  1119.     resetsys;    (* return terminal to original state *)
  1120.     END.  {Kermit}
  1121.