home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / hp9826 / hp9ker.pas next >
Pascal/Delphi Source File  |  2020-01-01  |  146KB  |  4,995 lines
  1. {--file KERVERS--}
  2. const VERSION_STRING = 'HP98xx Kermit version 1.0     20-Jan-84';
  3.  
  4. {--file KERMMAIN--}
  5.  
  6. $UCSD ON$
  7. $SYSPROG$
  8. $SEARCH '*IO.', '*INTERFACE.',
  9.         'KRMIO', 'KRMGUTS', 'KRMCMD', 'KRMWNDW',
  10.         'KRMRPT', 'KRMIO'$
  11.  
  12. {
  13.  
  14. This file, KRMMAIN.TEXT, contains the Kermit main program block.  It
  15. calls the appropriate procedures in the proper order to read a command
  16. line, parse it, and execute the command.
  17.  
  18. }
  19. PROGRAM KERMIT (input, output, keyboard);
  20.  
  21. import  terminal,               { for the SerialFlush error recovery }
  22.         krmguts,
  23.         command,
  24.         err_codes,
  25.         krmrpt,
  26.         iodeclarations,
  27.         general_3;
  28.         
  29. const
  30.  
  31. { Command keyword values.  Each defined command has an associated value that
  32.   is returned by parse when its keyword is parsed.
  33. }
  34. cmd_connect = 1;
  35. cmd_exit = 2;
  36. cmd_login = 3;
  37. cmd_receive = 4;
  38. cmd_send = 5;
  39. cmd_set = 6;
  40. cmd_show = 7;
  41. cmd_tn = 8;
  42.   
  43. set_debug = 1;                  { options of the set command }
  44. set_half = 2;
  45. set_log = 3;
  46. set_verb = 4;
  47.  
  48. var
  49.   ck : keyword_table_ptr;       { pointer to command keyword table }
  50.   setk : keyword_table_ptr;     { pointer to set option keyword table }
  51.   prompt, word, report, state_msg : text_string;
  52.   rpos : integer;               { position within report }
  53.   ior : integer;
  54.   deflogfile, logfile : text_string;
  55.  
  56. procedure initcmd;
  57.   begin
  58.   init_cmd_windows;
  59.   prompt := 'HP-Kermit>';
  60.   
  61.   new(ck);                   { Build the command keyword table }
  62.   ck^[1].ks := 'CONNECT';
  63.   ck^[1].kv := cmd_connect;
  64.   ck^[2].ks := 'EXIT';
  65.   ck^[2].kv := cmd_exit;
  66.   ck^[3].ks := 'LOGIN';
  67.   ck^[3].kv := cmd_login;
  68.   ck^[4].ks := 'RECEIVE';
  69.   ck^[4].kv := cmd_receive;
  70.   ck^[5].ks := 'SEND';
  71.   ck^[5].kv := cmd_send;
  72.   ck^[6].ks := 'SET';
  73.   ck^[6].kv := cmd_set;
  74.   ck^[7].ks := 'SHOW';
  75.   ck^[7].kv := cmd_show;
  76.   ck^[8].ks := 'TN';
  77.   ck^[8].kv := cmd_tn;
  78.   ck^[9].ks := '';           { table terminated by null string }
  79.   ck^[9].kv := 0;
  80.   
  81.   new(setk);                    { set up keyword table for SET options }
  82.   setk^[1].ks := 'DEBUG';
  83.   setk^[1].kv := set_debug;
  84.   setk^[2].ks := 'HALFDUPLEX';
  85.   setk^[2].kv := set_half;
  86.   setk^[3].ks := 'LOGFILE';
  87.   setk^[3].kv := set_log;
  88.   setk^[4].ks := 'VERBOSITY';
  89.   setk^[4].kv := set_verb;
  90.   setk^[5].ks := '';
  91.   setk^[5].kv := 0;
  92.   
  93.   end;  { procedure initcmd }
  94.  
  95. {
  96.  
  97. proc_command    Process command line.
  98.  
  99. Reads a command line and searches the keyword table pointed to by ck.
  100. Decodes the keyword, and reads the proper arguments, and branches to
  101. the associated action routine.  Returns true if the command indicated
  102. that the program should exit (eg, EXIT command).
  103. }
  104. function proc_command : boolean;
  105.   label 1000;
  106.   var done : boolean;
  107.       files : filename_list;
  108.       setflag : integer;
  109.       username, password, account : string [80];
  110.   begin
  111.   done := false;
  112.   parse_init(prompt);
  113.   parse_keyword_table := ck;       { use command keyword table }
  114.   parse(p_keyword, required);
  115.   state_msg := 'parsing command keyword'; 
  116.   if check_error( parse_result, state_msg )
  117.      then goto 1000;
  118.   
  119.   setstrlen(report,0);
  120.   case arg_integer of
  121.     cmd_connect, cmd_tn :
  122.            begin
  123.            TN;                          { connect to the host }
  124.            end;  { tn }
  125.     cmd_exit    :       done := true;
  126.     cmd_login   :       begin
  127.            parse(p_text, required);
  128.            if check_error( parse_result, parse_result_str)
  129.               then goto 1000;
  130.            username := arg_text;
  131.            parse(p_password, required);
  132.            if check_error( parse_result, parse_result_str)
  133.               then goto 1000;
  134.            password := arg_text;
  135.            parse(p_text, optional);
  136.            if check_error( parse_result, parse_result_str)
  137.               then goto 1000;
  138.            account := arg_text;
  139.            end;  { login }
  140.     cmd_receive :       begin
  141.            parse(p_text, required);
  142.            if check_error( parse_result, parse_result_str)
  143.               then goto 1000;
  144.            parse(p_eol, optional);
  145.            files[1] := arg_text;        { get file name to receive }
  146.            setstrlen(files[2],0);
  147.            state_msg := 'Receiving file';
  148.            RecvSwitch( files );         { receive the file }
  149.            if odd(kermit_error)
  150.              then report_error(file_rcvd_ok,state_msg)
  151.              else begin
  152.                report_error(kermit_error,state_msg);
  153.                goto 1000;
  154.                end;
  155.            end;  { receive }
  156.     cmd_send    :       begin
  157.            parse( p_text, required );
  158.            if check_error( parse_result, parse_result_str)
  159.               then goto 1000;
  160.            parse(p_eol, required);
  161.            files[1] := arg_text;        { get file name to send }
  162.            setstrlen(files[2],0);
  163.            state_msg := 'Sending file';
  164.            SendSwitch( files );         { send the file }
  165.            if odd(kermit_error)
  166.              then report_error(file_sent_ok,state_msg)
  167.              else begin
  168.                report_error(kermit_error,state_msg);
  169.                goto 1000;
  170.                end;
  171.            end;  { send }
  172.     cmd_set     :     begin
  173.            parse_keyword_table := setk;
  174.            parse( p_keyword, required );
  175.            if check_error(parse_result, parse_result_str)
  176.               then goto 1000;
  177.            setflag := arg_integer;
  178.            if setflag in [set_debug, set_half, set_verb]
  179.               then begin
  180.                 parse(p_boolean, required);
  181.                 if check_error(parse_result, parse_result_str)
  182.                    then goto 1000;
  183.               end;
  184.            if setflag = set_log
  185.               then begin  { read log file name }
  186.                 arg_text := '';
  187.                 parse(p_text, optional);
  188.                 if check_error(parse_result, parse_result_str)
  189.                    then goto 1000;
  190.               end;  { read log file name }
  191.            parse(p_eol, required);
  192.            case setflag of
  193.               set_debug :  debug := arg_boolean;
  194.               set_half  :  {halfduplex := arg_boolean};
  195.               set_log   :  set_logfile(arg_text);
  196.               set_verb  :  verbosity := arg_boolean;
  197.               end;  { case }
  198.     
  199.            end;  { set }
  200.     cmd_show  :  begin
  201.            parse(p_eol,required);
  202.            clear_status_window;
  203.            setstrlen(report,0);
  204.            strwrite(report,1,rpos,'Verbosity    ',verbosity);
  205.            report_status(report);
  206.            setstrlen(report,0);
  207.            strwrite(report,1,rpos,'Debug        ',debug);
  208.            report_status(report);
  209.            setstrlen(report,0);
  210.            get_logfile(logfile);
  211.            strwrite(report,1,rpos,'Log file     ',logfile);
  212.            report_status(report);
  213.            end;  { show }
  214.     end;  { case }
  215. 1000:
  216.   proc_command := done;
  217.   end;  { procedure proc_command }
  218.  
  219. { Main Program }
  220.  BEGIN
  221.  try
  222.    SYSInit;                     { do system dependent initialization }
  223.    ParmInit;                    { initialize parameters to defaults }
  224.    OneWayOnly := false;
  225.    Verbosity := FALSE;          { default to false / only valid if local }
  226.    Debug := FALSE;
  227.    Local := TRUE;
  228.    deflogfile := '';
  229.    set_logfile( deflogfile );
  230.    
  231.    initcmd;                     { initialize command processor }
  232.    report_version;
  233.    
  234. repeat
  235.    KermitInit;                  { initialize protocol machine and }
  236.                                 { default options}
  237.     
  238. until proc_command;             { parse command and dispatch to
  239.                                   proper command action routine }
  240.  
  241. SYSFinish;                      { do system dependent cleanup }
  242.  
  243. recover
  244.    begin
  245.    writeln;
  246.    if escapecode = ioescapecode
  247.       then begin                { I/O library error occurred }
  248.            writeln(ioerror_message(ioe_result));
  249.            if ioe_result = 5    { if buffer overflowed }
  250.               then begin
  251.                    writeln;
  252.                    write(' Serial input buffer overflow :  size = ');
  253.                    writeln( SerialData );
  254.                    writeln('Flushing input buffer');
  255.                    SerialFlush;
  256.                    end
  257.               else escape(ioescapecode);
  258.            end         { I/O library error occurred }
  259.                  
  260.       else begin                { not I/O library error }
  261.          if escapecode = -10
  262.             then begin
  263.               ior := ioresult;
  264.               writeln('I/O error #',ior:4);
  265.               end
  266.             else escape(escapecode);
  267.          end;  { not I/O library error }
  268.    end;   { recover }
  269.  
  270. END.    { Program KERMIT }
  271.  
  272. {--file KRMGUTS--}
  273. $Debug off$
  274. $UCSD ON$
  275. $SYSPROG$
  276. $SEARCH  '*INTERFACE.', '*IO.',
  277.          'KRMIO', 'KRMWNDW', 'KRMRPT'$
  278. $PAGE$
  279. {
  280. Module KRMGUTS contains the heart of Kermit - the procedures,
  281. variables, etc., that actually implement the Kermit protocol.
  282. }
  283. module  krmguts;
  284.  
  285. import  ascii_defs,
  286.         byte_str,
  287.         byte_io,
  288.         err_codes,
  289.         krmrpt,
  290.         terminal,
  291.         iodeclarations,
  292.         general_1,
  293.         general_3;
  294.  
  295. export
  296.   const
  297.     MAXFILES = 10;                { maximum number of files that can be sent }
  298.   type
  299.     filename_list = array[1..MAXFILES] of filename;
  300.   var
  301.     
  302.     RunType : Transfer_type;  { type of transfer currently in effect }
  303.     
  304.     Kermit_error : integer;   { Error and status conditions left here }
  305.     Kermit_error_string : string [80];
  306.  
  307.     { operational parameters }
  308.   
  309.     Local : boolean;          { local/remote flag }
  310.     OneWayOnly : boolean;     { used for testing }
  311.     Verbosity: boolean;       { true to print verbose messages }
  312.     Debug : boolean;          { true to print really verbose debugging msgs }
  313.  
  314.   PROCEDURE KermitInit;       { initialize various parameters & defaults }
  315.   PROCEDURE SYSInit;          { system dependent initialization }
  316.   PROCEDURE SYSFinish;        { system dependent cleanup }
  317.   PROCEDURE ParmInit;         { initialize operating parameters }
  318.  
  319.   { Command entry points }
  320.   
  321.   procedure RecvSwitch( files : filename_list );     { Receive file group
  322.                                                        entry point }
  323.   procedure SendSwitch( files : filename_list );     { Send file group
  324.                                                        entry point }
  325.   procedure TN;                 { invokes terminal emulator }
  326.   
  327. implement
  328.  
  329. CONST
  330.  
  331. {-%- System Dependent -%-}
  332.   
  333.   DEFPARMFILE   =    'KERMIT.PRM';
  334.   TEMPFILE      =    'TEMP.K';
  335.  
  336.   abort_file_key = #X;        { ^X aborts single file send }
  337.   abort_group_key = #Z;       { ^Z aborts file group send }
  338.  
  339.   
  340. { Default transmission parameter definitions.  These are assigned to }
  341. { the transmission parameter variables by ParmInit when Kermit is }
  342. { first started. }
  343.  
  344.   DEFTRY       = 10;      { default for number of retries }
  345.   DEFTIMEOUT   = 12;      { default time out }
  346.   MAXPACK      = 94;      { max is 94 ~ - ' ' }
  347.   DEFDELAY     = 5;       { delay before sending first init for send }
  348.   NUMPARAM     = 6;       { number of parameters in init packet }
  349.   DEFMARK      = SOH;     { packet start mark }
  350.   DEFQUOTE     = SHARP;   { default quote character  }
  351.   DEFPAD       = 0;       { default number of padding chars  }
  352.   DEFPADCHAR   = 0;       { default padding character  }
  353.   DEFEOL       = CR;      { default end of line sequence }
  354.   DEFEOLTYPE   = 2;       { 1 = LineFeed
  355.                             2 = CrLf
  356.                             3 = Just Cr }
  357.  
  358.  
  359.   NUMBUFFERS = 5;         { Number of buffers }
  360.  
  361.   { packet types }
  362.  
  363.   TYPEB  = 66; { ord('B')  break packet }
  364.   TYPEC  = 67; { ord('C')  Host command packet }
  365.   TYPED  = 68; { ord('D')  data packet }
  366.   TYPEE  = 69; { ord('E')  error packet }
  367.   TYPEF  = 70; { ord('F')  file header packet }
  368.   TYPEG  = 71; { ord('G')  generic kermit command packet }
  369.   TYPEN  = 78; { ord('N')  NAK packet }
  370.   TYPER  = 82; { ord('R')  Receive init packet }
  371.   TYPES  = 83; { ord('S')  send init packet }
  372.   TYPET  = 84; { ord('T')  ? }
  373.   TYPEX  = 88; { ord('X')  Text packet }
  374.   TYPEY  = 89; { ord('Y')  ACK packet }
  375.   TYPEZ  = 90; { ord('Z')  EOF packet }
  376.  
  377.  
  378. $PAGE$
  379. TYPE
  380.  
  381.   { Data Types for Kermit }
  382.  
  383.   Packet = RECORD
  384.              mark : byte;                  { SOH character }
  385.              count: byte;                  { # of bytes following this field }
  386.              seq  : byte;                  { sequence number modulo 64  }
  387.              ptype: byte;                  { d,y,n,s,b,f,z,e,t  packet type }
  388.              data : ByteString;            { the actual data }
  389.              { chksum is last valid char in data array }
  390.              { eol is added, not considered part of packet proper }
  391.            END;
  392.  
  393.  
  394.   EOLtype = (LineFeed,CrLf,JustCr);
  395.  
  396.   Ppack = 1..NUMBUFFERS;
  397.  
  398.   CType = RECORD
  399.             check : integer;      { checksum summation counter }
  400.             PacketPtr : integer;  { points to next "raw" byte in data field }
  401.             i : integer;          { points to next cooked byte in data field }
  402.             fld : integer;        { packet field counter }
  403.             t : byte;             { raw byte received from remote }
  404.             finished : boolean;   { true if packet completely received }
  405.             restart : boolean;
  406.             good : boolean;
  407.           END;
  408.  
  409. $PAGE$
  410. VAR
  411.  
  412.   keyboard : text;                 { non-echoing standard input file }
  413.   
  414.   ior : integer;                   { error recovery routine saves ioresult }
  415.                                    { here }
  416.   breakchar : byte;                { break character for TN mode }
  417.   ch : char;                       { scratch character }
  418.   report : string[120];            { status report string }
  419.   rpos : integer;                  { status report string position }
  420.  
  421.   { Variables for Kermit }
  422.   
  423.   ParmFile : filename;      { parameter file name }
  424.   DiskFile : filedesc;      { file being sent or received }
  425.   EOLforFile : EOLtype;     { EOL sequence used for Kermit data }
  426.   State    : kermitstates;  { current state of the automaton }
  427.   SaveState : kermitstates; { holds old state for retries }
  428.   n,J      : integer;       { packet sequence number }
  429.  
  430.   MaxTry   : integer;       { maximum number of retries allowed }
  431.   NumTry   : integer;       { times this packet retried }
  432.   OldTry   : integer;       { times last packet retried }
  433.  
  434. { packet transmission parameters }
  435.  
  436.   LocalMark     : integer;       { packet start mark }
  437.   RemoteMark    : integer;
  438.   LocalPad      : integer;       { number of padding characters I need }
  439.   RemotePad     : integer;       { number of padding chars to send }
  440.   LocalPadChar  : byte;          { padding character I need }
  441.   RemotePadChar : byte;          { padding character to use }
  442.   LocalTimeOut  :  integer;      { our timeout interval in seconds }
  443.   RemoteTimeOut : integer;       { their timeout interval in seconds }
  444.   LocalDelay    : integer;       { delay before sending first init }
  445.   LocalEOL,LocalQuote : byte;    { parms. for us }
  446.   RemoteEOL, RemoteQuote : byte; { parms. the remote wants }
  447.   SizeRecv, SizeSend : integer;  { buffer sizes for receive and send }
  448.  
  449. { statistics variables }
  450.  
  451.   stats : kermit_statistics;
  452.   
  453. { Packet buffers.  These are used to hold packets being built as }
  454. { received, or assembled for transmission. }
  455.  
  456.   Buf : ARRAY [1..NUMBUFFERS] OF packet;
  457.   ThisPacket : Ppack;           { current packet being sent }
  458.   LastPacket : Ppack;           { last packet sent }
  459.   CurrentPacket : Ppack;        { current packet received }
  460.   NextPacket : Ppack;           { next packet being received }
  461.   DebugPacket : Ppack;          { save input to do debug }
  462.  
  463.   TOPacket : packet;            { Time_Out Packet }
  464.   TimeLeft : integer;           { until Time_Out }
  465.  
  466.   PackControl : CType;          { variables for receive packet routine }
  467.  
  468.  
  469. $PAGE$
  470. PROCEDURE Verbose ( c : cstring );
  471. {
  472.  
  473. Print string c if verbosity
  474.  
  475. Called by       Field1
  476.                 Field2
  477.                 Field3
  478.                 Field5
  479.                 SendFile
  480.                 SendEOF
  481.                 SendBreak
  482.                 SendOurInit
  483.                 GetTheirInit
  484.                 ReceiveData
  485. }
  486.   BEGIN
  487.     IF Verbosity
  488.       THEN begin
  489.         setstrlen(report,0);
  490.         strwrite(report, 1,rpos, c);
  491.         report_log( report );
  492.         end;
  493.   END;  { procedure verbosity }
  494.  
  495. $PAGE$
  496. PROCEDURE PutErr( c : cstring );
  497. {
  498.  
  499. Print error messages.
  500.  
  501. }
  502.  
  503.   BEGIN
  504.     IF Local
  505.       THEN begin
  506.         setstrlen(report,0);
  507.         strwrite(report,1,rpos,c);
  508.         report_status(report);
  509.         report_log(report);
  510.         end;
  511.   END;  { procedure PutErr }
  512.  
  513. $PAGE$
  514. PROCEDURE OverHead ( p , f : integer;   VAR o : integer );
  515. {
  516.  
  517.  Calculate OverHead as %
  518.  OverHead := (p-f)*100/f
  519.  
  520. Called by       DisplayStatistics
  521. }
  522.   BEGIN
  523.   IF f <> 0
  524.     then o := trunc((p-f)*100/f)
  525.     else o := 0;
  526.   END;
  527.  
  528. $PAGE$
  529. PROCEDURE CalRat ( f : integer;   t : integer;   VAR r : integer );
  530. {
  531.  
  532.  Calculate Effective Baud Rate
  533.  Rate = f*10/t
  534.  
  535. Called by       DisplayStatistics
  536. }
  537.    BEGIN
  538.      r := 0;
  539.    END;
  540.  
  541. $PAGE$
  542. PROCEDURE Sleep ( t : integer);            { pause for t seconds }
  543. {
  544.  
  545. Called by       SendSwitch
  546. }
  547.    BEGIN
  548.    END;
  549.  
  550. $PAGE$
  551. PROCEDURE StartTimer;
  552. {
  553.  
  554. Called by       ReceivePacket
  555. }
  556.    BEGIN
  557.      TimeLeft := RemoteTimeOut;
  558.    END;
  559.  
  560. $PAGE$
  561. PROCEDURE StopTimer;
  562. {
  563.  
  564. Called by       ReceivePacket
  565. }
  566.    BEGIN
  567.      TimeLeft := MaxInt;
  568.    END;
  569.  
  570. $PAGE$
  571. FUNCTION MakeChar ( c : byte ) : byte;
  572. {
  573.  
  574. Convert integer to printable character.
  575.  
  576. }
  577.    BEGIN
  578.      MakeChar := c+BLANK;
  579.    END;
  580.  
  581. $PAGE$
  582. FUNCTION UnChar ( c : byte ) : byte;
  583. {
  584.  
  585. Reverse of MakeChar
  586.  
  587. }
  588.    BEGIN
  589.      UnChar := c-BLANK
  590.    END;
  591.  
  592. $PAGE$
  593. FUNCTION Ctl ( c : byte ) : byte;
  594. {
  595.  
  596. Does  c XOR 100.
  597.  
  598. }
  599.    BEGIN
  600.      IF IsControl(c)
  601.        THEN  c := c+64
  602.        ELSE  c := c-64;
  603.      Ctl := c;
  604.    END;
  605.  
  606. $PAGE$
  607. FUNCTION IsValidPType ( c : byte ) : boolean;
  608. {
  609.  
  610. True if c is a valid packet type.
  611.  
  612. Called by       Field3
  613. }
  614.    BEGIN
  615.      IsValidPType := c in [TYPEB, TYPEC, TYPED, TYPEE, TYPEF, TYPEG,
  616.                            TYPEN, TYPER, TYPES, TYPET, TYPEX, TYPEY,
  617.                            TYPEZ]
  618.    END;
  619.  
  620. $PAGE$
  621. FUNCTION CheckFunction ( c : integer ) : byte;
  622. {
  623.  
  624. Calculate checksum 
  625.  
  626. Called by       SendPacket
  627.                 Field5
  628. }
  629.   VAR  x: integer;
  630.   BEGIN
  631.  
  632.   {   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; }
  633.  
  634.     x := (c MOD 256 ) DIV 64;
  635.     x := x+c;
  636.     CheckFunction := x MOD 64;
  637.   END;
  638.  
  639. $PAGE$
  640. PROCEDURE EnCodeParm ( VAR data : ByteString ); { encode parameters }
  641. {
  642.  
  643. Encodes the global parameter variables and places them into the given
  644. parameter ByteString. 
  645.  
  646. References :    SizeRecv
  647.                 LocalTimeOut
  648.                 LocalPad
  649.                 LocalPadChar
  650.                 LocalEOL
  651.                 LocalQuote
  652.  
  653. Called by       SendOurInit
  654.                 GetTheirInit
  655.                 DoInitLast
  656. }
  657.   VAR i: integer;
  658.   BEGIN
  659.     FOR i:=1 TO NUMPARAM DO
  660.        data[i] := BLANK;
  661.     data[NUMPARAM+1] := ENDSTR;
  662.     data[1] := MakeChar(SizeRecv);                { my biggest packet }
  663.     data[2] := MakeChar(LocalTimeOut);            { when I want timeout}
  664.     data[3] := MakeChar(LocalPad);                { how much padding }
  665.     data[4] := Ctl(LocalPadChar);                 { my padding character }
  666.     data[5] := MakeChar(LocalEOL);                { my EOL }
  667.     data[6] := LocalQuote;                        { my quote char }
  668.   END;
  669.  
  670. $PAGE$
  671. PROCEDURE DeCodeParm ( VAR data : ByteString ); { decode parameters }
  672. {
  673.  
  674. Accepts a parameter string, decodes the values, and places them in the
  675. global parameter variables.
  676.  
  677. Modifies :      SizeSend
  678.                 RemoteTimeOut
  679.                 RemotePad
  680.                 RemotePadChar
  681.                 RemoteEOL
  682.                 RemoteQuote
  683.  
  684. Called by       GetTheirInit
  685. }
  686.    BEGIN
  687.      SizeSend := UnChar(data[1]);
  688.      RemoteTimeOut := UnChar(data[2]);   { when I should time out }
  689.      RemotePad := UnChar(data[3]);       { padding characters to send  }
  690.      RemotePadChar := Ctl(data[4]);      { padding character }
  691.      RemoteEOL := UnChar(data[5]);       { EOL to send }
  692.      RemoteQuote := data[6];             { quote to send }
  693.    END;
  694.  
  695. $PAGE$
  696. PROCEDURE ReadParm ( VAR Parms : ByteString ; ParmFile : filename );
  697. {
  698.  
  699. Opens the parameter file, if any, and reads a single line from it into
  700. the parameter Parms.  If no parameter file exists, returns a null
  701. string (i.e., just ENDSTR in the first position).
  702.  
  703. Inputs :        ParmFile      filename of parameter file
  704.  
  705. Calls           Exists
  706.                 Sopen
  707.                 GetLine
  708.  
  709. Called by       GetParm
  710. }
  711.   VAR
  712.     dummy : boolean;
  713.     fd : filedesc;
  714.    BEGIN;
  715.      Parms[1]:=ENDSTR;
  716.      IF Exists(ParmFile) THEN
  717.         BEGIN
  718.         fd := Sopen(ParmFile,IOREAD);
  719.         dummy := GetLine(Parms,fd,MAXSTR);
  720.         Sclose(fd);
  721.         END;
  722.    END;
  723.  
  724. $PAGE$
  725. PROCEDURE GetParm( ParmFile : filename );                  { get parameters from file }
  726. {
  727.  
  728. Reads a line from the parameter file via ReadParm and sets the global
  729. parameter variables according to the values in the file.
  730.  
  731. Inputs :        ParmFile      filename of parameter file
  732.  
  733. Modifies        SizeRecv
  734.                 LocalTimeOut
  735.                 LocalPad
  736.                 LocalPadChar
  737.                 LocalEOL
  738.                 LocalQuote
  739.  
  740. Calls           ReadParm
  741.  
  742. Called by       ParmInit
  743.                 SetParameters
  744. }
  745.   VAR
  746.     data : ByteString;
  747.    BEGIN;
  748.      ReadParm(data, ParmFile);
  749.      IF (length(data) > 0)
  750.       THEN      { get parameters }
  751.        BEGIN
  752.          SizeRecv := UnChar(data[1]);
  753.          LocalTimeOut := UnChar(data[2]);     { when I should time out }
  754.          LocalPad := UnChar(data[3]);         { padding characters to send }
  755.          LocalPadChar := Ctl(data[4]);        { padding character }
  756.          LocalEOL := UnChar(data[5]);         { EOL to send }
  757.          LocalQuote := data[6];               { quote to send }
  758.        END;
  759.    END;
  760.  
  761. $PAGE$
  762. PROCEDURE ParmInit;
  763. {
  764.  
  765. Initializes transmission parameters (pad character, timeout, etc.) to
  766. their default values as defined by the default parameter constants,
  767. then reads any new values from the parameter file.  Parameter file
  768. values thus override the initial 'hardwired' defaults.
  769.  
  770. Calls           GetParm
  771.  
  772. Called by       Main Program
  773. }
  774.   BEGIN
  775.   breakchar:=CTRLY;
  776.  
  777. { Set the initial default values }
  778.  
  779.      RemotePad          := DEFPAD;
  780.      LocalPad           := DEFPAD;
  781.      RemotePadChar      := DEFPADCHAR;
  782.      LocalPadChar       := DEFPADCHAR;
  783.      LocalMark          := DEFMARK;
  784.      RemoteTimeOut      := DEFTIMEOUT;
  785.      LocalTimeOut       := DEFTIMEOUT;
  786.      LocalDelay         := DEFDELAY;
  787.      SizeRecv           := MAXPACK;
  788.      SizeSend           := MAXPACK;
  789.      RemoteEOL          := DEFEOL;
  790.      LocalEOL           := DEFEOL;
  791.      RemoteQuote        := DEFQUOTE;
  792.      LocalQuote         := DEFQUOTE;
  793.      MaxTry             := DEFTRY;
  794.      CASE DEFEOLTYPE OF
  795.        1:      EOLforFile := LineFeed;
  796.        2:      EOLforFile := CrLf;
  797.        3:      EOLforFile := JustCR;
  798.       END { case };
  799.  
  800. { Now read the new defaults from the parameter file }
  801.  
  802.      ParmFile := DEFPARMFILE;
  803.      GetParm( ParmFile );
  804.      Local := true;      { default to local }
  805.    END;
  806.  
  807. $PAGE$
  808. {-%- System Dependent -%-}
  809.  
  810. PROCEDURE SYSInit;
  811. {
  812.  
  813. Performs system dependent initialization, for example setting the mode
  814. of the console terminal.  Called once by the main program when Kermit
  815. is started. 
  816.  
  817. Called by       Main Program
  818. }
  819.    begin   { procedure SYSInit }
  820.    ioinitialize;
  821.    initio;                      { initialize the byte I/O module }
  822.    init_data_comm;
  823.    end;    { procedure SYSInit }
  824.  
  825. $PAGE$
  826. {-%- System Dependent -%-}
  827.  
  828. PROCEDURE SYSFinish;
  829. {
  830.  
  831. Performs any system dependent cleanup operations, for example
  832. resetting the mode of the console terminal to normal.  Called once
  833. by main program just before Kermit exits.
  834.  
  835. Called by       Main Program
  836. }
  837.    BEGIN
  838.    iouninitialize;
  839.    END;
  840.  
  841.  
  842. $PAGE$
  843. PROCEDURE StartRun;                    { initialization for transaction }
  844. {
  845.  
  846. Called just before a transaction is started.
  847.  
  848. Modifies        stats.RunTime
  849.  
  850. Calls           SerialFlush
  851.  
  852. Called by       SendSwitch
  853.                 RecvSwitch
  854. }
  855.    BEGIN
  856.      SerialFlush;
  857.      stats.RunTime := 0;
  858.    END;
  859.  
  860. $PAGE$
  861.  
  862. { Function DoBreakchar is the break character action routine passed to
  863.   the procedure emulator when in TN mode.  The break character command
  864.   (i.e., the character typed immediately after the break character) is
  865.   passed as the argument.  If it returns true, the emulator will exit back
  866.   to its caller.
  867. }
  868. function DoBreakchar ( c : char ) : boolean;
  869.    begin
  870.    DoBreakchar := false;
  871.    case c of
  872.       'c','C': DoBreakchar := true;
  873.       otherwise
  874.            begin
  875.            writeln('Break character commands:');
  876.            writeln('  C   Break connection');
  877.            writeln('  ?   This message');
  878.            end;
  879.       end; { case }
  880.    end;  { procedure DoBreakchar }
  881.  
  882.  
  883.  
  884.  
  885.  
  886. PROCEDURE TN;
  887. {
  888.  
  889. This procedure implements the 'terminal emulator' to connect to the
  890. host.
  891.  
  892. Calls           emulator
  893.  
  894. Called by       Main program
  895. }
  896.  
  897. BEGIN    { procedure TN }
  898.    write(#12);
  899.    writeln('Connecting to host');
  900.    emulator( chr(CTRLY), DoBreakchar );
  901.    write(#12);
  902.    END;    { procedure TN }
  903.  
  904. $PAGE$
  905. PROCEDURE SetParameters( arg : filename );
  906. {
  907.  
  908. Sets new parameter file name, loads new parameters via GetParm.
  909.  
  910. Implicit inputs :       Arg     filename of file from which to read new
  911.                                  parameters
  912. Calls           GetParm
  913.  
  914. Called by       Main Program    (invoked by load new parameters command)
  915. }
  916.   var   fnm : filename;
  917.    BEGIN
  918.      IF (strlen(Arg) > 2)
  919.       THEN
  920.        BEGIN
  921.          ParmFile := arg;               { get the new parameter file }
  922.                                         { name from the command line }
  923.                                         { into ParmFile }
  924.          GetParm( ParmFile );                       { read new parameters }
  925.        END;
  926.    END;
  927.  
  928. $PAGE$
  929. PROCEDURE KermitInit;          { initialize various parameters & defaults }
  930. {
  931.  
  932. Initializes the KERMIT protocol machine and sets the option variables
  933. to default values.
  934.  
  935. Calls     
  936.  
  937. Called by       Main program
  938. }
  939.    BEGIN
  940.      n := 0;
  941.  
  942.      stats.NumSendPacks := 0;
  943.      stats.NumRecvPacks := 0;
  944.      stats.NumACKsent := 0;
  945.      stats.NumNAKsent := 0;
  946.      stats.NumACKrecv := 0;
  947.      stats.NumNAKrecv := 0;
  948.      stats.NumBADrecv := 0;
  949.  
  950.      stats.ChInPack := 0;
  951.      stats.ChInFile := 0;
  952.  
  953.      RunType := invalid;
  954.      DiskFile := IOERROR;      { to indicate not open yet }
  955.  
  956.      ThisPacket := 1;
  957.      LastPacket := 2;
  958.      CurrentPacket := 3;
  959.      NextPacket := 4;
  960.      DebugPacket := 5;
  961.  
  962.      WITH TOPacket DO
  963.       BEGIN
  964.         count := 3;
  965.         seq := 0;
  966.         ptype := TYPEN;
  967.         data[1] := ENDSTR;
  968.       END;  { with }
  969.      
  970.    END;  { procedure KermitInit }
  971.  
  972. $PAGE$
  973. {-%- System Dependent -%-}
  974.  
  975. procedure FinishUpFile;                   { clean up the open file }
  976. {
  977.  
  978. Called by       ErrorPack
  979.                 BuildPacket
  980.                 ReceivePacket
  981. }
  982.   begin
  983.   Sclose(DiskFile);
  984.   end;  { procedure FinishUpFile }
  985.  
  986. $PAGE$
  987. PROCEDURE DisplayStatistics;
  988. {
  989.  
  990. Calls           OverHead
  991.                 CalRat
  992.  
  993. Called by       ErrorPack
  994.                 BuildPacket
  995.                 ReceivePacket
  996. }
  997.   BEGIN
  998.   IF ((RunType <> Invalid) AND Local )
  999.     THEN with stats do BEGIN
  1000.       OverHead(ChInPack,ChInFile,packet_overhead);
  1001.       CalRat(ChInFile,RunTime,effrate);
  1002.       report_packet_statistics( stats, runtype );
  1003.       END; { with }
  1004.   END;  { procedure DisplayStatistics }
  1005.  
  1006. $PAGE$
  1007. PROCEDURE DisplayPacket ( mes : cstring;   VAR p : Ppack );
  1008. {
  1009.         where mes = string to be printed preceding packet contents
  1010.                 p = index into buf of packet to be displayed
  1011.  
  1012. Print Debugging Info.  Prints the given message on the standard error
  1013. device, followed by the contents of the given packet as follows:
  1014.  
  1015.    <message>      <count> <sequence #> <type>
  1016.    <packet data>
  1017.  
  1018.  
  1019. Called by       ReSendPacket
  1020.                 SendPacket
  1021.                 BuildPacket
  1022. }
  1023.   BEGIN
  1024.     WITH Buf[p] DO BEGIN
  1025.       setstrlen(report,0);
  1026.       strwrite(report,1,rpos, mes, UnChar(count):3, UnChar(seq):3,
  1027.                chr(ptype):3);
  1028.       report_log( report );
  1029.       BtoS(data, report);
  1030.       report_log( report );
  1031.     END;  { with }
  1032.   END;  { procedure DisplayPacket }
  1033.  
  1034. $PAGE$
  1035. PROCEDURE PutOut ( p : Ppack );            { Output Packet }
  1036. {
  1037.  
  1038.         where   p = index into buf of packet to be sent
  1039.  
  1040. Outputs the given packet, preceded by RemotePad padding characters, to the
  1041. serial line.
  1042.  
  1043. Calls           Putcf
  1044.                 PutCon
  1045.                 PutStr
  1046.  
  1047. Called by       ReSendPacket
  1048.                 SendPacket
  1049. }
  1050.   VAR
  1051.     i : integer;
  1052.   BEGIN
  1053.     IF (RemotePad > 0)
  1054.       THEN FOR i := 1 TO RemotePad DO
  1055.         Putcf(RemotePadChar,LineOut);
  1056.     WITH Buf[p] DO BEGIN
  1057.       report_send_packet(UnChar(seq));  { report which packet we're sending }
  1058.       
  1059.       Putcf(mark,LineOut);
  1060.       Putcf(count,LineOut);
  1061.       Putcf(seq,LineOut);
  1062.       Putcf(ptype,LineOut);
  1063.       PutStr(data,LineOut);
  1064.      END;  { with }
  1065.   END;  { procedure PutOut }
  1066.  
  1067. $PAGE$
  1068. PROCEDURE ReSendPacket;
  1069. {
  1070.  
  1071. Re-sends previous packet, which had been renamed to Buf[LastPacket] by
  1072. SendPacket just after that routine sent it.
  1073.  
  1074. Modifies        stats.ChInPack
  1075.                 stats.NumSendPacks
  1076.  
  1077. Calls           PutOut
  1078.  
  1079. Called by       SendPacket
  1080. }
  1081.  
  1082.    BEGIN
  1083.      stats.NumSendPacks := stats.NumSendPacks+1;
  1084.      stats.ChInPack := stats.ChInPack + RemotePad + UnChar(Buf[LastPacket].count) + 3;
  1085.      IF Debug
  1086.       THEN DisplayPacket('Re-Sending ...      ',LastPacket);
  1087.      PutOut(LastPacket);
  1088.    END;
  1089.  
  1090. $PAGE$
  1091. PROCEDURE SendPacket;       { sends ThisPacket; leaves it in LastPacket }
  1092. {
  1093.  
  1094. Accepts "raw" packet in Buf[ThisPacket].  Encodes count (which is
  1095. initially the length of the data field), sequence number, and
  1096. calculates the checksum.  After packet is sent, exchanges ThisPacket
  1097. and LastPacket by swapping pointers, so that ReSendPacket can send it
  1098. again if necessary.
  1099.  
  1100. Modifies        stats.ChInPack
  1101.  
  1102. Calls           PutOut
  1103.                 ReSendPacket
  1104.                 CheckFunction
  1105.                 DisplayPacket
  1106.  
  1107. Called by       SendACK
  1108.                 SendNAK
  1109.                 ErrorPack
  1110.                 SendFile
  1111.                 SendData
  1112.                 SendEOF
  1113.                 SendBreak
  1114.                 SendOurInit
  1115.                 GetTheirInit
  1116.                 DoInitLast
  1117. }
  1118.   VAR
  1119.     i,len,chksum : integer;
  1120.     temp : Ppack;
  1121.    BEGIN
  1122.      IF (NumTry <> 1) AND (RunType = Transmit )
  1123.        THEN ReSendPacket
  1124.        ELSE BEGIN       { send fresh packet }
  1125.          WITH Buf[ThisPacket] DO BEGIN
  1126.             mark := LocalMark;        { mark }
  1127.             len := count;             { save length }
  1128.             count := MakeChar(len+3); { count = 3+length of data }
  1129.             seq := MakeChar(seq);     { seq number }
  1130.             chksum := count + seq + ptype;
  1131.             IF ( len > 0)      { is there data ? }
  1132.               THEN FOR i:= 1 TO len DO
  1133.                      chksum := chksum + data[i];       { loop for data }
  1134.             chksum := CheckFunction(chksum);  { calculate  checksum }
  1135.             data[len+1] := MakeChar(chksum);  { make printable & output }
  1136.             data[len+2] := RemoteEOL;                    { EOL }
  1137.             data[len+3] := ENDSTR;
  1138.           END;  { WITH }
  1139.  
  1140.          stats.NumSendPacks := stats.NumSendPacks+1;
  1141.          IF Debug
  1142.           THEN DisplayPacket('Sending ...         ',ThisPacket);
  1143.          PutOut(ThisPacket);
  1144.  
  1145.          IF RunType = Transmit
  1146.           THEN BEGIN
  1147.              stats.ChInPack := stats.ChInPack + RemotePad + len + 6;
  1148.              temp := LastPacket;
  1149.              LastPacket := ThisPacket;
  1150.              ThisPacket := temp;
  1151.            END;
  1152.        END;  { send fresh packet }
  1153.    END;  { procedure SendPacket }
  1154.  
  1155. $PAGE$
  1156. PROCEDURE SendACK ( n : integer );         { send ACK packet }
  1157. {
  1158.  
  1159. Builds an ACK packet for the given sequence number in Buf[ThisPacket]
  1160. and sends it.
  1161.  
  1162. Modifies        stats.NumACKsent
  1163.                 Buf[ThisPacket]
  1164.  
  1165. Calls           SendPacket
  1166.  
  1167. Called by       BuildPacket
  1168.                 DoData
  1169.                 DoEOF
  1170.                 DoBreak
  1171.                 DoFile
  1172.                 DoEOFLast
  1173. }
  1174.    BEGIN
  1175.      WITH Buf[ThisPacket] DO
  1176.       BEGIN
  1177.         count := 0;
  1178.         seq := n;
  1179.         ptype := TYPEY;
  1180.       END;
  1181.      SendPacket;
  1182.      stats.NumACKsent := stats.NumACKsent+1;
  1183.    END;
  1184.  
  1185. $PAGE$
  1186. PROCEDURE SendNAK ( n : integer );         { send NAK packet }
  1187. {
  1188.  
  1189. Builds a NAK packet for the given sequence number into Buf[ThisPacket]
  1190. and sends it.
  1191.  
  1192. Modifies        stats.NumNAKsent
  1193.                 Buf[ThisPacket]
  1194.  
  1195. Calls           SendPacket
  1196.  
  1197. Called by       GetTheirInit
  1198.                 DoData
  1199.                 DoFileLast
  1200.                 DoEOF
  1201.                 DoBreak
  1202.                 DoFile
  1203.                 DoEOFLast
  1204.                 DoInitLast
  1205.                 ReceiveFile
  1206. }
  1207.    BEGIN
  1208.      WITH Buf[ThisPacket] DO
  1209.       BEGIN
  1210.         count := 0;
  1211.         seq := n;
  1212.         ptype := TYPEN;
  1213.       END;
  1214.      SendPacket;
  1215.      stats.NumNAKsent := stats.NumNAKsent+1;
  1216.    END;
  1217.  
  1218. $PAGE$
  1219. PROCEDURE ErrorPack ( c : cstring );
  1220. {
  1221.  
  1222.         where c = Error description string to be printed or sent in
  1223.                   data field of packet
  1224.  
  1225. Sends an error packet to the other Kermit with the error
  1226. string in the data field.
  1227.  
  1228. Calls           PutErr
  1229.                 SendPacket
  1230.  
  1231. Called by       GetFile
  1232.                 ReceivePacket
  1233. }
  1234.   BEGIN
  1235.     WITH Buf[ThisPacket] DO BEGIN
  1236.       seq := n;
  1237.       ptype := TYPEE;
  1238.       CtoB(c,data);
  1239.       count := length(data);
  1240.       END;  { with }
  1241.     SendPacket;
  1242.     FinishUpFile;
  1243.     DisplayStatistics;
  1244.   END;
  1245.  
  1246. $PAGE$
  1247. PROCEDURE Field1;                          { Count }
  1248. {
  1249.  
  1250. Checks the count field assumed to be in PackControl.t, sets the count
  1251. field in Buf[DebugPacket] to t itself, and the count field in
  1252. Buf[NextPacket] to UnChar(t).  If the count is not within the proper
  1253. range, a message will be printed via Verbose and PackControl.good will
  1254. be set FALSE; otherwise, PackControl.good will be unchanged.
  1255.  
  1256. References      SizeRecv
  1257.  
  1258. Modifies        Buf[NextPacket]
  1259.                 Buf[DebugPacket]
  1260.                 PackControl
  1261.  
  1262. Calls           Verbose
  1263.  
  1264. Called by       BuildPacket
  1265. }
  1266.   VAR
  1267.     test: boolean;
  1268.   BEGIN
  1269.     WITH Buf[NextPacket] DO BEGIN
  1270.        WITH PackControl DO BEGIN
  1271.           Buf[DebugPacket].count := t;
  1272.           count := UnChar(t);
  1273.           test := (count >= 3) OR (count <= SizeRecv-2);
  1274.           IF NOT test
  1275.             THEN Verbose('Bad count           ');
  1276.           good := good AND test;
  1277.         END;  { with PackControl }
  1278.      END;  { with NextPacket }
  1279.   END;  { procedure Field1 }
  1280.  
  1281. $PAGE$
  1282. PROCEDURE Field2;                          { Packet Number }
  1283. {
  1284.  
  1285. Checks the sequence number field assumed to be in PackControl.t, sets
  1286. the sequence number field in Buf[DebugPacket] to t itself, and the
  1287. sequence number field in Buf[NextPacket] to UnChar(t).  If the
  1288. sequence number is not within the proper range, a message will be
  1289. printed via Verbose and PackControl.good will be set FALSE; otherwise,
  1290. PackControl.good will be unchanged.
  1291.  
  1292. Modifies        Buf[NextPacket]
  1293.                 Buf[DebugPacket]
  1294.                 PackControl
  1295.  
  1296. Calls           Verbose
  1297.  
  1298. Called by       BuildPacket
  1299. }
  1300.   VAR
  1301.     test : boolean;
  1302.    BEGIN
  1303.      WITH Buf[NextPacket] DO BEGIN
  1304.         WITH PackControl DO BEGIN
  1305.            Buf[DebugPacket].seq := t;
  1306.            seq := UnChar(t);
  1307.            test := (seq >= 0) OR (seq <= 63);
  1308.            IF NOT test
  1309.              THEN Verbose('Bad seq number      ');
  1310.            good := test AND good;
  1311.          END;
  1312.       END;
  1313.    END;
  1314.  
  1315. $PAGE$
  1316. PROCEDURE Field3;                          { Packet Type }
  1317. {
  1318.  
  1319. Checks the type field assumed to be in PackControl.t, sets the type
  1320. field in Buf[DebugPacket] and in Buf[NextPacket] to PackControl.t.  If
  1321. the type is not a valid packet type, a message will be printed via
  1322. Verbose and PackControl.good will be set FALSE; otherwise,
  1323. PackControl.good will be unchanged.
  1324.  
  1325. Modifies        Buf[NextPacket]
  1326.                 Buf[DebugPacket]
  1327.                 PackControl
  1328.  
  1329. Calls           Verbose
  1330.                 IsValidPType
  1331.  
  1332. Called by       BuildPacket
  1333. }
  1334.   VAR
  1335.     test : boolean;
  1336.    BEGIN
  1337.      WITH Buf[NextPacket] DO BEGIN
  1338.         WITH PackControl DO BEGIN
  1339.            ptype := t;
  1340.            Buf[DebugPacket].ptype := t;
  1341.            test := IsValidPType(ptype);
  1342.            IF NOT test
  1343.             THEN Verbose('Bad Packet Type     ');
  1344.            good := test AND good;
  1345.          END;
  1346.       END;
  1347.    END;
  1348.  
  1349. $PAGE$
  1350. PROCEDURE Field4;                          { Data }
  1351. {
  1352.  
  1353. Places the data character, assumed to be in PackControl.t, into the
  1354. next position in Buf[DebugPacket].data.  This position is assumed to
  1355. be in PackControl.PacketPtr.  Does the proper unquoting, and leaves
  1356. the unquoted character in the next position of Buf[NextPacket].data.
  1357.  
  1358.  
  1359. Modifies        Buf[NextPacket]
  1360.                 Buf[DebugPacket]
  1361.                 PackControl
  1362.  
  1363. Calls           -nothing-
  1364.  
  1365. Called by       BuildPacket
  1366. }
  1367.    BEGIN
  1368.      WITH PackControl DO BEGIN
  1369.         PacketPtr := PacketPtr+1;
  1370.         Buf[DebugPacket].data[PacketPtr] := t;
  1371.         Buf[NextPacket].data[i] := t;
  1372.         i := i + 1;
  1373.         END;  { with PackControl }
  1374.    END;  { procedure Field4 }
  1375.  
  1376. $PAGE$
  1377. PROCEDURE Field5;                          { Check Sum }
  1378. {
  1379.  
  1380. Places the checksum character, assumed to be in PackControl.t,
  1381. followed by a terminator, into the next position of
  1382. Buf[DebugPacket].data.  Calls CheckFunction to verify the checksum; if
  1383. the checksum accumulated for the data does not match the one sent,
  1384. then outputs an error message via Verbose and sets Good to FALSE,
  1385. otherwise Good is unchanged.  Sets the PackControl.finished.
  1386.  
  1387. Modifies        Buf[NextPacket]
  1388.                 Buf[DebugPacket]
  1389.                 PackControl
  1390.  
  1391. Calls           Verbose
  1392.                 CheckFunction
  1393.  
  1394. Called by       BuildPacket
  1395. }
  1396.   VAR
  1397.     test : boolean;
  1398.    BEGIN
  1399.      WITH PackControl DO
  1400.       BEGIN
  1401.         PacketPtr := PacketPtr +1;
  1402.         Buf[DebugPacket].data[PacketPtr] := t;
  1403.         Buf[DebugPacket].data[PacketPtr + 1] := ENDSTR;
  1404.         check := CheckFunction(check);
  1405.         check := MakeChar(check);
  1406.         test := (t=check);
  1407.         IF NOT test
  1408.           THEN Verbose('Bad CheckSum        ');
  1409.         good := test AND good;
  1410.         Buf[NextPacket].data[i] := ENDSTR;
  1411.         finished := true;  { set finished }
  1412.       END;
  1413.    END;
  1414.  
  1415.  
  1416. $PAGE$
  1417. PROCEDURE BuildPacket;                 { Process received character }
  1418. {
  1419.  
  1420. Processes received character, assumed to be in PackControl.t, and adds
  1421. it to the packet in Buf[NextPacket] according to the state information
  1422. in PackControl.  When the packet is completely received, the packet is
  1423. checked to see if it is an error packet.
  1424.  
  1425. If the packet is an error packet, Kermit_error_string will be set to the
  1426. error packet text, and kermit_error will be set to abort_errpack.
  1427. FinishUpFile and DisplayStatistics will be called.
  1428.  
  1429. Returns one of the following error codes in Kermit_error:
  1430.         success         Character successfully processed
  1431.         abort_errpack   Error packet received from remote
  1432.  
  1433. Modifies        PackControl
  1434.                 Buf[NextPacket]
  1435.                 CurrentPacket
  1436.                 NextPacket
  1437.                 stats.NumRecvPacks
  1438.  
  1439. Calls           Field1
  1440.                 Field2
  1441.                 Field3
  1442.                 Field4
  1443.                 Field5
  1444.                 SendACK
  1445.                 DisplayPacket
  1446.  
  1447. Called by       ReceivePacket
  1448. }
  1449.   VAR
  1450.     temp : Ppack;
  1451.   BEGIN
  1452.     kermit_error := success;
  1453.     WITH PackControl DO BEGIN
  1454.       WITH Buf[NextPacket] DO BEGIN
  1455.         IF (t<>ENDSTR)        { if a character was read }
  1456.           THEN IF restart
  1457.                  THEN BEGIN    { read until we get SOH marker }
  1458.                    IF (t = SOH)
  1459.                      THEN BEGIN   { is packet mark }
  1460.                        finished := false;    { set variables }
  1461.                        good := true;
  1462.                        seq := -1;   { set return values to bad packet }
  1463.                        ptype := QUESTION;
  1464.                        data[1] := ENDSTR;
  1465.                        data[MAXSTR] := ENDSTR;
  1466.                        restart := false;
  1467.                        fld := 0;
  1468.                        i := 1;
  1469.                        PacketPtr := 0;
  1470.                        check := 0;
  1471.                        END;  { is packet mark }
  1472.                    END    { read until we get SOH marker }
  1473.                  ELSE BEGIN     { have started packet }
  1474.                    IF (t=SOH)          { check for restart or EOL }
  1475.                      THEN restart := true
  1476.                      ELSE IF (t=LocalEOL)
  1477.                             THEN BEGIN
  1478.                               finished := true;
  1479.                               good := false;
  1480.                               END
  1481.                             ELSE BEGIN  { not mark or EOL }
  1482.                               CASE fld OF
  1483.                               { increment field number }
  1484.                                 0:   fld := 1;
  1485.                                 1:   fld := 2;
  1486.                                 2:   fld := 3;
  1487.                                 3:  { no data }
  1488.                                    IF (count=3)
  1489.                                      THEN fld := 5
  1490.                                      ELSE fld := 4;
  1491.                                 4:       { end of data }
  1492.                                    IF (PacketPtr>=count-3)       
  1493.                                        THEN fld := 5;
  1494.                                 END { case };
  1495.                               IF (fld<>5)
  1496.                                 THEN { add into checksum }
  1497.                                      check := check+t;
  1498.  
  1499.                               CASE fld OF
  1500.                                  1:      Field1;
  1501.                                  2:      Field2;
  1502.                                  3:      Field3;
  1503.                                  4:      Field4;
  1504.                                  5:      Field5;
  1505.                               END;  { case }
  1506.                             END; { not mark or EOL }
  1507.                    END;  { have started packet }
  1508.  
  1509.         IF finished
  1510.           THEN BEGIN
  1511.             IF Debug
  1512.               THEN BEGIN
  1513.                 DisplayPacket('Received ...        ',DebugPacket);
  1514.                 IF good
  1515.                   THEN report := 'Packet is Good'
  1516.                   ELSE report := 'Packet is BAD';
  1517.                 report_log(report);
  1518.                 END; { debug }
  1519.             IF (ptype=TYPEE) AND good
  1520.               THEN BEGIN     { was error packet }
  1521.                 Kermit_error := abort_errpack;
  1522.                 BtoS(data, Kermit_error_string);
  1523.                 SendACK(n);          { send ACK }
  1524.                 END; { was error packet }
  1525.             stats.NumRecvPacks := stats.NumRecvPacks+1;
  1526.  
  1527.             temp := CurrentPacket;
  1528.             CurrentPacket := NextPacket;
  1529.             NextPacket := temp;
  1530.           END; { if finished }
  1531.       END;  { with Buf[NextPacket] }
  1532.     END;  { with PackControl }
  1533.   END;  { procedure BuildPacket }
  1534.  
  1535. $PAGE$
  1536. procedure ReceivePacket;
  1537. {
  1538.  
  1539. Receives a packet into Buf[NextPacket], which is then renamed to
  1540. Buf[CurrentPacket] when complete.  If the packet is not successfully
  1541. received, then FinishUpFile will be called.
  1542.  
  1543. Returns one of the following codes in Kermit_error :
  1544.         success         Packet successfully received
  1545.         timeout         Timeout while waiting for complete packet
  1546.         abort_file      Abort file key typed by user
  1547.         abort_group     Abort file group typed by user
  1548.         abort_errpack   Error packet received from remote
  1549.  
  1550. References      PackControl
  1551.  
  1552. Modifies        stats.ChInPack
  1553.  
  1554. Calls           SerialIn
  1555.                 ConsoleStatus
  1556.                 ConsoleIn
  1557.                 BuildPacket
  1558.  
  1559. Called by       ReceiveACK
  1560.                 GetTheirInit
  1561.                 ReceiveData
  1562.                 ReceiveFile
  1563. }
  1564.   label 1000;           { go to this when error occurs }
  1565.   var c : char;
  1566.   BEGIN
  1567.     kermit_error := success;     { assume success for now }
  1568.     WITH PackControl DO
  1569.      BEGIN
  1570.        StartTimer;
  1571.        finished := false;
  1572.        restart := true;
  1573.        REPEAT
  1574.          t := SerialIn;
  1575.          IF (RunType = Receive) AND (t <> ENDSTR)
  1576.             THEN stats.ChInPack := stats.ChInPack + 1;
  1577.          IF Local                     { see if character typed on console }
  1578.            THEN if consolestatus then begin    { if a character was typed }
  1579.                   c := consolein;              { read it }
  1580.                   if c in [abort_file_key, abort_group_key]
  1581.                     then begin   { abort file }
  1582.                       if c = abort_file_key
  1583.                         then kermit_error := abort_file
  1584.                         else kermit_error := abort_group;
  1585.                       good := false;
  1586.                       goto 1000;
  1587.                       end  { abort file }
  1588.                     else t := LocalEOL;
  1589.                   END;  { if a character was typed }
  1590.          BuildPacket;
  1591.          if Kermit_error <> success
  1592.            then goto 1000;              { return this error to caller }
  1593.        UNTIL finished  OR (TimeLeft = 0);
  1594.        IF (TimeLeft = 0)       { if timed out waiting for packet }
  1595.         THEN BEGIN
  1596.            Buf[CurrentPacket] := TOPacket;
  1597.            restart := true;
  1598.            IF NOT ((RunType=Transmit) AND (State=RecvInit))
  1599.             THEN BEGIN
  1600.                Kermit_error := timeout;
  1601.             END;
  1602.          END;
  1603. 1000:
  1604.        If kermit_error <> success
  1605.          then FinishUpFile;
  1606.        if (Kermit_error = abort_file) or (Kermit_error = abort_group)
  1607.          then ErrorPack('Transfer aborted    ');
  1608.        StopTimer;
  1609.        DisplayStatistics;
  1610.      END;  { with PackControl }
  1611.   END;  { procedure ReceivePacket }
  1612.  
  1613. $PAGE$
  1614. FUNCTION ReceiveACK : boolean;  { Receive ACK with correct number }
  1615. {
  1616.  
  1617. If OneWayOnly is set, then returns TRUE immediately.  Receives a
  1618. packet into CurrentPacket.  If it is not received correctly, will
  1619. return FALSE and the NumXXXRecv counters will be invalid (!?).
  1620. Otherwise, if it is an ACK packet, increments stats.NumACKrecv.  If it is an
  1621. ACK packet, increments stats.NumNAKrecv.  If it is any other type,
  1622. increments stats.NumBADrecv.  If it is an ACK packet and the sequence number
  1623. number matches the one expected, then will return TRUE.
  1624.  
  1625.  
  1626. Errors          errors returned by ReceivePacket
  1627.  
  1628. Modifies        stats.NumACKrecv
  1629.                 stats.NumNAKrecv
  1630.                 stats.NumBADrecv
  1631.  
  1632. Calls           ReceivePacket
  1633.  
  1634. Called by       SendFile
  1635.                 SendData
  1636.                 SendEOF
  1637.                 SendBreak
  1638.                 SendOurInit
  1639. }
  1640.   VAR
  1641.     Ok: boolean;
  1642.   BEGIN
  1643.   kermit_error := success;
  1644.   if onewayonly
  1645.     then ReceiveACK := true
  1646.     else begin  { look for ACK from remote }
  1647.       ReceivePacket;
  1648.       if not odd(Kermit_error)             { if ReceivePacket returned error }
  1649.         then ReceiveACK := false                 { error receiving packet }
  1650.         else WITH Buf[CurrentPacket] DO BEGIN    { packet received ok }
  1651.           IF (ptype=TYPEY)
  1652.             THEN stats.NumACKrecv := stats.NumACKrecv+1
  1653.             ELSE IF (ptype=TYPEN)
  1654.                    THEN  stats.NumNAKrecv := stats.NumNAKrecv+1
  1655.                    ELSE  stats.NumBADrecv := stats.NumBADrecv +1;
  1656.           { was this packet the one we expected? }
  1657.           ReceiveACK := (ptype=TYPEY) AND (n=seq);
  1658.           END;  { packet received ok }
  1659.     end;  { look for ACK from remote }
  1660.   END;  { function ReceiveACK }
  1661.  
  1662. $PAGE$
  1663. PROCEDURE DataFromFile ( VAR newstate : KermitStates );
  1664.                                       { Get data from file into ThisPacket }
  1665.  
  1666. {
  1667.  
  1668. Fills the data field of Buf[ThisPacket] with characters from DiskFile,
  1669. which is assumed to be opened.  Characters are read from file via
  1670. Getcf.  The field is terminated by ENDSTR, and the count, sequence and
  1671. packet type fields are set.  If EOF is reached, the file is closed,
  1672. and newstate and SaveState are set to FileData.  Otherwise, newstate is
  1673. set to whatever SaveState is, and SaveState is left unchanged.
  1674.  
  1675. References      Diskfile
  1676.  
  1677. Modifies        SaveState
  1678.                 Buf[ThisPacket]
  1679.                 stats.ChInFile
  1680.  
  1681. Calls           Sclose
  1682.                 Getcf
  1683.  
  1684. Called by       SendData
  1685. }
  1686.   VAR
  1687.     x,c : byte;
  1688.     i: integer;
  1689.   BEGIN
  1690.     IF (NumTry=1)      { if first time packet sent }
  1691.       THEN BEGIN
  1692.         i := 1;
  1693.         x := ENDSTR;
  1694.         WITH Buf[ThisPacket] DO BEGIN
  1695.           { leave room for quote  & NEWLINE }
  1696.           WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)  DO begin
  1697.             x := Getcf(c,DiskFile);  { get character and quote if necessary }
  1698.             IF (x<>ENDFILE)
  1699.                THEN IF (IsControl(x)) OR (x=RemoteQuote)
  1700.                       THEN BEGIN           { control char -- quote }
  1701.                         IF (x=NEWLINE)
  1702.                           THEN  CASE EOLforFile OF    { use proper EOL }
  1703.                              LineFeed:   { ok as is };
  1704.                              CrLf:     BEGIN
  1705.                                        data[i] := RemoteQuote;
  1706.                                        i := i+1;
  1707.                                        data[i] := Ctl(CR);
  1708.                                        i := i+1; 
  1709.                                        { LF will be put in below }
  1710.                                        END;  { CrLf }
  1711.                              JustCR:   x := CR;
  1712.                             END { case };
  1713.                         data[i] := RemoteQuote;
  1714.                         i := i+1;
  1715.                         IF (x<>RemoteQuote)
  1716.                           THEN  data[i] := Ctl(x)
  1717.                           ELSE  data[i] := RemoteQuote;
  1718.                         END  { control char }
  1719.                       ELSE  data[i] := x;     { it's regular char }
  1720.  
  1721.                IF (x<>ENDFILE)
  1722.                 THEN BEGIN
  1723.                    i := i+1;     { increase count for next char }
  1724.                    stats.ChInFile := stats.ChInFile + 1;
  1725.                    END;
  1726.              END;                { get character and quote if necessary }
  1727.  
  1728.             data[i] := ENDSTR;   { terminate ByteString }
  1729.  
  1730.             count := i-1;        { set data fieldlength }
  1731.             seq := n;            { set sequence number }
  1732.             ptype := TYPED;      { set packet type }
  1733.  
  1734.             IF (x=ENDFILE)
  1735.                THEN BEGIN
  1736.                     newstate := EOFile;
  1737.                     Sclose(DiskFile);
  1738.                     DiskFile := ioerror;
  1739.                   END
  1740.                ELSE newstate := FileData;
  1741.             SaveState := newstate;        { save state }
  1742.           END  { with Buf[ThisPacket] do }
  1743.        END  { if first time packet sent }
  1744.       ELSE newstate := SaveState;        { get old state }
  1745.    END;  { procedure DataFromFile }
  1746.  
  1747. $PAGE$
  1748. PROCEDURE SendFile( name : filename );              { send file name packet }
  1749. {
  1750.  
  1751. Sends file header packet for the named file.
  1752.  
  1753. If file does not exist, returns cant_find_file.
  1754. If file cannot be opened, returns cant_read_file.
  1755. If attempt to send header fails, leaves state set to FileHeader.
  1756. If the attempt fails more than MaxTry times, sets state to Abort
  1757.   and returns retry_exhausted.
  1758. If the file header is succesfully sent (ACKed by other side), sets state
  1759.   to FileData and returns success.
  1760.  
  1761. Errors          Retry Count Exhausted
  1762.                 cant_find_file
  1763.                 cant_read_file
  1764.  
  1765. References      MaxTry
  1766.  
  1767. Modifies        Buf[ThisPacket]
  1768.                 NumTry
  1769.                 State
  1770.                 n
  1771.  
  1772. Calls           PutErr
  1773.                 Verbose
  1774.                 SendPacket
  1775.                 ReceiveACK
  1776.  
  1777. Called by       SendSwitch
  1778. }
  1779.   var num : integer;
  1780.   BEGIN
  1781.   Kermit_error := success;
  1782.   IF NumTry > MaxTry
  1783.     THEN BEGIN  { retry count exhausted }
  1784.       PutErr ('Send file - Too Many');
  1785.       Kermit_error := retry_exhausted;
  1786.       State := Abort;      { too many tries, abort }
  1787.       END  { retry count exhausted }
  1788.     ELSE BEGIN  { Open the file and send file header }
  1789.       IF Exists(name)
  1790.         THEN with Buf[ThisPacket] do begin
  1791.              { File already exists.  Open it, set up ThisPacket with name
  1792.                of file in data field.  Show filename in file status
  1793.                display, send error packet if can't open file. }
  1794.           DiskFile := Sopen(name,IOREAD);
  1795.           count := strlen(name);   { set packet length }
  1796.           StoB(name, data);        { convert name to Bytestring }
  1797.                                    { in data field of packet }
  1798.           report_send_file(name);
  1799.           stats.ChInFile := stats.ChInFile + count;
  1800.           seq := n;
  1801.           ptype := TYPEF;
  1802.           IF DiskFile <= IOERROR
  1803.             THEN Kermit_error := cant_read_file;
  1804.           END  { file already exists (with) }
  1805.         ELSE begin { file does not exist }
  1806.           kermit_error := cant_find_file;
  1807.           end;  { file does not exist }
  1808.       NumTry := NumTry+1;
  1809.       IF Verbosity
  1810.         THEN begin  { report sending file header }
  1811.           IF (NumTry = 1)  { If first time we're sending file header }
  1812.             THEN num := Buf[ThisPacket].seq
  1813.             ELSE num := Buf[LastPacket].seq;
  1814.           setstrlen(report,0);
  1815.           strwrite(report,1,rpos,'Sending file header packet #',
  1816.                    num:1,' for ',name:1);
  1817.           report_log(report);
  1818.           end;  { report sending file header }
  1819.       SendPacket;     { send this packet }
  1820.       IF ReceiveACK
  1821.         THEN BEGIN
  1822.           NumTry := 0;             { reset packet retry count }
  1823.           State := FileData;
  1824.           n := (n+1) MOD 64;
  1825.           END
  1826.       END;  { send file header }
  1827.   END;  { procedure SendFile }
  1828.  
  1829. $PAGE$
  1830. PROCEDURE SendData;                     { send file data packets }
  1831. {
  1832.  
  1833. Errors          Retry Count Exhausted
  1834.  
  1835. References      MaxTry
  1836.  
  1837. Modifies        NumTry
  1838.                 State
  1839.                 n
  1840.  
  1841. Calls           PutCon
  1842.                 PutNum
  1843.                 PutErr
  1844.                 DataFromFile
  1845.                 SendPacket
  1846.                 ReceiveACK
  1847.  
  1848. Called by       SendSwitch
  1849. }
  1850.   VAR
  1851.     newstate: KermitStates;
  1852.   BEGIN
  1853.     IF Verbosity
  1854.       THEN BEGIN
  1855.         setstrlen(report,0);
  1856.         strwrite(report,1,rpos,'Sending data packet #',n:1);
  1857.         report_log(report);
  1858.         END;
  1859.     IF NumTry > MaxTry
  1860.       THEN BEGIN
  1861.          State := Abort;       { too many tries, abort }
  1862.          PutErr ('Send data - Too many');
  1863.          END
  1864.       ELSE BEGIN                { send data packet }
  1865.          NumTry := NumTry+1;
  1866.          DataFromFile(newstate);
  1867.          SendPacket;
  1868.          IF ReceiveACK
  1869.            THEN BEGIN           { got acknowledgement }
  1870.              State := newstate;
  1871.              NumTry := 0;
  1872.              n := (n+1) MOD 64;
  1873.              END;  { got acknowledgement }
  1874.        END;  { send data packet }
  1875.    END;  { procedure SendData }
  1876.  
  1877. $PAGE$
  1878. PROCEDURE SendEOF;                         { send EOF  packet }
  1879. {
  1880.  
  1881.  
  1882. References      MaxTry
  1883.  
  1884. Modifies        Buf[ThisPacket]
  1885.                 NumTry
  1886.                 State
  1887.                 n
  1888.  
  1889. Calls           Verbose
  1890.                 SendPacket
  1891.                 ReceiveACK
  1892.  
  1893. Called by       SendSwitch
  1894. }
  1895.    BEGIN
  1896.      Verbose ('Sending EOF         ');
  1897.      IF NumTry > MaxTry
  1898.       THEN BEGIN
  1899.          State := Abort;       { too many tries, abort }
  1900.          PutErr('Send EOF - Too Many ');
  1901.          END
  1902.       ELSE BEGIN        { send EOF packet }
  1903.         NumTry := NumTry+1;
  1904.         IF (NumTry = 1)
  1905.           THEN BEGIN  { if first time packet sent }
  1906.              WITH Buf[ThisPacket] DO BEGIN
  1907.                 ptype := TYPEZ;
  1908.                 seq := n;
  1909.                 count := 0;
  1910.                 END  { with }
  1911.              END;  { if first time packet sent }
  1912.          SendPacket;
  1913.          IF ReceiveACK
  1914.            THEN BEGIN           { got acknowledgement }
  1915.              State := FileHeader;
  1916.              NumTry := 0;
  1917.              n := (n+1) MOD 64;
  1918.              END;  { got acknowledgement }
  1919.        END;  { send EOF packet }
  1920.    END;  { procedure SendEOF }
  1921.  
  1922. $PAGE$
  1923. PROCEDURE SendBreak; { send break packet }
  1924. {
  1925.  
  1926. Sends a break packet.  If ACKed by other side, sets state to Complete.
  1927. If not, leaves state set to Break, returns success.
  1928. However, if the failure exhausted the retry count, sets state to Abort
  1929. and returns retry_exhausted.
  1930.  
  1931. Errors          retry_exhausted
  1932.  
  1933. References      MaxTry
  1934.  
  1935. Modifies        Buf[ThisPacket]
  1936.                 NumTry
  1937.                 State
  1938.                 n
  1939.  
  1940. Calls           Verbose
  1941.                 PutErr
  1942.                 SendPacket
  1943.                 ReceiveACK
  1944.  
  1945. Called by       SendSwitch
  1946. }
  1947.    BEGIN
  1948.    Kermit_error := success;
  1949.    Verbose ('Sending break       ');
  1950.    IF NumTry > MaxTry
  1951.      THEN BEGIN
  1952.        State := Abort;       { too many tries, abort }
  1953.        PutErr('Send break -Too Many');
  1954.        Kermit_error := retry_exhausted;
  1955.        END
  1956.      ELSE BEGIN  { send break packet }
  1957.        NumTry := NumTry+1;
  1958.        { make up packet  }
  1959.        IF NumTry = 1
  1960.         THEN BEGIN
  1961.            WITH Buf[ThisPacket] DO BEGIN
  1962.               ptype := TYPEB;
  1963.               seq := n;
  1964.               count := 0;
  1965.               END
  1966.            END;  { with }
  1967.        SendPacket; { send this packet }
  1968.        IF ReceiveACK
  1969.          THEN State := Complete;
  1970.      END;  { send break packet }
  1971.    END;  { procedure SendBreak }
  1972.  
  1973. $PAGE$
  1974. PROCEDURE SendOurInit;  { send init packet }
  1975. {
  1976.  
  1977. Send our init packet to the remote, get its init packet, set the
  1978. remotexxxx parameters from it.
  1979.  
  1980. References      MaxTry
  1981.                 OneWayOnly
  1982.  
  1983. Modifies        Buf[ThisPacket]
  1984.                 Buf[CurrentPacket]
  1985.                 NumTry
  1986.                 State
  1987.                 n
  1988.                 SizeSend
  1989.                 RemoteTimeOut
  1990.                 RemotePad
  1991.                 RemotePadChar
  1992.                 RemoteEOL
  1993.                 RemoteQuote
  1994.  
  1995. Calls           Verbose
  1996.                 PutErr
  1997.                 EnCodeParm
  1998.                 SendPacket
  1999.                 ReceiveACK
  2000.                 
  2001.  
  2002. Called by       SendSwitch
  2003. }
  2004.   BEGIN
  2005.   Verbose ('Sending init        ');
  2006.   IF NumTry > MaxTry
  2007.    THEN BEGIN
  2008.       State := Abort;      { too many tries, abort }
  2009.       PutErr('Cannot Initialize   ');
  2010.       END
  2011.    ELSE BEGIN        { send our send init packet }
  2012.       NumTry := NumTry+1;
  2013.       IF (NumTry = 1)
  2014.         THEN BEGIN            { if first time packet sent }
  2015.           WITH Buf[ThisPacket] DO BEGIN
  2016.               EnCodeParm(data);
  2017.               count := NUMPARAM;
  2018.               seq := n;
  2019.               ptype := TYPES;
  2020.               END  { with }
  2021.           END;  { if first time packet sent }
  2022.  
  2023.       SendPacket;            { send this packet }
  2024.       
  2025.       IF ReceiveACK
  2026.         THEN BEGIN           { got acknowledgment }
  2027.           WITH Buf[CurrentPacket] DO BEGIN
  2028.             IF OneWayOnly     { use same data if test mode }
  2029.                THEN data := Buf[LastPacket].data;
  2030.             SizeSend := UnChar(data[1]);
  2031.             RemoteTimeOut := UnChar(data[2]);
  2032.             RemotePad := UnChar(data[3]);
  2033.             RemotePadChar := Ctl(data[4]);
  2034.             RemoteEOL := CR;  { default to CR }
  2035.             IF (length(data) >= 5)
  2036.               THEN IF (data[5] <> 0)
  2037.                      THEN RemoteEOL := UnChar(data[5]);
  2038.             RemoteQuote := DEFQUOTE;
  2039.             IF (length(data) >= 6)
  2040.               THEN IF (data[6] <> 0)
  2041.                      THEN RemoteQuote := data[6];
  2042.             END;  { with }
  2043.  
  2044.           State := FileHeader;
  2045.           NumTry := 0;
  2046.           n := (n+1) MOD 64;
  2047.         END;  { got acknowledgement }
  2048.     END;  { send our send init packet }
  2049.   END;  { procedure SendOurInit }
  2050.  
  2051. $PAGE$
  2052. PROCEDURE SendSwitch( files : filename_list);
  2053. {
  2054.  
  2055. Send-switch is the state table switcher for sending files.
  2056. It loops until either it is finished or a fault is encountered.
  2057. Routines called by SendSwitch are responsible for changing the state.
  2058. If an error does occur, Kermit_error is left set to the value put there
  2059. by the routine that detected the error.
  2060.  
  2061. References      OneWayOnly
  2062.  
  2063. Modifies        State
  2064.                 NumTry
  2065.  
  2066. Calls           Sleep
  2067.                 StartRun
  2068.                 SendData
  2069.                 SendFile
  2070.                 SendEOF
  2071.                 SendOurInit
  2072.                 SendBreak
  2073.  
  2074. Called by       Main Program
  2075. }
  2076.    var nf : integer;
  2077.        done : boolean;
  2078.    BEGIN
  2079.      RunType := Transmit;
  2080.      State := SendInit;          { send initiate is the start state }
  2081.      NumTry := 0;                { say no tries yet }
  2082.      init_packet_display(runtype);
  2083.      IF (NOT OneWayOnly)
  2084.        THEN  Sleep(LocalDelay);
  2085.      nf := 1;       { point to first filename }
  2086.      StartRun;
  2087.      done := false;
  2088.      while (not done) do begin
  2089.        CASE State OF
  2090.          FileData:     SendData;            { data-send state }
  2091.          FileHeader:   if strlen(files[nf]) = 0    { if no more files to send }
  2092.                          then state := Break
  2093.                          else SendFile(files[nf]); { send file name in header }
  2094.          EOFile:       begin
  2095.                        nf := nf + 1;        { point to next file name }
  2096.                        SendEOF;             { send end-of-file }
  2097.                        end;
  2098.          SendInit:     SendOurInit;         { send initialize }
  2099.          Break:        SendBreak;           { send break }
  2100.          Complete:     { nothing };
  2101.          Abort:        { nothing };
  2102.         END { case };
  2103.        done := (State = Abort) OR (State=Complete) or not odd(kermit_error);
  2104.        end;  { while }
  2105.      clean_packet_display(runtype);
  2106.    END;
  2107.  
  2108. $PAGE$
  2109. PROCEDURE GetFile ( data : bytestring );
  2110. {
  2111.  
  2112. Creates file with name given by the bytestring data.  Assigns it to
  2113. file descriptor diskfile.
  2114.  
  2115. References      Verbosity
  2116.  
  2117. Modifies        DiskFile
  2118.  
  2119. Calls           Exists
  2120.                 ErrorPack
  2121.  
  2122. Called by       DoFile
  2123. }
  2124.   VAR
  2125.     name : FileName;
  2126.     npos : integer;
  2127.   BEGIN
  2128.     IF DiskFile = IOERROR      { if we don't already have a file }
  2129.       THEN begin               { create a file }
  2130.         BtoS(data, name);      { get the filename from the given ByteString }
  2131.         IF Verbosity
  2132.           THEN begin
  2133.              setstrlen(report,0);
  2134.              strwrite(report,1,rpos,'Creating file ',name);
  2135.              report_log(report);
  2136.              end;
  2137.  
  2138.         { check Max length }
  2139.  
  2140.         IF strlen(name) > FILENAME_LENGTH
  2141.           THEN setstrlen(name, FILENAME_LENGTH);
  2142.  
  2143.         IF Exists(name)
  2144.           THEN BEGIN  { if file exists already }
  2145.              setstrlen(report,0);
  2146.              strwrite(report,1,rpos,'File already exists - ',name);
  2147.              setstrlen(name,0);
  2148.              strwrite(name, 1, npos, TEMPFILE:1, n:1);
  2149.              strwrite(report,rpos,rpos,
  2150.                       '.  Calling new file  ',name,' instead.');
  2151.              report_status(report);
  2152.           END;  { if file exists already }
  2153.         DiskFile := Sopen(name,IOWRITE);
  2154.         END;  { create a file }
  2155.     IF (Diskfile <= IOERROR)
  2156.       THEN begin        { could not create output file }
  2157.         Kermit_error := cant_create_file;
  2158.         ErrorPack('Couldn''t create file');
  2159.         end;
  2160.   END;  { procedure GetFile }
  2161.  
  2162. $PAGE$
  2163. PROCEDURE GetTheirInit;
  2164. {
  2165.  
  2166. Receive init packet.  Respond with ACK and  our parameters.
  2167.  
  2168. Errors          retry_exhausted         Retry count exhausted
  2169.                 rcvd_bad_init           Received Bad Init packet
  2170.  
  2171. References      MaxTry
  2172.                 Debug
  2173.  
  2174. Modifies        Buf[ThisPacket]
  2175.                 Buf[CurrentPacket]
  2176.                 State
  2177.                 NumTry
  2178.                 n
  2179.                 stats.NumACKsent
  2180.                 OldTry
  2181.  
  2182. Calls           Verbose
  2183.                 ReceivePacket
  2184.                 DeCodeParm
  2185.                 EnCodeParm
  2186.                 SendPacket
  2187.                 SendNAK
  2188.  
  2189. Called by       RecvSwitch
  2190. }
  2191.   VAR rs : boolean;
  2192.   BEGIN
  2193.     IF NumTry > MaxTry
  2194.       THEN BEGIN
  2195.         State := Abort;
  2196.         Kermit_error := retry_exhausted;
  2197.         END
  2198.       ELSE BEGIN        { Receive the Send init from remote }
  2199.         Verbose ( 'Receiving Init      ');
  2200.         NumTry := NumTry+1;
  2201.         ReceivePacket;
  2202.         IF odd(kermit_error)  AND   (Buf[CurrentPacket].ptype = TYPES)
  2203.           THEN BEGIN  { Good send init packet received }
  2204.              WITH Buf[CurrentPacket] DO BEGIN
  2205.                n := seq;
  2206.                DeCodeParm(data);
  2207.                END;  { with }
  2208.  
  2209.              { now send mine }
  2210.              WITH Buf[ThisPacket] DO
  2211.                BEGIN
  2212.                  count := NUMPARAM;
  2213.                  seq := n;
  2214.                  Ptype := TYPEY;
  2215.                  EnCodeParm(data);
  2216.                END;
  2217.              SendPacket;
  2218.              stats.NumACKsent := stats.NumACKsent+1;
  2219.              State := FileHeader;
  2220.              OldTry := NumTry;
  2221.              NumTry := 0;
  2222.              n := (n+1) MOD 64
  2223.              END  { good send init packet received }
  2224.           ELSE BEGIN    { ReceivePacket returned an error }
  2225.             if (Kermit_error <> abort_file) and (Kermit_error <> abort_group)
  2226.                then kermit_error := rcvd_bad_init;
  2227.             SendNAK(n);
  2228.             END;
  2229.         END;  { Receive the Send init from remote }
  2230.    END;
  2231.  
  2232. $PAGE$
  2233. PROCEDURE DataToFile;                      { output to file }
  2234. {
  2235.  
  2236. Writes the data field of Buf[CurrentPacket] to DiskFile, modifiying the
  2237. end of line sequence (dictated by EOLforFile) to be a single NEWLINE,
  2238. as required by Putcf.  Updates the file character counter stats.ChInFile.
  2239.  
  2240. Implicit Inputs
  2241.                 Buf[CurrentPacket]
  2242.  
  2243. References      EOLForFile
  2244.                 DiskFile
  2245.  
  2246. Modifies        stats.ChInFile
  2247.  
  2248. Calls           Putcf
  2249.  
  2250. Called by       DoData
  2251. }
  2252.   VAR
  2253.     i : integer;                { packet data field index }
  2254.     control : boolean;          { TRUE if last byte was control prefix }
  2255.   
  2256.   procedure bytetofile( b : byte );
  2257.     begin
  2258.     {
  2259.       Putcf wants the line terminator to be only a NEWLINE character.
  2260.       If the character is the current Kermit line terminator (depending
  2261.       on EOLforFile) then write a NEWLINE to the file.  NB: Here we
  2262.       assume that the NEWLINE character is actually a LF.
  2263.     }
  2264.     CASE EOLforFile OF
  2265.       LineFeed:     Putcf(b,DiskFile);              { terminator is already
  2266.                                                       a NEWLINE }
  2267.                       
  2268.       CrLf:         IF b <> CR                      { don't output CR }
  2269.                       THEN Putcf(b,DiskFile);
  2270.  
  2271.       JustCR:       IF b = CR                       { change CR to NEWLINE }
  2272.                       THEN Putcf(NEWLINE,DiskFile)
  2273.                       ELSE Putcf(b,DiskFile);
  2274.      END;  { case }
  2275.     stats.ChInFile := stats.ChInFile + 1;
  2276.     end;  { procedure bytetofile }
  2277.   
  2278.   BEGIN  { procedure DataToFile }
  2279.   WITH Buf[CurrentPacket] DO BEGIN
  2280.     control := FALSE;
  2281.     for i := 1 to length(data) do begin
  2282.       IF data[i] = LocalQuote
  2283.         THEN IF control              { character is quote }
  2284.             THEN begin               { quote, quote  }
  2285.               bytetofile(LocalQuote);
  2286.               control := FALSE;
  2287.               END  { quote, quote }
  2288.             ELSE control := TRUE     { set control on }
  2289.         ELSE IF control              { not quote }
  2290.                THEN begin            { convert to control }
  2291.                  bytetofile(Ctl(data[i]));
  2292.                  control := FALSE;
  2293.                  END
  2294.                ELSE bytetofile(data[i]);
  2295.       end;  { for }
  2296.     END;  { with CurrentPacket }
  2297.   END;  { procedure DataToFile }
  2298.  
  2299. $PAGE$
  2300. PROCEDURE DoData;                          { Process Data packet }
  2301. {
  2302.  
  2303. Processes received data packet, assumed to be in CurrentPacket.  If
  2304. the packet is the expected one, writes the data to the destination
  2305. file via DataToFile.  If it is the previous packet (i.e. the ACK for
  2306. that packet got lost), ACKs that packet again if the retry count has
  2307. not reached maximum.  If it is any other packet number, the a NAK will
  2308. be sent for the expected packet.
  2309.  
  2310. Implicit Inputs
  2311.                 Buf[CurrentPacket]
  2312.  
  2313. Errors          Retry count exhausted
  2314.  
  2315. References      MaxTry
  2316.                 OldTry
  2317.  
  2318. Modifies        OldTry
  2319.                 NumTry
  2320.                 n
  2321.                 State
  2322.  
  2323. Calls           DataToFile
  2324.                 PutErr
  2325.                 SendACK
  2326.                 SendNAK
  2327.  
  2328. Called by       ReceiveData
  2329. }
  2330.    BEGIN
  2331.      WITH Buf[CurrentPacket] DO
  2332.       BEGIN
  2333.         IF  seq = ((n + 63) MOD 64)
  2334.          THEN BEGIN                { it's the previous data packet }
  2335.             IF OldTry>MaxTry   { if retried too many times }
  2336.              THEN BEGIN
  2337.                 State := Abort;
  2338.                 kermit_error := retry_exhausted;
  2339.                 END
  2340.              ELSE BEGIN
  2341.                 SendACK(seq);
  2342.                 NumTry := 0;
  2343.                 END;
  2344.              END   { it's the previous packet }
  2345.          ELSE BEGIN    { it's not the previous one }
  2346.             IF (n<>seq)    { if it's not the expected one }
  2347.               THEN  SendNAK(n)  { NAK the expected one }
  2348.               ELSE BEGIN
  2349.                 SendACK(n); { ACK }
  2350.                 DataToFile;
  2351.                 OldTry := NumTry;
  2352.                 NumTry := 0;
  2353.                 n := (n+1) MOD 64;
  2354.               END;
  2355.           END; { it's not the previous one }
  2356.       END;  { with }
  2357.    END;  { procedure DoData }
  2358.  
  2359. $PAGE$
  2360. PROCEDURE DoFileLast;                      { Process File Packet }
  2361. {
  2362.  
  2363. Called by ReceiveData when file header packet received when a data
  2364. packet expected (ie the sender never got the ACK for the file header).
  2365.  
  2366. Errors          Retry count exhausted
  2367.  
  2368. References      Buf[CurrentPacket]
  2369.                 MaxTry
  2370.  
  2371. Modifies        State
  2372.                 OldTry
  2373.                 NumTry
  2374.  
  2375. Calls           PutErr
  2376.                 SendACK
  2377.                 SendNAK
  2378.  
  2379. Called by       ReceiveData
  2380. }
  2381.    BEGIN          { File header - last one  }
  2382.      IF OldTry > MaxTry { tries ? }
  2383.       THEN BEGIN
  2384.          State := Abort;
  2385.          PutErr('Old file - Too many ');
  2386.          END
  2387.       ELSE BEGIN
  2388.          OldTry := OldTry+1;
  2389.          WITH Buf[CurrentPacket] DO
  2390.           BEGIN
  2391.             IF seq = ((n + 63) MOD 64)
  2392.              { packet number }
  2393.              THEN BEGIN  { send ACK }
  2394.                 SendACK(seq);
  2395.                 NumTry := 0
  2396.                END
  2397.              ELSE BEGIN
  2398.                 SendNAK(n);   { NAK }
  2399.                END;
  2400.           END;  { with }
  2401.        END;  { retry not exhausted }
  2402.    END;  { procedure DoFileLast }
  2403.  
  2404. $PAGE$
  2405. PROCEDURE DoEOF;                           { Process EOF packet }
  2406. {
  2407.  
  2408. Called by ReceiveData to process received EOF packets.  If not the
  2409. expected sequence number, NAKs the expected packet, otherwise ACKs it
  2410. and closes the file. 
  2411.  
  2412. References      Buf[CurrentPacket]
  2413.                 DiskFile
  2414.  
  2415. Modifies        DiskFile
  2416.                 OldTry
  2417.                 NumTry
  2418.                 State
  2419.                 n
  2420.  
  2421. Calls           SendNAK
  2422.                 SendACK
  2423.                 Sclose
  2424.  
  2425. Called by       ReceiveData
  2426. }
  2427.    BEGIN                 { EOF - this one }
  2428.      IF Buf[CurrentPacket].seq<>n    { packet number ? }
  2429.       THEN SendNAK(n)   { NAK the expected packet }
  2430.       ELSE  BEGIN       { ACK this one }
  2431.          SendACK(n);
  2432.          Sclose(DiskFile);  { close file }
  2433.          DiskFile := IOERROR;
  2434.          OldTry := NumTry;
  2435.          NumTry := 0;
  2436.          n := (n+1) MOD 64; { next packet  }
  2437.          State := FileHeader;   { change state }
  2438.         END; { ACK this one }
  2439.    END;  { procedure DoEOF }
  2440.  
  2441. $PAGE$
  2442. PROCEDURE ReceiveData;                     { Receive data packets }
  2443. {
  2444.  
  2445. Reads packet, dispatches to proper routine if data, EOF, or file header
  2446. packet.  If it is any other type, NAKs the expected data packet.
  2447.  
  2448. Returns one of the following codes in Kermit_error:
  2449.         success                 Data packet successfully received
  2450.         retry_ehausted          Retry Count Exhausted
  2451.         inv_packet_type         Invalid Packet Type
  2452.         errors returned by ReceivePacket
  2453.  
  2454. References      MaxTry
  2455.                 Verbosity
  2456.                 Local
  2457.                 Buf[CurrentPacket]
  2458.  
  2459. Modifies        NumTry
  2460.  
  2461. Calls           ReceivePacket
  2462.                 DoData
  2463.                 DoFileLast
  2464.                 DoEOF
  2465.                 Verbose
  2466.                 SendNAK
  2467.  
  2468. Called by       RecvSwitch
  2469. }
  2470.   VAR
  2471.     strend : integer;
  2472.     packetnum : ByteString;
  2473.     good : boolean;
  2474.  
  2475.   BEGIN
  2476.     kermit_error := success;
  2477.     IF NumTry > MaxTry          { check number of tries }
  2478.       THEN BEGIN
  2479.           State := Abort;
  2480.           Kermit_error := retry_exhausted;
  2481.          END
  2482.       ELSE  BEGIN       { retry not exhausted }
  2483.          NumTry := NumTry+1;                { increase number of tries }
  2484.          ReceivePacket;             { get packet }
  2485.          WITH Buf[CurrentPacket] DO  BEGIN
  2486.             IF Verbosity
  2487.               THEN BEGIN
  2488.                  PutCon('Receiving (Data)    ',STDERR);
  2489.                  PutNum(seq,STDERR);
  2490.                 END;
  2491.             IF (ptype in [TYPED, TYPEZ, TYPEF])        { check type }
  2492.                  AND odd(kermit_error)    { and ReceivePacket status }
  2493.               THEN  CASE ptype OF
  2494.                       TYPED:  DoData;
  2495.                       TYPEF:  DoFileLast;
  2496.                       TYPEZ:  DoEOF;
  2497.                      END { case }
  2498.               ELSE BEGIN                { not a good type }
  2499.                  Verbose('Expected data pack  ');
  2500.                  if odd(kermit_error)   { if ReceivePacket was successful }
  2501.                     then kermit_error := inv_packet_type;
  2502.                  SendNAK(n);
  2503.                 END;
  2504.           END;  { with }
  2505.        END;  { retry not exhausted }
  2506.   END;  { procedure ReceiveData }
  2507.  
  2508. $PAGE$
  2509. PROCEDURE DoBreak;                         { Process Break packet }
  2510. {
  2511.  
  2512. Called by ReceiveFile to process a break packet.
  2513.  
  2514. Errors          None
  2515.  
  2516. References      Buf[CurrentPacket]
  2517.                 n
  2518.  
  2519. Modifies        State
  2520.  
  2521. Calls           SendNAK
  2522.                 SendACK
  2523.  
  2524. Called by       ReceiveFile
  2525. }
  2526.    BEGIN                    { Break transmission }
  2527.      IF Buf[CurrentPacket].seq<>n    { packet number ? }
  2528.       THEN SendNAK(n) { NAK }
  2529.       ELSE BEGIN            { send  ACK }
  2530.          SendACK(n) ;
  2531.          State := Complete  { change state }
  2532.         END
  2533.    END;
  2534.  
  2535. $PAGE$
  2536. PROCEDURE DoFile;                          { Process file packet }
  2537. {
  2538.  
  2539. Called by ReceiveFile to process file header packet.
  2540.  
  2541. Errors          None
  2542.  
  2543. References      Buf[CurrentPacket]
  2544.  
  2545. Modifies        stats.ChInFile
  2546.                 OldTry
  2547.                 NumTry
  2548.                 n
  2549.                 State
  2550.  
  2551. Calls           SendNAK
  2552.                 SendACK
  2553.                 GetFile
  2554.  
  2555. Called by       ReceiveFile
  2556. }
  2557.   BEGIN
  2558.     WITH Buf[CurrentPacket] DO BEGIN
  2559.         IF seq<>n                       { packet number ? }
  2560.           THEN SendNAK(n)                { NAK }
  2561.           ELSE BEGIN                     { send ACK }
  2562.             SendACK(n);
  2563.             stats.ChInFile := stats.ChInFile + length(data);
  2564.             GetFile(data);              { get file name }
  2565.             OldTry := NumTry;
  2566.             NumTry := 0;
  2567.             n := (n+1) MOD 64;          { next packet  }
  2568.             State := FileData;          { change state }
  2569.             END;  { send ACK }
  2570.        END;  { with }
  2571.    END;  { procedure DoFile }
  2572.  
  2573. $PAGE$
  2574. PROCEDURE DoEOFLast;                       { Process EOF Packet }
  2575. {
  2576.  
  2577. Called by ReceiveFile to process an EOF for the last file (i.e., the
  2578. ACK for the last EOF was lost).  Resends the ACK for the EOF.
  2579.  
  2580. Errors          Retry count exhausted
  2581.  
  2582. References      Buf[CurrentPacket]
  2583.                 MaxTry
  2584.                 n
  2585.  
  2586. Modifies        State
  2587.                 OldTry
  2588.                 NumTry
  2589.  
  2590. Calls           PutErr
  2591.                 SendACK
  2592.                 SendNAK
  2593.  
  2594. Called by       ReceiveFile
  2595. }
  2596.   BEGIN               { End Of File Last One}
  2597.     IF OldTry > MaxTry { tries ? }
  2598.       THEN BEGIN
  2599.          State := Abort;
  2600.          PutErr('Old EOF - Too many  ');
  2601.          END
  2602.       ELSE BEGIN        { process last EOF packet }
  2603.         OldTry := OldTry+1;
  2604.         WITH Buf[CurrentPacket] DO BEGIN
  2605.           IF seq =((n + 63 ) MOD 64)            { packet number }
  2606.             THEN BEGIN  { send ACK }
  2607.               SendACK(seq);
  2608.               Numtry := 0;
  2609.               END
  2610.             ELSE SendNAK(n);  { NAK }
  2611.           END;  { with }
  2612.        END;  { process last EOF packet }
  2613.    END;  { procedure DoEOFLast }
  2614.  
  2615. $PAGE$
  2616. PROCEDURE DoInitLast;
  2617. {
  2618.  
  2619. Called by ReceiveFile when a Send-Init packet was received (i.e. when
  2620. the ACK for the last Send-Init was lost).  Resends the Send-Init.
  2621.  
  2622. Errors          Retry count exhausted
  2623.  
  2624. References      MaxTry
  2625.                 Buf[CurrentPacket]
  2626.                 NUMPARAM
  2627.  
  2628. Modifies        Buf[ThisPacket]
  2629.                 State
  2630.                 OldTry
  2631.                 NumTry
  2632.                 stats.NumACKsent
  2633.  
  2634. Calls           PutErr
  2635.                 EnCodeParm
  2636.                 SendPacket
  2637.                 SendNAK
  2638.  
  2639. Called by       ReceiveFile
  2640. }
  2641.   BEGIN                { Init Packet - last one }
  2642.     IF OldTry>MaxTry   { number of tries? }
  2643.       THEN BEGIN
  2644.         State := Abort;
  2645.         PutErr('Old init - Too many ');
  2646.         END
  2647.       ELSE BEGIN  { process last init packet }
  2648.         OldTry := OldTry+1;
  2649.         IF Buf[CurrentPacket].seq = ((n + 63) MOD  64)  { packet number }
  2650.           THEN BEGIN   { send ACK }
  2651.             WITH Buf[ThisPacket] DO BEGIN
  2652.               count := NUMPARAM;
  2653.               seq := Buf[CurrentPacket].seq;
  2654.               ptype := TYPEY;
  2655.               EnCodeParm(data);
  2656.               END;
  2657.             SendPacket;
  2658.             stats.NumACKsent := stats.NumACKsent+1;
  2659.             NumTry := 0;
  2660.             END  { send ACK }
  2661.           ELSE SendNAK(n);  { NAK }
  2662.        END;  { process last init packet }
  2663.    END;  { procedure DoInitLast }
  2664.  
  2665. $PAGE$
  2666. PROCEDURE ReceiveFile;                     { receive file packet }
  2667. {
  2668.  
  2669. Receives file header packet from host.
  2670.  
  2671. Returns one of the following codes in Kermit_error:
  2672.         success                 file header packet successfully received
  2673.         retry_exhausted         Retry count exhausted
  2674.         inv_packet_type         Invalid Packet Type
  2675.         errors returned by ReceivePacket
  2676.  
  2677. References      MaxTry
  2678.                 Verbosity
  2679.                 Debug
  2680.  
  2681. Modifies        Buf[CurrentPacket]
  2682.                 NumTry
  2683.  
  2684. Calls           ReceivePacket
  2685.                 DoInitLast
  2686.                 DoEOFLast
  2687.                 DoFile
  2688.                 DoBreak
  2689.                 SendNAK
  2690.  
  2691. Called by       RecvSwitch
  2692. }
  2693.   VAR
  2694.     good: boolean;
  2695.     rpos : integer;
  2696.     report, fnm : string[80];
  2697.   BEGIN
  2698.     kermit_error := success;
  2699.     IF NumTry > MaxTry          { check number of tries }
  2700.       THEN BEGIN        { retry count exhausted }
  2701.          State := Abort;
  2702.          kermit_error := retry_exhausted;
  2703.          END  { retry count exhausted }
  2704.       ELSE BEGIN        { get the file header packet }
  2705.         NumTry := NumTry+1;                { increase number of tries }
  2706.         ReceivePacket;                     { get packet }
  2707.         WITH Buf[CurrentPacket] DO BEGIN
  2708.           IF VERBOSITY
  2709.             THEN BEGIN
  2710.               setstrlen(report,0);
  2711.               strwrite(report,1,rpos, 'Receiving file header packet #',
  2712.                         seq:1); 
  2713.               report_log(report);
  2714.               END;
  2715.           IF (ptype in [TYPES, TYPEZ, TYPEF, TYPEB]) AND odd(kermit_error)
  2716.             THEN 
  2717.               CASE ptype OF
  2718.                 TYPES:  DoInitLast;      { ACK to Init packet lost }
  2719.                 TYPEZ:  DoEOFLast;       { ACK to EOF lost }
  2720.                 TYPEF:  begin            { File header }
  2721.                         BtoS(data, fnm);
  2722.                         report_receive_file(fnm);
  2723.                         DoFile;
  2724.                         end;  { TYPEF }
  2725.                 TYPEB:  DoBreak;         { finished receiving file group }
  2726.                END { case }
  2727.             ELSE BEGIN
  2728.               IF Debug
  2729.                 THEN PutErr('Expected File Packet');
  2730.               if odd(Kermit_error)       { if ReceivePacket successful }
  2731.                 then kermit_error := inv_packet_type;
  2732.               SendNAK(n);
  2733.               END;
  2734.         END;  { with }
  2735.       END;  { get the file header packet }
  2736.   END;  { procedure ReceiveFile }
  2737.  
  2738. $PAGE$
  2739. procedure SendRecvInit( fnm : filename );
  2740. {
  2741.  
  2742. Sends receive initiate packet with the given filename to the remote server.
  2743.  
  2744. Called by       RecvSwitch
  2745. }
  2746.   begin
  2747.   { build the Receive Init packet in ThisPacket }
  2748.   with Buf[ThisPacket] do begin
  2749.     StoB(fnm, data);        { convert filename into bytestring in data field }
  2750.     count := strlen(fnm);
  2751.     seq := n;
  2752.     ptype := TYPER;     { type is Receive Init }
  2753.     end;  { with }
  2754.   SendPacket;           { send ThisPacket }
  2755.   end;  { procedure SendRecvInit }
  2756.  
  2757.  
  2758. $PAGE$
  2759. procedure RecvSwitch( files : filename_list );
  2760. {
  2761.  
  2762. Receive file group state switcher.  If filename_list is non-empty, sends
  2763. receive init packet for the files in it.
  2764.  
  2765. Modifies        State
  2766.                 NumTry
  2767.  
  2768. Calls           StartRun
  2769.                 ReceiveData
  2770.                 GetTheirInit
  2771.                 ReceiveFile
  2772.  
  2773. Called by       Main program
  2774. }
  2775.    var i : integer;
  2776.        fnm : filename;
  2777.    BEGIN
  2778.      RunType := Receive;
  2779.      State := RecvInit;
  2780.      init_packet_display(runtype);
  2781.      NumTry := 0;
  2782.      StartRun;
  2783.      i := 1;
  2784.      while strlen(files[i]) <> 0 do begin
  2785.        fnm := files[i];
  2786.        i := i + 1;
  2787.        SendRecvInit( fnm );
  2788.        REPEAT
  2789.           if debug or verbosity
  2790.             then begin          { print blank line to separate packet info }
  2791.               report := '';
  2792.               report_log(report);
  2793.               end;
  2794.           CASE State OF
  2795.             FileData:       ReceiveData;
  2796.             RecvInit:       GetTheirInit;
  2797.             Break:          { nothing };
  2798.             FileHeader:     ReceiveFile;
  2799.             EOFile:         { nothing };
  2800.             Complete:       { nothing };
  2801.             Abort:          { nothing };
  2802.            END;  { case }
  2803.          UNTIL (State=Abort) OR (State=Complete ) or (not odd(kermit_error));
  2804.        end;  { while }
  2805.      clean_packet_display(runtype);
  2806.    END;  { procedure recvswitch }
  2807.  
  2808. end.  { module krmguts }
  2809.  
  2810. {--file KRMCMD--}
  2811. $Search 'KRMWNDW', 'KRMRPT'$
  2812. $ucsd on$
  2813.  
  2814. module command;
  2815. import  windowlib,
  2816.         err_codes,
  2817.         krmrpt;
  2818. export
  2819.  
  2820. const
  2821.   text_string_size = 255;
  2822.   MAXKEYWORDS = 20;
  2823.   required = false;         { arguments for parse, tell if arg is optional }
  2824.   optional = true;
  2825.   
  2826. type
  2827.   breakset_type = set of char;
  2828.   arg_type = (p_char,  p_integer,  p_text,  p_eol,  p_boolean,
  2829.                p_password, p_keyword);
  2830.   text_string = string [text_string_size];
  2831.   keyword_string_type = string [20];
  2832.   keyword_entry = record
  2833.                     ks : keyword_string_type;
  2834.                     kv : integer;
  2835.                   end;  { record }
  2836.   
  2837.   keyword_table = array[1..MAXKEYWORDS] of keyword_entry;
  2838.   keyword_table_ptr = ^keyword_table;
  2839.  
  2840. var
  2841.   parse_keyword_table : keyword_table_ptr;
  2842.   parse_result : integer;  { result of last parse }
  2843.   parse_result_str : text_string;
  2844.   
  2845. {
  2846. These are the argument buffers.  There is one buffer for each type of
  2847. argument.
  2848. }
  2849.   arg_char : char;
  2850.   arg_integer : integer;          { holds integers }
  2851.   arg_keyword : keyword_string_type;  { holds full keyword text of last
  2852.                                         parsed keyword }
  2853.   arg_text : text_string;         { holds text, keywords, passwords }
  2854.   arg_boolean : boolean;
  2855.  
  2856.  
  2857. procedure parse_init ( var prompt : string );
  2858. procedure parse( arg : arg_type ;  opt : boolean );
  2859.  
  2860. $page$
  2861. implement
  2862.  
  2863. var
  2864. eol_parsed : boolean;   { cleared by parse_init, set by parse }
  2865.  
  2866. cur_bufpos : integer;        { position of next char to be put in buffer }
  2867. init_bufpos : integer;       { position of first char of this token }
  2868. parse_buffer : string [80];
  2869.  
  2870.   
  2871. function read_kbd_char : char;
  2872. {
  2873.   Reads a char from the keyboard (non-echoing).  If a carriage return is
  2874.   typed,  returns a control M (#M).
  2875. }  
  2876.   var c : char;
  2877.   begin
  2878.   if eoln(keyboard)
  2879.        then begin
  2880.             readln(keyboard);
  2881.             c := #13;  { carriage return }
  2882.             end
  2883.        else read(keyboard,c);
  2884.   read_kbd_char := c;
  2885.   end;  { function read_kbd_char }
  2886.        
  2887. $page$
  2888. {
  2889. read_break      Reads from the terminal until one of a specified set of
  2890. characters is read.  The break character that terminated the read is
  2891. placed in breakchar.
  2892.   
  2893. Inputs :        buffer          Buffer used to accumulate actual characters
  2894.                                 typed on keyboard, including prompt and break
  2895.                                 characters
  2896.                 init_bufpos     Initial position in buffer in which to store
  2897.                                 the next character read from the keyboard.
  2898.                                 Will be updated to point to next char. after
  2899.                                 current input.
  2900.                 atom            String in which to return the token read
  2901.                                 (without break characters)
  2902.                 breakset        Set of characters which, when typed, signal
  2903.                                 that the token has been completed and that
  2904.                                 it should now be parsed
  2905.                 breakchar       Receives the break character actually
  2906.                                 read
  2907.                 echo            If true, characters read will be echoed
  2908.                                 to the screen; if false, they will not
  2909.                                 be echoed.
  2910.                 
  2911. Returns :    Result code, one of the following:
  2912.  
  2913.     success             The field was successfully read
  2914.     back_past_field     The user backed up past the beginning of this field
  2915.     abort_line          The user aborted the line by typing CTRL-U
  2916.     null_string         The user typed only a break character
  2917. }
  2918. function read_break( var buffer : string;
  2919.                      init_bufpos : integer;
  2920.                      var cur_bufpos : integer;
  2921.                      var atom : string;
  2922.                      breakset : breakset_type;
  2923.                      var breakchar : char;
  2924.                      echo : boolean ) : integer;
  2925.   
  2926.   var c : char;
  2927.       done : boolean;
  2928.       result : integer;
  2929.       bufpos : integer;
  2930.       
  2931.   begin
  2932.   result := success;
  2933.   done := false;
  2934.   bufpos := cur_bufpos;
  2935.   {setstrlen(atom,0);}
  2936.   
  2937.   repeat
  2938.     c := read_kbd_char;
  2939.     case c of
  2940.        #H,#127:   begin           { backspace or delete }
  2941.                   if bufpos > init_bufpos
  2942.                      then begin  { delete the character }
  2943.                        bufpos := bufpos-1;
  2944.                        setstrlen( buffer, strlen(buffer)-1);
  2945.                        setstrlen( atom, strlen(atom)-1);
  2946.                        write_window_char(command_window,#127);
  2947.                        end  { delete the character }
  2948.                      else begin  { backing up past beginning of field }
  2949.                           write(#7);  { beep }
  2950.                           result := back_past_field;
  2951.                           done := true;
  2952.                           end;  { backing up past field }
  2953.                   end;            { backspace or delete }
  2954.        #U:        begin           { control-U }
  2955.                   done := true;
  2956.                   result := abort_line;
  2957.                   end;            { control-U }
  2958.        #R:        begin           { control-R }
  2959.                   end;            { control-R }
  2960.        
  2961.        otherwise  begin           { c is not an editing char }
  2962.            if c >= #32 then begin        { if c is printable }
  2963.               setstrlen(buffer,strlen(buffer)+1);
  2964.               buffer[bufpos] := c;
  2965.               bufpos := bufpos + 1;
  2966.               if echo 
  2967.                  then write_window_char(command_window, c);
  2968.               end;  { if c is printable }
  2969.             
  2970.            if not (c in breakset)
  2971.                then if c >= #32
  2972.                        then begin       { c is printable }
  2973.                          setstrlen(atom,strlen(atom)+1);
  2974.                          atom[strlen(atom)] := c;
  2975.                          end  { c is printable }
  2976.                        else begin  { c is not printable }
  2977.                          write(#7);  { beep }
  2978.                          end   { c is not printable }
  2979.                else begin  { c is a break char }
  2980.                  breakchar := c;
  2981.                  if strlen(atom) <> 0
  2982.                     then result := success
  2983.                     else result := null_string;
  2984.                  done := true;
  2985.                  end;  { c is a break char }
  2986.             end;  { c is not an editing char }
  2987.     end;  { case }
  2988.   until done;
  2989.   read_break := result;
  2990.   cur_bufpos := bufpos;
  2991.   end;  { procedure read_break }
  2992.   
  2993.   
  2994. $page$
  2995. function stoi( var s : string ;  var i : integer ) : integer;
  2996. {
  2997.   
  2998. Converts string to integer.
  2999.   
  3000. Inputs :        s       string containing decimal digits to convert
  3001.                 i       integer to receive the converted value if successful
  3002.                 
  3003. Returns  :      Status code, one of the following:
  3004.  
  3005.         success                 Integer converted successfully
  3006.         non_digit               Non-digit character encountered
  3007.         overflow                Integer overflow
  3008.         null_string             Null string given as argument
  3009. }
  3010.   var
  3011.     e, j, digit : integer;    
  3012.     c : char;
  3013.     result : integer;
  3014.   begin
  3015.     result := success;
  3016.     e := 1;
  3017.     i := 0;
  3018.     j := strlen(s);
  3019.     if j = 0
  3020.        then result := null_string;
  3021.     while (j <> 0) and (result = success) do begin
  3022.       c := s[j];
  3023.       digit := ord(c) - ord('0');
  3024.       if (digit < 0) or (digit > 9)
  3025.          then result := non_digit
  3026.          else begin
  3027.            i := i + e*digit;
  3028.            e := e * 10;
  3029.            j := j - 1;
  3030.            end;
  3031.        end;  { while }
  3032.     stoi := result;
  3033.   end;  { procedure stoi }
  3034.     
  3035.     
  3036. { Function match returns true if the string test is a valid abbreviation
  3037.   for the string keyword.
  3038. }
  3039. function match (var word : string;  var keyword : string) : boolean;
  3040.   var result : boolean;
  3041.     j : integer;
  3042.     c : char;
  3043.   begin
  3044.   result := true;
  3045.   if strlen(word) > strlen(keyword)
  3046.      then result := false
  3047.      else begin       { could still be abbreviation }
  3048.        j := 1;
  3049.        while (j <= strlen(word)) and (result = true) do begin
  3050.          c := word[j];          { get character from test string }
  3051.          if c >= 'a' then c := chr( ord(c) - ord(' ') );  { uppercase it }
  3052.          if c <> keyword[j]
  3053.             then result := false;
  3054.             j := j+1;
  3055.          end;  { while }
  3056.        end;  { could still be abbreviation }
  3057.   match := result;
  3058.   end;  { function match }
  3059.   
  3060.   
  3061. $page$
  3062. function lookup_key( table : keyword_table;  var word : string;
  3063.                       var value : integer;
  3064.                       var full_word : string ) : integer;
  3065. {
  3066.  
  3067. Searches the given keyword table for an entry that matches the given
  3068. keyword.
  3069.  
  3070. Inputs :  table - keyword table, which is array of records of type
  3071.                   keyword_entry.  These records consist of the keyword
  3072.                   string itself and the integer value assigned to the
  3073.                   keyword.
  3074.                   
  3075.           word -  keyword string to search for.
  3076.           
  3077. Outputs :  value -  If a match for the keyword is found, value receives
  3078.                     the integer value assigned to the keyword, found in
  3079.                     the keyword's record.
  3080.                     
  3081.            full_word - if a match for the keyword is found, full_word
  3082.                     receives the full keyword text.  For example, if
  3083.                     the word 'FO' matched the keyword 'FORMS' then
  3084.                     full_word would receive 'FORMS'.
  3085.                     
  3086. Returns:   Result code, one of
  3087.  
  3088.     success             match found for keyword, value contains the
  3089.                         keyword's assigned integer value.
  3090.                             
  3091.     ambig_keyword       given keyword matched more than one
  3092.                         table entry
  3093.      
  3094.     no_keyword          No table entry matched the given keyword.
  3095.           
  3096. }
  3097.   var i : integer;      { keyword position in table }
  3098.       result : integer;
  3099.  
  3100. begin
  3101.   i := 1;               { point to first keyword in table }
  3102.   result := no_keyword;
  3103.   while (result <> ambig_keyword) and (strlen(table[i].ks) <> 0) do begin
  3104.     if match(word, table[i].ks)
  3105.        then begin       { this keyword matches }
  3106.          if result = success
  3107.            then result := ambig_keyword         { already found match }
  3108.            else begin                   { this is first match yet }
  3109.              value := table[i].kv;
  3110.              full_word := table[i].ks;
  3111.              result := success;
  3112.              end;  { this is first match yet }
  3113.          end;  { this keyword matches }
  3114.        i := i + 1;
  3115.     end;  { while }
  3116.   lookup_key := result;
  3117.   end;  { procedure lookup_key }
  3118.     
  3119. $page$
  3120.  
  3121. procedure parse_init ( var prompt : string );
  3122.   begin
  3123.   clear_window(command_window);
  3124.   clear_window(help_window);
  3125.   write_window_string(command_window, prompt);
  3126.   clear_eol_window(command_window);
  3127.   parse_buffer := prompt;
  3128.   init_bufpos := strlen(prompt) + 1;
  3129.   cur_bufpos := init_bufpos;
  3130.   eol_parsed := false;
  3131.   end;  { procedure parse_init }
  3132.   
  3133. $page$
  3134. {
  3135.  
  3136. This procedure, parse, reads an argument of the given type from the
  3137. command input device (usually the console) and leaves it in the buffer
  3138. corresponding to that type (there is a buffer for each type of
  3139. argument).  If the argument is optional, as indicated by the second
  3140. parameter (named optional) being true, then the argument may or may
  3141. not be given by the user.  If it is not, the corresponding buffer will
  3142. remain unchanged.  This allows default values to be set by the
  3143. set_p_xxx procedures.  The value in the buffer may be read by the
  3144. get_p_xxx functions.
  3145.  
  3146. Error code will be left in parse_result.  A string with an parse error
  3147. message and the atom causing the error will be left in
  3148. parse_result_str.
  3149. }
  3150. procedure parse( arg : arg_type ;  opt : boolean );
  3151.   label 200,1000;
  3152.   var
  3153.     breakchar : char;
  3154.     read_result : integer;
  3155.     atom, report, title, kwd : string [80];
  3156.     echo : boolean;
  3157.     added_keyword, kwd_match : boolean;
  3158.     breakset : breakset_type;
  3159.     rpos, i : integer;
  3160.     bk : keyword_table_ptr;     { boolean TRUE/FALSE keyword table }
  3161.   
  3162.   procedure do_tab( var s : string );
  3163.     var pos : integer;
  3164.     begin
  3165.     pos := strlen(s);
  3166.     repeat
  3167.       pos := pos + 1;
  3168.       setstrlen(s,pos);
  3169.       s[pos] := ' ';
  3170.     until pos mod 8 = 0;
  3171.     end;  { procedure do_tab }
  3172.     
  3173.   begin
  3174.   parse_result := success;      { assume success for now }
  3175.   atom := '';
  3176.   cur_bufpos := init_bufpos;
  3177.   
  3178.   if arg = p_eol
  3179.      then begin         { parsing for EOL }
  3180.        if not eol_parsed
  3181.         then parse_result := not_confirmed;
  3182.         goto 1000;
  3183.        end
  3184.      else                 { not parsing for EOL }
  3185.        if eol_parsed then begin
  3186.           if not opt
  3187.             then parse_result := parse_after_eol;
  3188.           goto 1000;
  3189.           end;
  3190.      
  3191.   if arg = p_password
  3192.      then echo := false
  3193.      else echo := true;
  3194.      
  3195. 200:
  3196.   if arg in [p_text, p_integer, p_boolean, p_password, p_keyword]
  3197.      then begin  { arg needs a string }
  3198.        if arg = p_text
  3199.           then breakset := ['?', #M]
  3200.           else breakset := ['?', ' ', ',', #M];
  3201.           read_result := read_break ( parse_buffer, init_bufpos,
  3202.                                       cur_bufpos, atom,
  3203.                                       breakset, breakchar, echo );
  3204.        
  3205.        case read_result of
  3206.           success:           begin
  3207.                              if breakchar = #M then eol_parsed := true;
  3208.                              end;
  3209.           
  3210.           back_past_field:   begin
  3211.                              parse_result := back_past_field;
  3212.                              goto 1000;
  3213.                              end;
  3214.           
  3215.           abort_line:        begin
  3216.                              parse_result := abort_line;
  3217.                              goto 1000;
  3218.                              end;
  3219.           
  3220.           null_string:       begin
  3221.                              if breakchar <> '?'
  3222.                                then begin
  3223.                                  parse_result := null_string;
  3224.                                  goto 1000;
  3225.                                  end;
  3226.                              end;
  3227.           end;  { case }
  3228.        end;  { arg needs a string }
  3229.      
  3230.   case arg of
  3231.      p_char     :  begin
  3232.                    arg_char := read_kbd_char;
  3233.                    end; { p_char }
  3234.                    
  3235.      p_integer  :  begin
  3236.                    parse_result := stoi( atom, arg_integer );
  3237.                    end; { p_integer }
  3238.                    
  3239.      p_text     :  begin
  3240.                    arg_text := atom;
  3241.                    end; { p_text }
  3242.                    
  3243.      p_boolean  :  begin
  3244.                    new(bk);
  3245.                    bk^[1].ks := 'FALSE';
  3246.                    bk^[1].kv := 0;
  3247.                    bk^[2].ks := 'TRUE';
  3248.                    bk^[2].kv := 1;
  3249.                    bk^[3].ks := '';
  3250.                    bk^[3].kv := 0;
  3251.                    parse_result := lookup_key( bk^, atom,
  3252.                                                arg_integer, arg_keyword );
  3253.                    arg_boolean := (arg_integer = 1);
  3254.                    end; { p_boolean }
  3255.      
  3256.      p_password :  begin
  3257.                    arg_text := atom;
  3258.                    end; { p_password }
  3259.      {
  3260.      Parse a keyword.  See if the given string matches any of the entries
  3261.      in parse_keyword_table.
  3262.      }
  3263.      p_keyword  :  begin
  3264.            if breakchar = '?'
  3265.              then begin         { help character typed }
  3266.                clear_window( help_window );
  3267.                i := 1;
  3268.                setstrlen(report,0);
  3269.                added_keyword := false;
  3270.                repeat
  3271.                  kwd := parse_keyword_table^[i].ks;
  3272.                  if (strlen(atom) = 0)
  3273.                    then kwd_match := true
  3274.                    else kwd_match := match(atom,kwd);
  3275.                  if (strlen(kwd) <> 0) and kwd_match 
  3276.                    then begin           { add keyword to output string }
  3277.                      do_tab(report);
  3278.                      rpos := strlen(report)+1;
  3279.                      strwrite(report,rpos,rpos,kwd);
  3280.                      if strlen(kwd) >=7 then do_tab(report);
  3281.                      if not added_keyword     { if haven't printed title yet }
  3282.                        then begin   { print title }
  3283.                          title := 'Keyword, one of the following:';
  3284.                          writeln_window_string(help_window, title);
  3285.                          added_keyword := true;
  3286.                          end;  { print title }
  3287.                      end;  { add keyword to output string }
  3288.                  
  3289.                  if (strlen(report) > 64)  or  (strlen(kwd) = 0)
  3290.                    then begin  { print the accumulated keyword list }
  3291.                      writeln_window_string(help_window,report);
  3292.                      setstrlen(report,0);
  3293.                      rpos := 1;
  3294.                      end; { print the accumulated keyword list }
  3295.                  i := i+1;
  3296.                until strlen(kwd) = 0;
  3297.                
  3298.                if not added_keyword     { if no keywords in list }
  3299.                  then begin  { print no match msg }
  3300.                    title := 'Keyword (no defined keywords match this input)';
  3301.                    writeln_window_string(help_window,title);
  3302.                    end;  { print no match msg }
  3303.          
  3304.          { remove the break character from the input buffer }
  3305.                setstrlen(parse_buffer, strlen(parse_buffer)-1);
  3306.                cur_bufpos := cur_bufpos - 1;
  3307.                clear_window(command_window);
  3308.                write_window_string(command_window,parse_buffer);
  3309.                goto 200;
  3310.                end  { help character typed }
  3311.              else begin         { parse the keyword }
  3312.                parse_result := lookup_key( parse_keyword_table^,
  3313.                                            atom,
  3314.                                            arg_integer,
  3315.                                            arg_keyword );
  3316.                arg_text := atom;
  3317.                end;  { parse the keyword }
  3318.            end;  { p_keyword }
  3319.   end; { case }
  3320. 1000:
  3321. init_bufpos := cur_bufpos;
  3322.  
  3323. if not (parse_result in [success, abort_line, back_past_field, null_string])
  3324.   then begin            { set up parse error string }
  3325.     setstrlen(parse_result_str,0);
  3326.     strwrite(parse_result_str,1,rpos,'parsing "',atom,'"' );
  3327.     end;    { set up parse error string }
  3328. end;  { procedure parse }
  3329.  
  3330. end.  { module command }
  3331.  
  3332. {--file KRMIO--}
  3333. $Debug off$
  3334. $UCSD ON$
  3335. $SYSPROG$
  3336. $SEARCH '*IO.', '*INTERFACE.'$
  3337.  
  3338. MODULE ascii_defs;      { Defines ASCII character set as decimal numbers }
  3339.  
  3340. export
  3341.    const
  3342.      { ASCII character set in decimal }
  3343.    
  3344.      SOH        = 1;                  { ascii SOH character }
  3345.      CTRLC      = 3;
  3346.      BACKSPACE  = 8;
  3347.      TAB        = 9;
  3348.      NEWLINE    = 10;
  3349.      LF         = 10;
  3350.      FORMFEED   = 12;
  3351.      CR         = 13;                 { CR }
  3352.      RETURN     = 13;
  3353.      
  3354.      CTRLY      = 25;
  3355.      CONTROLBAR = 28;
  3356.      
  3357.      BLANK     = 32;
  3358.      EXCLAM    = 33;                  { ! }
  3359.      DQUOTE    = 34;                  { " }
  3360.      SHARP     = 35;                  { # }
  3361.      DOLLAR    = 36;                  { $ }
  3362.      PERCENT   = 37;                  { % }
  3363.      AMPER     = 38;                  { & }
  3364.      SQUOTE    = 39;                  { ' }
  3365.      ACUTE     = SQUOTE;
  3366.      LPAREN    = 40;                  { ( }
  3367.      RPAREN    = 41;                  { ) }
  3368.      STAR      = 42;                  { * }
  3369.      PLUS      = 43;                  { + }
  3370.      COMMA     = 44;                  { , }
  3371.      MINUS     = 45;                  { - }
  3372.      DASH      = MINUS;
  3373.      PERIOD    = 46;                  { . }
  3374.      SLASH     = 47;                  { / }
  3375.      COLON     = 58;                  { : }
  3376.      SEMICOL   = 59;                  { ; }
  3377.      LESS      = 60;                  { < }
  3378.      EQUALS    = 61;                  { = }
  3379.      GREATER   = 62;                  { > }
  3380.      QUESTION  = 63;                  { ? }
  3381.      ATSIGN    = 64;                  { @ }
  3382.      LBRACK    = 91;                  { [ }
  3383.      BACKSLASH = 92;                  { \ }
  3384.      RBRACK    = 93;                  { ] }
  3385.      CARET     = 94;                  { ^ }
  3386.      UNDERLINE = 95;                  { _ }
  3387.      GRAVE = 96;                      { ` }
  3388.      LETA = 97;                       { lower case ... }
  3389.      LETB = 98;
  3390.      LETC = 99;
  3391.      LETD = 100;
  3392.      LETE = 101;
  3393.      LETF = 102;
  3394.      LETG = 103;
  3395.      LETH = 104;
  3396.      LETI = 105;
  3397.      LETJ = 106;
  3398.      LETK = 107;
  3399.      LETL = 108;
  3400.      LETM = 109;
  3401.      LETN = 110;
  3402.      LETO = 111;
  3403.      LETP = 112;
  3404.      LETQ = 113;
  3405.      LETR = 114;
  3406.      LETS = 115;
  3407.      LETT = 116;
  3408.      LETU = 117;
  3409.      LETV = 118;
  3410.      LETW = 119;
  3411.      LETX = 120;
  3412.      LETY = 121;
  3413.      LETZ = 122;
  3414.      LBRACE = 123;                    { left brace }       
  3415.      BAR = 124;                       { | }
  3416.      RBRACE = 125;                    { right brace }
  3417.      TILDE = 126;                     { ~ }
  3418.    
  3419.      DEL = 127;                       { rubout }      
  3420.  
  3421. implement
  3422.  
  3423. end;  { Module ascii_defs }
  3424.  
  3425.  
  3426. $PAGE$
  3427. {
  3428.  
  3429. Module BYTE_STR defines data structures for storing 8-bit
  3430. "characters", and provides routines for manipulating them.
  3431.  
  3432. }
  3433. MODULE byte_str;
  3434. import  ascii_defs;
  3435.  
  3436. export
  3437.  
  3438. const
  3439.   ENDSTR = 0;     { null-terminated ByteStrings }
  3440.   MAXSTR = 100;   { longest possible ByteString }
  3441.   CONLENGTH = 20; { length of constant string }
  3442.  
  3443. type
  3444.   byte = -1..255;                        { byte-sized ascii + other stuff }
  3445.   ByteString = ARRAY [1..MAXSTR] OF byte;
  3446.   cstring = PACKED ARRAY [1..CONLENGTH] OF char;
  3447.    
  3448. FUNCTION  length (VAR s : ByteString) : integer;
  3449. FUNCTION  index (VAR s : ByteString; c : byte) : integer;
  3450. PROCEDURE scopy (VAR src : ByteString; i : integer;
  3451.                    VAR dest : ByteString; j : integer);
  3452. PROCEDURE CtoB ( cs : cstring; VAR bs : ByteString );
  3453. PROCEDURE StoB ( VAR s : string;  VAR bs : ByteString );
  3454. PROCEDURE BtoS ( bs : ByteString; var s : string );
  3455. FUNCTION  ItoC (n : integer; VAR s : ByteString; i : integer)
  3456.                 : integer;      { returns index of end of s }
  3457. FUNCTION  IsUpper (c : byte) : boolean;
  3458. FUNCTION  IsControl (c : byte) : boolean;
  3459. FUNCTION  IsPrintable (c : byte) : boolean;
  3460.  
  3461.  
  3462. implement
  3463. $PAGE$
  3464.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  3465.  
  3466. FUNCTION length (VAR s : ByteString) : integer;
  3467. {
  3468.  
  3469. Computes length of string, not counting the end delimiter (ENDSTR).
  3470.  
  3471. }
  3472.  
  3473.   VAR
  3474.     n : integer;
  3475.    BEGIN
  3476.      n := 1;
  3477.      WHILE (s[n] <> ENDSTR) DO
  3478.      n := n + 1;
  3479.      length := n - 1
  3480.    END;
  3481.  
  3482. $PAGE$
  3483.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  3484.  
  3485. FUNCTION index (VAR s : ByteString; c : byte) : integer;
  3486. {
  3487.  
  3488. Find position of character c in ByteString s
  3489.  
  3490. }
  3491.   VAR
  3492.     i : integer;
  3493.    BEGIN
  3494.      i := 1;
  3495.      WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
  3496.        i := i + 1;
  3497.        IF (s[i] = ENDSTR)
  3498.         THEN index := 0
  3499.         ELSE index := i
  3500.    END;
  3501.  
  3502. $PAGE$
  3503.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  3504.  
  3505. PROCEDURE scopy (VAR src : ByteString; i : integer;
  3506.                    VAR dest : ByteString; j : integer);
  3507. {
  3508.  
  3509. Copy ByteString at src[i] to dest[j].
  3510.  
  3511. }
  3512.    BEGIN
  3513.      WHILE (src[i] <> ENDSTR) DO
  3514.       BEGIN
  3515.         dest[j] := src[i];
  3516.         i := i + 1;
  3517.         j := j + 1
  3518.       END;
  3519.      dest[j] := ENDSTR
  3520.    END;
  3521.  
  3522. $PAGE$
  3523. PROCEDURE CtoB ( cs : cstring; VAR bs : ByteString );
  3524. {
  3525.         where cs = packed array of char (PAC) to be converted
  3526.               bs = packed array of byte (ByteString) to receive the
  3527.                    converted string
  3528.  
  3529. Convert PAC constant to ByteString.
  3530.  
  3531. Called by       PutCon
  3532.                 ParmInit
  3533.                 SendNAK
  3534.                 GetFile
  3535.                 ReceiveData
  3536.                 Main prog
  3537. }
  3538.  
  3539.   VAR
  3540.     i : integer;
  3541.    BEGIN
  3542.      FOR i:=1 TO CONLENGTH DO
  3543.      bs[i] := ord(cs[i]);
  3544.      bs[CONLENGTH+1] := ENDSTR;
  3545.    END;
  3546.  
  3547. $PAGE$
  3548. PROCEDURE StoB ( VAR s : string;  VAR bs : ByteString );
  3549. {
  3550.         where  s = string to be converted
  3551.               bs = packed array of byte (ByteString) to receive the
  3552.                    converted string
  3553.  
  3554. Converts string to ByteString.
  3555.  
  3556. Called by       GetNextFile
  3557. }
  3558.  
  3559.   VAR
  3560.     i : integer;
  3561.    BEGIN
  3562.      FOR i:=1 TO strlen(s) DO
  3563.        bs[i] := ord(s[i]);
  3564.      bs[strlen(s)+1] := ENDSTR;
  3565.    END;
  3566.  
  3567. $PAGE$
  3568. PROCEDURE BtoS ( bs : ByteString; var s : string );
  3569.   var i : integer;
  3570.      CH : CHAR;
  3571.   begin
  3572.   TRY
  3573.   i := 1;
  3574.   s := '';
  3575.   while bs[i] <> ENDSTR do begin
  3576.     setstrlen(s, strlen(s)+1);
  3577.     s[i] := chr(bs[i]);
  3578.     i := i + 1;
  3579.     end;  { while }
  3580.   setstrlen(s,i-1);
  3581.   
  3582.   RECOVER BEGIN
  3583.     if escapecode = -8
  3584.        then begin  { value range error }
  3585.          writeln('Value range error in BtoS :  i = ',i:1,
  3586.                  '  bs[i] = ',CHR(bs[i]));
  3587.          writeln('Type any char to continue');
  3588.          READ(CH);
  3589.          end  { value range error }
  3590.        else escape(escapecode);
  3591.     END;  { RECOVER }
  3592.     
  3593.   end;  { procedure BtoS }
  3594.   
  3595. $PAGE$
  3596.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  3597.  
  3598. FUNCTION ItoC (n : integer; VAR s : ByteString; i : integer)
  3599.     : integer;      { returns index of end of s }
  3600. {
  3601.  
  3602.         where   n = integer to be converted
  3603.                 s = ByteString in which to return the converted integer
  3604.                 i = starting index within s at which to store the 
  3605.                     first character of converted integer
  3606.  
  3607. Converts integer n to char ByteString in s[i].  Returns index in s of the
  3608. character after the last one written.
  3609.  
  3610. Called by       PutNum
  3611.                 GetFile
  3612.                 ReceiveData
  3613. }
  3614.  
  3615.    BEGIN
  3616.      IF (n < 0)
  3617.       THEN
  3618.        BEGIN
  3619.          s[i] := ord('-');
  3620.          ItoC := ItoC(-n, s, i+1)
  3621.        END
  3622.       ELSE
  3623.        BEGIN
  3624.          IF (n >= 10)
  3625.           THEN
  3626.           i := ItoC(n DIV 10, s, i);
  3627.          s[i] := n MOD 10 + ord('0');
  3628.          s[i+1] := ENDSTR;
  3629.          ItoC := i + 1
  3630.        END
  3631.    END;
  3632.  
  3633. $PAGE$
  3634.   { copyright (c) 1981 university of toronto computing services }
  3635.  
  3636. FUNCTION IsUpper ( c : byte ) : boolean;
  3637. {
  3638.  
  3639. True if c is upper case letter.
  3640.  
  3641. }
  3642.    BEGIN
  3643.      IsUpper := (c >= ord('A')) AND (c <= ord('Z'))
  3644.    END;
  3645.  
  3646. $PAGE$
  3647. FUNCTION IsControl ( c : byte ) : boolean;
  3648. {
  3649.  
  3650. True if character is a control character (ie, if c < 32.).
  3651.  
  3652. }
  3653.    BEGIN
  3654.      IsControl := (c=DEL ) OR (c < BLANK );
  3655.    END;
  3656.  
  3657. $PAGE$
  3658. FUNCTION IsPrintable ( c : byte ) : boolean;
  3659. {
  3660.  
  3661. True if character is not a control character (ie, if c >= 32.).
  3662.  
  3663. }
  3664.    BEGIN
  3665.      IsPrintable := NOT IsControl(c);
  3666.    END;
  3667.  
  3668. end; { module byte_str }
  3669.  
  3670.  
  3671. $PAGE$
  3672. MODULE terminal;   
  3673.  
  3674. { Module terminal provides low level character i/o to the console
  3675.   keyboard (non-echoing), CRT screen, and the datacomm interface.
  3676.   A terminal emulator procedure is also provided which implements
  3677.   a rudimentary (glass TTY) terminal over the datacomm interface.
  3678. }
  3679. import  ascii_defs,
  3680.         byte_str,
  3681.         iodeclarations,
  3682.         iocomasm,
  3683.         general_0,
  3684.         general_1,
  3685.         general_2,
  3686.         general_3,
  3687.         general_4,
  3688.         serial_0,
  3689.         serial_3;
  3690.  
  3691. export
  3692.   var
  3693.       { Datacomm interface parameters }
  3694.  
  3695.         comm_bits_per_char : 5..8;
  3696.         comm_stop_bits : real;
  3697.         comm_parity : type_parity;
  3698.         comm_speed : integer;
  3699.  
  3700.  
  3701.   procedure init_data_comm;             { sets up serial port }
  3702.   procedure check_data_comm;            { maintains serial input buffer }
  3703.   
  3704.   function SerialStatus : boolean;      { returns true if serial char ready }
  3705.   function SerialIn : byte;             { returns char from serial port }
  3706.   procedure SerialOut( c : byte );      { sends char to serial port }
  3707.   procedure SerialFlush;                { flushes serial input buffer }
  3708.   function SerialData : integer;        { returns number of chars in buffer }
  3709.   
  3710.   function ConsoleStatus : boolean;     { returns true if kybd char typed }
  3711.   function ConsoleIn : char;            { returns char typed on console }
  3712.   procedure ConsoleOut ( c : char );    { sends character to console }
  3713.   
  3714.   procedure Emulator ( breakchar : char ;
  3715.                        function break_func ( c : char ) : boolean );
  3716.                                         { provides glass tty }
  3717.  
  3718. $PAGE$
  3719. implement
  3720.    const
  3721.       comm = 20;           { Datacomm select code }
  3722.       bufsize = 5000;      { buffer size for datacomm transfers }
  3723.       kbdunit = 2;         { Unit number for keyboard }
  3724.    
  3725.    var
  3726.      termbuf : buf_info_type;   { buffer for serial input }
  3727.  
  3728. {
  3729. init_data_comm must be called before any of the SerialXxx routines.
  3730. It sets the physical transmission parameters for the datacomm
  3731. interface, initializes a transfer buffer for incoming characters
  3732. (termbuf), and starts a transfer into that buffer.  For some reason
  3733. the serial port seems to ignore any incoming characters until it has
  3734. sent one itself, so NUL is sent to the serial port. 
  3735. }
  3736. procedure init_data_comm;
  3737.    
  3738.    procedure init_comm_parms;
  3739.       begin
  3740.       comm_bits_per_char := 8;
  3741.       comm_stop_bits := 1;
  3742.       comm_speed := 9600;
  3743.       comm_parity := no_parity;
  3744.       end;
  3745.  
  3746.    begin
  3747.    ioreset(comm);            { reset the datacomm card }
  3748.    init_comm_parms;          { initialize transmission parameters }
  3749.    iocontrol(comm,22,0);     { no flow control protocol }
  3750.    iocontrol(comm,23,0);     { no handshake }
  3751.    iocontrol(comm,24,127);   { pass all characters }
  3752.    iocontrol(comm,28,0);     { card EOL = none }
  3753.  
  3754.    set_baud_rate(comm,comm_speed);
  3755.    set_parity(comm,comm_parity);
  3756.    set_char_length(comm,comm_bits_per_char);
  3757.    set_stop_bits(comm,comm_stop_bits);
  3758.  
  3759.    iobuffer(termbuf,bufsize);           { get a ring buffer for datacomm }
  3760.                                         { incoming characters }
  3761.    transfer(comm,overlap,to_memory,termbuf,bufsize); { initial transfer }
  3762.    writechar(comm, chr(0));   { send null to allow incoming chars }
  3763.                               { don't know why... }
  3764.    end;  { procedure init_data_comm }
  3765.    
  3766. $PAGE$
  3767. {
  3768. check_data_comm makes sure that there is an active transfer in
  3769. progress from the serial port to its buffer (termbuf).  It is called
  3770. automatically by SerialStatus.
  3771. }
  3772. procedure check_data_comm;   { maintains datacomm input buffers }
  3773.   begin
  3774.   if (termbuf.active_isc = no_isc) and (buffer_data(termbuf)=0)
  3775.      then begin             { if buffer is empty and no transfer occurring }
  3776.        transfer(comm,overlap,to_memory,termbuf,bufsize);
  3777.      end;  { if buffer empty and no transfer occurring }
  3778.   end;  { procedure check_data_comm }
  3779.  
  3780. {
  3781. SerialStatus returns true if a character is ready from the serial
  3782. port.  It calls check_data_comm to ensure the buffer is being filled.
  3783. }
  3784. function SerialStatus : boolean;
  3785.   begin
  3786.   check_data_comm;                      { make sure buffer is being filled }
  3787.   SerialStatus := buffer_data (termbuf) <> 0;
  3788.   end;  { function SerialStatus }
  3789.   
  3790. function SerialIn : byte;
  3791.   var ch : char;
  3792.   begin
  3793.   if SerialStatus
  3794.      then begin                         { character ready }
  3795.           readbuffer(termbuf,ch);       { get the character from the buffer }
  3796.           SerialIn := ord( ch );
  3797.           end
  3798.      else begin                         { no character ready }
  3799.           SerialIn := ENDSTR;
  3800.           end;
  3801.   end;  { function SerialIn }
  3802.  
  3803. {
  3804. SerialOut writes the given byte to the serial port.
  3805. }
  3806. procedure SerialOut ( c : byte );
  3807.   begin
  3808.   writechar(comm, chr(c));
  3809.   end;  { procedure SerialOut }
  3810.   
  3811. {
  3812. SerialFlush empties the serial input buffer.
  3813. }
  3814. procedure SerialFlush;
  3815.   var c : char;
  3816.   begin
  3817.   while (buffer_data(termbuf) <> 0) do
  3818.     readbuffer(termbuf,c);
  3819.   end;  { procedure SerialFlush }
  3820.  
  3821. function SerialData : integer;        { returns number of chars. in buffer }
  3822.   begin
  3823.   SerialData := buffer_data(termbuf);
  3824.   end;  { function SerialData }
  3825.   
  3826. $PAGE$
  3827. function ConsoleStatus : boolean;    { returns true if char available }
  3828.   begin
  3829.   ConsoleStatus := not unitbusy(kbdunit);
  3830.   end;  { function ConsoleStatus }
  3831.  
  3832. function ConsoleIn : char;      { returns byte read from keyboard (no echo) }
  3833.   var ch : char;
  3834.   begin
  3835.   if eoln(keyboard)
  3836.      then begin
  3837.        readln(keyboard);
  3838.        ch := chr(NEWLINE);           { return NEWLINE if eoln }
  3839.        end
  3840.      else read(keyboard,ch);
  3841.   ConsoleIn := ch;     { return of char }
  3842.   end;  { function ConsoleIn }
  3843.   
  3844. procedure ConsoleOut ( c : char );
  3845.   var c7 : char;
  3846.   begin
  3847.   c7 := chr(binand(ord(c), 127));         { mask off bit 7 }
  3848.   if c7 <> #0                    { if not null }
  3849.      then write( c7 );
  3850.   end;  { procedure ConsoleOut }
  3851.   
  3852.  
  3853. $PAGE$
  3854. procedure Emulator ( breakchar : char ;
  3855.                      function break_func ( c : char ) : boolean );
  3856.                                           { implements terminal emulator }
  3857.  
  3858. { When the user types the break character, the next character is read
  3859.   (but not sent to the datacomm port).  If the second character is also
  3860.   the break character, the break character will be sent to the datacomm
  3861.   port.  If it is not, the break_func action routine will be called with
  3862.   that character as the parameter.  Note that break_func must be declared
  3863.   in a program block, as must all functions and procedures passed as
  3864.   parameters.  If the break_func returns TRUE, the emulator will return
  3865.   to the caller.
  3866.   
  3867.   The datacomm interface is assumed to have been previously initialized
  3868.   via a previous call to init_data_comm.
  3869. }
  3870.    var  serchar : byte;
  3871.         kbdchar : char;
  3872.         done : boolean;
  3873.         
  3874.    
  3875.    begin { procedure Emulator }
  3876.    
  3877.    writeln( 'Entering terminal emulator' );
  3878.    write  ( 'Escape character is ');
  3879.    if breakchar < #32
  3880.       then writeln('^',chr( ord(breakchar) + 64))
  3881.       else writeln('''',breakchar,'''');
  3882.    writeln;
  3883.    
  3884.    done := false;
  3885.    repeat
  3886.       if consolestatus                  { if keyboard char available }
  3887.          then begin             
  3888.            kbdchar := ConsoleIn;
  3889.            if kbdchar = breakchar       { if break character typed }
  3890.               then begin
  3891.                    kbdchar := ConsoleIn;
  3892.                    if kbdchar <> breakchar
  3893.                       then begin
  3894.                         if break_func ( kbdchar )  { then call break_func }
  3895.                           then done := true;
  3896.                         end
  3897.                       else SerialOut(ord(breakchar)); { else send breakchar }
  3898.                    end   { if break character typed }
  3899.               else SerialOut(ord(kbdchar))         { send char to datacomm }
  3900.            end;  { if keyboard char available }
  3901.          
  3902.       if serialstatus                   { if data ready from datacomm }
  3903.          then begin
  3904.          serchar := SerialIn;
  3905.          ConsoleOut( chr(serchar) );
  3906.          end;       { if data ready from datacomm }
  3907.    
  3908.    until done;
  3909.    
  3910. end;   { procedure Emulator }
  3911.  
  3912. end;  { End MODULE terminal }
  3913.  
  3914. $PAGE$
  3915. MODULE byte_io;
  3916. import  ascii_defs,
  3917.         byte_str,
  3918.         terminal;
  3919.  
  3920. export
  3921.  
  3922. const
  3923.   
  3924.   FLEN1 = 10;   { length of file name only (without extension) }
  3925.   FLEN2 = 15;   { length of filespec (with extension) }
  3926.   FILENAME_LENGTH = 30;
  3927.   
  3928.   LP =       'PRINTER:            ';
  3929.   TTYNAME =  'CONSOLE:';        { ByteString name of console (local)
  3930.                                   terminal that can be given to RESET,
  3931.                                   REWRITE, etc. }
  3932.  
  3933.   { standard file descriptors. subscripts in open, etc. }
  3934.  
  3935.   STDIN = 1;              { these are not to be changed }
  3936.   STDOUT = 2;
  3937.   STDERR = 3;
  3938.   LINEOUT = 4;
  3939.   LINEIN = 5;
  3940.  
  3941.   { other io-related stuff }
  3942.  
  3943.   IOERROR = 0;                  { status values for open files }
  3944.   IOAVAIL = 1;
  3945.   IOREAD = 2;
  3946.   IOWRITE = 3;
  3947.   MAXOPEN = 15;                 { maximum number of open files }
  3948.   ENDFILE = -1;
  3949.  
  3950. type
  3951.  
  3952.   filedesc = IOERROR..MAXOPEN;  { file descriptor values }
  3953.   filename = string [FILENAME_LENGTH];
  3954.  
  3955. PROCEDURE initio;
  3956. FUNCTION  Getcf ( VAR c: byte;   fd : filedesc ) : byte;
  3957. FUNCTION  GetLine ( VAR s : ByteString; fd : filedesc;
  3958.                                    maxsize : integer ) : boolean;
  3959. PROCEDURE Putc ( c : byte );
  3960. PROCEDURE Putcf ( c : byte;  fd : filedesc );
  3961. PROCEDURE PutStr (VAR s : ByteString; fd : filedesc);
  3962. FUNCTION  Sopen (name : filename; mode :   integer) : filedesc;
  3963. PROCEDURE Sclose (fd : filedesc);
  3964. FUNCTION  Exists (s : filename) : boolean;
  3965. PROCEDURE PutNum ( n : integer;    fd : filedesc );
  3966. PROCEDURE PutCon( x : cstring;  fd : filedesc );
  3967.  
  3968. implement
  3969.  
  3970. type
  3971.  
  3972.   ioblock = RECORD        { to keep track of open files }
  3973.               filevar : text;
  3974.               mode : IOERROR..IOWRITE;
  3975.               linepos : integer;           { character position within line }
  3976.             END;
  3977. var
  3978.   opencount : integer;
  3979.   openlist : ARRAY [1..MAXOPEN] OF ioblock;        {  open files }
  3980.  
  3981. $PAGE$
  3982. PROCEDURE initio;
  3983. {
  3984.  
  3985. Initializes open file list.
  3986.  
  3987. Calls           Rewrite
  3988.  
  3989. Called by       Main program
  3990. }
  3991.  
  3992.   VAR
  3993.     i :     filedesc;
  3994.    BEGIN
  3995.      openlist[STDIN].mode := IOREAD;
  3996.      openlist[STDOUT].mode := IOWRITE;
  3997.      openlist[STDOUT].linepos := 0;
  3998.      openlist[STDERR].mode := IOWRITE;
  3999.      openlist[STDERR].linepos := 0;
  4000.      openlist[lineout].mode := IOWRITE;
  4001.      openlist[linein].mode := IOREAD;
  4002.  
  4003.      { connect STDERR to user's terminal }
  4004.      rewrite(openlist[STDERR].filevar, TTYNAME);
  4005.  
  4006.      { initialize rest of files  }
  4007.      FOR i := linein+1 TO MAXOPEN DO
  4008.      openlist[i].mode := IOAVAIL;
  4009.  
  4010.    END;  { procedure initio }
  4011.  
  4012. $PAGE$
  4013.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  4014.  
  4015. FUNCTION Getcf ( VAR c: byte;   fd : filedesc ) : byte;
  4016. {
  4017.   Reads a character from the given file into the character variable c,
  4018.   and also returns the same character as its value.  Can also return
  4019.   ENDFILE or NEWLINE upon end of file or end of line, respectively.
  4020.  
  4021.   If the mode of the file is not IOREAD, Getcf will print an error
  4022.   message on the console and exit the main program.
  4023.  
  4024.  
  4025. Calls           Halt
  4026.  
  4027. Called by       GetLine
  4028.                 Exists          (but commented out there)
  4029.                 DataFromFile
  4030. }
  4031.   VAR
  4032.     ch : char;
  4033.    BEGIN
  4034.      IF (openlist[fd].mode <> IOREAD)
  4035.        THEN begin
  4036.           writeln('Called Getcf without file.mode=IOREAD'); halt;
  4037.           end;
  4038.      IF (fd = STDIN)
  4039.         THEN IF eoln
  4040.                 THEN begin
  4041.                      readln;
  4042.                      c:= NEWLINE;
  4043.                      end
  4044.                 ELSE begin
  4045.                      read(ch);
  4046.                      c := ord(ch);
  4047.                      end
  4048.         ELSE IF eof(openlist[fd].filevar)
  4049.                 THEN c := ENDFILE
  4050.                 ELSE IF eoln(openlist[fd].filevar)
  4051.                      THEN BEGIN
  4052.                        readln(openlist[fd].filevar);
  4053.                        c := NEWLINE
  4054.                        END
  4055.                      ELSE BEGIN
  4056.                        read(openlist[fd].filevar, ch);
  4057.                        c := ord(ch)
  4058.                        END;
  4059.      Getcf := c
  4060.    END;
  4061.  
  4062.  
  4063. $PAGE$
  4064.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  4065.   { GetLine (UCB) -- get a line from file }
  4066.  
  4067. FUNCTION GetLine ( VAR s : ByteString; fd : filedesc;
  4068.                                    maxsize : integer ) : boolean;
  4069. {
  4070.   Reads a line from the given file into the given string, up to the
  4071.   maximum number of characters given.  Stops reading after ENDFILE or
  4072.   NEWLINE, or when maxsize characters have been read.  NEWLINE will be
  4073.   included in the string, but ENDFILE will not be.  String is always
  4074.   terminated by ENDSTR.  Note that the string must be able to hold
  4075.   maxsize+1 characters, to accomodate the ENDSTR terminator.
  4076.  
  4077. Calls           Getcf
  4078.  
  4079. Called by       InitCmd
  4080.                 ReadParm
  4081. }
  4082.   VAR
  4083.     i : integer;
  4084.     c : byte;
  4085.    BEGIN
  4086.      i := 1;
  4087.       REPEAT
  4088.        s[i] := Getcf(c, fd);
  4089.        i := i + 1
  4090.       UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
  4091.      IF (c = ENDFILE) 
  4092.       THEN   { went one too far }
  4093.       i := i - 1;
  4094.      s[i] := ENDSTR;
  4095.      GetLine := (c <> ENDFILE)
  4096.    END;
  4097.  
  4098. $PAGE$
  4099. PROCEDURE Putc ( c : byte );
  4100. {
  4101.  
  4102. Puts one Byte on standard output.
  4103.  
  4104. Calls           Write
  4105.                 Writeln
  4106.  
  4107. Called by       Putcf
  4108. }
  4109.    BEGIN
  4110.      IF c = NEWLINE
  4111.       THEN writeln
  4112.       ELSE write(chr(c))
  4113.    END;
  4114.  
  4115.  
  4116. $PAGE$
  4117.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  4118.  
  4119. PROCEDURE Putcf ( c : byte;  fd : filedesc );
  4120. {
  4121.  
  4122. Writes a single character to the file given by fd.
  4123.  
  4124.  
  4125. Calls           Putc
  4126.                 SerialOut
  4127.                 Writeln
  4128.                 Write
  4129.  
  4130. Called by       PutStr
  4131.                 PutOut
  4132.                 DisplayStatistics
  4133.                 DisplayPacket
  4134.                 DataToFile
  4135. }
  4136.   BEGIN
  4137.   with openlist[fd] do begin
  4138.     IF (fd = STDOUT)
  4139.       THEN Putc(c)
  4140.       ELSE if (fd = lineout)
  4141.              then SerialOut(c)
  4142.              else IF c = NEWLINE
  4143.                     THEN begin
  4144.                       writeln(filevar);
  4145.                       linepos := 0;
  4146.                       end
  4147.                     ELSE begin          { char not newline }
  4148.                       if c = TAB
  4149.                         then begin       { expand tab to spaces }
  4150.                           repeat
  4151.                             write(filevar,' ');
  4152.                             linepos := linepos + 1;
  4153.                           until (linepos mod 8) = 0;
  4154.                           end  { expand tab to spaces }
  4155.                         else if IsPrintable(c)
  4156.                                then begin       { write char to file }
  4157.                                  write(filevar, chr(c));
  4158.                                  linepos := linepos + 1;
  4159.                                  end;  { write char to file }
  4160.                       end;  { char not newline }
  4161.     end;  { with }
  4162.   END;  { procedure PutCf }
  4163.  
  4164. $PAGE$
  4165.   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  4166.  
  4167. PROCEDURE PutStr (VAR s : ByteString; fd : filedesc);
  4168. {
  4169.  
  4170. Put out string on file given by f.
  4171.  
  4172. Calls           Putcf
  4173.  
  4174. Called by       PutCon
  4175.                 PutNum
  4176.                 PutOut
  4177.                 DisplayPacket
  4178.                 BuildPacket
  4179.                 GetNextFile
  4180.                 SendFile
  4181.                 GetFile
  4182.                 DataToFile
  4183.                 ReceiveData
  4184.                 ReceiveFile
  4185.                 Main Program
  4186. }
  4187.   VAR
  4188.     i : integer;
  4189.    BEGIN
  4190.      i := 1;
  4191.      WHILE (s[i] <> ENDSTR) DO
  4192.       BEGIN
  4193.         Putcf(s[i], fd);
  4194.         i := i + 1
  4195.       END
  4196.    END;
  4197.  
  4198.  
  4199. $PAGE$
  4200. FUNCTION Sopen (name : FileName; mode :   integer) : filedesc;
  4201. {
  4202.  
  4203. Opens a file for reading or writing.
  4204.  
  4205. Calls           
  4206.  
  4207. Called by       Exists
  4208.                 ReadParm
  4209.                 GetNextFile
  4210.                 GetFile
  4211.                 Main program
  4212. }
  4213.  
  4214.   VAR
  4215.     i :     integer;
  4216.     found : boolean;
  4217.   BEGIN
  4218.       
  4219.   { find a free slot in openlist }
  4220.   Sopen := IOERROR;
  4221.   found := false;
  4222.   i := 1;
  4223.   WHILE (i <= MAXOPEN) AND (NOT found) DO BEGIN
  4224.     IF (openlist[i].mode = IOAVAIL)
  4225.       THEN BEGIN
  4226.         openlist[i].mode := mode;
  4227.         IF (mode = IOREAD)
  4228.           THEN begin
  4229.                reset(openlist[i].filevar, name);
  4230.                end
  4231.           ELSE begin
  4232.                rewrite(openlist[i].filevar, name); 
  4233.                openlist[i].linepos := 0;
  4234.                end;
  4235.         Sopen:=i;
  4236.         found := true
  4237.         END;
  4238.      i := i + 1;
  4239.      END;  { while }
  4240.   END;  { procedure Sopen }
  4241.  
  4242. $PAGE$
  4243. PROCEDURE Sclose (fd : filedesc);
  4244. {
  4245. Called by       Exists
  4246.                 ReadParm
  4247.                 DisplayStatistics
  4248.                 DataFromFile
  4249.                 DoEOF
  4250. }
  4251.  
  4252.    BEGIN
  4253.      IF      (fd > STDERR) AND (fd <= MAXOPEN)
  4254.       THEN
  4255.        BEGIN
  4256.          openlist[fd].mode := IOAVAIL;
  4257.          close(openlist[fd].filevar,'LOCK');
  4258.        END
  4259.    END;  { procedure Sclose }
  4260.  
  4261. $PAGE$
  4262. FUNCTION Exists (s : FileName) : boolean;
  4263. {
  4264.  
  4265. Returns true if file exists.
  4266.  
  4267.  
  4268. Calls           Sopen
  4269.                 Sclose
  4270.                 Getcf
  4271.  
  4272. Called by       ReadParm
  4273.                 GetNextFile
  4274.                 GetFile
  4275.                 Main prog
  4276. }
  4277.  
  4278.  
  4279.    VAR
  4280.      fd :     filedesc;
  4281.      ior : integer;                   { saves io result }
  4282.    BEGIN
  4283.      try
  4284.      Exists := false;
  4285.      fd := Sopen(s,IOREAD);
  4286.      Sclose(fd);
  4287.      Exists := true;
  4288.  
  4289.      recover
  4290.      if escapecode = -10                { if IO error occurred }
  4291.         then begin
  4292.              ior := ioresult;
  4293.              if not (ior in [9,10])
  4294.                 then writeln('Error in file operation - #',ior:4)
  4295.              end  { if IO error occurred }
  4296.         else escape(escapecode);
  4297.    END;  { procedure Exists }
  4298.  
  4299. $PAGE$
  4300. PROCEDURE PutNum ( n : integer;    fd : filedesc );
  4301. {
  4302.  
  4303. Ouputs number n to the file given by fd preceded by a leading blank.
  4304. Uses ItoC to convert the number.
  4305.  
  4306. Calls           ItoC
  4307.  
  4308. Called by       PutOut
  4309.                 DisplayStatistics
  4310.                 DisplayPacket
  4311.                 SendData
  4312.                 ReceiveData
  4313.                 ReceiveFile
  4314. }
  4315.   VAR
  4316.     s: ByteString;
  4317.     dummy: integer;
  4318.    BEGIN
  4319.      s[1] := BLANK;
  4320.      dummy := ItoC(n,s,2);
  4321.      PutStr(s,fd);
  4322.    END;
  4323.  
  4324. $PAGE$
  4325. PROCEDURE PutCon( x : cstring;  fd : filedesc);
  4326. {
  4327.  
  4328. Outputs a literal string preceded by a NEWLINE.
  4329.  
  4330. Calls           PutStr
  4331.                 CtoB
  4332.  
  4333. Called by       InitCmd
  4334.                 PutOut
  4335.                 DisplayStatistics
  4336.                 DisplayPacket
  4337.                 ErrorPack
  4338.                 Verbose
  4339.                 PutErr
  4340.                 BuildPacket
  4341.                 SendData
  4342.                 GetFile
  4343.                 ReceiveInit
  4344.                 ReceiveData
  4345.                 ReceiveFile
  4346. }
  4347.   VAR
  4348.     i: integer;
  4349.     s: ByteString;
  4350.    BEGIN
  4351.      s[1] := NEWLINE;
  4352.      s[2] := ENDSTR;
  4353.      PutStr(s,fd);
  4354.      CtoB(x,s);
  4355.      PutStr(s,fd);
  4356.    END;
  4357.  
  4358. end. { module byte_io }
  4359.  
  4360. {--file KRMWNDW--}
  4361. $DEBUG OFF$
  4362. $ucsd on$
  4363. module windowlib;
  4364. export
  4365.   const
  4366.     screen_y_max = 23;
  4367.     screen_x_max = 79;
  4368.   
  4369.   type
  4370.     window_type = record
  4371.                     xmin_abs, xmax_abs : integer;
  4372.                     ymin_abs, ymax_abs : integer;
  4373.                     xsize, ysize : integer;
  4374.                     current_x : integer;
  4375.                     current_y : integer;
  4376.                   end;  { record }
  4377.                     
  4378.     window_ptr = ^window_type;
  4379.   
  4380.   function init_window ( xmin, xmax : integer;
  4381.                          ymin, ymax : integer ) : window_ptr;
  4382.   procedure gotoxy_window ( w : window_ptr;  x, y : integer );
  4383.   procedure window_newline ( w : window_ptr );
  4384.   procedure write_window_char ( w : window_ptr; c : char );
  4385.   procedure write_window_string ( w : window_ptr; var s : string );
  4386.   procedure writeln_window_string ( w : window_ptr; var s : string );
  4387.   procedure clear_eol_window( w : window_ptr );
  4388.   procedure clear_end_window( w : window_ptr );
  4389.   procedure clear_window ( w : window_ptr );
  4390.  
  4391. implement
  4392.  
  4393.   var
  4394.     cursor_x, cursor_y : integer;       { screen cursor coordinates }
  4395.     
  4396.   function init_window ( xmin, xmax : integer;
  4397.                          ymin, ymax : integer ) : window_ptr;
  4398.     var pw : window_ptr;
  4399.     begin
  4400.     new(pw);
  4401.     with pw^ do begin
  4402.       xmin_abs := xmin;
  4403.       xmax_abs := xmax;
  4404.       ymin_abs := ymin;
  4405.       ymax_abs := ymax;
  4406.       xsize := xmax - xmin;
  4407.       ysize := ymax - ymin;
  4408.       current_x := 0;
  4409.       current_y := 0;
  4410.     end;  { with }
  4411.     init_window := pw;
  4412.     end;  { function init_window }
  4413.     
  4414.   procedure pos_cursor( w : window_ptr );
  4415.     begin
  4416.     with w^ do begin
  4417.       cursor_x := current_x + xmin_abs;
  4418.       cursor_y := current_y + ymin_abs;
  4419. { special case : keep the cursor off the last position to keep the screen
  4420.   from scrolling }
  4421.       if (cursor_y = screen_y_max) and (cursor_x = screen_x_max)
  4422.          then cursor_x := screen_x_max - 1;  
  4423.       gotoxy( cursor_x, cursor_y );
  4424.     end;  { with }
  4425.     end; { procedure pos_cursor }
  4426.     
  4427. { put_screen    puts the given character on the screen at the position
  4428.   specified by the current cursor coordinates cursor_x and cursor_y
  4429. }
  4430.   procedure put_screen( c : char );
  4431.     begin
  4432.     write(c);
  4433.     end;  { procedure put_screen }
  4434.     
  4435.   procedure gotoxy_window ( w : window_ptr;  x, y : integer );
  4436.     begin
  4437.     with w^ do begin
  4438.       current_x := x;
  4439.       current_y := y;
  4440.       if (x < 0) then current_x := 0;
  4441.       if (x > xsize) then current_x := xsize;
  4442.       if (y < 0) then current_y := 0;
  4443.       if (y > ysize) then current_y := ysize;
  4444.      end;  { with }
  4445.     end;  { procedure gotoxy_window }
  4446.  
  4447.  
  4448. procedure step_cursor ( w : window_ptr );
  4449.   begin
  4450.   with w^ do begin
  4451.       current_x := current_x + 1;
  4452.       if current_x > xsize
  4453.          then begin     { cursor went past x boundary }
  4454.            current_x := 0;
  4455.            current_y := current_y + 1;
  4456.            if current_y > ysize then current_y := 0;
  4457.            end;  { cursor went past x boundary }
  4458.     end;  { with }
  4459.   end;  { procedure step_cursor }
  4460.     
  4461. procedure back_cursor ( w : window_ptr );
  4462.   begin
  4463.   with w^ do begin
  4464.     current_x := current_x -1;
  4465.     if current_x < 0
  4466.        then begin       { x went back past start of line }
  4467.             current_x := xsize;
  4468.             current_y := current_y - 1;
  4469.             if current_y < 0 then current_y := ysize;
  4470.             end;  { x went back past start of line }
  4471.     end;  { with }
  4472.   end;  { procedure back_cursor }
  4473.     
  4474.   procedure window_newline ( w : window_ptr );
  4475.     begin
  4476.     with w^ do begin
  4477.       current_x := xsize;
  4478.       step_cursor( w );
  4479.       pos_cursor( w );
  4480.       clear_eol_window( w );
  4481.     end;  { with }
  4482.     end;  { procedure window_newline }
  4483.   
  4484.   procedure write_window_char ( w : window_ptr; c : char );
  4485.     begin
  4486.     if c = #127
  4487.        then begin  { rubout }
  4488.          back_cursor( w );
  4489.          pos_cursor( w );
  4490.          put_screen(' ');
  4491.          pos_cursor( w );
  4492.          end  { rubout } 
  4493.        else begin   { printing character }
  4494.          pos_cursor( w );
  4495.          put_screen(c);
  4496.          step_cursor ( w );
  4497.          end;  { printing character }
  4498.     end;  { procedure write_window_char }
  4499.     
  4500.   procedure write_window_string ( w : window_ptr; var s : string );
  4501.     var i : integer;
  4502.     begin
  4503.     for i := 1 to length(s) do
  4504.       write_window_char( w, s[i] );
  4505.     end;  { procedure write_window_string }
  4506.     
  4507.   procedure writeln_window_string ( w : window_ptr; var s : string );
  4508.     begin
  4509.     write_window_string (w, s);
  4510.     window_newline( w );
  4511.     end;  { procedure writeln_window_string }
  4512.   
  4513.   procedure clear_eol_window( w : window_ptr );
  4514.     var x, y : integer;
  4515.     begin
  4516.     with w^ do begin 
  4517.       x := current_x;
  4518.       y := current_y;
  4519.       pos_cursor ( w );
  4520.       if xmax_abs = screen_x_max
  4521.         then write(#9)
  4522.         else while current_x <= xsize do begin
  4523.                write(' ');
  4524.                current_x := current_x + 1;
  4525.                end;  { while }
  4526.       end;  { with }
  4527.     gotoxy_window( w, x, y );            { restore initial position }
  4528.     pos_cursor( w );
  4529.     end;  { procedure clear_eol_window }
  4530.   
  4531.   procedure clear_end_window( w : window_ptr );
  4532.     var  x, y : integer;
  4533.     begin
  4534.     with w^ do begin
  4535.       x := current_x;
  4536.       y := current_y;
  4537.       while current_y <= ysize do begin
  4538.         clear_eol_window( w );
  4539.         current_x := 0;
  4540.         current_y := current_y + 1;
  4541.         end;  { while }
  4542.       end;  { with }
  4543.     gotoxy_window( w, x, y );            { restore initial position }
  4544.     end;  { procedure clear_end_window }
  4545.     
  4546.   procedure clear_window ( w : window_ptr );
  4547.     begin
  4548.     gotoxy_window(w, 0,0);         { go to upper left hand corner }
  4549.     clear_end_window( w );      { clear to the end of the window }
  4550.     end;  { procedure clear_window }
  4551.   
  4552.   end. { module windowlib }
  4553.  
  4554. {--file KRMRPT}
  4555. $SEARCH 'KRMWNDW', '*IO.', '*INTERFACE.'$
  4556. {
  4557.  
  4558. This file, KRMRPT.TEXT, contains the error and status reporting
  4559. modules used by all other Kermit modules.  The following modules
  4560. reside in this file:
  4561.  
  4562.         ERR_CODES       Error code definitions
  4563.         KRMRPT          Error and status reporting procedures
  4564.         
  4565. The module KRMRPT includes the file KRMVERS.TEXT, which declares the version
  4566. string constant VERSION_STRING.
  4567. }
  4568.  
  4569.  
  4570. {
  4571.  
  4572. Module ERR_CODES defines the integer error code values that can be
  4573. returned by a procedure to indicate whether it completed successfully,
  4574. or, if not, what error occurred.  Successful and warning error codes
  4575. are odd (low order bit set), and indicate that all went reasonably well.
  4576. Failing error codes are even (low order bit clear), and indicate that
  4577. something happened that kept a routine from doing what it was supposed to.
  4578.  
  4579. Function ERRSTR returns the error message string associated with the
  4580. given  error code.
  4581.  
  4582. All Kermit modules have access to ERR_CODES.
  4583.  
  4584. }
  4585. module err_codes;
  4586. export
  4587.  
  4588. const
  4589.   error_string_length = 80;       { Maximum length of error strings }
  4590.  
  4591. { Facility code definitions.  These codes identify the facility generating
  4592.   the error.
  4593. }
  4594.  
  4595. cmdfac = 1*128;             { command interpreter }
  4596. trmfac = 2*128;             { terminal emulation code }
  4597. iofac  = 3*128;             { IO error }
  4598. krmfac = 4*128;             { kermit protocol machine }
  4599.  
  4600. {  Status code definitions.  Successful return codes are odd, those
  4601.    corresponding to error conditions are even.  Returned by functions,
  4602.    etc.
  4603. }
  4604.   
  4605.   success       = 1;
  4606.   file_rcvd_ok  = 3;    { file received successfully }
  4607.   file_sent_ok  = 5;    { file transmitted successfully }
  4608.   
  4609.   inv_packet_type = 7;  { unexpected packet type received }
  4610.   
  4611. {  Error condition status codes }
  4612. {  Codes returned by lookup_key in module command }
  4613.   
  4614.   ambig_keyword = 2;
  4615.   no_keyword    = 4;
  4616.  
  4617. {  Codes returned by parse in module command }
  4618.  
  4619.   not_confirmed = 6;
  4620.   integer_error = 8;
  4621.   no_match      = 10;
  4622.   non_digit     = 12;        { Non-digit character encountered }
  4623.   integer_overflow = 14;     { Integer overflow }
  4624.   null_string   = 16;        { null string given as argument }
  4625.   parse_after_eol = 18;      { parse called after eol parsed }
  4626.   
  4627. {  Codes returned by read_break in module command }
  4628.   
  4629.   back_past_field = 20;
  4630.   abort_line    = 22;
  4631.   
  4632. { Codes returned by Kermit protocol procedures in module krmguts }
  4633.  
  4634.   retry_exhausted = 24;
  4635.   timeout = 26;
  4636.   abort_file = 28;
  4637.   abort_group = 30;
  4638.   abort_errpack = 32;
  4639.   rcvd_bad_init = 34;
  4640.   cant_read_file = 36;
  4641.   cant_write_file = 38;
  4642.   cant_create_file = 40;
  4643.   cant_find_file = 42;
  4644.  
  4645. type
  4646.    error_string = string[error_string_length];
  4647.  
  4648.  
  4649. function errstr ( errcode : integer ) : error_string;
  4650.   
  4651. $page$
  4652. implement
  4653.  
  4654. function errstr ( errcode : integer ) : error_string;
  4655. {
  4656.  
  4657. Returns the error string associated with each error.
  4658. }
  4659.   var s : error_string;
  4660.   begin
  4661.   case errcode of
  4662.     success:            s := 'Success';
  4663.     inv_packet_type:    s := 'Unexpected packet type received';
  4664.     file_rcvd_ok:       s := 'File received successfully';
  4665.     file_sent_ok:       s := 'File sent successfully';
  4666.     
  4667.   { Codes returned by lookup_key }
  4668.   
  4669.     ambig_keyword:      s := 'Ambiguous keyword';
  4670.     no_keyword:         s := 'No keywords match this input';
  4671.   
  4672.   {  Codes returned by parse  }
  4673.   
  4674.     not_confirmed:      s := 'Not confirmed';
  4675.     integer_error:      s := 'Error reading integer';
  4676.     no_match:           s := 'No defined keywords match this input';
  4677.     non_digit:          s := 'Non-digit character encountered';
  4678.     integer_overflow:   s := 'Integer overflow';
  4679.     null_string:        s := 'Null string given as argument';
  4680.     parse_after_eol:    s := 'Parse called after end of line parsed';
  4681.     
  4682.   {  Codes returned by read_break }
  4683.     
  4684.     back_past_field:    s := 'Input deleted past beginning of field';
  4685.     abort_line:         s := 'Line aborted by CTRL-U';
  4686.  
  4687.   { Codes returned by Kermit protocol procedures }
  4688.  
  4689.     retry_exhausted:    s := 'Retry count exhausted';
  4690.     timeout:            s := 'Timeout';
  4691.     abort_file:         s := 'File transfer aborted by user';
  4692.     abort_group:        s := 'File group transfer aborted by user';
  4693.     abort_errpack:      s := 'Transfer aborted by error packet from remote';
  4694.     cant_read_file:     s := 'Cannot open file for reading';
  4695.     cant_write_file:    s := 'Cannot open file for writing';
  4696.     cant_create_file:   s := 'Cannot create file';
  4697.     cant_find_file:     s := 'File does not exist';
  4698.    end;  { case }
  4699.   errstr := s;
  4700.   end;  { function errstr }
  4701.  
  4702. end;  { module err_codes }
  4703.  
  4704.  
  4705. $PAGE$
  4706. {
  4707.  
  4708. Module KRMRPT handles error and status reporting for the rest of
  4709. Kermit.  Basically, except for command echoing, anything that is
  4710. displayed on the screen is put there by procedures in this module.
  4711. These procedures do the proper text formatting, positioning, etc., and
  4712. then call procedures in module WINDOWLIB (in file KRMWNDW.TEXT) to
  4713. actually do the screen output.
  4714.  
  4715. All Kermit modules have access to KRMRPT.
  4716.  
  4717. }
  4718. module  krmrpt;
  4719. import  windowlib,
  4720.         err_codes;
  4721.  
  4722. export
  4723.  
  4724. $INCLUDE 'KRMVERS.TEXT'$     { This file has const declarations for the
  4725.                                version variables VERSION_NUM and VERSION_DATE,
  4726.                                which are string constants }
  4727.  
  4728. var
  4729.   help_window, command_window, error_window, stat_window : window_ptr;
  4730.   
  4731. type
  4732.  
  4733.   { Packet transfer statistics record }
  4734.  
  4735.   kermit_statistics = record
  4736.          NumSendPacks : integer;   { number of packets sent }
  4737.          NumRecvPacks : integer;   { number of packets received }
  4738.          NumACKsent : integer;     { number of ACKs we've sent }
  4739.          NumNAKsent : integer;     { number of NAKs we've sent }
  4740.          NumACKrecv : integer;     { number of ACKs we've received }
  4741.          NumNAKrecv : integer;     { number of NAKs we've received }
  4742.          NumBADrecv : integer;     { number of non-ACKs we've received when }
  4743.                                    { waiting for an ACK }
  4744.          RunTime: integer;         { elapsed time for current transaction }
  4745.          ChInFile : integer;       { number of characters in file }
  4746.          ChInPack : integer;       { number of characters in packets }
  4747.          packet_overhead : integer; { percent overhead of packetizing }
  4748.          effrate : integer;        { effective baud rate of transfer }
  4749.          end;  { record }
  4750.  
  4751.   KermitStates = (FileData,RecvInit,SendInit,Break,
  4752.                   FileHeader,EOFile,Complete,Abort);
  4753.   
  4754.   Transfer_type = (Transmit, Receive, Invalid);
  4755.   
  4756.  
  4757. procedure set_logfile( var fnm : string );
  4758. procedure get_logfile( var fnm : string );
  4759. procedure report_version;
  4760. procedure report_status( var report : string );
  4761. procedure report_log( var report : string );
  4762. procedure report_error( code : integer; var where_msg : string );
  4763. procedure init_cmd_windows;
  4764. procedure clear_status_window;
  4765. procedure init_packet_display( runtype : transfer_type );
  4766. procedure clean_packet_display( runtype : transfer_type );
  4767. procedure report_send_packet( seq : integer );
  4768. procedure report_receive_file( var fnm : string );
  4769. procedure report_send_file( var fnm : string );
  4770. procedure report_packet_statistics( stats : kermit_statistics;
  4771.                                     runtype : transfer_type );
  4772. function check_error( code : integer; var where_msg : string ) : boolean;
  4773.  
  4774. implement
  4775.  
  4776. const
  4777.   send_packet_y = 2;
  4778.   packet_stat_x = 25;
  4779.   packet_stat_y = 4;
  4780.   stat_random_x = 0;
  4781.   stat_random_y = 14;
  4782.   file_report_x = 0;
  4783.   file_report_y = 0;
  4784.   
  4785. var
  4786.   log_filename : string[50];
  4787.   log_file : text;
  4788.   log_on : boolean;
  4789.   send_packet_x : integer;            { window coords of send packet # }
  4790.   report : string[80];
  4791.   rpos : integer;
  4792.   
  4793. procedure set_logfile( var fnm : string );
  4794.   begin
  4795.   if strlen(fnm) = 0
  4796.      then begin
  4797.        log_on := false;
  4798.        log_filename := 'OFF';
  4799.        end
  4800.      else begin
  4801.           log_on := true;
  4802.           log_filename := fnm;
  4803.           rewrite(log_file,log_filename);
  4804.           end;
  4805.   end;  { procedure set_logfile }
  4806.   
  4807. procedure get_logfile( var fnm : string );
  4808.   begin
  4809.   fnm := log_filename;
  4810.   end;  { procedure get_logfile }
  4811.   
  4812. procedure report_version;
  4813.   var vs : string[80];
  4814.       p : integer;              { dummy for strwrite }
  4815.   begin
  4816.   strwrite(vs,1,p,VERSION_STRING);
  4817.   writeln_window_string(stat_window,vs);
  4818.   end;  { procedure report_version }
  4819.   
  4820. procedure report_status( var report : string );
  4821.   begin
  4822.   writeln_window_string( stat_window, report );
  4823.   end;  { procedure report_status }
  4824.  
  4825. procedure report_log( var report : string );
  4826.   begin
  4827.   if log_on
  4828.     then writeln(log_file, report);
  4829.   end;  { procedure report_status }
  4830.  
  4831. procedure report_error( code : integer; var where_msg : string );
  4832.   var report : string [80];
  4833.       rpos : integer;
  4834.   begin
  4835.   setstrlen(report,0);
  4836.   if odd(code)
  4837.     then strwrite(report,1,rpos,errstr(code))
  4838.     else strwrite(report,1,rpos,'?Error ',where_msg, ' - ', errstr(code));
  4839.   clear_window(error_window);
  4840.   writeln_window_string( error_window, report );
  4841.   end;  { procedure report_error }
  4842.  
  4843. $page$
  4844. procedure init_cmd_windows;
  4845.   begin
  4846.   stat_window    := init_window(0,screen_x_max, 0,16);
  4847.   help_window    := init_window(0,screen_x_max, 17,20);
  4848.   command_window := init_window(0,screen_x_max, 21,21);
  4849.   error_window   := init_window(0,screen_x_max, 22,23);
  4850.   end;  { procedure init_cmd_windows }
  4851.   
  4852. procedure clear_status_window;
  4853.   begin
  4854.   clear_window(stat_window);
  4855.   end;  { procedure clear_status_window }
  4856.   
  4857. procedure init_packet_display( runtype : transfer_type );
  4858.   var lab : string[80];
  4859.   begin
  4860.   clear_window(stat_window);
  4861.   lab := 'Sending Packet # ';
  4862.   send_packet_x := strlen(lab);
  4863.   gotoxy_window(stat_window, 0, send_packet_y);
  4864.   writeln_window_string( stat_window, lab);
  4865.   clear_eol_window(stat_window);
  4866.   
  4867.   gotoxy_window( stat_window, 0, packet_stat_y );
  4868.   setstrlen(report,0);
  4869.   strwrite(report,1,rpos,'Packets sent');
  4870.   report_status(report);
  4871.   setstrlen(report,0);
  4872.   strwrite(report,1,rpos,'Packets received');
  4873.   report_status(report);
  4874.   setstrlen(report,0);
  4875.   if runtype = transmit
  4876.      then strwrite(report,1,rpos,'Total chars. sent')
  4877.      else strwrite(report,1,rpos,'Total chars. rcvd');
  4878.   report_status(report);
  4879.   setstrlen(report,0);
  4880.   if runtype = transmit
  4881.      then strwrite(report,1,rpos,'Data chars. sent')
  4882.      else strwrite(report,1,rpos,'Data chars. rcvd');
  4883.   report_status(report);
  4884.   
  4885.   setstrlen(report,0);
  4886.   strwrite(report,1,rpos,'Overhead (%)');
  4887.   report_status(report);
  4888.   setstrlen(report,0);
  4889.   strwrite(report,1,rpos,'Effective Rate');
  4890.   report_status(report);
  4891.   setstrlen(report,0);
  4892.   strwrite(report,1,rpos,'Number of ACK');
  4893.   report_status(report);
  4894.   setstrlen(report,0);
  4895.   strwrite(report,1,rpos,'Number of NAK');
  4896.   report_status(report);
  4897.   IF (RunType = Transmit)
  4898.     THEN BEGIN
  4899.       setstrlen(report,0);
  4900.       strwrite(report,1,rpos,'Number of BAD');
  4901.       report_status(report);
  4902.       END;
  4903.   gotoxy_window(stat_window, stat_random_x, stat_random_y);
  4904.   end;  { procedure init_packet_display }
  4905.   
  4906. procedure clean_packet_display( runtype : transfer_type );
  4907.   begin
  4908.   gotoxy_window(stat_window, 0, send_packet_y);
  4909.   clear_eol_window(stat_window);
  4910.   end;  { procedure clean_packet_display }
  4911.   
  4912. procedure report_send_packet( seq : integer );
  4913.   begin
  4914.   gotoxy_window(stat_window, send_packet_x, send_packet_y);
  4915.   setstrlen(report,0);
  4916.   strwrite(report,1,rpos,seq:1);
  4917.   write_window_string(stat_window, report);
  4918.   clear_eol_window(stat_window);
  4919.   gotoxy_window(stat_window, stat_random_x, stat_random_y);
  4920.   end;  { report_send_packet }
  4921.   
  4922. procedure report_send_file( var fnm : string );
  4923.   begin
  4924.   gotoxy_window(stat_window, file_report_x, file_report_y);
  4925.   setstrlen(report,0);
  4926.   strwrite(report,1,rpos,'Sending file   ',fnm);
  4927.   write_window_string(stat_window, report);
  4928.   clear_eol_window(stat_window);
  4929.   gotoxy_window(stat_window, stat_random_x, stat_random_y);
  4930.   end;  { procedure report_send_file }
  4931.  
  4932. procedure report_receive_file( var fnm : string );
  4933.   begin
  4934.   gotoxy_window(stat_window, file_report_x, file_report_y);
  4935.   setstrlen(report,0);
  4936.   strwrite(report,1,rpos,'Receiving file ',fnm);
  4937.   write_window_string(stat_window, report);
  4938.   clear_eol_window(stat_window);
  4939.   gotoxy_window(stat_window, stat_random_x, stat_random_y);
  4940.   end;  { procedure report_receive_file }
  4941.  
  4942. procedure report_packet_statistics( stats : kermit_statistics;
  4943.                                     runtype : transfer_type );
  4944.   var row : integer;
  4945.   procedure report_num( i : integer );
  4946.     begin
  4947.     setstrlen(report,0);
  4948.     strwrite(report,1,rpos,i:5);
  4949.     gotoxy_window(stat_window, packet_stat_x, row);
  4950.     write_window_string(stat_window,report);
  4951.     row := row + 1;
  4952.     end;  { procedure report_num }
  4953.     
  4954.   begin
  4955.   row := packet_stat_y;
  4956.   report_num(stats.NumSendPacks);
  4957.   report_num(stats.NumRecvPacks);
  4958.   report_num(stats.ChInPack);
  4959.   report_num(stats.ChInFile);
  4960.   report_num(stats.packet_overhead);
  4961.   report_num(stats.effrate);
  4962.   IF (RunType = Transmit)
  4963.     THEN BEGIN  { for transmit }
  4964.       report_num(stats.NumACKrecv);
  4965.       report_num(stats.NumNAKrecv);
  4966.       report_num(stats.NumBADrecv);
  4967.       END  { for transmit }
  4968.     ELSE BEGIN   { for Receive }
  4969.       report_num(stats.NumACKsent);
  4970.       report_num(stats.NumNAKsent);
  4971.       END;  { for Receive }
  4972.     gotoxy_window(stat_window, stat_random_x, stat_random_y);
  4973.   end;  { procedure report_packet_statistics }
  4974.  
  4975.  
  4976. $page$
  4977. { check_error           Checks given condition code.  Returns false if code
  4978.   is successful.  If code is error code, prints associated error message
  4979.   and returns true.
  4980. }
  4981. function check_error( code : integer; var where_msg : string ) : boolean;
  4982.   var ret : boolean;
  4983.   begin
  4984.     ret := false;
  4985.     if not odd(code)       { successful conditions are odd, failing (error)
  4986.                           conditions are even }
  4987.        then begin
  4988.        report_error( code, where_msg );
  4989.        ret := true;
  4990.        end;
  4991.     check_error := ret;
  4992.   end;  { procedure check_error }
  4993.      
  4994. end.  { module krmrpt }
  4995.