home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / honeywellcp6b / hcp6.pas < prev    next >
Pascal/Delphi Source File  |  1988-08-15  |  131KB  |  4,396 lines

  1. !JOB NAME=KERMIT
  2. !PASCAL ME OVER KERMIT_OBJ (NDB,LS)
  3. {
  4. Program Kermit implements the KERMIT protocol under HONEYWELL/CP6.
  5.  
  6. Authors:   Philip Murton - original RT-11 pascal program.
  7.            Bruce W. Pinn - modified version for VAX/VMS.
  8.            Douglas Vaughan, Cheryl Poostay, Kevin Asplen, Jay Undercoffler
  9.                          - modified VAX/VMS version for HONEYWELL/CP6.
  10.  
  11. Date:  March 27, 1985
  12.  
  13. Site:  Bucknell University Computing Services
  14.        Lewisburg, Pennsylvania 17837
  15.        (717) 524-1801
  16. }
  17. program Kermit(input,output,LINE,ERRORS,DiskOutFile,DiskInFile);
  18.  
  19. label
  20.       9999;               { used only to simulate a "halt"  instruction }
  21.  
  22.      {%INCLUDE 'CURRENT_GLOBAL'(lines 22-102)}
  23. {label
  24.       9999; }             { used only to simulate a "halt"  instruction }
  25.  
  26. const
  27.  
  28.  
  29.     { other io-related stuff }
  30.       IOERROR = 0;        { status values for open files  }
  31.       IOAVAIL = 1;
  32.       IOREAD  = 2;
  33.       IOWRITE = 3;
  34.  
  35.  
  36.     { universal manifest constants  }
  37.       NULL = 0;
  38.       ENDSTR =    -1 ;       { null-terminated strings }
  39.       ENDFILE =   -2 ;
  40.       ENDOFQIO =  -3 ;
  41.       MAXSTR = 100;       { longest possible string }
  42.       CONLENGTH = 20;
  43.  
  44.     { ascii character set in decimal }
  45.       BACKSPACE = 8;
  46.       TAB = 9;
  47.       NEWLINE = 10;
  48.       BLANK = 32;
  49.       EXMARK = 33;
  50.       SHARP = 35;
  51.       AMPERSAND = 38;
  52.       PERIOD = 46;
  53.       RABRACK = 62;
  54.       QUESTION = 63;
  55.       GRAVE = 96;
  56.       TILDE = 126;
  57.       LETA = 65;
  58.       LETZ = 90;
  59.       LETsa = 97;
  60.       LETsz = 122;
  61.       LET0 = 48;
  62.       LET9 = 57;
  63.  
  64.       SOH = 1;            { ascii SOH character }
  65.       CR = 13;            { CR }
  66.       DEL = 127;          { rubout }
  67.  
  68.       DEFTRY = 5;         { default for number of retries }
  69.       DEFITRY = 10;       { default for number of retries on init }
  70.       DEFTIMEOUT = 20;    { default time  out }
  71.       DEFDELAY = 10 ;    { delay before  sending first init }
  72.       NUMPARAM = 7;       { number of parameters in init packet }
  73.       DEFQUOTE = SHARP;   { default quote character   }
  74.       DEFEBQUOTE = AMPERSAND;
  75.       DEFPAD = 0;         { default number of padding chars   }
  76.       DEFPADCHAR = 0;     { default padding character  }
  77.  
  78.     { SYSTEM DEPENDENT }
  79.       DEFEOL = CR;
  80.  
  81.     { packet TYPES  }
  82.  
  83.       TYPEB  = 66;    { ord('B') }
  84.       TYPED  = 68;    { ord('D') }
  85.       TYPEE  = 69;    { ord('E') }
  86.       TYPEF  = 70;    { ord('F') }
  87.       TYPEN  = 78;    { ord('N') }
  88.       TYPES  = 83;    { ord('S') }
  89.       TYPET  = 84;    { ord('T') }
  90.       TYPEY  = 89;    { ord('Y') }
  91.       TYPEZ  = 90;    { ord('Z') }
  92.  
  93.       MAXCMD = 10;
  94.  
  95.  
  96.       LineInSize = 512;
  97.  
  98.     { Command parser constants }
  99.       SMALLSIZE = 13;
  100.       LARGESIZE = 80;
  101.       MINPACKETSIZE = 10;
  102.       MAXPACKETSIZE = 94;
  103.  
  104.     { %include   'CURRENT_CONSTANT' (lines 105-395)}
  105.    NULLTOKE = 100;
  106.    RANGENULL = 101;
  107.         KERMITPROMPT = 'Kermit-CP6>';
  108.         KERMITHELP = 'KERMITHLP:';
  109.  
  110.    INVALIDCOMMAND = 1;
  111.    INVALIDSETCOMMAND = 2;
  112.    INVALIDSHOWCOMMAND = 3;
  113.    NOTIMPLEMENTED = 4;
  114.    INVALIDFILESPEC = 5;
  115.    INVALIDSETCVALUE =  6;
  116.    INVALIDSETDVALUE =  7;
  117.    INVALIDSETOVALUE = 8;
  118.    INVALIDSETRANGE = 9;
  119.         SENDPARMS = 10;
  120.         RECEIVEPARMS = 11;
  121.         LOCALPARMS = 12;
  122.         BLANKLINE = 13;
  123.         NOHELPAVAILABLE = 14;
  124.    IBEXSPAWNFAILED = 15;
  125.  
  126.    cSET        = 'SET          ';
  127.    cSHOW       = 'SHOW         ';
  128.    cSTATUS     = 'STATUS       ';
  129.    cCONNECT    = 'CONNECT      ';
  130.    cHELP       = 'HELP         ';
  131.    cEXIT       = 'EXIT         ';
  132.    cQUIT       = 'QUIT         ';
  133.    cQUESTION   = '?            ';
  134.    cSEND       = 'SEND         ';
  135.    cRECEIVE    = 'RECEIVE      ';
  136.    cDEBUGGING  = 'DEBUGGING    ';
  137.    cLOCALECHO  = 'LOCAL-ECHO   ';
  138.    cDELAY      = 'DELAY        ';
  139.    cPACKETLENGTH   = 'PACKET-LENGTH';
  140.    cPADDING    = 'PADDING      ';
  141.    cPADCHAR    = 'PADCHAR      ';
  142.    cTIMEOUT    = 'TIMEOUT      ';
  143.    cENDOFLINE  = 'END-OF-LINE  ';
  144.    cQUOTE      = 'QUOTE        ';
  145.    cALL        = 'ALL          ';
  146.    cON     = 'ON           ';
  147.    cOFF        = 'OFF          ';
  148.         cBADTOKEN       = 'XX           ';
  149.    cTRANSMODE  = 'TRANSMODE    ';
  150.    cASCII      = 'ASCII        ';
  151.    cBINARY     = 'BINARY       ';
  152.    cEIGHTQUOTE = 'EIGHT-QUOTE  ';
  153.         cFILERECORD     = 'FILERECORD   ';
  154.         cCR        = 'CR           ';
  155.         cLF        = 'LF           ';
  156.         cCRLF      = 'CRLF         ';
  157.    cPARITY     = 'PARITY       ';
  158.    cEVEN       = 'EVEN         ';
  159.    cODD        = 'ODD          ';
  160.    cNONE       = 'NONE         ';
  161.    cSPEED      = 'SPEED        ';
  162.    cIBEX        = 'IBEX         ';
  163.  
  164.    uSET = 3;
  165.    uMSEND = 3;
  166.    uMRECEIVE = 1;
  167.    uSHOW = 2;
  168.    uSTATUS = 2;
  169.    uCONNECT = 1;
  170.    uIBEX = 1;
  171.    uHELP = 1;
  172.    uQUESTION = 1;
  173.    uEXIT = 1;
  174.    uQUIT = 1;
  175.    uSEND = 1;
  176.    uRECEIVE = 1;
  177.    uDEBUGGING = 3;
  178.         uFILERECORD = 1;
  179.    uTRANSMODE = 1;
  180.    uLOCALECHO = 2;
  181.    uDELAY = 3;
  182.    uPACKETLENGTH = 3;
  183.    uPADDING = 4;
  184.    uPADCHAR = 4;
  185.    uTIMEOUT = 1;
  186.    uENDOFLINE = 1;
  187.    uQUOTE = 1;
  188.    uALL = 1;
  189.    uON = 2;
  190.    uOFF = 2;
  191.         uBADTOKEN = 1;
  192.         uCR = 2;
  193.         uLF = 1;
  194.         uCRLF = 2;
  195.    uPARITY = 1;
  196.    uEVEN = 1;
  197.    uODD = 1;
  198.    uNONE = 1;
  199.    uSPEED = 2;
  200.    uASCII = 1;
  201.    uBINARY = 1;
  202.    uQUOTED = 1;
  203.    uEIGHTQUOTE = 1;
  204.  
  205.    oON = 0;
  206.    oOFF = 1;
  207.    oEVEN = 2;
  208.    oODD = 3;
  209.    oNONE = 4;
  210.    oSET = 5;
  211.    oSHOW = 6;
  212.    oSTATUS = 7;
  213.    oCONNECT = 8;
  214.    oHELP = 9;
  215.    oEXIT = 10;
  216.    oQUIT = 11;
  217.    oSEND = 12;
  218.    oRECEIVE = 13;
  219.    oDEBUGGING = 14;
  220.    oLOCALECHO = 15;
  221.    oDELAY = 16;
  222.    oPACKETLENGTH = 17;
  223.    oPADDING = 18;
  224.    oPADCHAR = 19;
  225.    oTIMEOUT = 20;
  226.    oENDOFLINE = 21;
  227.    oQUOTE = 22;
  228.    oQUESTIONM = 23;
  229.    oALL = 24;
  230.         oBADTOKEN = 25;
  231.         oFILERECORD = 26;
  232.         oCR = 27;
  233.         oLF = 28;
  234.         oCRLF = 29;
  235.    oPARITY = 30;
  236.    oSPEED = 31;
  237.    oIBEX = 32;
  238.    oTRANSMODE = 33;
  239.    oASCII = 34;
  240.    oBINARY = 35;
  241.    oEIGHTQUOTE = 36;
  242.    oXXXX = 100 ;
  243.  
  244.    oMAINTYPE = 1;
  245.    oSETTYPE = 2;
  246.    oSHOWTYPE = 3;
  247.    oSENDTYPE = 4;
  248.    oRECEIVETYPE = 5;
  249.    oDEBUGTYPE = 6;
  250.         oFILERECTYPE = 8;
  251.    oLOCECHOTYPE = 9;
  252.    oPARITYTYPE = 10;
  253.    oTRANSTYPE = 11;
  254.  
  255.    DECIMAL = 0;
  256.    SDECIMAL = 1;
  257.    OCTAL = 2;
  258.    CHRACTER = 3;
  259.    IDECIMAL = 4;
  260.    EBCHRACTER = 5;
  261.  
  262.    oASCSTATE = 1;
  263.    oBINSTATE = 0;
  264.  
  265.    o300BAUD = 300;
  266.    o600BAUD = 600;
  267.    o1200BAUD = 1200;
  268.    o2400BAUD = 2400;
  269.    o4800BAUD = 4800;
  270.    o9600BAUD = 9600;
  271.  
  272. type
  273.      character = ENDOFQIO..255;     { byte-sized. ascii + other stuff }
  274.      schar = -128..127;
  275.      wordInteger = 0..65535;
  276.      string = array [1..MAXSTR] of character;
  277.      vstring = record
  278.           len : integer;
  279.           ch  : array [1..MAXSTR] of char;
  280.           end;
  281.      cstring = PACKED array [1..CONLENGTH] of char;
  282.      IOstate = IOERROR..IOWRITE;
  283.      filedesc = (keyboard,screen,RS232,history,outfile,infile) ;
  284.  
  285.     IOBUFFER = packed array[1..LineInSize] of character ;
  286.     { Eight bit file stuff }
  287.      EBQtype = (Ascii, Binary);
  288.  
  289.      SevenEight =
  290.      RECORD
  291.      CASE mode : EBQtype OF
  292.          Ascii : ( seven  : CHAR   );
  293.         Binary : ( eight  : 0..255 )
  294.      END ;
  295.     { Data  TYPES for Kermit }
  296.      Packet = RECORD
  297.           mark : character;       { SOH character  }
  298.           count: character;       { # of bytes following this field }
  299.           seq  : character;       { sequence number modulo 64  }
  300.           ptype: character;       { d,y,n,s,b,f,z,e,t  packet type }
  301.           data : string;          { the actual data }
  302.          end;
  303.     { chksum is last validchar in data array }
  304.     { eol is added, not considered  part of packet proper }
  305.  
  306.      Command = (Transmit,Receive,Invalid,Connect);
  307.      KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
  308.      EOLtype = (LineFeed,CrLf,JustCr);
  309.  
  310.      Stats = integer;
  311.      Ppack = ^Packet;
  312.  
  313.      Intype = (nothing,CRin,abortnow);
  314.  
  315.     {  Parser defined types }
  316.      vmsString = packed array [1..255] of char;
  317.      string13 = packed array [1..SMALLSIZE] of char;
  318.      string80 = packed array [1..LARGESIZE] of char;
  319.     NewString80 =
  320.        record
  321.           StringPart  : packed array [1..80] of char;
  322.           LengthOfSP  : 0..80
  323.        end;
  324.  
  325. var
  326.     cmdargs  : 0..MAXCMD;
  327.     LINE,ERRORS,DiskOutFile,DiskInFile : text;
  328.     file3cnt, file4cnt : integer;
  329.  
  330.     { varibles for  Kermit }
  331.     DiskFile : IOstate ;     { File being read/written }
  332.     SaveState : kermitstates;
  333.     NextArg  : integer;      { next argument to process }
  334.     local    : boolean;      { local/remote flag }
  335.     MaxTry   : integer;
  336.     n        : integer;      { packet number }
  337.     NumTry   : integer;      { times this packet retried }
  338.     OldTry   : integer;
  339.     Delay    : integer;
  340.     Pad, MyPad : integer;      { number of padding characters I need  }
  341.     PadChar, MyPadChar: INTEGER;
  342.     MyTimeOut, TheirTimeOut : integer;
  343.     timeOutStatus : boolean;
  344.     Runtype, oldRunType  : command;
  345.     State    : kermitstates;
  346.  
  347.     STDERR, LineOUT, ControlIN, ControlOUT : filedesc;
  348.     SizeRecv, SizeSend : integer;
  349.     SendEOL, SendQuote : INTEGER;
  350.     myEOL,myQuote: INTEGER;
  351.     EOLFORFILE : EOLtype;
  352.     NumSendPacks, NumRecvPacks : integer;
  353.     NumACK, NumNAK : integer;
  354.     NumACKrecv, NumNAKrecv, NumBADrecv : integer;
  355.     RunTime : integer;
  356.     ChInFileRecv, ChInPackRecv, ChInFileSend, ChInPackSend : Stats;
  357.     Debug : boolean;
  358.     ThisPacket :    Ppack;  { current packet being  sent }
  359.     LastPacket :    Ppack;  { last  packet sent }
  360.     CurrentPacket : Ppack;  { current packet received }
  361.     NextPacket :    Ppack;  { next  packet being received }
  362.     InputPacket : Ppack;    { save  input to do debug }
  363.  
  364.     { these are used for the Receive Packet procedures }
  365.     FromConsole : Intype ;
  366.     check: integer;         { Checksum }
  367.     PacketPtr : integer;    { pointer to InputPacket }
  368.     dataptr : integer;      { pointer to data of Packet }
  369.     fld : 0..5;             { current fld number }
  370.     t : character;          { input character }
  371.     finished : boolean;     { finished packet ? }
  372.     restart : boolean;      { restart packet ? }
  373.     control : boolean;      { quoted ? }
  374.     isgood : boolean;       { packet is good  ? }
  375.  
  376.     IncomingPacket : IOBUFFER;
  377.     BufferPointer, BufferEnd : integer ;
  378.  
  379.     { Eight Bit Quoting Info }
  380.     sentEBQuote, recvdEBQuote, needEBQuote : boolean; { Used for determining 8 bit state }
  381.     EBQState : EBQtype;    { ... }
  382.     EBQchar : INTEGER;   { Quote character for 8 bit trans }
  383.     ishigh : integer;    { Shift to put high bit on }
  384.  
  385.     {  Parser defined variables }
  386.     commandLine : string80;
  387.     fileSpec  : string80;
  388.     exitProgram : boolean;
  389.     localEcho, sFileSpec, rFileSpec, lSpeed, transtype : integer;
  390.     escape, debugging, commandLen, fileEol, parity : integer;
  391.     width, linespeed : integer ;
  392.       MAXPACK : 0..MAXPACKETSIZE ;  {number of characters must be less }
  393.                                     {than platen width-otherwise LF is inserted}
  394.  
  395.    DEFPARITY : integer ;
  396.  
  397.  
  398. PROCEDURE Take_Nap (seconds : integer) ; external ;
  399. PROCEDURE set_profile (mode : integer ; {0=get,1=restore}
  400.                       var linespeed : integer ;
  401.                       var width     : integer ; {max line before wrap-around}
  402.                       var parity    : integer ) ; external ;
  403. PROCEDURE set_prompt {NO PROMPT} ; external ;
  404. PROCEDURE set_parity (parity : integer) ; external ;
  405. function ReadCommLine (var IncomingPacket : IOBUFFER ;
  406.                            N : integer ;
  407.                            timeout : integer ;
  408.                        var status : boolean ;
  409.                        var endofline : integer ;
  410.                        var start : integer ) : integer ;
  411. type      line = packed array [1..LineInSize] of char ;
  412. var       Buffer : line ;
  413.           ChValue : SevenEight ;
  414.           k : integer ;
  415.           EOL : char;
  416. PROCEDURE getlineinput (var Buffer : line ;
  417.                             LENGTH : integer ;
  418.                             wait   : integer ; {timeout seconds}
  419.                         var status : boolean ) ; external ;
  420.  
  421. begin
  422.       EOL := chr (endofline) ;
  423.       for k := 1 to LineInSize do Buffer[k] := EOL ;
  424.       start := 0 ;
  425.       ReadCommLine := 0;
  426.       getlineinput (Buffer, LineInSize, timeout, status) ;
  427.       begin
  428.            k := 1 ;
  429.            while (k <= LineInSize) and (Buffer[k] <> EOL) do
  430.                  begin
  431.                  ReadCommLine := k ;
  432.                  ChValue.seven := Buffer[k] ;
  433.                  IncomingPacket[k] := ChValue.eight ;
  434.                  k := k + 1
  435.                  end ;
  436.       end
  437. end;
  438.  
  439.  
  440. function min (a,b: integer) : integer ;
  441. begin if a <= b then
  442.          min := a
  443.       else
  444.          min := b
  445. end ;
  446.  
  447. function max (a,b: integer) : integer ;
  448. begin if a >= b then
  449.          max := a
  450.       else
  451.          max := b
  452. end ;
  453. procedure GetCf(var c:character);
  454. var
  455.    ch : SevenEight ;
  456. begin
  457.    if not eof(DiskInFile) then
  458.       if eoln(DiskInFile) then
  459.          begin
  460.            readln(DiskInFile);
  461.            c := NEWLINE
  462.          end
  463.       else
  464.          begin
  465.            read(DiskInFile, ch.seven) ;
  466.            c := ch.eight
  467.          end
  468.    else
  469.       c := ENDFILE
  470. end;
  471.  
  472.  
  473.  
  474. procedure DebugMessage(c : cstring);
  475. forward;
  476.  
  477.  
  478. procedure PutCln(x:cstring;
  479.                  fd:filedesc);
  480. forward;
  481.  
  482.  
  483. procedure AddTo(var sum : Stats;
  484.                 inc:integer);
  485. forward;
  486.  
  487.  
  488. procedure PutCN(x:cstring;
  489.                 v : integer;
  490.                 fd:filedesc);
  491. forward;
  492.  
  493.  
  494. procedure FinishUp(noErrors : boolean);
  495. forward;
  496.  
  497.  
  498. procedure ErrorPack(c:cstring);
  499. forward;
  500.  
  501.  
  502. procedure ProgramHalt; { used by external  procedures for halt }
  503. begin
  504.    GOTO 9999
  505. end;
  506.  
  507. function FileOpen (FileName : string80 ; mode : filedesc) : IOstate ;
  508. begin
  509. case mode of
  510.      infile : begin
  511.               Set_File_Parameters (DiskInFile, FileName,
  512.                                   'DCB = DISKINFILE, ERROR=CONTINUE') ;
  513.               reset (DiskInFile) ;
  514.               if File_Status (DiskInFile) = 0 then
  515.                    FileOpen := IOREAD
  516.                  else
  517.                    FileOpen := IOERROR
  518.               end ;
  519.  
  520.     outfile : begin
  521.               Set_File_Parameters (DiskOutFile, FileName,
  522.                                    'DCB = DISKOUTFILE, CTG = YES') ;
  523.               rewrite (DiskOutFile ) ;
  524.               FileOpen := IOWRITE ;
  525.               end ;
  526. end {case}
  527. end;
  528.  
  529. procedure Sclose (var fd : IOstate);
  530. begin
  531. case fd of
  532.     IOREAD: Close_file (DiskInFile) ;
  533.    IOWRITE: Close_file (DiskOutFile)
  534. end {case};
  535.    fd := IOAVAIL
  536. end;
  537.  
  538. procedure Putcf (c : character; fd : filedesc);
  539. var  byte : SevenEight ;
  540. BEGIN
  541.    CASE FD OF
  542.       screen:
  543.               IF (C=NEWLINE) THEN
  544.                  WRITELN(OUTPUT)
  545.               ELSE
  546.                  WRITE(OUTPUT,CHR(C));
  547.       history:
  548.               IF (C=NEWLINE) THEN
  549.                  WRITELN(ERRORS)
  550.               ELSE
  551.                  WRITE(ERRORS,CHR(C));
  552.       RS232:        WRITE(LINE,CHR(C));
  553.       outfile:
  554.                 IF (C=NEWLINE) THEN
  555.                    WRITELN(DiskOutFile)
  556.                 ELSE
  557.                    begin
  558.                    byte.eight := c ;
  559.                    WRITE(DiskOutFile, byte.seven)
  560.                    end
  561.    END;
  562. END;
  563.  
  564. function getc (var c : character) : character;
  565. { getc  (UCB) -- get one character from standard input }
  566.  
  567. var
  568.     ch : char;
  569. begin
  570.    if eof then
  571.       c := ENDFILE
  572.    else
  573.       if eoln then
  574.          begin
  575.             readln;
  576.             c := NEWLINE
  577.          end
  578.    else
  579.       begin
  580.          read(ch);
  581.          c := ord(ch)
  582.       end;
  583.    getc := c
  584. end;
  585.  
  586.  
  587. procedure Putc (c : character);
  588. { putc  (UCB) -- put one character on standard output }
  589. begin
  590.    if c = NEWLINE then
  591.       writeln
  592.    else
  593.       write(chr(c));
  594. end;
  595.  
  596.  
  597.  
  598.  
  599. procedure PutStr (var s : string; f : filedesc);
  600. { putstr (UCB)  -- put out string on file }
  601.  
  602. var
  603.     i : integer;
  604. begin
  605.    i := 1;
  606.    while (s[i] <> ENDSTR) do
  607.       begin
  608.          Putcf(s[i], f);
  609.          i := i + 1
  610.       end
  611. end;
  612.  
  613.  
  614. function ItoC (n : integer; var s : string; i : integer)
  615. : integer;      { returns end of s }
  616. { ItoC  - convert integer n to char string in s[i]... }
  617. begin
  618.    if (n < 0) then
  619.       begin
  620.          s[i] := ord('-');
  621.          ItoC := ItoC(-n, s, i+1)
  622.       end
  623.    else
  624.       begin
  625.          if (n >= 10) then
  626.             i := ItoC(n div 10, s, i);
  627.          s[i] := n mod 10 + ord('0');
  628.          s[i+1] := ENDSTR;
  629.          ItoC := i + 1
  630.       end
  631. end;
  632.  
  633.  
  634. function LengthSTIP (var s : string) : integer;
  635. { lengthSTIP -- compute length of string }
  636.  
  637. var
  638.     n : integer;
  639. begin
  640.    n := 1;
  641.    while (s[n] <> ENDSTR) do
  642.       n := n + 1;
  643.    LengthSTIP := n - 1
  644. end;
  645.  
  646.  
  647. procedure Scopy (var src : string; i : integer;
  648.                  var dest : string; j : integer);
  649. { scopy -- copy string  at src[i] to dest[j] }
  650. begin
  651.    while (src[i] <> ENDSTR) do
  652.       begin
  653.          dest[j] := src[i];
  654.          i := i + 1;
  655.          j := j + 1
  656.       end;
  657.    dest[j] := ENDSTR
  658. end;
  659.  
  660.  
  661. function IsUpper (c : character) : boolean;
  662. { isupper -- true if c  is upper case letter }
  663. begin
  664.    isupper := (c >= ord('A')) and (c <= ord('Z'))
  665. end;
  666.  
  667.  
  668. function IndexSTIP (var s : string; c : character) : integer;
  669. { IndexSTIP -- find position of character c in string s }
  670.  
  671. var
  672.     i : integer;
  673. begin
  674.    i := 1;
  675.    while (s[i] <> c) and (s[i] <> ENDSTR) do
  676.       i := i + 1;
  677.    if (s[i] = ENDSTR) then
  678.       IndexSTIP := 0
  679.    else
  680.       IndexSTIP := i
  681. end;
  682.  
  683.  
  684. procedure CtoS(x:cstring;  var s:string);
  685. { convert constant to STIP string }
  686.  
  687. var
  688.     i : integer;
  689. begin
  690.    for i:=1 to CONLENGTH do
  691.       s[i] := ord(x[i]);
  692.    s[CONLENGTH+1] := ENDSTR;
  693. end;
  694.  
  695.  
  696. procedure PutCon(x:cstring;
  697.                  fd:filedesc);
  698. { output literal }
  699.  
  700. var
  701.     s: string;
  702. begin
  703.    CtoS(x,s);
  704.    PutStr(s,fd);
  705. end;
  706.  
  707.  
  708. procedure PutCln;
  709. { output literal followed by NEWLINE }
  710. begin
  711.    PutCon(x,fd);
  712.    Putcf(NEWLINE,fd);
  713. end;
  714.  
  715.  
  716. procedure PutNum(n:integer;
  717.                  fd:filedesc);
  718. { Ouput number  }
  719.  
  720. var
  721.     s: string;
  722.     dummy: integer;
  723. begin
  724.    s[1] := BLANK;
  725.    dummy := ItoC(n,s,2);
  726.    PutStr(s,fd);
  727. end;
  728.  
  729.  
  730. procedure PutCS(x:cstring;
  731.                 s : string;
  732.                 fd:filedesc);
  733. { output literal & string }
  734. begin
  735.    PutCon(x,fd);
  736.    PutStr(s,fd);
  737.    Putcf(NEWLINE,fd);
  738. end;
  739.  
  740.  
  741. procedure PutCN;
  742. { output literal & number }
  743. begin
  744.    PutCon(x,fd);
  745.    PutNum(v,fd);
  746.    Putcf(NEWLINE,fd);
  747. end;
  748.  
  749.  
  750. procedure AddTo;
  751. begin
  752.    sum := sum + inc;
  753. end;
  754.  
  755.  
  756. procedure OverHd(p,f: Stats;
  757.                  var o:integer);
  758. { Calculate OverHead as % }
  759. { 0verHead := (p-f)*100/f }
  760. begin
  761.    if (f <> 0) then
  762.       o := ((p - f)*100) div f
  763.    else
  764.       o := 100;
  765. end;
  766.  
  767.  
  768. procedure CalRat(f:   Stats;
  769.                  t:integer;
  770.                  var r:integer);
  771. { Calculate Effective Baud Rate }
  772. { Rate  = f*10/t }
  773. begin
  774.    if (t <> 0) then
  775.       r := (f * 10) div t
  776.    else
  777.       r := 0;
  778. end;
  779.  
  780. procedure DebugMessage;
  781. { Print writeln if debug }
  782. begin
  783.    if debug then
  784.       PUTCLN(C,STDERR);
  785. end;
  786.  
  787.  
  788. procedure DebugMessNumb(s : cstring; val : integer);
  789. { Print message and a number }
  790. begin
  791.    if debug then
  792.       begin
  793.          Putcln(s, STDERR);
  794.          PutNum(val, STDERR);
  795.       end;
  796. end;
  797.  
  798.  
  799.  
  800.  
  801. procedure PutPacket(p : Ppack); { Output Packet }
  802.  
  803. var
  804.     i : integer;
  805. begin
  806.    DebugMessage('PutPacket...        ');
  807.    if (Pad >0) then
  808.       for i := 1 to Pad do
  809.          Putcf(PadChar,LineOut);
  810.    with p^ do
  811.       begin
  812.          Putcf(mark,LineOut);
  813.          Putcf(count,LineOut);
  814.          Putcf(seq,LineOut);
  815.          Putcf(ptype,LineOut);
  816.          PutStr(data,LineOut);
  817.       end;
  818.  
  819.          Putcf(NEWLINE,LineOut) ;
  820. end;
  821.  
  822.  
  823. function GetIn  : character;  { get character    }
  824. { Should return NULL ( ENDSTR ) if  no characters }
  825.  
  826. var
  827.     c : character;
  828. begin
  829.    BufferPointer := BufferPointer + 1;
  830.  
  831.    if (BufferPointer <= BufferEnd) then
  832.       c := IncomingPacket[BufferPointer]
  833.    else
  834.       c := ENDOFQIO;
  835.    GetIn := c;
  836.    if (c <> NULL) then
  837.       AddTo(ChInPackRecv,1)
  838. end;
  839.  
  840.  
  841. function MakeChar(c:character): character;
  842. { convert integer to printable }
  843. begin
  844.    MakeChar := c+BLANK;
  845. end;
  846.  
  847.  
  848. function UnChar(c:character): character;
  849. { reverse of makechar }
  850. begin
  851.    UnChar := c - BLANK
  852. end;
  853.  
  854.  
  855. function IsControl(c:character): boolean;
  856. { true if control }
  857. begin
  858.    if (c >= NULL) then
  859.       IsControl := (c = DEL ) or (c < BLANK )
  860.    else
  861.       IsControl := IsControl(c + 128);
  862. end;
  863.  
  864.  
  865. function Ctl(c:character): character;
  866. { c XOR 100 }
  867. begin
  868.    if (c >= NULL) then
  869.       if (c < 64) then
  870.          c := c + 64
  871.    else
  872.       c := c-64
  873.    else
  874.       c := Ctl(c + 128) - 128;
  875.  
  876.    Ctl := c;
  877. end;
  878.  
  879.  
  880. function Checkfunction(c:integer): character;
  881. { calculate checksum }
  882.  
  883. var
  884.     x: integer;
  885. begin
  886.    DebugMessage('Checkfunction...    ');
  887.     {    Checkfunction := (c + ( c and 300 ) /100 ) and 77; }
  888.    x := (c MOD 256 ) DIV 64;
  889.    x := x+c;
  890.    Checkfunction := x MOD 64;
  891. end;
  892.  
  893.  
  894. procedure SetEBQuoteState;
  895. begin
  896.    if (EBQState = Binary) then
  897.       begin
  898.          transType := oBINARY;
  899.       end
  900.    else
  901.       begin
  902.          transType := oASCII;
  903.       end;
  904. end;
  905.  
  906.  
  907. procedure EnCodeParm(var data:string);    { encode parameters }
  908.  
  909. var
  910.     i: integer;
  911. begin
  912.    DebugMessage('EnCodeParm...       ');
  913.    for i:=1 to NUMPARAM do
  914.       data[i] := BLANK;
  915.    data[NUMPARAM+1] := ENDSTR;
  916.    data[1] := MakeChar(SizeRecv);          { my  biggest packet }
  917.    data[2] := MakeChar(MyTimeOut);         { when I want timeout}
  918.    data[3] := MakeChar(MyPad);             { how much padding }
  919.    data[4] := Ctl(MyPadChar);              { my padding character }
  920.    data[5] := MakeChar(myEOL);             { my EOL }
  921.    data[6] := MyQuote;                     { my quote char }
  922.  
  923.     { Handle eight bit quoting parm }
  924.    case RunType of
  925.       Transmit :
  926.                  if EBQState = Binary then
  927.                     begin
  928.                        if EBQChar <> DEFEBQUOTE then
  929.                           begin
  930.                              data[7] := EBQChar;
  931.                              sentEBQuote := true;
  932.                           end
  933.                        else
  934.                           data[7] := TYPEY;
  935.                     end
  936.                  else
  937.                     data[7] := TYPEN;
  938.  
  939.       Receive :
  940.                 if EBQState = Binary then
  941.                    begin
  942.                       if recvdEBQuote then
  943.                          data[7] := TYPEY
  944.                       else
  945.                          if needEBQuote then
  946.                             data[7] := EBQChar
  947.                       else
  948.                          begin
  949.                             EBQState := Ascii;
  950.                             data[7] := TYPEN;
  951.                          end;
  952.                    end
  953.                 else
  954.                    data[7] := TYPEN;
  955.    end;
  956.  
  957.    SetEBQuoteState;
  958.  
  959. end;
  960.  
  961.  
  962. function CheckEBQuote(inchr : character;
  963.                       var outchr : INTEGER) : EBQtype;
  964. begin
  965.    if (inchr in [EXMARK..RABRACK, GRAVE..TILDE]) then
  966.       begin
  967.          outchr := inchr;
  968.          CheckEBQuote := Binary
  969.       end
  970.    else
  971.       CheckEBQuote := Ascii;
  972. end;
  973.  
  974.  
  975. procedure DeCodeParm(var data:string); {   decode parameters }
  976.  
  977. var
  978.     InEBQChar : character;
  979. begin
  980.    DebugMessage('DeCodeParm...       ');
  981.    SizeSend := UnChar(data[1]);
  982.    TheirTimeOut := UnChar(data[2]);   { when I should time  out }
  983.    Pad := UnChar(data[3]);            { padding characters  to send  }
  984.    PadChar := Ctl(data[4]);           { padding character }
  985.    SendEOL := UnChar(data[5]);        { EOL to send }
  986.    SendQuote := data[6];              { quote to send }
  987.  
  988.     { Handle eight bit quoting parm }
  989.    InEBQchar := data[7];
  990.    case RunType of
  991.       Transmit :
  992.                  if EBQState = Binary then
  993.                     begin
  994.                        if sentEBQuote then
  995.                           begin
  996.                              if InEBQchar <> TYPEY then
  997.                                 EBQState := Ascii;
  998.                           end
  999.                        else
  1000.                           if InEBQchar = TYPEN then
  1001.                              EBQState := Ascii
  1002.                        else
  1003.                           EBQState := CheckEBQuote(InEBQchar, EBQchar);
  1004.                     end;
  1005.  
  1006.       Receive :
  1007.                 if EBQState = Binary then
  1008.                    begin
  1009.                       if InEBQchar = TYPEY then
  1010.                          needEBQuote := true
  1011.                       else
  1012.                          if InEBQchar = TYPEN then
  1013.                             EBQState := Ascii
  1014.                       else
  1015.                          begin
  1016.                             EBQState := CheckEBQuote(InEBQchar, EBQchar);
  1017.                             if EBQState = Binary then
  1018.                                recvdEBQuote := true;
  1019.                          end;
  1020.                    end;
  1021.    end;
  1022.  
  1023.    SetEBQuoteState;
  1024.  
  1025. end;
  1026.  
  1027.  
  1028. procedure StartRun; { initialization as necessary }
  1029. begin
  1030.    DebugMessage('StartRun...         ');
  1031.  
  1032.    NumSendPacks := 0;
  1033.    NumRecvPacks := 0;
  1034.    NumACK := 0;
  1035.    NumNAK := 0;
  1036.    NumACKrecv := 0;
  1037.    NumNAKrecv := 0;
  1038.    NumBADrecv := 0;
  1039.  
  1040.    ChInFileRecv := 0;
  1041.    ChInFileSend := 0;
  1042.    ChInPackRecv := 0;
  1043.    ChInPackSend := 0;
  1044.  
  1045.  
  1046.    State := Init;              { send  initiate is the start state }
  1047.    NumTry := 0;                { say no tries  yet }
  1048. end;
  1049.  
  1050.  
  1051. procedure ResetKermitPacketNumber;
  1052. begin
  1053.    n := 0;
  1054. end;
  1055.  
  1056.  
  1057. procedure KermitInit;  { initialize various parameters  & defaults }
  1058. VAR platen : integer ;
  1059. begin
  1060.    set_prompt ;
  1061.  
  1062.    set_file_parameters (line,'  ','ORG = TERMINAL') ;
  1063.    set_profile (0, {save terminal characteristics}
  1064.                      linespeed, {connect baud rate}
  1065.                      platen, {total packet most be smaller than this}
  1066.                      DEFPARITY) ; {connect parity}
  1067.    case linespeed of
  1068. 0,1,3,8,10,11 : {not support by CP_6} lSpeed := 0 ;
  1069.       2,4,5,6 : lSpeed := o300BAUD ;
  1070.             7 : lSpeed := o600BAUD ;
  1071.             9 : lSpeed := o1200BAUD ;
  1072.            12 : lSpeed := o2400BAUD ;
  1073.            13 : lSpeed := o4800BAUD ;
  1074.         14,15 : lSpeed := o9600BAUD ;
  1075.    end {case} ;
  1076.    MAXPACK := MAXPACKETSIZE ;
  1077.    REWRITE(LINE);
  1078.    REWRITE(ERRORS);
  1079.  
  1080.    Pad := DEFPAD;               { set defaults }
  1081.    MyPad := DEFPAD;
  1082.    PadChar := DEFPADCHAR;
  1083.    MyPadChar := DEFPADCHAR;
  1084.    TheirTimeOut := DEFTIMEOUT;
  1085.    MyTimeOut := DEFTIMEOUT;
  1086.    Delay := DEFDELAY;
  1087.    SizeRecv := MAXPACKETSIZE ;
  1088.    SizeSend := MAXPACK;
  1089.    SendEOL := DEFEOL;
  1090.    MyEOL := DEFEOL;
  1091.    SendQuote := DEFQUOTE;
  1092.    MyQuote := DEFQUOTE;
  1093.    EBQChar := DEFEBQUOTE;
  1094.    MaxTry := DEFITRY;
  1095.  
  1096.    localEcho := oOFF;
  1097.    parity  := DEFPARITY ;
  1098.    fileEol := oCRLF;
  1099.    transtype := oASCII;
  1100.    Local := true ;      { default to local  }
  1101.  
  1102.    Debug := false;
  1103.    debugging := oOFF;
  1104.    Runtype := invalid;
  1105.  
  1106.    DiskFile   := IOERROR;      { to indicate  not open yet }
  1107.    STDERR     := history ;
  1108.    LineOUT    := RS232  ;
  1109.    ControlIN  := keyboard ;
  1110.    ControlOUT := screen ;
  1111.  
  1112.    new(ThisPacket);
  1113.    new(LastPacket);
  1114.    new(CurrentPacket);
  1115.    new(NextPacket);
  1116.    new(InputPacket);
  1117.  
  1118.    NumSendPacks := 0;
  1119.    NumRecvPacks := 0;
  1120.    NumACK := 0;
  1121.    NumNAK := 0;
  1122.    NumACKrecv := 0;
  1123.    NumNAKrecv := 0;
  1124.    NumBADrecv := 0;
  1125.  
  1126.    ChInFileRecv := 0;
  1127.    ChInFileSend := 0;
  1128.    ChInPackRecv := 0;
  1129.    ChInPackSend := 0;
  1130.  
  1131.  
  1132.    NumTry := 0;                { say no tries  yet }
  1133.    OldRunType := connect ;
  1134.    EBQState := Ascii ;
  1135. end;
  1136.  
  1137.  
  1138. procedure FinishUp;
  1139. { do any  end of transmission clean up }
  1140. begin
  1141.    DebugMessage('FinishUp...         ');
  1142.  
  1143.   {Sclose(DiskFile);}
  1144.  
  1145.    if not(noErrors) then
  1146.    else
  1147.       begin
  1148.          ErrorPack('Aborting Transfer   ');
  1149.       end;
  1150.  
  1151.    oldRunType := RunType;
  1152.    PutCf(NEWLINE, ControlOUT);
  1153.  
  1154. end;
  1155.  
  1156.  
  1157. procedure DebugPacket(mes : cstring;
  1158.                       var p : Ppack);
  1159. { Print Debugging Info }
  1160. begin
  1161.    DebugMessage('DebugPacket...      ');
  1162.    PutCon(mes,STDERR);
  1163.    with p^ do
  1164.       begin
  1165.          PutNum(Unchar(count),STDERR);
  1166.          PutNum(Unchar(seq),STDERR);
  1167.          Putcf(BLANK,STDERR);
  1168.          Putcf(ptype,STDERR);
  1169.          Putcf(NEWLINE,STDERR);
  1170.          PutStr(data,STDERR);
  1171.          Putcf(NEWLINE,STDERR);
  1172.       end;
  1173. end;
  1174.  
  1175.  
  1176. procedure ReSendPacket;
  1177. { re -sends previous packet }
  1178. begin
  1179.    DebugMessage('ReSendPacket...     ');
  1180.    NumSendPacks := NumSendPacks+1;
  1181.    if Debug then
  1182.       DebugPacket('Re-Sending ...      ',LastPacket);
  1183.    PutPacket(LastPacket);
  1184. end;
  1185.  
  1186.  
  1187. procedure SendPacket;
  1188. { expects count as  length of data portion }
  1189. { and seq as number of packet }
  1190. { builds &  sends packet }
  1191.  
  1192. var
  1193.     i,len,chksum : integer;
  1194.     temp : Ppack;
  1195. begin
  1196.    DebugMessage('Sending Packet      ');
  1197.    if (NumTry <> 1) and (Runtype = Transmit ) then
  1198.       ReSendPacket
  1199.    else
  1200.       begin
  1201.          with ThisPacket^ do
  1202.             begin
  1203.                mark := SOH;               { mark }
  1204.                len := count;             {  save length }
  1205.                count := MakeChar(len+3); {  count = 3+length of data }
  1206.                seq := MakeChar(seq);     {  seq number }
  1207.                chksum := count + seq + ptype;
  1208.                if ( len > 0) then      { is there data ? }
  1209.                   for i:= 1 to len do
  1210.                      if (data[i] >= 0) then
  1211.                         chksum := chksum + data[i]  { loop for data }
  1212.                      else
  1213.                         chksum := chksum + data[i] + 256;
  1214.                chksum := Checkfunction(chksum);  {  calculate  checksum }
  1215.                data[len+1] := MakeChar(chksum);  {  make printable & output }
  1216.                data[len+2] := SendEOL;           { EOL }
  1217.                data[len+3] := ENDSTR;
  1218.             end;
  1219.  
  1220.          NumSendPacks := NumSendPacks+1;
  1221.          if Debug then
  1222.             DebugPacket('Sending ...         ',ThisPacket);
  1223.          PutPacket(ThisPacket);
  1224.  
  1225.          if Runtype = Transmit then
  1226.             begin
  1227.                temp := LastPacket;
  1228.                LastPacket := ThisPacket;
  1229.                ThisPacket := temp;
  1230.             end;
  1231.       end;
  1232. end;
  1233.  
  1234.  
  1235. procedure SendACK(n:integer); { send ACK  packet }
  1236. begin
  1237.    DebugMessage('SendAck...          ');
  1238.    with ThisPacket^ do
  1239.       begin
  1240.          count := 0;
  1241.          seq := n;
  1242.          ptype := TYPEY;
  1243.       end;
  1244.    SendPacket;
  1245.    NumACK := NumACK+1;
  1246. end;
  1247.  
  1248. procedure SendNAK(n:integer); { send NAK  packet }
  1249. begin
  1250.    DebugMessage('SendNAK...          ');
  1251.    with ThisPacket^ do
  1252.       begin
  1253.          count := 0;
  1254.          seq := n;
  1255.          ptype := TYPEN;
  1256.       end;
  1257.    SendPacket;
  1258.    NumNAK := NumNAK+1;
  1259. end;
  1260.  
  1261.  
  1262. procedure ErrorPack;
  1263. { output Error packet if necessary  -- then exit }
  1264. begin
  1265.    DebugMessage('ErrorPack...        ');
  1266.    with ThisPacket^ do
  1267.       begin
  1268.          seq := n;
  1269.          ptype := TYPEE;
  1270.          CtoS(c,data);
  1271.          count := LengthSTIP(data);
  1272.       end;
  1273.    SendPacket;
  1274. end;
  1275.  
  1276.  
  1277. procedure PutErr(c:cstring);
  1278. { Print error_messages }
  1279. begin
  1280.    DebugMessage('PutErr...           ');
  1281.    if debug then
  1282.       Putcln(c,STDERR);
  1283. end;
  1284.  
  1285.  
  1286. procedure Field1; { Count }
  1287.  
  1288. var
  1289.     test: boolean;
  1290. begin
  1291.    DebugMessage('Field1...           ');
  1292.    with NextPacket^ do
  1293.       begin
  1294.          InputPacket^.count := t;
  1295.          count := UnChar(t);
  1296.          test := (count >= 3) or (count <= SizeRecv-2);
  1297.          if not test then
  1298.             DebugMessage('Bad count           ');
  1299.          isgood := isgood and test;
  1300.       end;
  1301. end;
  1302.  
  1303.  
  1304. procedure Field2; { Packet Number }
  1305.  
  1306. var
  1307.     test : boolean;
  1308. begin
  1309.    DebugMessage('Field2...           ');
  1310.    with NextPacket^ do
  1311.       begin
  1312.          InputPacket^.seq := t;
  1313.          seq := UnChar(t);
  1314.          test := (seq >= 0) or (seq <= 63);
  1315.          if not test then
  1316.             DebugMessage('Bad seq number      ');
  1317.          isgood := isgood and test;
  1318.       end;
  1319. end;
  1320.  
  1321.  
  1322. procedure Field3; { Packet type }
  1323.  
  1324. var
  1325.     test : boolean;
  1326. begin
  1327.    DebugMessage('Field3...           ');
  1328.    with NextPacket^ do
  1329.       begin
  1330.          ptype := t;
  1331.          InputPacket^.ptype := t;
  1332.  
  1333.          test := (t =TYPEB) or (t=TYPED) or (t=TYPEE) or (t=TYPEF)
  1334.                  or (t=TYPEN) or (t=TYPES) or (t=TYPEY) or (t=TYPEZ);
  1335.          if not test then
  1336.             DebugMessage('Bad Packet type     ');
  1337.          isgood := isgood and test;
  1338.       end;
  1339. end;
  1340.  
  1341.  
  1342. procedure ProcessQuoted; { for data }
  1343. begin
  1344.    with NextPacket^ do
  1345.       begin
  1346.          if (t = MyQuote) or ((t = EBQchar) and (EBQState = Binary)) then
  1347.             begin
  1348.                if control then
  1349.                   begin
  1350.                      data[dataptr] := t + ishigh;
  1351.                      dataptr := dataptr + 1;
  1352.                      control := false;
  1353.                      ishigh := 0;
  1354.                   end
  1355.                else
  1356.                   if (t = MyQuote) then { Set Control on }
  1357.                      control := true;
  1358.             end
  1359.          else
  1360.             if control then
  1361.                begin
  1362.                   data[dataptr] := ctl(t) + ishigh;
  1363.                   dataptr := dataptr + 1;
  1364.                   control := false;
  1365.                   ishigh := 0;
  1366.                end
  1367.          else
  1368.             begin
  1369.                data[dataptr] := t + ishigh;
  1370.                dataptr := dataptr + 1;
  1371.                ishigh := 0;
  1372.             end;
  1373.       end;
  1374. end;
  1375.  
  1376.  
  1377. procedure Field4; { Data }
  1378. begin
  1379.    PacketPtr := PacketPtr+1;
  1380.    InputPacket^.data[PacketPtr] := t;
  1381.    with NextPacket^ do
  1382.       begin
  1383.          if ((pType = TYPES) or (pType = TYPEY)) then
  1384.             begin
  1385.                data[dataptr] := t;
  1386.                dataptr := dataptr+1;
  1387.             end
  1388.          else
  1389.             begin
  1390.                if (EBQstate = Binary) then
  1391.                   begin { Has it been quoted }
  1392.                      if (not(control) and (t = EBQchar)) then
  1393.                         ishigh := 128
  1394.                      else
  1395.                         ProcessQuoted;
  1396.                   end
  1397.                else
  1398.                   ProcessQuoted;
  1399.             end;
  1400.       end;
  1401. end;
  1402.  
  1403.  
  1404. procedure Field5; { Check Sum }
  1405.  
  1406. var
  1407.     test : boolean;
  1408. begin
  1409.    DebugMessage('Field5...           ');
  1410.    with InputPacket^ do
  1411.       begin
  1412.          PacketPtr := PacketPtr +1;
  1413.          data[PacketPtr] := t;
  1414.          PacketPtr := PacketPtr +1;
  1415.          data[PacketPtr] := ENDSTR;
  1416.       end;
  1417.     {  end of input string }
  1418.    check := Checkfunction(check);
  1419.    check := MakeChar(check);
  1420.    test := (t=check);
  1421.    if not test then
  1422.       DebugMessNumb('Bad CheckSum=       ', check);
  1423.    isgood := isgood and test;
  1424.    NextPacket^.data[dataptr] := ENDSTR;
  1425.     {  end of data string }
  1426.    finished := true;  { set finished }
  1427. end;
  1428.  
  1429.  
  1430. procedure BuildPacket;
  1431. { receive packet &  validate checksum }
  1432.  
  1433. var
  1434.     temp : Ppack;
  1435. begin
  1436.    with NextPacket^ do
  1437.       begin
  1438.          if restart then
  1439.             begin
  1440.     { read until get SOH marker }
  1441.                if (t = SOH) then
  1442.                   begin
  1443.                      finished := false;    { set varibles }
  1444.                      control := false;
  1445.                      ishigh := 0;  { no shift }
  1446.                      isgood := true;
  1447.                      seq := -1;       { set return values to  bad packet }
  1448.                      ptype := QUESTION;
  1449.                      data[1] := ENDSTR;
  1450.                      data[MAXSTR] := ENDSTR;
  1451.                      restart := false;
  1452.                      fld := 0;
  1453.                      dataptr := 1;
  1454.                      PacketPtr := 0;
  1455.                      check := 0;
  1456.                   end;
  1457.             end
  1458.          else                          { have started packet  }
  1459.             begin
  1460.                if (t=SOH) then
  1461.                   restart := true
  1462.                else
  1463.                   if (t=myEOL) then
  1464.                      begin
  1465.                         finished := true;
  1466.                         isgood := false;
  1467.                      end
  1468.                else
  1469.                   begin
  1470.                      case fld of
  1471. { increment  field number }
  1472.                         0: fld := 1;
  1473.                         1: fld := 2;
  1474.                         2: fld := 3;
  1475.                         3:
  1476.                            if (count=3) then
  1477.                               fld := 5
  1478.                            else
  1479.                               fld := 4;
  1480.                         4:
  1481.                            if (PacketPtr>=count-3) then
  1482.                               fld := 5;
  1483.                      end { case };
  1484.  
  1485.                      if (fld<>5) then
  1486. { add into checksum }
  1487.                         check := check+t;
  1488.  
  1489.                      case fld of
  1490.                         1: Field1;
  1491.                         2: Field2;
  1492.                         3: Field3;
  1493.                         4: Field4;
  1494.                         5: Field5;
  1495.                      end; { case }
  1496.                   end;
  1497.             end;
  1498.  
  1499.          if finished then
  1500.             begin
  1501.                if (ptype=TYPEE)  and isgood then   { error_packets }
  1502.                   begin
  1503.                      if Local then
  1504.                         PutStr(data,STDERR);
  1505.                      Putcf(NEWLINE,STDERR);
  1506.                      FinishUp(false);
  1507.                      ProgramHalt;
  1508.                   end;
  1509.                NumRecvPacks := NumRecvPacks+1;
  1510.                if Debug then
  1511.                   begin
  1512.                      DebugPacket('Received ...        ',InputPacket);
  1513.                      if isgood then
  1514.                         PutCln('Is Good             ',STDERR);
  1515.                   end;
  1516.                temp := CurrentPacket;
  1517.                CurrentPacket := NextPacket;
  1518.                NextPacket := temp;
  1519.             end;
  1520.       end;
  1521. end;
  1522.  
  1523.  
  1524. function ReceivePacket: boolean;
  1525. begin
  1526.    DebugMessage('ReceivePacket...    ');
  1527.    finished := false;
  1528.    restart := true;
  1529.    FromConsole := nothing;  { No Interupt }
  1530.  
  1531.     {  Obtain packet from VMS incoming channel }
  1532.    BufferEnd :=
  1533.      ReadCommLine(IncomingPacket,LineInSize,theirtimeout,timeoutstatus,
  1534.                  MYEOL,BufferPointer) ;
  1535.  
  1536.     {  Check local terminal for abort, resend character }
  1537.    if local then
  1538.       begin
  1539.     {CheckTypeAhead(FromConsole);}
  1540.          FROMCONSOLE := NOTHING;
  1541.          case FromConsole of
  1542.             abortnow:
  1543.                       begin
  1544.                          FinishUp(true);
  1545.                          ProgramHalt;
  1546.                       end;
  1547.             nothing:        { nothing };
  1548.             CRin:
  1549.                   begin
  1550.                      t := MyEOL;
  1551.                      FromConsole := nothing;
  1552.                   end;
  1553.          end;
  1554.       end;
  1555.  
  1556.    if (BufferEnd = 0) then
  1557.       begin
  1558.          ReceivePacket := false;
  1559.          if (timeOutStatus) then
  1560.             begin
  1561.                CurrentPacket^.ptype := TYPET;
  1562.                restart := true;
  1563.                if (debug) then
  1564.                   PutCln('Timed Out           ', STDERR)
  1565.             end;
  1566.       end
  1567.    else
  1568.       begin
  1569.          repeat
  1570.             t := GetIn;
  1571.  
  1572.             if (t<>ENDOFQIO) then
  1573.                BuildPacket
  1574.             else
  1575.                begin
  1576.                   finished := true;
  1577.                   isgood := false;
  1578.                end;
  1579.          until finished;
  1580.  
  1581.          ReceivePacket := isgood;
  1582.       end;
  1583. end;
  1584.  
  1585.  
  1586. function ReceiveACK : boolean;
  1587. { receive ACK with  correct number }
  1588.  
  1589. var
  1590.     Ok: boolean;
  1591. begin
  1592.    DebugMessage('ReceiveACK...       ');
  1593.    Ok := ReceivePacket;
  1594.    with CurrentPacket^ do
  1595.       begin
  1596.          if (ptype=TYPEY) then
  1597.             NumACKrecv := NumACKrecv+1
  1598.          else
  1599.             if (ptype=TYPEN) then
  1600.                NumNAKrecv := NumNAKrecv+1
  1601.          else
  1602.             NumBadrecv := NumBadrecv +1;
  1603.     { got right  one ? }
  1604.          ReceiveACK := ( Ok and (ptype=TYPEY) and (n=seq))
  1605.       end;
  1606. end;
  1607.  
  1608.  
  1609. procedure GetData(var newstate:KermitStates);
  1610. { get data from file into ThisPacket }
  1611.  
  1612. var
  1613.     { and return next state - data &  EOF }
  1614.     x,c : character;
  1615.     i: integer;
  1616. begin
  1617.    DebugMessage('GetData...          ');
  1618.    if (NumTry=1) then
  1619.       begin
  1620.          i := 1;
  1621.          x := ENDSTR;
  1622.          with ThisPacket^ do
  1623.             begin
  1624.                while (i< SizeSend - 8 ) and (x <> ENDFILE) do
  1625. { leave room for quote  & NEWLINE }
  1626.                   begin
  1627.                      GetCf (x) ;
  1628.                      if (x<>ENDFILE) then
  1629.                         begin
  1630.                            if (x < NULL) then
  1631.                               case EBQstate of
  1632.                                ascii :
  1633.                                        ErrorPack('No Binary Support   ');
  1634.                                binary :
  1635.                                         begin
  1636.                                          data[i] := EBQchar;
  1637.                                          i := i + 1;
  1638.                                          x := x + 128;
  1639.                                         end;
  1640.                               end;
  1641.  
  1642.                            if (IsControl(x)) or (x=SendQuote) or
  1643.                               ((x = EBQchar) and (EBQState = Binary)) then
  1644.                               begin      { control char -- quote }
  1645.                                if ((x=NEWLINE) and
  1646.                                   (EBQState <> Binary)) then
  1647.                                 case EOLFORFILE of
  1648.                                  LineFeed:   { ok as  is };
  1649.                                  CrLf:
  1650.                                        begin
  1651.                                         data[i] := SendQuote;
  1652.                                         i := i+1;
  1653.                                         data[i] := Ctl(CR);
  1654.                                         i := i+1;
  1655.     { LF  will sent below }
  1656.                                        end;
  1657.                                  JustCR:
  1658.                                          x := CR;
  1659.                                 end { case };
  1660.                                data[i] := SendQuote;
  1661.                                i := i+1;
  1662.                                if (x<>SendQuote) or (x <> EBQchar) then
  1663.                                 data[i] := Ctl(x)
  1664.                                else
  1665.                                 data[i] := x;
  1666.                               end
  1667.                            else               { regular char }
  1668.                               data[i] := x;
  1669.                         end;
  1670.  
  1671.                      if (x<>ENDFILE) then
  1672.                         begin
  1673.                            i := i+1;    { increase  count for next char }
  1674.                            AddTo(ChInFileSend,1);
  1675.                         end;
  1676.                   end;
  1677.  
  1678.                data[i] := ENDSTR;   { to terminate  string }
  1679.  
  1680.                count := i -1;       { length }
  1681.                seq := n;
  1682.                ptype := TYPED;
  1683.  
  1684.                if (x=ENDFILE) then
  1685.                   begin
  1686.                      newstate := EOFile;
  1687.                     {Sclose(DiskFile);}
  1688.                   end
  1689.                else
  1690.                   newstate := FileData;
  1691.                SaveState := newstate;        { save state }
  1692.             end
  1693.       end
  1694.    else
  1695.       newstate := SaveState;        {  get old state }
  1696. end;
  1697.  
  1698.  
  1699.  
  1700. function GetNextFile: boolean;
  1701. { get next  file to send in ThisPacket }
  1702. {there ain't no next file, this baby only sends one file at a time}
  1703. { returns true if no more }
  1704.  
  1705. var
  1706.     k : integer ;
  1707.     result: boolean;
  1708. begin
  1709.    DebugMessage('GetNextFile...      ');
  1710.    result := true;
  1711.    if (NumTry=1) then
  1712.       begin
  1713.         if FileSpec[1] <> ' ' then
  1714.            DiskFile := fileopen (filespec,infile) ;
  1715.         with ThisPacket^ do
  1716.                if DiskFile = IOREAD then
  1717.                   begin
  1718.                      k := 1;
  1719.                      while (FileSpec[k] <> ' ') and (FileSpec[k] <> '.') do
  1720.                         begin
  1721.                            data[k] := ord (FileSpec[k]) ;
  1722.                             FileSpec[k] := ' ';
  1723.                            data[k+1] := ENDSTR ;
  1724.                            k := k + 1
  1725.                         end ;
  1726.                      count := LengthSTIP(data);
  1727.                      AddTo(ChInFileSend , count);
  1728.                      seq := n;
  1729.                      ptype := TYPEF;
  1730.                      result := false;
  1731.                   end ;
  1732.  
  1733.  
  1734.       end ;
  1735.    GetNextFile := result;
  1736. end;
  1737. procedure SendFile; { send file name  packet }
  1738. begin
  1739.    DebugMessage('SendFile...         ');
  1740.    if NumTry > MaxTry then
  1741.       begin
  1742.          PutErr ('Send file - Too Many');
  1743.          State := Abort;      { too many tries, abort }
  1744.       end
  1745.    else
  1746.       begin
  1747.          NumTry := NumTry+1;
  1748.          if GetNextFile then
  1749.             begin
  1750.                State := Break;
  1751.                NumTry := 0;
  1752.             end
  1753.          else
  1754.             begin
  1755.                if debug then
  1756.                   begin
  1757.                      if (NumTry = 1) then
  1758.                         PutStr(ThisPacket^.data,STDERR)
  1759.                      else
  1760.                         PutStr(LastPacket^.data,STDERR);
  1761.                      Putcf(NEWLINE,STDERR);
  1762.                   end;
  1763.                SendPacket;     { send this packet }
  1764.                if ReceiveACK then
  1765.                   begin
  1766.                      State := FileData;
  1767.                      NumTry := 0;
  1768.                      n := (n+1) MOD 64;
  1769.                   end
  1770.             end;
  1771.       end;
  1772. end;
  1773.  
  1774.  
  1775. procedure SendData;  { send file data packets }
  1776.  
  1777. var
  1778.     newstate: KermitStates;
  1779. begin
  1780.    DebugMessage('SendData...         ');
  1781.    if debug then
  1782.       PutCN ('Sending data        ',n,STDERR);
  1783.    if NumTry > MaxTry then
  1784.       begin
  1785.          State := Abort;       { too  many tries, abort }
  1786.          PutErr ('Send data - Too many');
  1787.       end
  1788.    else
  1789.       begin
  1790.          NumTry := NumTry+1;
  1791.          GetData(newstate);
  1792.          SendPacket;
  1793.          if ReceiveACK then
  1794.             begin
  1795.                State := newstate;
  1796.                NumTry := 0;
  1797.                n := (n+1) MOD 64;
  1798.             end
  1799.       end;
  1800. end;
  1801.  
  1802.  
  1803. procedure SendEOF;    { send  EOF  packet }
  1804. begin
  1805.    DebugMessage('SendEOF...          ');
  1806.    if NumTry > MaxTry then
  1807.       begin
  1808.          State := Abort;       { too  many tries, abort }
  1809.          PutErr('Send EOF - Too Many ');
  1810.       end
  1811.    else
  1812.       begin
  1813.          NumTry := NumTry+1;
  1814.          if (NumTry = 1) then
  1815.             begin
  1816.                with ThisPacket^ do
  1817.                   begin
  1818.                      ptype := TYPEZ;
  1819.                      seq := n;
  1820.                      count := 0;
  1821.                   end;
  1822.                Sclose(DiskFile);
  1823.             end;
  1824.          SendPacket;
  1825.          if ReceiveACK then
  1826.             begin
  1827.                State := FileHeader;
  1828.                NumTry := 0;
  1829.                n := (n+1) MOD 64;
  1830.             end
  1831.       end;
  1832. end;
  1833.  
  1834.  
  1835. procedure SendBreak; { send break packet }
  1836. begin
  1837.    DebugMessage ('Sending break       ');
  1838.    if NumTry > MaxTry then
  1839.       begin
  1840.          State := Abort;       { too  many tries, abort }
  1841.          PutErr('Send break -Too Many');
  1842.       end
  1843.    else
  1844.       begin
  1845.          NumTry := NumTry+1;
  1846.     { make up packet  }
  1847.          if NumTry = 1 then
  1848.             begin
  1849.                with ThisPacket^ do
  1850.                   begin
  1851.                      ptype := TYPEB;
  1852.                      seq := n;
  1853.                      count := 0;
  1854.                   end
  1855.             end;
  1856.          SendPacket; { send this packet }
  1857.          if ReceiveACK then
  1858.             State := Complete;
  1859.       end;
  1860. end;
  1861.  
  1862.  
  1863. procedure SendInit;  { send init packet }
  1864. begin
  1865.    DebugMessage ('Sending init        ');
  1866.    if NumTry > MaxTry then
  1867.       begin
  1868.          State := Abort;      { too many tries, abort }
  1869.          PutErr('Cannot Initialize   ');
  1870.       end
  1871.    else
  1872.       begin
  1873.          NumTry := NumTry+1;
  1874.          if (NumTry = 1) then
  1875.             begin
  1876.                with ThisPacket^ do
  1877.                   begin
  1878.                      EnCodeParm(data);
  1879.                      count := NUMPARAM;
  1880.                      seq := n;
  1881.                      ptype := TYPES;
  1882.                   end
  1883.             end;
  1884.  
  1885.          SendPacket; { send this packet }
  1886.          if ReceiveACK then
  1887.             begin
  1888.                with CurrentPacket^ do
  1889.                   begin
  1890.                      SizeSend := UnChar(data[1]);
  1891.                      TheirTimeOut := UnChar(data[2]);
  1892.                      Pad := UnChar(data[3]);
  1893.                      PadChar := Ctl(data[4]);
  1894.                      SendEOL := CR;  { default to CR  }
  1895.                      if (LengthSTIP(data) >= 5) then
  1896.                         if (data[5] <> 0) then
  1897.                            SendEOL := UnChar(data[5]);
  1898.                      SendQuote := SHARP;  { default # }
  1899.                      if (LengthSTIP(data) >= 6) then
  1900.                         if (data[6] <> 0) then
  1901.                            SendQuote := data[6];
  1902.                   end;
  1903.  
  1904.                State := FileHeader;
  1905.                NumTry := 0;
  1906.                MaxTry := DEFTRY;  { use regular default now  }
  1907.                n := (n+1) MOD 64;
  1908.             end;
  1909.       end;
  1910. end;
  1911.  
  1912.  
  1913. procedure SendSwitch;
  1914. { Send-switch is the state  table switcher for sending files.
  1915. * It loops until either it is finished or a fault is encountered.
  1916. * Routines called by sendswitch are responsible for changing the state. }
  1917.  
  1918. begin
  1919.    DebugMessage ('Send Switch         ');
  1920.    StartRun;
  1921.    repeat
  1922.       case State of
  1923.          FileData: SendData;         { data-send state }
  1924.          FileHeader: SENDFILE;         { send file name }
  1925.          EOFile: SendEOF;          { send end-of-file }
  1926.          Init: begin Take_Nap (Delay); SendInit end ;    { send initialize }
  1927.          Break: SendBreak;        { send break }
  1928.          Complete:     {  nothing };
  1929.          Abort:        {  nothing };
  1930.       end { case };
  1931.    until ( (State = Abort) or (State=Complete) );
  1932. end;
  1933.  
  1934.  
  1935. procedure GetFile(data:string);
  1936. { create file from  fileheader packet }
  1937.  
  1938. const UNDERSCORE = '_' ;
  1939.  
  1940. var
  1941.     i, j : integer;
  1942.     FileName : string80 ;
  1943. begin
  1944.    DebugMessage ('GetFile...          ');
  1945.    with CurrentPacket^ do
  1946.       begin
  1947.          FileName[1] := '*' ;
  1948.          for i := 2 to LARGESIZE do FileName[i] := ' ' ;
  1949.          i := 1;
  1950.          j := 1;
  1951.          repeat
  1952.             if (data[i] in [LETA..LETZ, LETsa..LETsz,
  1953.                LET0..LET9, PERIOD]) then
  1954.                begin
  1955.                   FileName[j] := chr (data[i]) ;
  1956.                   if data[i] = PERIOD then
  1957.                      FileName[j] := UNDERSCORE ;
  1958.                   j := j + 1 ; if j > LARGESIZE then j := LARGESIZE ;
  1959.                end;
  1960.             i := i + 1
  1961.          until (data[i] = ENDSTR) ;
  1962.       end;
  1963.    if rFileSpec = oON then
  1964.        begin
  1965.        rFileSpec := oOFF ;
  1966.        FileName := filespec
  1967.        end ;
  1968.    diskfile := fileopen (FileName, outfile)
  1969. end;
  1970.  
  1971.  
  1972. procedure ReceiveInit;
  1973. { receive init packet }
  1974. { respond with ACK  and  our parameters }
  1975.  
  1976. var
  1977.     receiveStat : boolean;
  1978. begin
  1979.    DebugMessage ('ReceiveInit...      ');
  1980.    if NumTry > MaxTry then
  1981.       begin
  1982.          State := Abort;
  1983.          PutErr('Cannot receive init ');
  1984.       end
  1985.    else
  1986.       begin
  1987.          NumTry := NumTry+1;
  1988.          receiveStat := ReceivePacket;
  1989.          if (ReceiveStat and (CurrentPacket^.ptype = TYPES)) then
  1990.             begin
  1991.                n := CurrentPacket^.seq;
  1992.                DeCodeParm(InputPacket^.data);
  1993.     {  now send mine }
  1994.                with ThisPacket^ do
  1995.                   begin
  1996.                      count := NUMPARAM;
  1997.                      seq := n;
  1998.                      Ptype := TYPEY;
  1999.                      EnCodeParm(data);
  2000.                   end;
  2001.                SendPacket;
  2002.  
  2003.                NumACK := NumACK+1;
  2004.                State := FileHeader;
  2005.                OldTry := NumTry;
  2006.                NumTry := 0;
  2007.                MaxTry := DEFTRY; { use  regular default now }
  2008.                n := (n+1) MOD 64
  2009.             end
  2010.          else
  2011.             begin
  2012.                if Debug then
  2013.                   PutCln('Received Bad init   ',STDERR);
  2014.                SendNAK(n);
  2015.             end;
  2016.       end;
  2017. end;
  2018.  
  2019.  
  2020. procedure DataToFile; { output to file }
  2021.  
  2022. var
  2023.     len,i : integer;
  2024.     temp : string;
  2025. begin
  2026.    DebugMessage ('DataToFile...       ');
  2027.    with CurrentPacket^ do
  2028.       begin
  2029.          len := LengthSTIP(data);
  2030.          AddTo(ChInFileRecv ,len);
  2031.          if (EBQState <> Binary) then
  2032.             case EOLFORFILE of
  2033.                LineFeed:
  2034.                          PutStr(data,outfile);
  2035.                CrLf:
  2036.                      begin  { don't output   CR }
  2037.                         for i:=1 to len do
  2038.                            if data[i] <> CR then
  2039.                               Putcf(data[i],outfile);
  2040.                      end;
  2041.                JustCR:
  2042.                        begin   { change CR  to NEWLINE }
  2043.                           for i:=1 to len do
  2044.                              if data[i]=CR then
  2045.                                 data[i] := NEWLINE;
  2046.                           PutStr(data,outfile);
  2047.                        end;
  2048.             end
  2049.          else
  2050.             PutStr(data, outfile);
  2051.       end;
  2052. end;
  2053.  
  2054.  
  2055. procedure dodata;  {  Process Data packet }
  2056. begin
  2057.    DebugMessage ('DoData...           ');
  2058.    with CurrentPacket^ do
  2059.       begin
  2060.          if seq = ((n + 63) MOD 64) then
  2061.             begin                { data last one }
  2062.                if OldTry>MaxTry then
  2063.                   begin
  2064.                      State := Abort;
  2065.                      PutErr('Old data - Too many ');
  2066.                   end
  2067.                else
  2068.                   begin
  2069.                      SendACK(seq);
  2070.                      NumTry := 0;
  2071.                   end;
  2072.             end
  2073.          else
  2074.             begin            { data  - this one }
  2075.                if (n<>seq) then
  2076.                   SendNAK(n)
  2077.                else
  2078.                   begin
  2079.                      DataToFile;
  2080.                      SendACK(n); { ACK }
  2081.                      OldTry := NumTry;
  2082.                      NumTry := 0;
  2083.                      n := (n+1) MOD 64;
  2084.                   end;
  2085.             end;
  2086.       end;
  2087. end;
  2088.  
  2089. procedure doFileLast;   { Process File Packet }
  2090. begin          { File header - last  one  }
  2091.    DebugMessage ('DoFileLast...       ');
  2092.    if OldTry > MaxTry { tries ? } then
  2093.       begin
  2094.          State := Abort;
  2095.          PutErr('Old file - Too many ');
  2096.       end
  2097.    else
  2098.       begin
  2099.          OldTry := OldTry+1;
  2100.          with CurrentPacket^ do
  2101.             begin
  2102.                if seq = ((n + 63) MOD 64) then
  2103.         {  packet number }
  2104.                   begin  { send ACK }
  2105.                      SendACK(seq);
  2106.                      NumTry := 0
  2107.                   end
  2108.                else
  2109.                   begin
  2110.                      SendNAK(n);   {  NAK }
  2111.                   end;
  2112.             end;
  2113.       end;
  2114. end;
  2115.  
  2116.  
  2117. procedure DoEOF;  { Process EOF packet }
  2118. begin                 { EOF  - this one }
  2119.    DebugMessage ('DoEOF...            ');
  2120.    if CurrentPacket^.seq<>n then   { packet number ? }
  2121.       SendNAK(n) { NAK }
  2122.    else
  2123.       begin               { send ACK }
  2124.          Sclose(DiskFile);  { close file }
  2125.          SendACK(n);
  2126.          OldTry := NumTry;
  2127.          NumTry := 0;
  2128.          n := (n+1) MOD 64; { next packet  }
  2129.          State := FileHeader;   { change state }
  2130.       end;
  2131. end;
  2132.  
  2133.  
  2134. procedure ReceiveData;  { Receive data packets }
  2135.  
  2136. var
  2137.     strend: integer;
  2138.     good : boolean;
  2139.  
  2140. begin
  2141.    DebugMessage ('ReceiveData...      ');
  2142.    if NumTry > MaxTry then          { check number of tries }
  2143.       begin
  2144.          State := Abort;
  2145.          if debug then
  2146.             PutCN('Recv data -Too many ',n,STDERR);
  2147.       end
  2148.    else
  2149.       begin
  2150.          NumTry := NumTry+1;                { increase number of tries }
  2151.          good := ReceivePacket;        { get  packet }
  2152.          with CurrentPacket^ do
  2153.             begin
  2154.                if debug then
  2155.                   PutCN('Receiving (Data)    ',CurrentPacket^.seq,STDERR);
  2156.                if ((ptype = TYPED) or (ptype=TYPEZ)
  2157.                   or (ptype=TYPEF)) and good then     { check type }
  2158.                   case ptype of
  2159.                      TYPED: doData;
  2160.                      TYPEF: doFileLast;
  2161.                      TYPEZ: doEOF;
  2162.                   end { case }
  2163.                else
  2164.                   begin
  2165.                      if Debug then
  2166.                         PutCln('Expected data pack  ',STDERR);
  2167.                      SendNAK(n);
  2168.                   end;
  2169.             end;
  2170.       end;
  2171. end;
  2172.  
  2173.  
  2174. procedure doBreak; {  Process Break packet }
  2175. begin                    { Break transmission }
  2176.    DebugMessage ('DoBreak...          ');
  2177.    if CurrentPacket^.seq<>n then    { packet number ? }
  2178.       SendNAK(n) { NAK }
  2179.    else
  2180.       begin            { send   ACK }
  2181.          SendACK(n) ;
  2182.          State := Complete  { change  state }
  2183.       end;
  2184. end;
  2185.  
  2186.  
  2187. procedure DoFile; { Process file packet }
  2188. begin                 { File Header  }
  2189.    DebugMessage ('DoFile...           ');
  2190.    with CurrentPacket^ do
  2191.       begin
  2192.          if seq<>n then           { packet number ? }
  2193.             SendNAK(n)  { NAK }
  2194.          else
  2195.             begin               { send ACK }
  2196.                AddTo(ChInFileRecv, LengthSTIP(data));
  2197.                GetFile(data);   { get file  name }
  2198.                SendACK(n);
  2199.                OldTry := NumTry;
  2200.                NumTry := 0;
  2201.                n := (n+1) MOD 64; { next packet  }
  2202.                State := FileData;   { change state  }
  2203.             end;
  2204.       end;
  2205. end;
  2206.  
  2207.  
  2208. procedure DoEOFLast; { Process EOF Packet }
  2209. begin               { end of File Last One}
  2210.    DebugMessage ('DoEOFLast...        ');
  2211.    if OldTry > MaxTry then
  2212.       begin
  2213.          State := Abort;
  2214.          PutErr('Old EOF - Too many  ');
  2215.       end
  2216.    else
  2217.       begin
  2218.          OldTry := OldTry+1;
  2219.          with CurrentPacket^ do
  2220.             begin
  2221.                if seq =((n + 63 ) MOD 64) then
  2222. {  packet number }
  2223.                   begin  { send ACK }
  2224.                      SendACK(seq);
  2225.                      Numtry := 0
  2226.                   end
  2227.                else
  2228.                   begin
  2229.                      SendNAK(n);  { NAK }
  2230.                   end
  2231.             end;
  2232.       end;
  2233. end;
  2234.  
  2235.  
  2236. procedure DoInitLast;
  2237. begin                { Init  Packet - last one }
  2238.    DebugMessage ('DoInitLast...       ');
  2239.    if OldTry>MaxTry then
  2240.       begin
  2241.          State := Abort;
  2242.          PutErr('Old init - Too many ');
  2243.       end
  2244.    else
  2245.       begin
  2246.          OldTry := OldTry+1;
  2247.          if CurrentPacket^.seq = ((n + 63) MOD  64) then
  2248.     { packet number }
  2249.             begin   { send ACK }
  2250.                with ThisPacket^ do
  2251.                   begin
  2252.                      count := NUMPARAM;
  2253.                      seq := CurrentPacket^.seq;
  2254.                      ptype := TYPEY;
  2255.                      EnCodeParm(data);
  2256.                   end;
  2257.                SendPacket;
  2258.                NumACK := NumACK+1;
  2259.                NumTry := 0;
  2260.             end
  2261.          else
  2262.             begin
  2263.                SendNAK(n);  { NAK }
  2264.             end;
  2265.       end;
  2266. end;
  2267.  
  2268.  
  2269. procedure ReceiveFile; { receive file packet  }
  2270.  
  2271. var
  2272.     good: boolean;
  2273.  
  2274. begin
  2275.    DebugMessage ('ReceiveFile...      ');
  2276.    if NumTry > MaxTry then          { check number of tries }
  2277.       begin
  2278.          State := Abort;
  2279.          PutErr('Recv file - Too many');
  2280.       end
  2281.    else
  2282.       begin
  2283.          NumTry := NumTry+1;                { increase number of tries }
  2284.          good := ReceivePacket;             { get packet }
  2285.          with CurrentPacket^ do
  2286.             begin
  2287.                if debug then
  2288.                   PutCN('Receiving (File)    ',seq,STDERR);
  2289.                if ((ptype = TYPES) or (ptype=TYPEZ)
  2290.                   or (ptype=TYPEF) or (ptype=TYPEB)) { check type }
  2291.                   and good then
  2292.                   case ptype of
  2293.                      TYPES: doInitLast;
  2294.                      TYPEZ: doEOFLast;
  2295.                      TYPEF: doFile;
  2296.                      TYPEB: doBreak;
  2297.                   end { case }
  2298.                else
  2299.                   begin
  2300.                      if Debug then
  2301.                         PutCln('Expected File Pack  ',STDERR);
  2302.                      SendNAK(n);
  2303.                   end;
  2304.             end;
  2305.       end;
  2306. end;
  2307.  
  2308.  
  2309. procedure RecvSwitch; { this procedure  is the main receive routine }
  2310. begin
  2311.    DebugMessage ('RecvSwitch...       ');
  2312.    StartRun;
  2313.    repeat
  2314.       case State of
  2315.          FileData: ReceiveData;
  2316.          Init: ReceiveInit;
  2317.          Break:          {  nothing };
  2318.          FileHeader: ReceiveFile;
  2319.          EOFile:         {  nothing };
  2320.          Complete:       {  nothing };
  2321.          Abort:          {  nothing };
  2322.       end;
  2323.     {  case }
  2324.    until (State = Abort ) or ( State = Complete );
  2325. end;
  2326.  
  2327.  
  2328. procedure KermitMain; { Main  procedure }
  2329.  
  2330. var
  2331.     aline : string;
  2332.     j : integer;
  2333.     errorOccurred : boolean;
  2334. begin
  2335.  
  2336.    DebugMessage ('KermitMain...       ');
  2337.  
  2338.    errorOccurred := false;
  2339.    case Runtype of
  2340.       Receive:
  2341.                begin { filename is optional here }
  2342.                      RecvSwitch;
  2343.                end;
  2344.       Transmit:
  2345.                 SendSwitch;
  2346.  
  2347.       Invalid:        { nothing };
  2348.    end; {  case }
  2349.  
  2350.    FinishUp(errorOccurred); { end  of program }
  2351.  
  2352. end { main   };
  2353.  
  2354. {  Include the parser into kermit.(lines 2355-4263) }
  2355. {  Determine length of string. }
  2356.  
  2357. function LenString(var tempStr : string80) : integer;
  2358.  
  2359. var
  2360.     i : integer;
  2361.     endofstring : boolean;
  2362. begin
  2363.    i := 80;
  2364.    endofstring := false;
  2365.    while ((i >= 1) and not(endofstring)) do
  2366.       if (tempStr[i] = ' ') then
  2367.          i := i - 1
  2368.       else
  2369.          endofstring := true;
  2370.  
  2371.    LenString := i;
  2372. end;
  2373.  
  2374.  
  2375. {  Copy command line into temporary string until either EOS or blank }
  2376.  
  2377. procedure SkipBlanks(var command : string80;
  2378.                      var commandLen : integer);
  2379.  
  2380. var
  2381.     i, k, j, oldComLen : integer;
  2382.     endOfString : boolean;
  2383.  
  2384. begin
  2385.  
  2386.    i := 1;
  2387.    endofString := false;
  2388.    oldComLen := commandLen;
  2389.    while ((i <= commandLen) and (not(endofString))) do
  2390.       if (command[i] = ' ') then
  2391.          i := i + 1
  2392.       else
  2393.          endofString := true;
  2394.  
  2395.    k := 1;
  2396.    for j:=i to commandLen do
  2397.       begin
  2398.          command[k] := command[j];
  2399.          k := k + 1;
  2400.       end;
  2401.  
  2402.    if ((oldComLen = 1) and (i <> 1)) then
  2403.       commandLen := commandLen - i
  2404.    else
  2405.       commandLen := commandLen - (i-1);
  2406. end;
  2407.  
  2408.  
  2409. {  Copy command line into temporary string until either EOS or blank }
  2410.  
  2411. procedure CopyToken(var command : string80;
  2412.                     var commandLen : integer;
  2413.                     var tempStr : string13;
  2414.                     var totChars : integer);
  2415.  
  2416. const
  2417.     { %include 'CURRENT_CONSTANT' (lines 2418-2583}
  2418.    NULLTOKE = 100;
  2419.    RANGENULL = 101;
  2420.         KERMITPROMPT = 'Kermit-CP6>';
  2421.         KERMITHELP = 'KERMITHLP:';
  2422.  
  2423.    INVALIDCOMMAND = 1;
  2424.    INVALIDSETCOMMAND = 2;
  2425.    INVALIDSHOWCOMMAND = 3;
  2426.    NOTIMPLEMENTED = 4;
  2427.    INVALIDFILESPEC = 5;
  2428.    INVALIDSETCVALUE =  6;
  2429.    INVALIDSETDVALUE =  7;
  2430.    INVALIDSETOVALUE = 8;
  2431.    INVALIDSETRANGE = 9;
  2432.         SENDPARMS = 10;
  2433.         RECEIVEPARMS = 11;
  2434.         LOCALPARMS = 12;
  2435.         BLANKLINE = 13;
  2436.         NOHELPAVAILABLE = 14;
  2437.    IBEXSPAWNFAILED = 15;
  2438.  
  2439.    cSET        = 'SET          ';
  2440.    cSHOW       = 'SHOW         ';
  2441.    cSTATUS     = 'STATUS       ';
  2442.    cCONNECT    = 'CONNECT      ';
  2443.    cHELP       = 'HELP         ';
  2444.    cEXIT       = 'EXIT         ';
  2445.    cQUIT       = 'QUIT         ';
  2446.    cQUESTION   = '?            ';
  2447.    cSEND       = 'SEND         ';
  2448.    cRECEIVE    = 'RECEIVE      ';
  2449.    cDEBUGGING  = 'DEBUGGING    ';
  2450.    cLOCALECHO  = 'LOCAL-ECHO   ';
  2451.    cDELAY      = 'DELAY        ';
  2452.    cPACKETLENGTH   = 'PACKET-LENGTH';
  2453.    cPADDING    = 'PADDING      ';
  2454.    cPADCHAR    = 'PADCHAR      ';
  2455.    cTIMEOUT    = 'TIMEOUT      ';
  2456.    cENDOFLINE  = 'END-OF-LINE  ';
  2457.    cQUOTE      = 'QUOTE        ';
  2458.    cALL        = 'ALL          ';
  2459.    cON     = 'ON           ';
  2460.    cOFF        = 'OFF          ';
  2461.         cBADTOKEN       = 'XX           ';
  2462.    cTRANSMODE  = 'TRANSMODE    ';
  2463.    cASCII      = 'ASCII        ';
  2464.    cBINARY     = 'BINARY       ';
  2465.    cEIGHTQUOTE = 'EIGHT-QUOTE  ';
  2466.         cFILERECORD     = 'FILERECORD   ';
  2467.         cCR        = 'CR           ';
  2468.         cLF        = 'LF           ';
  2469.         cCRLF      = 'CRLF         ';
  2470.    cPARITY     = 'PARITY       ';
  2471.    cEVEN       = 'EVEN         ';
  2472.    cODD        = 'ODD          ';
  2473.    cNONE       = 'NONE         ';
  2474.    cSPEED      = 'SPEED        ';
  2475.    cIBEX        = 'IBEX         ';
  2476.  
  2477.    uSET = 3;
  2478.    uMSEND = 3;
  2479.    uMRECEIVE = 1;
  2480.    uSHOW = 2;
  2481.    uSTATUS = 2;
  2482.    uCONNECT = 1;
  2483.    uIBEX = 1;
  2484.    uHELP = 1;
  2485.    uQUESTION = 1;
  2486.    uEXIT = 1;
  2487.    uQUIT = 1;
  2488.    uSEND = 1;
  2489.    uRECEIVE = 1;
  2490.    uDEBUGGING = 3;
  2491.         uFILERECORD = 1;
  2492.    uTRANSMODE = 1;
  2493.    uLOCALECHO = 2;
  2494.    uDELAY = 3;
  2495.    uPACKETLENGTH = 3;
  2496.    uPADDING = 4;
  2497.    uPADCHAR = 4;
  2498.    uTIMEOUT = 1;
  2499.    uENDOFLINE = 1;
  2500.    uQUOTE = 1;
  2501.    uALL = 1;
  2502.    uON = 2;
  2503.    uOFF = 2;
  2504.         uBADTOKEN = 1;
  2505.         uCR = 2;
  2506.         uLF = 1;
  2507.         uCRLF = 2;
  2508.    uPARITY = 1;
  2509.    uEVEN = 1;
  2510.    uODD = 1;
  2511.    uNONE = 1;
  2512.    uSPEED = 2;
  2513.    uASCII = 1;
  2514.    uBINARY = 1;
  2515.    uQUOTED = 1;
  2516.    uEIGHTQUOTE = 1;
  2517.  
  2518.    oON = 0;
  2519.    oOFF = 1;
  2520.    oEVEN = 2;
  2521.    oODD = 3;
  2522.    oNONE = 4;
  2523.    oSET = 5;
  2524.    oSHOW = 6;
  2525.    oSTATUS = 7;
  2526.    oCONNECT = 8;
  2527.    oHELP = 9;
  2528.    oEXIT = 10;
  2529.    oQUIT = 11;
  2530.    oSEND = 12;
  2531.    oRECEIVE = 13;
  2532.    oDEBUGGING = 14;
  2533.    oLOCALECHO = 15;
  2534.    oDELAY = 16;
  2535.    oPACKETLENGTH = 17;
  2536.    oPADDING = 18;
  2537.    oPADCHAR = 19;
  2538.    oTIMEOUT = 20;
  2539.    oENDOFLINE = 21;
  2540.    oQUOTE = 22;
  2541.    oQUESTIONM = 23;
  2542.    oALL = 24;
  2543.         oBADTOKEN = 25;
  2544.         oFILERECORD = 26;
  2545.         oCR = 27;
  2546.         oLF = 28;
  2547.         oCRLF = 29;
  2548.    oPARITY = 30;
  2549.    oSPEED = 31;
  2550.    oIBEX = 32;
  2551.    oTRANSMODE = 33;
  2552.    oASCII = 34;
  2553.    oBINARY = 35;
  2554.    oEIGHTQUOTE = 36;
  2555.    oXXXX = 100 ;
  2556.  
  2557.    oMAINTYPE = 1;
  2558.    oSETTYPE = 2;
  2559.    oSHOWTYPE = 3;
  2560.    oSENDTYPE = 4;
  2561.    oRECEIVETYPE = 5;
  2562.    oDEBUGTYPE = 6;
  2563.         oFILERECTYPE = 8;
  2564.    oLOCECHOTYPE = 9;
  2565.    oPARITYTYPE = 10;
  2566.    oTRANSTYPE = 11;
  2567.  
  2568.    DECIMAL = 0;
  2569.    SDECIMAL = 1;
  2570.    OCTAL = 2;
  2571.    CHRACTER = 3;
  2572.    IDECIMAL = 4;
  2573.    EBCHRACTER = 5;
  2574.  
  2575.    oASCSTATE = 1;
  2576.    oBINSTATE = 0;
  2577.  
  2578.    o300BAUD = 300;
  2579.    o600BAUD = 600;
  2580.    o1200BAUD = 1200;
  2581.    o2400BAUD = 2400;
  2582.    o4800BAUD = 4800;
  2583.    o9600BAUD = 9600;
  2584.  
  2585. var
  2586.     i, j, k : integer;
  2587.     noBlank : boolean;
  2588.     tempToken : string80;
  2589.  
  2590. begin
  2591.  
  2592.    for i:=1 to SMALLSIZE do
  2593.       tempStr[i] := ' ';
  2594.  
  2595.    i := 1;
  2596.    noblank := true;
  2597.    while ((i <= commandLen) and (noblank)) do
  2598.       if (command[i] <> ' ') then
  2599.          begin
  2600.             tempToken[i] := command[i];
  2601.             i := i + 1;
  2602.          end
  2603.       else
  2604.          noBlank := false;
  2605.  
  2606.    totChars := i - 1;
  2607.  
  2608.    if (totChars <= SMALLSIZE) then
  2609.       for i:=1 to totChars do
  2610.          tempStr[i] := tempToken[i]
  2611.          else
  2612.             begin
  2613.                totChars := 2;
  2614.                tempStr := cBADTOKEN;
  2615.             end;
  2616.  
  2617.    k := 1;
  2618.    for j:=(totChars+1) to commandLen do
  2619.       begin
  2620.          command[k] := command[j];
  2621.          k := k + 1;
  2622.       end;
  2623.  
  2624.    commandLen := commandLen - totChars;
  2625. end;
  2626.  
  2627.  
  2628. {  Routine to compare strings for symbol comparison. }
  2629.  
  2630. function CompareStr(command, symbol : string13;
  2631.                     commandLen, symbolLen : integer) : boolean;
  2632.  
  2633. var
  2634.     i : integer;
  2635.     sameStr : boolean;
  2636.  
  2637. begin
  2638.    sameStr := true;
  2639.    i := 1;
  2640.    while (sameStr and (i <= commandLen)) do
  2641.       if command[i] <> symbol[i] then
  2642.          sameStr := false
  2643.       else
  2644.          i := i + 1;
  2645.    i := i - 1;
  2646.  
  2647.    CompareStr := sameStr and (i >= symbolLen);
  2648. end;
  2649.  
  2650.  
  2651. procedure StrUpcase(var command : string80;
  2652.                     commandLen : integer);
  2653.  
  2654. var
  2655.     i, diff : integer;
  2656.  
  2657. begin
  2658.    diff := ord('a') - ord('A');
  2659.    for i:=1 to commandLen do
  2660.       if ((command[i] >= 'a') and (command[i] <= 'z')) then
  2661.          command[i] := chr(ord(command[i]) - diff);
  2662. end;
  2663.  
  2664.  
  2665. function IsNumeric(token : string13;
  2666.                    var tokLen, value : integer;
  2667.                    typeToken : integer) : boolean;
  2668.  
  2669.  
  2670. var
  2671.     goodChar : boolean;
  2672.     upBound : char;
  2673.     base, i : integer;
  2674.  
  2675. begin
  2676.  
  2677.    value := 0;
  2678.    i := 1;
  2679.    goodChar := true;
  2680.    upBound := '9';
  2681.    base := 10;
  2682.    if (typeToken = OCTAL) then
  2683.       begin
  2684.          upBound := '7';
  2685.          base := 8;
  2686.       end;
  2687.  
  2688.    while ((i <= tokLen) and (goodChar)) do
  2689.       if ((token[i] >= '0') and (token[i] <= upBound)) then
  2690.          begin
  2691.             value := (value*base) + (ord(token[i]) - ord('0'));
  2692.             i := i + 1;
  2693.          end
  2694.       else
  2695.          begin
  2696.             goodChar := false;
  2697.             value := 0;
  2698.          end;
  2699.  
  2700.    goodChar := goodChar and (tokLen > 0);
  2701.  
  2702.    if (typeToken = OCTAL) then
  2703.       IsNumeric := goodChar and ((value >= 0) and (value <= 31))
  2704.    else
  2705.       if (typeToken = SDECIMAL) then
  2706.          IsNumeric := goodChar and ((value >= MINPACKETSIZE) and
  2707.                       (value <= MAXPACKETSIZE))
  2708.    else
  2709.       if (typeToken = IDECIMAL) then
  2710.          IsNumeric := goodChar and ((value = o300BAUD)
  2711.                       or (value=o600BAUD) or (value = o1200BAUD)
  2712.                       or (value=o2400BAUD) or (value = o4800BAUD)
  2713.                       or (value = o9600BAUD))
  2714.    else
  2715.       IsNumeric := goodChar and ((value >= 0) and
  2716.                    (value <= 99))
  2717.  
  2718. end;
  2719.  
  2720.  
  2721. {  Print the ? help message for set menu. }
  2722.  
  2723. procedure PrintSetHelp;
  2724. begin
  2725.    writeln;
  2726.    writeln;
  2727.    writeln('*** HELP ==>');
  2728.    writeln;
  2729.    writeln('    SET keyword');
  2730.    writeln;
  2731.    writeln('        Keywords:');
  2732.    writeln('          SEND  <option>');
  2733.    writeln('          RECEIVE <option>');
  2734.    writeln('          TRANSMODE <ASCII | binary>');
  2735.    writeln('          EIGHT-QUOTE <character>');
  2736.    writeln('          FILERECORD <CRLF | lf | cr>');
  2737.    writeln('          PARITY <NONE | even | odd>');
  2738.    writeln('          DEBUGGING <on | OFF>');
  2739.    writeln('          SPEED  <decimal>');
  2740.    writeln('          DELAY  <decimal>');
  2741.    writeln;
  2742.    writeln('*** END-OF-MESSAGE');
  2743.    writeln;
  2744.    writeln;
  2745. end;
  2746.  
  2747.  
  2748. {  Print the ? help message for show menu. }
  2749.  
  2750. procedure PrintShowHelp;
  2751. begin
  2752.    writeln;
  2753.    writeln;
  2754.    writeln('*** HELP ==>');
  2755.    writeln;
  2756.    writeln('    SHOW keyword');
  2757.    writeln;
  2758.    writeln('       Keywords:');
  2759.    writeln('         SEND  <option>');
  2760.    writeln('         RECEIVE <option>');
  2761.    writeln('         TRANSMODE');
  2762.    writeln('         EIGHT-QUOTE');
  2763.    writeln('         FILERECORD');
  2764.    writeln('         DEBUGGING');
  2765.    writeln('         SPEED');
  2766.    writeln('         DELAY');
  2767.    writeln('         ALL');
  2768.    writeln;
  2769.    writeln('*** END-OF-MESSAGE');
  2770.    writeln;
  2771.    writeln;
  2772. end;
  2773.  
  2774.  
  2775. {  Print the ? help message for set send/receive menu. }
  2776.  
  2777. procedure PrintSetSendReceiveHelp;
  2778. begin
  2779.    writeln;
  2780.    writeln;
  2781.    writeln('*** HELP ==>');
  2782.    writeln;
  2783.    writeln('    SET SEND/RECEIVE keyword');
  2784.    writeln;
  2785.    writeln('        Keywords:');
  2786.    writeln('          PACKET-LENGTH <decimal>');
  2787.    writeln('          PADDING <decimal>');
  2788.    writeln('          PADCHAR <octal value>');
  2789.    writeln('          TIMEOUT <decimal>');
  2790.    writeln('          END-OF-LINE <octal value>');
  2791.    writeln('          QUOTE <character>');
  2792.    writeln;
  2793.    writeln('*** END-OF-MESSAGE');
  2794.    writeln;
  2795.    writeln;
  2796. end;
  2797.  
  2798.  
  2799. {  Print the ? help message for show send/receive menu. }
  2800.  
  2801. procedure PrintShowSendReceiveHelp;
  2802. begin
  2803.    writeln;
  2804.    writeln;
  2805.    writeln('*** HELP ==>');
  2806.    writeln;
  2807.    writeln('    SHOW SEND/RECEIVE keyword');
  2808.    writeln;
  2809.    writeln('         Keywords:');
  2810.    writeln('           PACKET-LENGTH');
  2811.    writeln('           PADDING');
  2812.    writeln('           PADCHAR');
  2813.    writeln('           TIMEOUT');
  2814.    writeln('           END-OF-LINE');
  2815.    writeln('           QUOTE');
  2816.    writeln;
  2817.    writeln('*** END-OF-MESSAGE');
  2818.    writeln;
  2819.    writeln;
  2820. end;
  2821.  
  2822.  
  2823. procedure PrintStatus;
  2824. {  Print the status of the last send/receive. }
  2825.  
  2826. const
  2827.       STRWIDTH = 7;
  2828.  
  2829. var
  2830.     overHead, effectiveRate : integer;
  2831. begin
  2832.    writeln('  Packets Sent =                ', NumSendPacks : STRWIDTH);
  2833.    if (oldRunType = Transmit) then
  2834.       begin
  2835.          writeln('  Number of ACK packets =       ', NumACKrecv : STRWIDTH);
  2836.          writeln('  Number of NAK packets =       ', NumNAKrecv : STRWIDTH);
  2837.          writeln('  Number of BAD packets =       ', NumBADrecv : STRWIDTH);
  2838.       end
  2839.    else
  2840.       begin
  2841.          writeln('  Number of ACK packets =       ', NumACK : STRWIDTH);
  2842.          writeln('  Number of NAK packets =       ', NumNAK : STRWIDTH);
  2843.       end;
  2844.    writeln('  Data characters Sent =        ', ChInFileSend : STRWIDTH);
  2845.    writeln('  Total characters Sent =       ', ChInPackSend : STRWIDTH);
  2846.    OverHd(ChInPackSend, ChInFileSend, overHead);
  2847.    writeln('  Overhead on Send Packets =    ', overHead : STRWIDTH, ' %');
  2848.    writeln(' ');
  2849.    writeln('  Packets Received =            ', NumRecvPacks : STRWIDTH);
  2850.    writeln('  Data characters Received =    ', ChInFileRecv : STRWIDTH);
  2851.    writeln('  Total characters Received =   ', ChInPackRecv : STRWIDTH);
  2852.    OverHd(ChInPackRecv, ChInFileRecv, overHead);
  2853.    writeln('  Overhead on Receive Packets = ', overHead : STRWIDTH, ' %');
  2854.  
  2855.    writeln;
  2856.  
  2857. end;
  2858.  
  2859.  
  2860. {  Print the message specified. }
  2861.  
  2862. procedure PrintMessage(messageNumber : integer);
  2863.  
  2864.  
  2865. begin
  2866.    case messageNumber of
  2867.       NOTIMPLEMENTED :
  2868.                        writeln(' ? Not Implemented');
  2869.       INVALIDCOMMAND :
  2870.                        writeln(' ? Invalid command');
  2871.       INVALIDSETCOMMAND :
  2872.                           writeln(' ? Invalid set command');
  2873.       INVALIDSHOWCOMMAND :
  2874.                            writeln(' ? Invalid show command');
  2875.       INVALIDFILESPEC :
  2876.                         writeln(' ? Invalid file specification');
  2877.       INVALIDSETCVALUE :
  2878.                          writeln(' ? Bad value: character');
  2879.       INVALIDSETDVALUE :
  2880.                          writeln(' ? Bad value: decimal');
  2881.       INVALIDSETOVALUE :
  2882.                          writeln(' ? Bad value: octal');
  2883.       INVALIDSETRANGE :
  2884.                         writeln(' ? Value not in accepted range');
  2885.       NOHELPAVAILABLE :
  2886.                         writeln(' ? Not a HELP subject');
  2887.       IBEXSPAWNFAILED :
  2888.                         writeln(' ? IBEX spawn failed');
  2889.       SENDPARMS :
  2890.                   writeln('Send Parameters:');
  2891.       RECEIVEPARMS :
  2892.                      writeln('Receive Parameters:');
  2893.       LOCALPARMS :
  2894.                    writeln('Local System Parameters:');
  2895.       BLANKLINE :
  2896.                   writeln(' ');
  2897.    end;
  2898. end;
  2899.  
  2900.  
  2901. procedure ExecShell(dclcommd : string80;
  2902.                     commdLen : integer);
  2903. {  Call the IBEX shell }
  2904.  
  2905. const
  2906.       SPAWN = 'SPAWN';
  2907.       BLANK = '                                                           ';
  2908.       MAXCOMMD = 60;
  2909.  
  2910. var
  2911.     status, i : integer;
  2912.     shellLine : NewString80;
  2913.  
  2914. begin
  2915.  
  2916.         PrintMessage(NOTIMPLEMENTED);
  2917.  
  2918. end;
  2919.  
  2920. procedure ScanForToken(var commandLine:String80;
  2921.                        var commandLen, token: integer;
  2922.                        typeToken:integer);forward;
  2923.  
  2924.  
  2925.  
  2926. {  Print out appropriate help message according to the code
  2927.    received from either HELPSetShow or PrintHelpCP6.                 }
  2928.  
  2929. procedure HelpMessage(code : integer);
  2930. begin
  2931.    writeln;
  2932.    writeln;
  2933.    writeln('*** HELP ==>');
  2934.    case code of
  2935.       1  : begin
  2936.               writeln('    SHOW SEND PACKET-LENGTH par');
  2937.               writeln;
  2938.               writeln('    Description:');
  2939.               write('        This command shows the send ');
  2940.               writeln('packet length.');
  2941.               writeln('    par:');
  2942.               write('        may be any decimal value between ');
  2943.               writeln('10 and 96');
  2944.               writeln('        Default Value = 94');
  2945.               writeln;
  2946.               writeln('    Note that SETting this will have no effect since');
  2947.               writeln('    the remote Kermit will send the value it requires.');
  2948.               writeln;
  2949.               writeln('    Affect this change by SETting the RECEIVE PACKET-LENGTH');
  2950.               writeLN('    parameter of the remote Kermit.');
  2951.               writeln;
  2952.               writeln('    Example:');
  2953.               writeln('        KERMIT-CP6> SHOW SEND PACKET-LENGTH');
  2954.               writeln('        KERMIT-IBM> SET RECEIVE PACKET-LENGTH 80');
  2955.            end;
  2956.       2  : begin
  2957.               writeln;
  2958.               writeln('    SHOW SEND PADDING ');
  2959.               writeln;
  2960.               writeln('    Description:');
  2961.               write('        This command shows the number of ');
  2962.               writeln('padding characters that will be ');
  2963.               writeln('        sent to the remote Kermit.  ');
  2964.               writeln;
  2965.               writeln('    Note that SETting this will have no effect since');
  2966.               writeln('    the remote Kermit will send the value it requires.');
  2967.               writeln;
  2968.               writeln('    Affect this change by SETting the RECEIVE PADDING');
  2969.               writeln('    parameter of the remote Kermit.');
  2970.               writeln;
  2971.               writeln('    Example:');
  2972.               writeln('        KERMIT-CP6> SHOW SEND PADDING');
  2973.               writeln('        KERMIT-IBM> SET RECEIVE PADDING 30');
  2974.            end;
  2975.       3  : begin
  2976.               writeln;
  2977.               writeln('    SHOW SEND PADCHAR ');
  2978.               writeln;
  2979.               writeln('    Description:');
  2980.               write('        This command shows the character ');
  2981.               writeln('that will be sent ');
  2982.               writeln('        as padding to the remote Kermit.  ');
  2983.               writeln;
  2984.               writeln('    Note that SETting this parameter will have no effect since');
  2985.               writeln('    the remote Kermit will send the value it requires.');
  2986.               writeln;
  2987.               writeln('    Example:');
  2988.               writeln('        KERMIT-CP6> SHOW SEND PADCHAR');
  2989.            end;
  2990.       4  : begin
  2991.               writeln;
  2992.               writeln('    SHOW SEND TIMEOUT par');
  2993.               writeln;
  2994.               writeln('    Description:');
  2995.               writeln('        This command shows the number of seconds Kermit CP6');
  2996.               writeln('        will wait for a response to a packet sent to the remote Kermit.');
  2997.               writeln('        The SEND is terminated if a timeout occurs.');
  2998.               writeln('    par:');
  2999.               write('        may be any positive decimal number, ');
  3000.               writeln('given in seconds');
  3001.               writeln('        Default value = 20 seconds');
  3002.               writeln;
  3003.               writeln('    Note that SETting this will have no effect since');
  3004.               writeln('    the remote Kermit will send the value it requires.');
  3005.               writeln;
  3006.               writeln('    Affect this change by SETting the RECEIVE TIMEOUT');
  3007.               writeln('    parameter of the remote Kermit.');
  3008.               writeln;
  3009.               writeln('    Example:');
  3010.               writeln('        KERMIT-CP6> SHOW SEND TIMEOUT');
  3011.               writeln('        KERMIT-IBM> SET RECEIVE TIMEOUT 10');
  3012.            end;
  3013.       5  : begin
  3014.               writeln;
  3015.               writeln('    SET/SHOW SEND END-OF-LINE par');
  3016.               writeln;
  3017.               writeln('    Description:');
  3018.               write('        This command sets/shows the end of line');
  3019.               writeln(' character that KERMITCP6 will ');
  3020.               writeln('        send to the remote Kermit.');
  3021.               writeln;
  3022.               writeln('    par:');
  3023.               write('        may be any ASCII value for a character, ');
  3024.               writeln('given in octal');
  3025.               writeln('        Default value = 15 (ASCII CR, CTRL-M)');
  3026.               writeln;
  3027.               writeln('    Examples:');
  3028.               writeln('        KERMIT-CP6> SET SEND END-OF-LINE 12');
  3029.               writeln('        KERMIT-CP6> SHOW SEND END-OF-LINE');
  3030.            end;
  3031.       6  : begin
  3032.               writeln;
  3033.               writeln('    SET/SHOW SEND QUOTE par');
  3034.               writeln;
  3035.               writeln('    Description:');
  3036.               write('        This command sets/shows the printable ');
  3037.               writeln('character that KERMITCP6 will ');
  3038.               write('        send to the remote Kermit to prefix');
  3039.               writeln(' control characters.');
  3040.               writeln('    par:');
  3041.               writeln('        may be any printable character');
  3042.               writeln('        Default value = "#" (ASCII 35(dec) )');
  3043.               writeln('        NOTE:  Change the quote character to send ');
  3044.               writeln('               CP6 files with many ''#'' characters.');
  3045.               writeln('    Affect this change by');
  3046.               write('      SETting the RECEIVE QUOTE parameter');
  3047.               writeln(' of the remote KERMIT,');
  3048.               write('              the SEND QUOTE parameter');
  3049.               writeln(' of the remote KERMIT, and');
  3050.               write('              the SEND QUOTE parameter');
  3051.               writeln(' of CP6 KERMIT to the same value.');
  3052.               writeln('    Examples:');
  3053.               writeln('        KERMIT-CP6> SHOW SEND  QUOTE');
  3054.               writeln('        KERMIT-CP6> SET SEND QUOTE +');
  3055.               writeln('        KERMIT-IBM> SET SEND QUOTE 43 (The ASCII value of ''+'' is 43.) ');
  3056.               writeln('        KERMIT-IBM> SET RECEIVE QUOTE 43');
  3057.            end;
  3058.       7  : begin
  3059.               writeln(code)
  3060.            end;
  3061.       8  : begin
  3062.               writeln;
  3063.               writeln('    SET/SHOW RECEIVE PACKET-LENGTH par');
  3064.               writeln;
  3065.               writeln('    Description:');
  3066.               writeln('        This command sets/shows the maximum of characters');
  3067.               writeln('        in a message received by KermitCP6.');
  3068.               writeln;
  3069.               writeln('    par:');
  3070.               write('        may be any decimal value between ');
  3071.               writeln('10 and 96');
  3072.               writeln('        Default Value = 94');
  3073.               writeln;
  3074.               writeln('    Examples: ');
  3075.               writeln('        KERMIT-CP6> SET RECEIVE PACKET-LENGTH 60');
  3076.               writeln('        KERMIT-CP6> SHOW RECEIVE PACKET-LENGTH');
  3077.            end;
  3078.       9  : begin
  3079.               writeln;
  3080.               writeln('    SET/SHOW RECEIVE PADDING par');
  3081.               writeln;
  3082.               writeln('    Description:');
  3083.               write('        This command sets/shows the number of ');
  3084.               writeln('padding characters that will ');
  3085.               writeln('        precede a message received by KERMITCP6.');
  3086.               writeln;
  3087.               writeln('    par:');
  3088.               writeln('        may be any positive decimal number');
  3089.               writeln('        Default value = 0');
  3090.               writeln;
  3091.               writeln('    Examples:');
  3092.               writeln('        KERMIT-CP6> SET RECEIVE PADDING 5');
  3093.               writeln('        KERMIT-CP6> SHOW RECEIVE PADDING');
  3094.            end;
  3095.       10 : begin
  3096.               writeln;
  3097.               writeln('    SET/SHOW RECEIVE PADCHAR par');
  3098.               writeln;
  3099.               writeln('    Description:');
  3100.               write('        This command sets/shows the character ');
  3101.               writeln('that will precede ');
  3102.               writeln('        a message received by KERMITCP6.');
  3103.               writeln('        See SET RECEIVE PADDING.');
  3104.               writeln;
  3105.               writeln('    par:');
  3106.               writeln('        may be any ASCII value, given as an octal ');
  3107.               writeln('        number in the range: 0-37, or 177');
  3108.               writeln('        Default value = 0  (ASCII NUL)');
  3109.               writeln;
  3110.               writeln('    Examples:');
  3111.               writeln('        KERMIT-CP6> SET RECEIVE PADCHAR 15');
  3112.               writeln('        KERMIT-CP6> SHOW RECEIVE PADCHAR');
  3113.            end;
  3114.       11 : begin
  3115.               writeln;
  3116.               writeln('    SET/SHOW RECEIVE TIMEOUT par');
  3117.               writeln;
  3118.               writeln('    Description:');
  3119.               write('        This command sets/shows the number of ');
  3120.               writeln('seconds KERMITCP6 will ');
  3121.               writeln('        wait while attempting to receive a message from the remote Kermit.');
  3122.               writeln;
  3123.               writeln('    par:');
  3124.               write('        may be any positive decimal number, ');
  3125.               writeln('given in seconds');
  3126.               writeln('        Default value = 20 seconds');
  3127.               writeln;
  3128.               writeln('    Examples:');
  3129.               writeln('        KERMIT-CP6> SET RECEIVE TIMEOUT 15');
  3130.               writeln('        KERMIT-CP6> SHOW RECEIVE TIMEOUT');
  3131.            end;
  3132.       12 : begin
  3133.               writeln;
  3134.               writeln('    SET/SHOW RECEIVE END-OF-LINE par');
  3135.               writeln;
  3136.               writeln('    Description:');
  3137.               write('        This command sets/shows the end of line');
  3138.               writeln(' character that KERMITCP6 will ');
  3139.               writeln('        expect to receive from the remote Kermit.');
  3140.               writeln;
  3141.               writeln('    par:');
  3142.               write('        may be any ASCII value for a character, ');
  3143.               writeln('given in octal');
  3144.               writeln('        Default value = 15 (ASCII CR, CTRL-M)');
  3145.               writeln;
  3146.               writeln('    Examples:');
  3147.               writeln('        KERMIT-CP6> SET RECEIVE END-OF-LINE 12');
  3148.               writeln('        KERMIT-CP6> SHOW RECEIVE END-OF-LINE');
  3149.            end;
  3150.       13 : begin
  3151.               writeln;
  3152.               writeln('    SET/SHOW RECEIVE QUOTE par');
  3153.               writeln;
  3154.               writeln('    Description:');
  3155.               writeln('        This command sets/shows the printable character KermitCP6 expects');
  3156.               writeln('        to be prefixed to the control characters of messages sent');
  3157.               writeln('        by the remote Kermit.');
  3158.               writeln('    par:');
  3159.               writeln('        may be any printable character');
  3160.               writeln('        Default value = "#" (ASCII 35(dec) )');
  3161.               writeln('     NOTE:  Change the quote character to receive remote Kermit');
  3162.               writeln('            files with many ''#'' characters.');
  3163.               writeln('    Affect this change by SETting');
  3164.               writeln('        the SEND QUOTE parameter of the remote Kermit,');
  3165.               writeln('        the SEND QUOTE parameter of CP6 Kermit, and');
  3166.               writeln('        the RECEIVE QUOTE parameter of CP6 Kermit to the same value.');
  3167.               writeln('    Examples:');
  3168.               writeln('        KERMIT-CP6> SHOW SEND  QUOTE');
  3169.               writeln('        KERMIT-CP6> SET RECEIVE QUOTE +');
  3170.               writeln('        KERMIT-CP6> SET SEND QUOTE +');
  3171.               writeln('        KERMIT-IBM> SET SEND QUOTE 43  (The ASCII value of ''+'' is 43.)');
  3172.            end;
  3173.       14 : begin
  3174.               writeln(code)
  3175.            end;
  3176.       15 : begin
  3177.               writeln;
  3178.               writeln('    SET/SHOW TRANSMODE par');
  3179.               writeln;
  3180.               writeln('    Description:');
  3181.               write('        This command sets/shows the type of ');
  3182.               writeln('file that KERMITCP6 ');
  3183.               writeln('        will receive.');
  3184.               writeln;
  3185.               writeln('    par:');
  3186.               writeln('        must be one of the following...');
  3187.               writeln('             ASCII  - for text files');
  3188.               writeln('             BINARY - for non-text files');
  3189.               writeln('        Default value = ASCII');
  3190.               writeln;
  3191.               writeln('    Examples:');
  3192.               writeln('        KERMIT-CP6> SET TRANSMODE BINARY');
  3193.               writeln('        KERMIT-CP6> SHOW TRANSMODE');
  3194.            end;
  3195.       16 : begin
  3196.               writeln;
  3197.               writeln('    SET/SHOW EIGHT-QUOTE par');
  3198.               writeln;
  3199.               writeln('    Description:');
  3200.               write('        This command sets/shows the character ');
  3201.               writeln('that KERMITCP6 will send ');
  3202.               write('        to the remote Kermit as a quote for');
  3203.               writeln(' eight-bit characters.');
  3204.               writeln;
  3205.               writeln('    par:');
  3206.               writeln('        may be any printable character');
  3207.               writeln('        Default value = "&"  (ASCII 38(dec) )');
  3208.               writeln;
  3209.               writeln('    Examples:');
  3210.               writeln('        KERMIT-CP6> SET EIGHT-QUOTE %');
  3211.               writeln('        KERMIT-CP6> SHOW EIGHT-QUOTE');
  3212.            end;
  3213.       17 : begin
  3214.               writeln;
  3215.               writeln('    SET/SHOW DEBUGGING par');
  3216.               writeln;
  3217.               writeln('    Description:');
  3218.               writeln('        This command sets/shows the state of KermitCP6''s debugging');
  3219.               writeln('        messages.  When on, messages are sent to the user''s terminal.');
  3220.               writeln('        Redirect messages to a CP6 file by using an');
  3221.               writeln('        IBEX SET command ''!SET DEBUGGING fid, CTG=YES''.');
  3222.               writeln;
  3223.               writeln('    par:');
  3224.               writeln('        must be ON or OFF');
  3225.               writeln('        Default value = OFF');
  3226.               writeln('    NOTE:  Debugging is only meaningful for modification of Kermit code.');
  3227.               writeln;
  3228.               writeln('    Examples:');
  3229.               writeln('        KERMIT-CP6> SET DEBUGGING ON');
  3230.               writeln('        KERMIT-CP6> SHOW DEBUGGING');
  3231.            end;
  3232.       18 : begin
  3233.               writeln;
  3234.               writeln('    SET/SHOW FILERECORD par');
  3235.               writeln;
  3236.               writeln('    Description:');
  3237.               writeln('        This command sets/shows the end of line character being used ');
  3238.               writeln('        to separate records in a file being  sent from CP6 ');
  3239.               writeln('        to the remote Kermit.');
  3240.               writeln;
  3241.               writeln('    par:');
  3242.               writeln('        must be one of the following ...');
  3243.               writeln('           CR   - a carriage return');
  3244.               writeln('           LF   - a line feed');
  3245.               write('           CRLF  - a carriage return, ');
  3246.               writeln('followed by a linefeed');
  3247.               writeln('        Default value = CRLF');
  3248.               writeln;
  3249.               writeln('    SUGGESTED USE:');
  3250.               writeln('        SET FILERECORD LF to transmit a PASCAL source to an APPLE IIe.');
  3251.               writeln;
  3252.               writeln('    Examples:');
  3253.               writeln('        KERMIT-CP6> SET FILERECORD LF');
  3254.               writeln('        KERMIT-CP6> SHOW FILERECORD');
  3255.            end;
  3256.       19 : begin
  3257.            end;
  3258.       20 : begin
  3259.               writeln;
  3260.               writeln('    SET/SHOW PARITY par');
  3261.               writeln;
  3262.               writeln('    Description:');
  3263.               write('        This command sets/shows the type of ');
  3264.               writeln('parity being used on the ');
  3265.               writeln('        the transmission line.');
  3266.               writeln;
  3267.               writeln('    par:');
  3268.               writeln('        must be EVEN, ODD, or NONE');
  3269.               write('        Default value = NONE (others require ');
  3270.               writeln('eight-bit prefixing ');
  3271.               writeln('                             for binary files)');
  3272.               writeln('    Examples:');
  3273.               writeln('        KERMIT-CP6> SET PARITY EVEN');
  3274.               writeln('        KERMIT-CP6> SHOW PARITY');
  3275.            end;
  3276.       21 : begin
  3277.               writeln;
  3278.               writeln('    SHOW SPEED ');
  3279.               writeln;
  3280.               writeln('    Description:');
  3281.               write('        This command shows the baud rate ');
  3282.               writeln('of transmission.');
  3283.               writeln;
  3284.               writeln('    NOTE:  SPEED must be SET by the microcomputer Kermit.');
  3285.               writeln;
  3286.               writeln('    Example:');
  3287.               writeln('        KERMIT-CP6> SHOW SPEED');
  3288.            end;
  3289.       22 : begin
  3290.               writeln;
  3291.               writeln('    SET/SHOW DELAY par');
  3292.               writeln;
  3293.               writeln('    Description:');
  3294.               write('        This command sets/shows the number ');
  3295.               writeln('of seconds KERMITCP6 will ');
  3296.               write('        wait before sending data following ');
  3297.               writeln('a SEND command.');
  3298.               writeln;
  3299.               writeln('    par:');
  3300.               write('        may be any positive decimal number, ');
  3301.               writeln('given in seconds');
  3302.               writeln('        Default value = 5 seconds');
  3303.               writeln;
  3304.               writeln('    Examples:');
  3305.               writeln('        KERMIT-CP6> SET DELAY 25');
  3306.               writeln('        KERMIT-CP6> SHOW DELAY');
  3307.               writeln('        NOT YET IMPLEMENTED !!');
  3308.            end;
  3309.       23 : begin
  3310.               writeln(code)
  3311.            end;
  3312.       24 : begin
  3313.               writeln;
  3314.               writeln('    SHOW ALL');
  3315.               writeln;
  3316.               writeln('    Description:');
  3317.               writeln('        This command shows the current values of the KermitCP6');
  3318.               writeln('        SEND, RECEIVE, and Local System parameters.');
  3319.               writeln;
  3320.               writeln('    Example:');
  3321.               writeln('        KERMIT-CP6> SHOW ALL');
  3322.            end;
  3323.       25 : begin
  3324.               writeln;
  3325.               writeln('    SEND filespec');
  3326.               writeln;
  3327.               writeln('    Description:');
  3328.               write('        This command will send the specified ');
  3329.               writeln('CP6 file to the remote ');
  3330.               writeln('        Kermit.');
  3331.               writeln;
  3332.               writeln('    filespec:');
  3333.               writeln('        any valid, existing CP6 file-specification.');
  3334.               writeln;
  3335.               writeln('    Examples:');
  3336.               writeln('        KERMIT-CP6> SEND MYFILE');
  3337.               writeln('        KERMIT-CP6> SEND ANOTHER_FILE');
  3338.            end;
  3339.       26 : begin
  3340.               writeln;
  3341.               writeln('    RECEIVE filespec');
  3342.               writeln;
  3343.               writeln('    Description:');
  3344.               write('        This command will prepare KERMITCP6 ');
  3345.               writeln('to receive a file being ');
  3346.               writeln('        sent by the remote Kermit.');
  3347.               writeln;
  3348.               writeln('    filespec:');
  3349.               writeln('        any valid CP6 file-specification. ');
  3350.               write('        if omitted, the file-specification ');
  3351.               writeln('will be obtained from the ');
  3352.               write('           file header sent by the remote ');
  3353.               writeln('Kermit.');
  3354.               writeln;
  3355.               writeln('    WARNING!  KERMIT will overwrite an existing');
  3356.               writeln('              file with the given filespec.');
  3357.               writeln;
  3358.               writeln('    Examples:');
  3359.               writeln('        KERMIT-CP6> RECEIVE MYFILE');
  3360.               writeln('        KERMIT-CP6> RECEIVE');
  3361.            end;
  3362.       27 : begin
  3363.               writeln;
  3364.               writeln('    STATUS');
  3365.               writeln;
  3366.               writeln('    Description:');
  3367.               writeLN('      This command will display information ');
  3368.               writeln('      on the most recent transmission of data.');
  3369.               writeln;
  3370.               writeln('    Example:');
  3371.               writeln('        KERMIT-CP6> STATUS');
  3372.            end;
  3373.       28 : begin
  3374.            end;
  3375.       29 : begin
  3376.               writeln;
  3377.               writeln('    The following are valid KERMIT-CP6 commands:');
  3378.               writeln;
  3379.               write('      STATUS      HELP        EXIT        QUIT');
  3380.               writeln('      RECEIVE     SEND ');
  3381.               writeln('      SET         SHOW        ');
  3382.               writeln;
  3383.               write('    In order to use the HELP facilities on ');
  3384.               writeln('KERMIT-CP6, type ''HELP command''.  ');
  3385.               write('    Abbreviated HELP can be obtained on selected');
  3386.               writeln(' commands by typing ''command ?''.');
  3387.            end;
  3388.       30 : begin
  3389.               writeln;
  3390.               writeln('    EXIT/QUIT');
  3391.               writeln;
  3392.               writeln('    Description:');
  3393.               write('        This command allows the user to ');
  3394.               writeln('exit KERMITCP6 and return to IBEX.');
  3395.               writeln;
  3396.               writeln('    Examples:');
  3397.               writeln('        KERMIT-CP6> QUIT');
  3398.               writeln('        KERMIT-CP6> EXIT');
  3399.            end;
  3400.       31 : begin
  3401.               writeln(code)
  3402.            end;
  3403.       32 : begin
  3404.               writeln(code)
  3405.            end
  3406.    end; {of case code of}
  3407.    writeln;
  3408.    writeln('*** END-OF-MESSAGE');
  3409.    writeln
  3410. end;
  3411.  
  3412. {  Parse the help set/show command and print the appropriate
  3413.    help message.                                                     }
  3414.  
  3415. procedure HELPSetShow(var commandLine : string80;
  3416.                       var commandLen : integer;
  3417.                       commandType : integer);
  3418.  
  3419.  
  3420. var
  3421.     token : integer;
  3422.  
  3423. begin
  3424.    ScanForToken(commandLine, commandLen, token, commandType);
  3425.  
  3426.    if (token in [oSEND, oRECEIVE, oDEBUGGING, oDELAY,
  3427.       oQUESTIONM, oALL, oFILERECORD, oPARITY, oSPEED,
  3428.       oTRANSMODE, oEIGHTQUOTE]) or (token =  NULLTOKE) then
  3429.       case token of
  3430.          oSEND    :
  3431.                     begin
  3432.                        ScanForToken(commandLine, commandLen, token, oSENDTYPE);
  3433.              { This next line checks if token is oPACKETLENGTH, oPADDING,
  3434.                oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
  3435.                        if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) or
  3436.                           (token = NULLTOKE) then
  3437.                           case token of
  3438.                              oPACKETLENGTH : HelpMessage(1);
  3439.                              oPADDING : HelpMessage(2);
  3440.                              oPADCHAR : HelpMessage(3);
  3441.                              oTIMEOUT : HelpMessage(4);
  3442.                              oENDOFLINE : HelpMessage(5);
  3443.                              oQUOTE : HelpMessage(6);
  3444.                              oQUESTIONM,
  3445.                              NULLTOKE : if commandType = oSETTYPE then
  3446.                                          PrintSetSendReceiveHelp
  3447.                                         else
  3448.                                          PrintShowSendReceiveHelp;
  3449.                           end { inner case token of }
  3450.                        else
  3451.                           begin
  3452.                              PrintMessage(NOHELPAVAILABLE);
  3453.                              HelpMessage(29)
  3454.                           end
  3455.                     end; {of oSEND case}
  3456.  
  3457.          oRECEIVE :
  3458.                     begin
  3459.                        ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
  3460.              { This next line checks if token is oPACKETLENGTH, oPADDING,
  3461.                oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
  3462.                        if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) or
  3463.                           (token = NULLTOKE) then
  3464.                           case token of
  3465.                              oPACKETLENGTH : HelpMessage(8);
  3466.                              oPADDING : HelpMessage(9);
  3467.                              oPADCHAR : HelpMessage(10);
  3468.                              oTIMEOUT : HelpMessage(11);
  3469.                              oENDOFLINE : HelpMessage(12);
  3470.                              oQUOTE : HelpMessage(13);
  3471.                              oQUESTIONM,
  3472.                              NULLTOKE : if commandType = oSETTYPE then
  3473.                                          PrintSetSendReceiveHelp
  3474.                                         else
  3475.                                          PrintShowSendReceiveHelp;
  3476.                           end {inner case token of}
  3477.                        else
  3478.                           begin
  3479.                              PrintMessage(NOHELPAVAILABLE);
  3480.                              HelpMessage(29);
  3481.                           end
  3482.                     end; {of oRECEIVE case}
  3483.  
  3484.          oTRANSMODE : HelpMessage(15);
  3485.          oEIGHTQUOTE : HelpMessage(16);
  3486.          oDEBUGGING : HelpMessage(17);
  3487.          oFILERECORD : HelpMessage(18);
  3488.          oPARITY : HelpMessage(20);
  3489.          oSPEED : HelpMessage(21);
  3490.          oDELAY : HelpMessage(22);
  3491.          oALL : if commandType = oSHOWTYPE then
  3492.                    HelpMessage(24)
  3493.                 else
  3494.                    begin
  3495.                       PrintMessage(NOHELPAVAILABLE);
  3496.                       PrintSetHelp
  3497.                    end;
  3498.          oQUESTIONM,
  3499.          NULLTOKE : if commandType = oSETTYPE then
  3500.                        PrintSetHelp
  3501.                     else
  3502.                        PrintShowHelp;
  3503.       end { of outer case token of }
  3504.    else
  3505.       begin
  3506.          PrintMessage(NOHELPAVAILABLE);
  3507.          HelpMessage(29)
  3508.       end
  3509. end;
  3510.  
  3511.  
  3512.  
  3513.  
  3514.  
  3515.  
  3516.  
  3517. {  Routine to print appropriate help message.
  3518.    Determines token following help. }
  3519.  
  3520. procedure PrintHelpCP6(var commandLine : String80;
  3521.                        var commandLen : integer);
  3522.  
  3523.  
  3524. var
  3525.     token : integer;
  3526.  
  3527.  
  3528. begin
  3529.    ScanForToken(commandLine, commandLen, token, oMAINTYPE);
  3530.     { Make HELP and HELP HELP equivalent statements. }
  3531.    if token = NULLTOKE then
  3532.       token := oHELP;
  3533.    if token in [oSET, oSHOW, oSTATUS,  oHELP, oEXIT,
  3534.       oQUIT, oSEND, oRECEIVE, oQUESTIONM] then
  3535.       case token of
  3536.          oSET       : HELPSetShow(commandLine, commandLen, oSETTYPE);
  3537.          oSHOW      : HELPSetShow(commandLine, commandLen, oSHOWTYPE);
  3538.          oSEND      : HelpMessage(25);
  3539.          oRECEIVE   : HelpMessage(26);
  3540.          oSTATUS    : HelpMessage(27);
  3541.          oHELP,
  3542.          oQUESTIONM : HelpMessage(29);
  3543.          oEXIT,
  3544.          oQUIT      : HelpMessage(30);
  3545.       end { of case token of }
  3546.    else
  3547.       begin
  3548.          PrintMessage(NOHELPAVAILABLE);
  3549.          HelpMessage(29);
  3550.       end
  3551. end;
  3552.  
  3553.  
  3554.  
  3555.  
  3556. {  Routine to print parameter values. }
  3557.  
  3558. procedure PrintParmValue(value, token : integer);
  3559.  
  3560.  
  3561. begin
  3562.    case token of
  3563.       oPACKETLENGTH :
  3564.                       writeln('  Packet-Length =         ', value : 2, ' (dec)');
  3565.       oPADDING :
  3566.                  writeln('  Padding =               ', value : 2, ' (dec)');
  3567.       oPADCHAR :
  3568.                  writeln('  Padding Character =     ', value, ' (decimal)');
  3569.       oTIMEOUT :
  3570.                  writeln('  Time-out length =       ', value : 2, ' (sec)');
  3571.       oENDOFLINE :
  3572.                    writeln('  End of Line Character = ', value, ' (decimal)');
  3573.       oQUOTE :
  3574.                writeln('  Quote Character =       ', chr(value));
  3575.       oTRANSMODE :
  3576.                    begin
  3577.                       write('  File Transfer Type =    ');
  3578.                       if (value = oASCII) then
  3579.                          writeln('ascii')
  3580.                       else
  3581.                          writeln('binary');
  3582.                    end;
  3583.       oEIGHTQUOTE :
  3584.                     writeln('  Eight-Bit Quote =       ', chr(value));
  3585.       oFILERECORD :
  3586.                     begin
  3587.                        write('  End of Line for file =  ');
  3588.                        if (value = oCR) then
  3589.                           writeln('cr')
  3590.                        else
  3591.                           if (value = oLF) then
  3592.                              writeln('lf')
  3593.                        else
  3594.                           writeln('cr/lf');
  3595.                     end;
  3596.       oDELAY :
  3597.                writeln('  Delay =                 ', value : 2, ' (sec)');
  3598.       oDEBUGGING :
  3599.                    begin
  3600.                       write('  Debugging =             ');
  3601.                       if (value = oOFF) then
  3602.                          writeln('off')
  3603.                       else
  3604.                          writeln('on');
  3605.                    end;
  3606.       oPARITY :
  3607.                 begin
  3608.                    write('  Parity =                ');
  3609.                    if (value = oEVEN) then
  3610.                       writeln('even')
  3611.                    else
  3612.                       if (value = oODD) then
  3613.                          writeln('odd')
  3614.                    else
  3615.                       writeln('none');
  3616.                 end;
  3617.       oSPEED :
  3618.                writeln('  Line Speed =            ', lSpeed : 4);
  3619.    end;
  3620. end;
  3621.  
  3622.  
  3623. {  Routine to scan for an appropriate value }
  3624.  
  3625. procedure ScanForValue(var command : string80;
  3626.                        var commandLen, value : integer;
  3627.                        convertType, commandType : integer);
  3628.  
  3629.  
  3630. var
  3631.     tempToken : string13;
  3632.     totChars  : integer;
  3633.     badvalue : boolean;
  3634.  
  3635. begin
  3636.  
  3637.    CopyToken(command, commandLen, tempToken, totChars);
  3638.  
  3639.    case convertType of
  3640.       DECIMAL ,
  3641.       SDECIMAL,
  3642.       IDECIMAL :
  3643.                  if not(IsNumeric(tempToken, totChars, value, convertType)) and
  3644.                     (commandType <> oSHOWTYPE) then
  3645.                     begin
  3646.                        PrintMessage(INVALIDSETDVALUE);
  3647.                        value := RANGENULL;
  3648.                     end;
  3649.       OCTAL :
  3650.               if not(IsNumeric(tempToken, totChars, value, convertType)) and
  3651.                  (commandType <> oSHOWTYPE) then
  3652.                  begin
  3653.                     PrintMessage(INVALIDSETOVALUE);
  3654.                     value := RANGENULL;
  3655.                  end;
  3656.       CHRACTER :
  3657.                  if (totChars = 1) then
  3658.                     value := ord(tempToken[1])
  3659.                  else
  3660.                     if (commandType <> oSHOWTYPE) then
  3661.                        begin
  3662.                           PrintMessage(INVALIDSETCVALUE);
  3663.                           value := RANGENULL;
  3664.                        end;
  3665.       EBCHRACTER :
  3666.                    begin
  3667.                       if (totChars = 1) then
  3668.                          begin
  3669.                             value := ord(tempToken[1]);
  3670.                             badvalue := false;
  3671.                             if (not(value in [EXMARK..RABRACK, GRAVE..TILDE])) then
  3672.                                badvalue := true;
  3673.                          end
  3674.                       else
  3675.                          badvalue := true;
  3676.                       if ((commandType <> oSHOWTYPE) and (badvalue)) then
  3677.                          begin
  3678.                             PrintMessage(INVALIDSETCVALUE);
  3679.                             value := RANGENULL;
  3680.                          end;
  3681.                    end;
  3682.    end;
  3683. end;
  3684.  
  3685.  
  3686. {  Determine if we have a valid number, and if so set it.  }
  3687.  
  3688. procedure TestAndSetValue(var value, numberToSet : integer;
  3689.                           token, commandType : integer);
  3690.  
  3691.  
  3692. begin
  3693.    if (commandType = oSHOWTYPE) then
  3694.       PrintParmValue(numberToSet, token)
  3695.    else
  3696.       if (value = NULLTOKE) then
  3697.          begin
  3698.             PrintMessage(INVALIDSETCOMMAND);
  3699.          end
  3700.    else
  3701.       if (value <> RANGENULL) then
  3702.          numberToSet := value;
  3703. end;
  3704.  
  3705.  
  3706. {  Routine to print the value of all parameters in program.  }
  3707.  
  3708. procedure PrintAllParameters;
  3709.  
  3710.  
  3711. begin
  3712.    PrintMessage(SENDPARMS);
  3713.    PrintParmValue(SizeSend, oPACKETLENGTH);
  3714.    PrintParmValue(Pad, oPADDING);
  3715.    PrintParmValue(PadChar, oPADCHAR);
  3716.    PrintParmValue(TheirTimeOut, oTIMEOUT);
  3717.    PrintParmValue(SendEOL, oENDOFLINE);
  3718.    PrintParmValue(SendQuote, oQUOTE);
  3719.  
  3720.    PrintMessage(RECEIVEPARMS);
  3721.    PrintParmValue(SizeRecv, oPACKETLENGTH);
  3722.    PrintParmValue(MyPad, oPADDING);
  3723.    PrintParmValue(MyPadChar, oPADCHAR);
  3724.    PrintParmValue(MyTimeOut, oTIMEOUT);
  3725.    PrintParmValue(MyEOL, oENDOFLINE);
  3726.    PrintParmValue(MyQuote, oQUOTE);
  3727.  
  3728.    PrintMessage(LOCALPARMS);
  3729.    PrintParmValue(transtype, oTRANSMODE);
  3730.    PrintParmValue(EBQChar, oEIGHTQUOTE);
  3731.    PrintParmValue(fileEol, oFILERECORD);
  3732.    PrintParmValue(parity, oPARITY);
  3733.    PrintParmValue(lSpeed, oSPEED);
  3734.    PrintParmValue(Delay, oDELAY);
  3735.    PrintParmValue(debugging, oDEBUGGING);
  3736. end;
  3737.  
  3738.  
  3739. {  Routine to parse send/receive command for file name or wildcard des. }
  3740.  
  3741. procedure ParseSendReceiveCommand(var commandLine : string80;
  3742.                                   var commandLen : integer;
  3743.                                   var tempFile : string80;
  3744.                                   var token : integer);
  3745.  
  3746.  
  3747. var
  3748.     i : integer;
  3749.  
  3750. begin
  3751.    for i:=1 to LARGESIZE do
  3752.       tempFile[i] := ' ';
  3753.  
  3754.    if ((commandLine[1] <> ' ') and (commandLen > 0)) then
  3755.       begin
  3756.  
  3757.          if (commandLen > LARGESIZE) then
  3758.             commandLen := LARGESIZE;
  3759.  
  3760.          for i := 1 to commandLen do
  3761.             tempFile[i] := commandLine[i];
  3762.  
  3763.          if (commandLine[1] = '?') then
  3764.             begin
  3765.                if token = oSEND then
  3766.                   HelpMessage(25)
  3767.                else
  3768.                   HelpMessage(26);
  3769.                token := oXXXX;
  3770.             end
  3771.          else
  3772.             if token = oSEND then
  3773.                sFileSpec := oON
  3774.          else
  3775.             rFileSpec := oON;
  3776.       end {end if}
  3777.    else
  3778.       begin
  3779.          if token = oSEND then
  3780.             begin
  3781.                sFileSpec := oOFF;
  3782.                PrintMessage(INVALIDFILESPEC)
  3783.             end
  3784.          else
  3785.             rFileSpec := oOFF
  3786.       end; {end if}
  3787.  
  3788.  
  3789. end;
  3790.  
  3791.  
  3792. {  Get a valid token form the command line and return it. }
  3793. procedure ScanForToken;
  3794.  
  3795.  
  3796. var
  3797.     tempToken : string13;
  3798.     totChars : integer;
  3799.  
  3800. begin
  3801.  
  3802.    CopyToken(commandLine, commandLen, tempToken, totChars);
  3803.    SkipBlanks(commandLine, commandLen);
  3804.  
  3805.    token := oBADTOKEN;
  3806.    if (totChars <> 0) then
  3807.       case typeToken of
  3808.          oMAINTYPE :
  3809.                      if (CompareStr(tempToken, cSET, totChars, uSET)) then
  3810.                         token := oSET
  3811.                      else
  3812.                         if (CompareStr(tempToken, cSHOW, totChars, uSHOW)) then
  3813.                            token := oSHOW
  3814.                      else
  3815.                         if (CompareStr(tempToken, cSTATUS, totChars, uSTATUS)) then
  3816.                            token := oSTATUS
  3817.                      else
  3818.                         if (CompareStr(tempToken, cSEND, totChars, uMSEND)) then
  3819.                            token := oSEND
  3820.                      else
  3821.                         if (CompareStr(tempToken, cRECEIVE, totChars, uMRECEIVE)) then
  3822.                            token := oRECEIVE
  3823.                      else
  3824.                         if (CompareStr(tempToken, cIBEX, totChars, uIBEX)) then
  3825.                            token := oIBEX
  3826.                      else
  3827.                         if (CompareStr(tempToken, cHELP, totChars, uHELP)) then
  3828.                            token := oHELP
  3829.                      else
  3830.                         if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  3831.                            token := oQUESTIONM
  3832.                      else
  3833.                         if (CompareStr(tempToken, cQUIT, totChars, uQUIT)) then
  3834.                            token := oQUIT
  3835.                      else
  3836.                         if (CompareStr(tempToken, cEXIT, totChars, uEXIT)) then
  3837.                            token := oEXIT;
  3838.  
  3839.          oSETTYPE,
  3840.          oSHOWTYPE :
  3841.                      if (CompareStr(tempToken, cSEND, totChars, uSEND)) then
  3842.                         token := oSEND
  3843.                      else
  3844.                         if (CompareStr(tempToken, cRECEIVE, totChars, uRECEIVE)) then
  3845.                            token := oRECEIVE
  3846.                      else
  3847.                         if (CompareStr(tempToken, cTRANSMODE, totChars, uTRANSMODE)) then
  3848.                            token := oTRANSMODE
  3849.                      else
  3850.                         if (CompareStr(tempToken, cEIGHTQUOTE, totChars, uEIGHTQUOTE)) then
  3851.                            token := oEIGHTQUOTE
  3852.                      else
  3853.                         if (CompareStr(tempToken, cDEBUGGING, totChars, uDEBUGGING)) then
  3854.                            token := oDEBUGGING
  3855.                      else
  3856.                         if (CompareStr(tempToken, cFILERECORD, totChars, uFILERECORD)) then
  3857.                            token := oFILERECORD
  3858.                      else
  3859.                         if (CompareStr(tempToken, cDELAY, totChars, uDELAY)) then
  3860.                            token := oDELAY
  3861.                      else
  3862.                         if (CompareStr(tempToken, cPARITY, totChars, uPARITY)) then
  3863.                            token := oPARITY
  3864.                      else
  3865.                         if (CompareStr(temptoken, cSPEED, totChars, uSPEED)) then
  3866.                            token := oSPEED
  3867.                      else
  3868.                         if (CompareStr(tempToken, cALL, totChars, uALL)) then
  3869.                            token := oALL
  3870.                      else
  3871.                         if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  3872.                            token := oQUESTIONM;
  3873.  
  3874.          oSENDTYPE,
  3875.          oRECEIVETYPE :
  3876.                         if (CompareStr(tempToken, cPACKETLENGTH, totChars, uPACKETLENGTH)) then
  3877.                            token := oPACKETLENGTH
  3878.                         else
  3879.                            if (CompareStr(tempToken, cPADDING, totChars, uPADDING)) then
  3880.                               token := oPADDING
  3881.                         else
  3882.                            if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  3883.                               token := oQUESTIONM
  3884.                         else
  3885.                            if (CompareStr(tempToken, cPADCHAR, totChars, uPADCHAR)) then
  3886.                               token := oPADCHAR
  3887.                         else
  3888.                            if (CompareStr(tempToken, cTIMEOUT, totChars, uTIMEOUT)) then
  3889.                               token := oTIMEOUT
  3890.                         else
  3891.                            if (CompareStr(tempToken, cENDOFLINE, totChars, uENDOFLINE)) then
  3892.                               token := oENDOFLINE
  3893.                         else
  3894.                            if (CompareStr(tempToken, cQUOTE, totChars, uQUOTE)) then
  3895.                               token := oQUOTE;
  3896.  
  3897.          oTRANSTYPE :
  3898.                       if (CompareStr(tempToken, cASCII, totChars, uASCII)) then
  3899.                          token := oASCII
  3900.                       else
  3901.                          if (CompareStr(tempToken, cBINARY, totChars, uBINARY)) then
  3902.                             token := oBINARY;
  3903.  
  3904.          oDEBUGTYPE,
  3905.          oLOCECHOTYPE :
  3906.                         if (CompareStr(tempToken, cON, totChars, uON)) then
  3907.                            token := oON
  3908.                         else
  3909.                            if (CompareStr(tempToken, cOFF, totChars, uOFF)) then
  3910.                               token := oOFF;
  3911.  
  3912.          oFILERECTYPE :
  3913.                         if (CompareStr(tempToken, cCR, totChars, uCR)) then
  3914.                            token := oCR
  3915.                         else
  3916.                            if (CompareStr(tempToken, cLF, totChars, uLF)) then
  3917.                               token := oLF
  3918.                         else
  3919.                            if (CompareStr(tempToken, cCRLF, totChars, uCRLF)) then
  3920.                               token := oCRLF;
  3921.  
  3922.          oPARITYTYPE :
  3923.                        if (CompareStr(tempToken, cEVEN, totChars, uEVEN)) then
  3924.                           token := oEVEN
  3925.                        else
  3926.                           if (CompareStr(tempToken, cODD, totChars, uODD)) then
  3927.                              token := oODD
  3928.                        else
  3929.                           if (CompareStr(tempToken, cNONE, totChars, uNONE)) then
  3930.                              token := oNONE;
  3931.       end  {of case typeToken of}
  3932.    else
  3933.       token := NULLTOKE
  3934.  
  3935. end;
  3936.  
  3937.  
  3938. {  Parse the set and show command and the proceed to set appropriate
  3939.    kermit variables.                                                 }
  3940.  
  3941. procedure ParseSetShowCommand(var commandLine : string80;
  3942.                               var commandLen : integer;
  3943.                               commandType : integer);
  3944.  
  3945.  
  3946. var
  3947.     token, value : integer;
  3948.  
  3949. begin
  3950.    ScanForToken(commandLine, commandLen, token, commandType);
  3951.  
  3952.    if token in [oSEND, oRECEIVE, oDEBUGGING,  oDELAY,
  3953.       oQUESTIONM, oALL, oFILERECORD, oPARITY, oSPEED,
  3954.       oTRANSMODE, oEIGHTQUOTE] then
  3955.       case token of
  3956.          oSEND    :
  3957.                     begin
  3958.                        ScanForToken(commandLine, commandLen, token, oSENDTYPE);
  3959.              { This next line checks if token is oPACKETLENGTH, oPADDING,
  3960.                oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
  3961.                        if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) then
  3962.                           case token of
  3963.                              oPACKETLENGTH :
  3964.                                              begin
  3965.                                               ScanForValue(commandLine, commandLen, value,
  3966.                                                            SDECIMAL, commandType);
  3967.                                               TestAndSetValue(value, SizeSend, token,
  3968.                                                               commandType);
  3969.                                              end;
  3970.                              oPADDING :
  3971.                                         begin
  3972.                                          ScanForValue(commandLine, commandLen, value,
  3973.                                                       DECIMAL, commandType);
  3974.                                          TestAndSetValue(value, Pad, token, commandType);
  3975.                                         end;
  3976.                              oPADCHAR :
  3977.                                         begin
  3978.                                          ScanForValue(commandLine, commandLen, value,
  3979.                                                       OCTAL, commandType);
  3980.                                          TestAndSetValue(value, PadChar, token,
  3981.                                                          commandType);
  3982.                                         end;
  3983.                              oTIMEOUT :
  3984.                                         begin
  3985.                                          ScanForValue(commandLine, commandLen, value,
  3986.                                                       DECIMAL, commandType);
  3987.                                          TestAndSetValue(value, TheirTimeOut, token,
  3988.                                                          commandType);
  3989.                                         end;
  3990.                              oENDOFLINE :
  3991.                                           begin
  3992.                                            ScanForValue(commandLine, commandLen, value,
  3993.                                                         OCTAL, commandType);
  3994.                                            TestAndSetValue(value, SendEol, token,
  3995.                                                            commandType);
  3996.                                           end;
  3997.                              oQUOTE :
  3998.                                       begin
  3999.                                        ScanForValue(commandLine, commandLen, value,
  4000.                                                     CHRACTER, commandType);
  4001.                                        TestAndSetValue(value, SendQuote, token,
  4002.                                                        commandType);
  4003.                                       end;
  4004.                              oQUESTIONM :
  4005.                                           if (commandType = oSETTYPE) then
  4006.                                            PrintSetSendReceiveHelp
  4007.                                           else
  4008.                                            PrintShowSendReceiveHelp;
  4009.                           end { inner case token of }
  4010.                        else
  4011.                           if (commandType = oSETTYPE) then
  4012.                              PrintMessage(INVALIDSETCOMMAND)
  4013.                        else
  4014.                           PrintMessage(INVALIDSHOWCOMMAND);
  4015.                     end; {of oSEND case}
  4016.  
  4017.          oRECEIVE :
  4018.                     begin
  4019.                        ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
  4020.              { This next line checks if token is oPACKETLENGTH, oPADDING,
  4021.                oPADCHAR, oTIMEOUT, oENDOFLINE, oQUOTE, or oQUESTIONM. }
  4022.                        if ((token>=oPACKETLENGTH) and (token<=oQUESTIONM)) then
  4023.                           case token of
  4024.                              oPACKETLENGTH :
  4025.                                              begin
  4026.                                               ScanForValue(commandLine, commandLen, value,
  4027.                                                            SDECIMAL, commandType);
  4028.                                               TestAndSetValue(value, SizeRecv, token,
  4029.                                                               commandType);
  4030.                                              end;
  4031.                              oPADDING :
  4032.                                         begin
  4033.                                          ScanForValue(commandLine, commandLen, value,
  4034.                                                       DECIMAL, commandType);
  4035.                                          TestAndSetValue(value, MyPad, token, commandType);
  4036.                                         end;
  4037.                              oPADCHAR :
  4038.                                         begin
  4039.                                          ScanForValue(commandLine, commandLen, value,
  4040.                                                       OCTAL, commandType);
  4041.                                          TestAndSetValue(value, MyPadChar, token,
  4042.                                                          commandType);
  4043.                                         end;
  4044.                              oTIMEOUT :
  4045.                                         begin
  4046.                                          ScanForValue(commandLine, commandLen, value,
  4047.                                                       DECIMAL, commandType);
  4048.                                          TestAndSetValue(value, MyTimeOut, token,
  4049.                                                          commandType);
  4050.                                         end;
  4051.                              oENDOFLINE :
  4052.                                           begin
  4053.                                            ScanForValue(commandLine, commandLen, value,
  4054.                                                         OCTAL, commandType);
  4055.                                            TestAndSetValue(value, MyEol, token,
  4056.                                                            commandType);
  4057.                                           end;
  4058.                              oQUOTE :
  4059.                                       begin
  4060.                                        ScanForValue(commandLine, commandLen, value,
  4061.                                                     CHRACTER, commandType);
  4062.                                        TestAndSetValue(value, MyQuote, token,
  4063.                                                        commandType);
  4064.                                       end;
  4065.                              oQUESTIONM :
  4066.                                           if (commandType = oSETTYPE) then
  4067.                                            PrintSetSendReceiveHelp
  4068.                                           else
  4069.                                            PrintShowSendReceiveHelp;
  4070.                           end { of inner case token of }
  4071.                        else
  4072.                           if (commandType = oSETTYPE) then
  4073.                              PrintMessage(INVALIDSETCOMMAND)
  4074.                        else
  4075.                           PrintMessage(INVALIDSHOWCOMMAND);
  4076.                     end; {of oRECEIVE case}
  4077.  
  4078.          oTRANSMODE :
  4079.                       begin
  4080.                          ScanForToken(commandLine, commandLen, value, oTRANSTYPE);
  4081.                          TestAndSetValue(value, transtype, token, commandType);
  4082.                       end;
  4083.          oEIGHTQUOTE :
  4084.                        begin
  4085.                           ScanForValue(commandLine, commandLen, value,
  4086.                                        EBCHRACTER, commandType);
  4087.                           TestAndSetValue(value, EBQChar, token, commandType);
  4088.                        end;
  4089.          oDEBUGGING :
  4090.                       begin
  4091.                          ScanForToken(commandLine, commandLen, value, oDEBUGTYPE);
  4092.                          TestAndSetValue(value, debugging, token, commandType);
  4093.                       end;
  4094.          oFILERECORD :
  4095.                        begin
  4096.                           ScanForToken(commandLine, commandLen, value, oFILERECTYPE);
  4097.                           TestAndSetValue(value, fileEOL, token, commandType);
  4098.                        end;
  4099.          oPARITY :
  4100.                    begin
  4101.                       ScanForToken(commandLine, commandLen, value, oPARITYTYPE);
  4102.                       TestAndSetValue(value, parity, token, commandType);
  4103.                    end;
  4104.          oSPEED :
  4105.                   begin
  4106.                      ScanForValue(commandLine, commandLen, value,
  4107.                                   IDECIMAL, commandType);
  4108.                      TestAndSetValue(value, lSpeed, token, commandType);
  4109.                   end;
  4110.          oDELAY :
  4111.                   begin
  4112.                      ScanForValue(commandLine, commandLen, value,
  4113.                                   DECIMAL, commandType);
  4114.                      TestAndSetValue(value, delay, token, commandType);
  4115.                   end;
  4116.          oQUESTIONM :
  4117.                       if (commandType = oSETTYPE) then
  4118.                          PrintSetHelp
  4119.                       else
  4120.                          PrintShowHelp;
  4121.          oALL :
  4122.                 if (commandType = oSHOWTYPE) then
  4123.                    PrintAllParameters
  4124.                 else
  4125.                    PrintMessage(INVALIDSETCOMMAND);
  4126.       end { of outer case token of }
  4127.    else
  4128.       if (commandType = oSETTYPE) then
  4129.          PrintMessage(INVALIDSETCOMMAND)
  4130.    else
  4131.       PrintMessage(INVALIDSHOWCOMMAND);
  4132. end;
  4133.  
  4134.  
  4135. {  Routine to Parse the incoming line for a valid command. }
  4136.  
  4137. procedure ParseInput(var commandLine : string80;
  4138.                      var commandLen : integer;
  4139.                      var runType : command);
  4140.  
  4141.  
  4142. var
  4143.     token : integer;
  4144.  
  4145. begin
  4146.    ScanForToken(commandLine, commandLen, token, oMAINTYPE);
  4147.  
  4148.    if token in [oSET, oSHOW, oSTATUS,  oHELP, oEXIT,
  4149.       oQUIT, oSEND, oRECEIVE, oQUESTIONM, oIBEX] then
  4150.       case token of
  4151.          oSET       : ParseSetShowCommand(commandLine, commandLen, oSETTYPE);
  4152.          oSHOW      : ParseSetShowCommand(commandLine, commandLen, oSHOWTYPE);
  4153.          oSEND,
  4154.          oRECEIVE  :
  4155.                      begin
  4156.                         ParseSendReceiveCommand(commandLine, commandLen,
  4157.                                                 fileSpec, token);
  4158.                         if ((token = oSEND) and (sFileSpec = oON)) then
  4159.                            runType := Transmit
  4160.                         else
  4161.                            if (token = oRECEIVE) then
  4162.                               runType := Receive;
  4163.                      end;
  4164.          oSTATUS    : PrintStatus;
  4165.          oIBEX       : ExecShell(commandLine, commandLen);
  4166.          oHELP      : PrintHelpCP6(commandLine, commandLen);
  4167.          oQUESTIONM : HelpMessage(29);
  4168.          oEXIT,
  4169.          oQUIT     : exitProgram := true;
  4170.       end { of case token of }
  4171.    else
  4172.       PrintMessage(INVALIDCOMMAND);
  4173. end;
  4174.  
  4175.  
  4176. {  Routine to print command line prompt and get user input }
  4177.  
  4178. function CommandPrompt(var commandLine : string80;
  4179.                        var commandLen : integer) : boolean;
  4180.  
  4181.  
  4182. var
  4183.     noInput : boolean;
  4184.     j : integer;
  4185.  
  4186. begin
  4187.    noInput := true;
  4188.  
  4189.    write(KERMITPROMPT);
  4190.    while ((noInput) and (not eof)) do
  4191.       begin
  4192.          j := 1;
  4193.          while (( not eoln ) and ( j<=LARGESIZE )) do
  4194.             begin
  4195.                read (commandline[j] );
  4196.                j := j+1
  4197.             end;
  4198.          readln;
  4199.          commandLen := j-1;
  4200.  
  4201.          if (commandLen > 0) then
  4202.             begin
  4203.                noInput := false;
  4204.                StrUpcase(commandLine, commandLen);
  4205.                SkipBlanks(commandLine, commandLen);
  4206.             end
  4207.          else
  4208.             write(KERMITPROMPT);
  4209.       end;
  4210.  
  4211.    CommandPrompt := not(noInput);
  4212. end;
  4213.  
  4214.  
  4215. procedure PromptAndParseUser(var exitProgram : boolean;
  4216.                              var RunType : command);
  4217.  
  4218.  
  4219. begin
  4220.  
  4221.    while ( not(exitProgram) and
  4222.          not((RunType = Receive) or
  4223.          (RunType = Transmit) or
  4224.          (RunType = Connect)) ) do
  4225.       begin
  4226.          if CommandPrompt(commandLine, commandLen) then
  4227.             ParseInput(commandLine, commandLen, RunType)
  4228.          else
  4229.             exitProgram := true;
  4230.       end;
  4231.  
  4232.        {  Set parms that could not be set normally }
  4233.    if (debugging = oOFF) then
  4234.       debug := false
  4235.    else
  4236.       debug := true;
  4237.  
  4238.    if (fileEol = oLF) then
  4239.       EOLFORFILE := LineFeed
  4240.    else
  4241.       if (fileEol = oCRLF) then
  4242.          EOLFORFILE := CrLf
  4243.    else
  4244.       EOLFORFILE := JustCr;
  4245.  
  4246.    if (transtype = oASCII) then
  4247.       begin
  4248.          EBQstate := Ascii;
  4249.       end
  4250.    else
  4251.       begin
  4252.          EBQstate := Binary;
  4253.       end;
  4254.    if parity <> DEFPARITY then
  4255.       begin
  4256.          DEFPARITY := parity ;
  4257.          case parity of
  4258.             oNONE: set_parity (0) ;
  4259.             oODD : set_parity (1) ;
  4260.             oEVEN: set_parity (2) ;
  4261.          end {case}
  4262.       end ;
  4263. end;
  4264. begin
  4265.  
  4266.  
  4267.    KermitInit ;
  4268.  
  4269.    9999: { Goto for an error packet }
  4270.  
  4271.          RunType := Invalid;
  4272.    exitProgram := false;
  4273.  
  4274.    while not(exitProgram) do
  4275.       begin
  4276.  
  4277.          PromptAndParseUser(exitProgram, RunType);
  4278.  
  4279.          if not(exitProgram) then
  4280.             begin
  4281.                ResetKermitPacketNumber;
  4282.                case RunType of
  4283.                   Receive,
  4284.                   Transmit : KermitMain ;
  4285.                   Invalid,
  4286.                   Connect : {do nothing}
  4287.                end;
  4288.             end;
  4289.          RunType := Invalid;
  4290.       end;
  4291.  
  4292.    set_profile (1, linespeed, width, parity) ; {reset}
  4293.  
  4294.  
  4295. end.
  4296. !EOD
  4297. !PL6 ME OVER PL6_OBJ (LS)
  4298. SET_PROMPT: PROC ;
  4299. %INCLUDE CP_6;
  4300. %FPT_PROMPT (FPTN = PROMPT, PROMPT = NONE, VFC = YES) ;
  4301. DCL NONE CHAR(1) CONSTANT INIT ('@') ;
  4302. CALL M$PROMPT (PROMPT) ;
  4303. RETURN ;
  4304. END SET_PROMPT ;
  4305. %EOD ;
  4306. SET_PROFILE: PROC (MODE, SPEED, WIDTH, PARITY) ;
  4307. %INCLUDE CP_6 ;
  4308. %FPT_TRMATTR (FPTN = ATTRIBUTES, TRMATTR = VLP_TRMATTR) ;
  4309. %VLP_TRMATTR ;
  4310. %FPT_PLATEN (FPTN = PLATEN, PLATEN = VLP_PLATEN) ;
  4311. %VLP_PLATEN (WIDTH=100) ;
  4312. %F$DCB ;
  4313. DCL MODE UBIN WORD ;
  4314. DCL SPEED UBIN WORD ;
  4315. DCL WIDTH UBIN WORD ;
  4316. DCL PARITY UBIN WORD ;
  4317. IF MODE = 0 THEN
  4318.     DO ;
  4319.     CALL M$GTRMATTR (ATTRIBUTES) ;
  4320.     SPEED = VLP_TRMATTR.SPEED# ;
  4321.     WIDTH = VLP_TRMATTR.WIDTH# ;
  4322.     PARITY = VLP_TRMATTR.PARITY# ;
  4323.     VLP_TRMATTR.WIDTH# = 100 ;
  4324.     CALL M$STRMATTR (ATTRIBUTES) ;
  4325.     VLP_TRMATTR.WIDTH# = WIDTH ;
  4326.     WIDTH = DCBADDR (DCBNUM (M$UC)) -> F$DCB.WIDTH# ;
  4327.     CALL M$PLATEN (PLATEN) ;
  4328.     VLP_PLATEN.WIDTH# = WIDTH ;
  4329.     END ;
  4330. ELSE
  4331.     DO ;
  4332.     CALL M$STRMATTR (ATTRIBUTES) ;
  4333.     CALL M$PLATEN (PLATEN) ;
  4334.     END ;
  4335. RETURN ;
  4336. END ;
  4337. %EOD ;
  4338. GETLINEINPUT: PROC(INCOMING,LENGTH,BEPATIENT,RESULT);
  4339. %INCLUDE CP_6;
  4340. %FPT_READ    (FPTN                     = READ_COMM_LINE,
  4341.               DCB=F$LINE,
  4342.               TRANS=YES );
  4343. %FPT_TRMCTL  (FPTN                     = SET_TERM,
  4344.               TRMCTL=TERM);
  4345. %VLP_TRMCTL  (FPTN                     = TERM,
  4346.               ACTONTRN=YES);
  4347. %FPT_TRMPRG  (FPTN=TYPEAHEAD,DCB=M$UC,PURGEINPUT=YES);
  4348. %FPT_EOM     (FPTN                     = TIMEOUT,
  4349.               EOMTABLE=VLP_EOMTABLE,
  4350.               TIMEOUT=0,
  4351.               UTYPE=SEC );
  4352. %VLP_EOMTABLE(FPTN                     = VLP_EOMTABLE,
  4353.               VALUES=STD);
  4354. DCL F$LINE DCB ;
  4355. DCL INCOMING CHAR(LENGTH);
  4356. DCL LENGTH UBIN WORD;
  4357. DCL BEPATIENT UBIN WORD;
  4358. DCL RESULT SBIN WORD ALIGNED;
  4359.  
  4360.     TIMEOUT.V.TIMEOUT# = BEPATIENT ;
  4361.     CALL M$EOM( TIMEOUT );
  4362.     READ_COMM_LINE.BUF_ = VECTOR (INCOMING);
  4363.     RESULT = 1;
  4364.     CALL M$STRMCTL (SET_TERM);
  4365. /*  CALL M$TRMPRG (TYPEAHEAD); */
  4366.     CALL M$READ( READ_COMM_LINE )  ALTRET( TIMED_OUT );
  4367.     RESULT = 0;
  4368.  
  4369. TIMED_OUT:
  4370.     TIMEOUT.V.TIMEOUT# = 0;
  4371.     CALL M$EOM( TIMEOUT );
  4372.     RETURN;
  4373.  
  4374. END GETLINEINPUT;
  4375. %EOD ;
  4376. TAKE_NAP: PROC (TIME) ;
  4377. %INCLUDE CP_6;
  4378. %FPT_WAIT (FPTN = WAIT, UNITS = 25);
  4379. DCL TIME UBIN WORD ;
  4380. WAIT.V.UNITS# = TIME ;
  4381. CALL M$WAIT (WAIT) ;
  4382. RETURN ;
  4383. END TAKE_NAP ;
  4384. %EOD ;
  4385. SET_PARITY: PROC (MODE) ;
  4386. %INCLUDE CP_6 ;
  4387. %FPT_TRMATTR (FPTN = PARITY, TRMATTR = VLP_TRMATTR) ;
  4388. %VLP_TRMATTR ;
  4389. DCL MODE UBIN WORD ;
  4390. VLP_TRMATTR.PARITY# = MODE ;
  4391. CALL M$STRMATTR (PARITY) ;
  4392. RETURN ;
  4393. END ;
  4394. !EOD
  4395. !LINK KERMIT_OBJ, PL6_OBJ OVER KERMIT_RU
  4396.