$Debug off$
$UCSD ON$
$SYSPROG$
$SEARCH  '*INTERFACE.', '*IO.',
         'KRMIO', 'KRMCMD', 'KRMWNDW', 'KRMRPT'$
$PAGE$
{
Module KRMGUTS contains the heart of Kermit - the procedures,
variables, etc., that actually implement the Kermit protocol.
}
module  krmguts;

import  ascii_defs,
        byte_str,
        byte_io,
        krmrpt,
        terminal,
        iodeclarations,
        general_1,
        general_3;

export
  const
    MAXFILES = 10;                { maximum number of files that can be sent }
  type
    filename_list = array[1..MAXFILES] of filename;
  var
    
    RunType : Transfer_type;    { type of transfer currently in effect }
    
    { operational parameters }
  
    Local    : boolean;       { local/remote flag }
    OneWayOnly : boolean;     { used for testing }
    Verbosity: boolean;       { true to print verbose messages }
    Debug : boolean;          { true to print really verbose debugging msgs }

  PROCEDURE KermitInit;          { initialize various parameters & defaults }
  PROCEDURE SYSInit;
  PROCEDURE ParmInit;

  { Command entry points }
  
  procedure RecvSwitch( files : filename_list );     { Receive file group
                                                       entry point }
  procedure SendSwitch( files : filename_list );     { Send file group
                                                       entry point }
  procedure TN;                 { invokes terminal emulator }
  
implement

CONST

{-%- System Dependent -%-}
  
  DEFPARMFILE   =    'KERMIT.PRM';
  TEMPFILE      =    'TEMP.K';

  ConsoleAbort = chr(CTRLC);    { character to abort packet }
                                { receive operation }


  
{ Default transmission parameter definitions.  These are assigned to }
{ the transmission parameter variables by ParmInit when Kermit is }
{ first started. }

  DEFTRY       = 10;      { default for number of retries }
  DEFTIMEOUT   = 12;      { default time out }
  MAXPACK      = 94;      { max is 94 ~ - ' ' }
  DEFDELAY     = 5;       { delay before sending first init for send }
  NUMPARAM     = 6;       { number of parameters in init packet }
  DEFMARK      = SOH;     { packet start mark }
  DEFQUOTE     = SHARP;   { default quote character  }
  DEFPAD       = 0;       { default number of padding chars  }
  DEFPADCHAR   = 0;       { default padding character  }
  DEFEOL       = CR;      { default end of line sequence }
  DEFEOLTYPE   = 2;       { 1 = LineFeed
                            2 = CrLf
                            3 = Just Cr }


  NUMBUFFERS = 5;         { Number of buffers }

  { packet types }

  TYPEB  = 66; { ord('B')  break packet }
  TYPEC  = 67; { ord('C')  Host command packet }
  TYPED  = 68; { ord('D')  data packet }
  TYPEE  = 69; { ord('E')  error packet }
  TYPEF  = 70; { ord('F')  file header packet }
  TYPEG  = 71; { ord('G')  generic kermit command packet }
  TYPEN  = 78; { ord('N')  NAK packet }
  TYPER  = 82; { ord('R')  Receive init packet }
  TYPES  = 83; { ord('S')  send init packet }
  TYPET  = 84; { ord('T')  ? }
  TYPEX  = 88; { ord('X')  Text packet }
  TYPEY  = 89; { ord('Y')  ACK packet }
  TYPEZ  = 90; { ord('Z')  EOF packet }


$PAGE$
TYPE

  { Data Types for Kermit }

  Packet = RECORD
             mark : byte;                  { SOH character }
             count: byte;                  { # of bytes following this field }
             seq  : byte;                  { sequence number modulo 64  }
             ptype: byte;                  { d,y,n,s,b,f,z,e,t  packet type }
             data : ByteString;            { the actual data }
             { chksum is last valid char in data array }
             { eol is added, not considered part of packet proper }
           END;


  EOLtype = (LineFeed,CrLf,JustCr);

  Ppack = 1..NUMBUFFERS;

  CType = RECORD
            check : integer;
            PacketPtr : integer;
            i : integer;
            fld : integer;
            t : byte;
            finished : boolean;
            restart : boolean;
            control : boolean;
            good : boolean;
          END;

$PAGE$
VAR

  keyboard : text;                 { non-echoing standard input file }
  
  ior : integer;                   { error recovery routine saves ioresult }
                                   { here }
  breakchar : byte;                { break character for TN mode }
  ch : char;                       { scratch character }
  report : string[120];            { status report string }
  rpos : integer;                  { status report string position }

  { Variables for Kermit }

  send_file_list : filename_list;       { list of filenames to be sent }
  send_file_next : 1..MAXFILES+1;        { index of next filename to be sent }
  
  ParmFile : filename;      { parameter file name }
  DiskFile : filedesc;      { file being sent or received }
  EOLforFile : EOLtype;     { EOL sequence to use for local files }
  State    : kermitstates;  { current state of the automaton }
  SaveState : kermitstates; { holds old state for retries }
  n,J      : integer;       { packet sequence number }

  MaxTry   : integer;       { maximum number of retries allowed }
  NumTry   : integer;       { times this packet retried }
  OldTry   : integer;       { times last packet retried }

{ packet transmission parameters }

  LocalMark     : integer;       { packet start mark }
  RemoteMark    : integer;
  LocalPad      : integer;       { number of padding characters I need }
  RemotePad     : integer;       { number of padding chars to send }
  LocalPadChar  : byte;          { padding character I need }
  RemotePadChar : byte;          { padding character to use }
  LocalTimeOut  :  integer;      { our timeout interval in seconds }
  RemoteTimeOut : integer;       { their timeout interval in seconds }
  LocalDelay    : integer;       { delay before sending first init }
  LocalEOL,LocalQuote : byte;    { parms. for us }
  RemoteEOL, RemoteQuote : byte; { parms. the remote wants }
  SizeRecv, SizeSend : integer;  { buffer sizes for receive and send }

{ statistics variables }

  stats : kermit_statistics;
  
{ Packet buffers.  These are used to hold packets being built as }
{ received, or assembled for transmission. }

  Buf : ARRAY [1..NUMBUFFERS] OF packet;
  ThisPacket : Ppack;           { current packet being sent }
  LastPacket : Ppack;           { last packet sent }
  CurrentPacket : Ppack;        { current packet received }
  NextPacket : Ppack;           { next packet being received }
  DebugPacket : Ppack;          { save input to do debug }

  TOPacket : packet;            { Time_Out Packet }
  TimeLeft : integer;           { until Time_Out }

  PackControl : CType;          { variables for receive packet routine }


$PAGE$
PROCEDURE Verbose ( c : cstring );
{

Print writeln if verbosity

Called by       Field1
                Field2
                Field3
                Field5
                SendFile
                SendEOF
                SendBreak
                SendOurInit
                GetTheirInit
                ReceiveData
}
  BEGIN
    IF Verbosity
      THEN begin
        setstrlen(report,0);
        strwrite(report, 1,rpos, c);
        report_log( report );
        end;
  END;  { procedure verbosity }

$PAGE$
PROCEDURE PutErr( c : cstring );
{

Print error messages.

}

  BEGIN
    IF Local
      THEN begin
        setstrlen(report,0);
        strwrite(report,1,rpos,c);
        report_status(report);
        report_log(report);
        end;
  END;  { procedure PutErr }

$PAGE$
PROCEDURE OverHead ( p , f : integer;   VAR o : integer );
{

 Calculate OverHead as %
 OverHead := (p-f)*100/f

Called by       DisplayStatistics
}
  BEGIN
  IF f <> 0
    then o := trunc((p-f)*100/f)
    else o := 0;
  END;

$PAGE$
PROCEDURE CalRat ( f : integer;   t : integer;   VAR r : integer );
{

 Calculate Effective Baud Rate
 Rate = f*10/t

Called by       DisplayStatistics
}
   BEGIN
     r := 0;
   END;

$PAGE$
PROCEDURE Sleep ( t : integer);            { pause for t seconds }
{

Called by       SendSwitch
}
   BEGIN
   END;

$PAGE$
PROCEDURE StartTimer;
{

Called by       ReceivePacket
}
   BEGIN
     TimeLeft := RemoteTimeOut;
   END;

$PAGE$
PROCEDURE StopTimer;
{

Called by       ReceivePacket
}
   BEGIN
     TimeLeft := MaxInt;
   END;

$PAGE$
FUNCTION MakeChar ( c : byte ) : byte;
{

Convert integer to printable character.

}
   BEGIN
     MakeChar := c+BLANK;
   END;

$PAGE$
FUNCTION UnChar ( c : byte ) : byte;
{

Reverse of MakeChar

}
   BEGIN
     UnChar := c-BLANK
   END;

$PAGE$
FUNCTION Ctl ( c : byte ) : byte;
{

Does  c XOR 100.

}
   BEGIN
     IF IsControl(c)
       THEN  c := c+64
       ELSE  c := c-64;
     Ctl := c;
   END;

$PAGE$
FUNCTION IsValidPType ( c : byte ) : boolean;
{

True if c is a valid packet type.

Called by       Field3
}
   BEGIN
     IsValidPType := c in [TYPEB, TYPEC, TYPED, TYPEE, TYPEF, TYPEG,
                           TYPEN, TYPER, TYPES, TYPET, TYPEX, TYPEY,
                           TYPEZ]
   END;

$PAGE$
FUNCTION CheckFunction ( c : integer ) : byte;
{

Calculate checksum 

Called by       SendPacket
                Field5
}
  VAR  x: integer;
  BEGIN

  {   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; }

    x := (c MOD 256 ) DIV 64;
    x := x+c;
    CheckFunction := x MOD 64;
  END;

$PAGE$
PROCEDURE EnCodeParm ( VAR data : ByteString ); { encode parameters }
{

Encodes the global parameter variables and places them into the given
parameter ByteString. 

References :    SizeRecv
                LocalTimeOut
                LocalPad
                LocalPadChar
                LocalEOL
                LocalQuote

Called by       SendOurInit
                GetTheirInit
                DoInitLast
}
  VAR i: integer;
  BEGIN
    FOR i:=1 TO NUMPARAM DO
       data[i] := BLANK;
    data[NUMPARAM+1] := ENDSTR;
    data[1] := MakeChar(SizeRecv);             { my biggest packet }
    data[2] := MakeChar(LocalTimeOut);            { when I want timeout}
    data[3] := MakeChar(LocalPad);                { how much padding }
    data[4] := Ctl(LocalPadChar);                 { my padding character }
    data[5] := MakeChar(LocalEOL);                { my EOL }
    data[6] := LocalQuote;                        { my quote char }
  END;

$PAGE$
PROCEDURE DeCodeParm ( VAR data : ByteString ); { decode parameters }
{

Accepts a parameter string, decodes the values, and places them in the
global parameter variables.

Modifies :      SizeSend
                RemoteTimeOut
                RemotePad
                RemotePadChar
                RemoteEOL
                RemoteQuote

Called by       GetTheirInit
}
   BEGIN
     SizeSend := UnChar(data[1]);
     RemoteTimeOut := UnChar(data[2]);   { when I should time out }
     RemotePad := UnChar(data[3]);            { padding characters to send  }
     RemotePadChar := Ctl(data[4]);           { padding character }
     RemoteEOL := UnChar(data[5]);        { EOL to send }
     RemoteQuote := data[6];              { quote to send }
   END;

$PAGE$
PROCEDURE ReadParm ( VAR Parms : ByteString ; ParmFile : filename );
{

Opens the parameter file, if any, and reads a single line from it into
the parameter Parms.  If no parameter file exists, returns a null
string (i.e., just ENDSTR in the first position).

Inputs :        ParmFile      filename of parameter file

Calls           Exists
                Sopen
                GetLine

Called by       GetParm
}
  VAR
    dummy : boolean;
    fd : filedesc;
   BEGIN;
     Parms[1]:=ENDSTR;
     IF Exists(ParmFile) THEN
        BEGIN
        fd := Sopen(ParmFile,IOREAD);
        dummy := GetLine(Parms,fd,MAXSTR);
        Sclose(fd);
        END;
   END;

$PAGE$
PROCEDURE GetParm( ParmFile : filename );                  { get parameters from file }
{

Reads a line from the parameter file via ReadParm and sets the global
parameter variables according to the values in the file.

Inputs :        ParmFile      filename of parameter file

Modifies        SizeRecv
                LocalTimeOut
                LocalPad
                LocalPadChar
                LocalEOL
                LocalQuote

Calls           ReadParm

Called by       ParmInit
                SetParameters
}
  VAR
    data : ByteString;
   BEGIN;
     ReadParm(data, ParmFile);
     IF (length(data) > 0)
      THEN      { get parameters }
       BEGIN
         SizeRecv := UnChar(data[1]);
         LocalTimeOut := UnChar(data[2]);     { when I should time out }
         LocalPad := UnChar(data[3]);         { padding characters to send }
         LocalPadChar := Ctl(data[4]);        { padding character }
         LocalEOL := UnChar(data[5]);         { EOL to send }
         LocalQuote := data[6];               { quote to send }
       END;
   END;

$PAGE$
PROCEDURE ParmInit;
{

Initializes transmission parameters (pad character, timeout, etc.) to
their default values as defined by the default parameter constants,
then reads any new values from the parameter file.  Parameter file
values thus override the initial 'hardwired' defaults.

Calls           GetParm

Called by       Main Program
}
  BEGIN
  breakchar:=CTRLY;

{ Set the initial default values }

     RemotePad          := DEFPAD;
     LocalPad        := DEFPAD;
     RemotePadChar      := DEFPADCHAR;
     LocalPadChar    := DEFPADCHAR;
     LocalMark       := DEFMARK;
     RemoteTimeOut := DEFTIMEOUT;
     LocalTimeOut    := DEFTIMEOUT;
     LocalDelay        := DEFDELAY;
     SizeRecv     := MAXPACK;
     SizeSend     := MAXPACK;
     RemoteEOL      := DEFEOL;
     LocalEOL        := DEFEOL;
     RemoteQuote    := DEFQUOTE;
     LocalQuote      := DEFQUOTE;
     MaxTry       := DEFTRY;
     CASE DEFEOLTYPE OF
       1:      EOLforFile := LineFeed;
       2:      EOLforFile := CrLf;
       3:      EOLforFile := JustCR;
      END { case };

{ Now read the new defaults from the parameter file }

     ParmFile := DEFPARMFILE;
     GetParm( ParmFile );
     Local := true;      { default to remote }
   END;

$PAGE$
{-%- System Dependent -%-}

PROCEDURE SYSInit;
{

Performs system dependent initialization, for example setting the mode
of the console terminal.  Called once by the main program when Kermit
is started. 

Called by       Main Program
}
   begin   { procedure SYSInit }
   ioinitialize;
   initio;                      { initialize the byte I/O module }
   init_data_comm;
   end;    { procedure SYSInit }

$PAGE$
{-%- System Dependent -%-}

PROCEDURE SYSFinish;
{

Performs any system dependent cleanup operations, for example
resetting the mode of the console terminal to normal.  Called once
by main program just before Kermit exits.

Called by       Main Program
}
   BEGIN
   iouninitialize;
   END;

$PAGE$
{-%- Sytem Dependent -%-}

PROCEDURE SYSArguments;
{

Processes system dependent command arguments.  Called by main program
when a 'do system function' command is processed.

}
   BEGIN

   END;

$PAGE$
PROCEDURE StartRun;                    { initialization as necessary }
{


Modifies        stats.RunTime

Calls           SerialFlush

Called by       SendSwitch
                RecvSwitch
}
   BEGIN
     SerialFlush;
     stats.RunTime := 0;
   END;

$PAGE$

{ Function DoBreakchar is the break character action routine passed to
  the procedure emulator when in TN mode.  The break character command
  (i.e., the character typed immediately after the break character) is
  passed as the argument.  If it returns true, the emulator will exit back
  to its caller.
}
function DoBreakchar ( c : char ) : boolean;
   begin
   DoBreakchar := false;
   case c of
      'c','C': DoBreakchar := true;
      otherwise
           begin
           writeln('Break character commands:');
           writeln('  C   Break connection');
           writeln('  ?   This message');
           end;
      end; { case }
   end;  { procedure DoBreakchar }





PROCEDURE TN;
{

This procedure implements the 'terminal emulator' to connect to the
host.

Calls

Called by       Main program
}

BEGIN    { procedure TN }
   write(#12);
   writeln('Connecting to host');
   emulator( chr(CTRLY), DoBreakchar );
   write(#12);
   END;    { procedure TN }

$PAGE$
PROCEDURE SetParameters( arg : filename );
{

Sets new parameter file name, loads new parameters via GetParm.

Implicit inputs :       Arg     filename of file from which to read new
                                 parameters
Calls           GetParm

Called by       Main Program    (invoked by load new parameters command)
}
  var   fnm : filename;
   BEGIN
     IF (strlen(Arg) > 2)
      THEN
       BEGIN
         ParmFile := arg;               { get the new parameter file }
                                        { name from the command line }
                                        { into ParmFile }
         GetParm( ParmFile );                       { read new parameters }
       END;
   END;

$PAGE$
PROCEDURE KermitInit;          { initialize various parameters & defaults }
{

Initializes the KERMIT protocol machine and sets the option variables
to default values.

Calls     

Called by       Main program
}
   BEGIN
     n := 0;

     stats.NumSendPacks := 0;
     stats.NumRecvPacks := 0;
     stats.NumACKsent := 0;
     stats.NumNAKsent := 0;
     stats.NumACKrecv := 0;
     stats.NumNAKrecv := 0;
     stats.NumBADrecv := 0;

     stats.ChInPack := 0;
     stats.ChInFile := 0;

     RunType := invalid;
     DiskFile := IOERROR;      { to indicate not open yet }

     ThisPacket := 1;
     LastPacket := 2;
     CurrentPacket := 3;
     NextPacket := 4;
     DebugPacket := 5;

     WITH TOPacket DO
      BEGIN
        count := 3;
        seq := 0;
        ptype := TYPEN;
        data[1] := ENDSTR;
      END;  { with }
     
   END;  { procedure KermitInit }

$PAGE$
procedure FinishUp;                   { do End of Program clean up }
{

Called by       ErrorPack
                BuildPacket
                ReceivePacket
                Main program
}
  begin
  Sclose(DiskFile);
  SYSFinish;                            { do System dependent }
  end;  { procedure FinishUp }

$PAGE$
PROCEDURE DisplayStatistics;
{

Calls           OverHead
                CalRat

Called by       ErrorPack
                BuildPacket
                ReceivePacket
}
  BEGIN
  IF ((RunType <> Invalid) AND Local )
    THEN with stats do BEGIN
      OverHead(ChInPack,ChInFile,packet_overhead);
      CalRat(ChInFile,RunTime,effrate);
      report_packet_statistics( stats, runtype );
      END; { with }
  END;  { procedure DisplayStatistics }

$PAGE$
PROCEDURE DisplayPacket ( mes : cstring;   VAR p : Ppack );
{
        where mes = string to be printed preceding packet contents
                p = index into buf of packet to be displayed

Print Debugging Info.  Prints the given message on the standard error
device, followed by the contents of the given packet as follows:

   <message>      <count> <sequence #> <type>
   <packet data>


Called by       ReSendPacket
                SendPacket
                BuildPacket
}
  BEGIN
    WITH Buf[p] DO BEGIN
      setstrlen(report,0);
      strwrite(report,1,rpos, mes, UnChar(count):3, UnChar(seq):3,
               chr(ptype):3);
      report_log( report );
      BtoS(data, report);
      report_log( report );
    END;  { with }
  END;  { procedure DisplayPacket }

$PAGE$
PROCEDURE PutOut ( p : Ppack );            { Output Packet }
{

        where   p = index into buf of packet to be sent

Outputs the given packet, preceded by RemotePad padding characters, to the
serial line.

Calls           Putcf
                PutCon
                PutStr

Called by       ReSendPacket
                SendPacket
}
  VAR
    i : integer;
  BEGIN
    IF (RemotePad > 0)
      THEN FOR i := 1 TO RemotePad DO
        Putcf(RemotePadChar,LineOut);
    WITH Buf[p] DO BEGIN
      report_send_packet(UnChar(seq));  { report which packet we're sending }
      
      Putcf(mark,LineOut);
      Putcf(count,LineOut);
      Putcf(seq,LineOut);
      Putcf(ptype,LineOut);
      PutStr(data,LineOut);
     END;  { with }
  END;  { procedure PutOut }

$PAGE$
PROCEDURE ReSendPacket;
{

Re-sends previous packet, which had been renamed to Buf[LastPacket] by
SendPacket just after that routine had sent it.

Modifies        stats.ChInPack
                stats.NumSendPacks

Calls           PutOut

Called by       SendPacket
}

   BEGIN
     stats.NumSendPacks := stats.NumSendPacks+1;
     stats.ChInPack := stats.ChInPack + RemotePad + UnChar(Buf[LastPacket].count) + 3;
     IF Debug
      THEN DisplayPacket('Re-Sending ...      ',LastPacket);
     PutOut(LastPacket);
   END;

$PAGE$
PROCEDURE SendPacket;       { sends ThisPacket; leaves it in LastPacket }
{

Accepts "raw" packet in Buf[ThisPacket].  Encodes count (which is
initially the length of the data field), sequence number, and
calculates the checksum.  After packet is sent, exchanges ThisPacket
and LastPacket by swapping pointers, so that ReSendPacket can send it
again if necessary.

Modifies        stats.ChInPack

Calls           PutOut
                ReSendPacket
                CheckFunction
                DisplayPacket

Called by       SendACK
                SendNAK
                ErrorPack
                SendFile
                SendData
                SendEOF
                SendBreak
                SendOurInit
                GetTheirInit
                DoInitLast
}
  VAR
    i,len,chksum : integer;
    temp : Ppack;
   BEGIN
     IF (NumTry <> 1) AND (RunType = Transmit )
       THEN ReSendPacket
       ELSE BEGIN       { send fresh packet }
         WITH Buf[ThisPacket] DO BEGIN
            mark := LocalMark;           { mark }
            len := count;             { save length }
            count := MakeChar(len+3); { count = 3+length of data }
            seq := MakeChar(seq);     { seq number }
            chksum := count + seq + ptype;
            IF ( len > 0)      { is there data ? }
              THEN FOR i:= 1 TO len DO
                     chksum := chksum + data[i];       { loop for data }
            chksum := CheckFunction(chksum);  { calculate  checksum }
            data[len+1] := MakeChar(chksum);  { make printable & output }
            data[len+2] := RemoteEOL;                    { EOL }
            data[len+3] := ENDSTR;
          END;  { WITH }

         stats.NumSendPacks := stats.NumSendPacks+1;
         IF Debug
          THEN DisplayPacket('Sending ...         ',ThisPacket);
         PutOut(ThisPacket);

         IF RunType = Transmit
          THEN BEGIN
             stats.ChInPack := stats.ChInPack + RemotePad + len + 6;
             temp := LastPacket;
             LastPacket := ThisPacket;
             ThisPacket := temp;
           END;
       END;  { send fresh packet }
   END;  { procedure SendPacket }

$PAGE$
PROCEDURE SendACK ( n : integer );         { send ACK packet }
{

Builds an ACK packet for the given sequence number in Buf[ThisPacket]
and sends it.

Modifies        stats.NumACKsent
                Buf[ThisPacket]

Calls           SendPacket

Called by       BuildPacket
                DoData
                DoEOF
                DoBreak
                DoFile
                DoEOFLast
}
   BEGIN
     WITH Buf[ThisPacket] DO
      BEGIN
        count := 0;
        seq := n;
        ptype := TYPEY;
      END;
     SendPacket;
     stats.NumACKsent := stats.NumACKsent+1;
   END;

$PAGE$
PROCEDURE SendNAK ( n : integer );         { send NAK packet }
{

Builds a NAK packet for the given sequence number into Buf[ThisPacket]
and sends it.

Modifies        stats.NumNAKsent
                Buf[ThisPacket]

Calls           SendPacket

Called by       GetTheirInit
                DoData
                DoFileLast
                DoEOF
                DoBreak
                DoFile
                DoEOFLast
                DoInitLast
                ReceiveFile
}
   BEGIN
     WITH Buf[ThisPacket] DO
      BEGIN
        count := 0;
        seq := n;
        ptype := TYPEN;
      END;
     SendPacket;
     stats.NumNAKsent := stats.NumNAKsent+1;
   END;

$PAGE$
PROCEDURE ErrorPack ( c : cstring );
{

        where c = Error description string to be printed or sent in
                  data field of packet

If local, prints the error string to the standard error device.
If remote, sends an error packet to the other host with the error
string in the data field.

Calls           PutCon
                SendPacket

Called by       GetNextFile
                GetFile
                Main program
}
  BEGIN
    IF Local
      THEN PutErr(c)
      ELSE BEGIN        { send error packet to remote Kermit }
        WITH Buf[ThisPacket] DO BEGIN
            seq := n;
            ptype := TYPEE;
            CtoB(c,data);
            count := length(data);
          END;  { with }
        SendPacket;
        END;  { send error packet to remote Kermit }
    FinishUp;
    DisplayStatistics;
  END;

$PAGE$
PROCEDURE Field1;                          { Count }
{

Checks the count field assumed to be in PackControl.t, sets the count
field in Buf[DebugPacket] to t itself, and the count field in
Buf[NextPacket] to UnChar(t).  If the count is not within the proper
range, a message will be printed via Verbose and PackControl.good will
be set FALSE; otherwise, PackControl.good will be unchanged.

References      SizeRecv

Modifies        Buf[NextPacket]
                Buf[DebugPacket]
                PackControl

Calls           Verbose

Called by       BuildPacket
}
  VAR
    test: boolean;
  BEGIN
    WITH Buf[NextPacket] DO BEGIN
       WITH PackControl DO BEGIN
          Buf[DebugPacket].count := t;
          count := UnChar(t);
          test := (count >= 3) OR (count <= SizeRecv-2);
          IF NOT test
            THEN Verbose('Bad count           ');
          good := good AND test;
        END;  { with PackControl }
     END;  { with NextPacket }
  END;  { procedure Field1 }

$PAGE$
PROCEDURE Field2;                          { Packet Number }
{

Checks the sequence number field assumed to be in PackControl.t, sets
the sequence number field in Buf[DebugPacket] to t itself, and the
sequence number field in Buf[NextPacket] to UnChar(t).  If the
sequence number is not within the proper range, a message will be
printed via Verbose and PackControl.good will be set FALSE; otherwise,
PackControl.good will be unchanged.

Modifies        Buf[NextPacket]
                Buf[DebugPacket]
                PackControl

Calls           Verbose

Called by       BuildPacket
}
  VAR
    test : boolean;
   BEGIN
     WITH Buf[NextPacket] DO BEGIN
        WITH PackControl DO BEGIN
           Buf[DebugPacket].seq := t;
           seq := UnChar(t);
           test := (seq >= 0) OR (seq <= 63);
           IF NOT test
             THEN Verbose('Bad seq number      ');
           good := test AND good;
         END;
      END;
   END;

$PAGE$
PROCEDURE Field3;                          { Packet Type }
{

Checks the type field assumed to be in PackControl.t, sets the type
field in Buf[DebugPacket] and in Buf[NextPacket] to PackControl.t.  If
the type is not a valid packet type, a message will be printed via
Verbose and PackControl.good will be set FALSE; otherwise,
PackControl.good will be unchanged.

Modifies        Buf[NextPacket]
                Buf[DebugPacket]
                PackControl

Calls           Verbose
                IsValidPType

Called by       BuildPacket
}
  VAR
    test : boolean;
   BEGIN
     WITH Buf[NextPacket] DO BEGIN
        WITH PackControl DO BEGIN
           ptype := t;
           Buf[DebugPacket].ptype := t;
           test := IsValidPType(ptype);
           IF NOT test
            THEN Verbose('Bad Packet Type     ');
           good := test AND good;
         END;
      END;
   END;

$PAGE$
PROCEDURE Field4;                          { Data }
{

Places the data character, assumed to be in PackControl.t, into the
next position in Buf[DebugPacket].data.  This position is assumed to
be in PackControl.PacketPtr.  Does the proper unquoting, and leaves
the unquoted character in the next position of Buf[NextPacket].data.


Modifies        Buf[NextPacket]
                Buf[DebugPacket]
                PackControl

Calls           -nothing-

Called by       BuildPacket
}
   BEGIN
     WITH PackControl DO BEGIN
        PacketPtr := PacketPtr+1;
        Buf[DebugPacket].data[PacketPtr] := t;
        WITH Buf[NextPacket] DO BEGIN
           IF t=LocalQuote
             THEN begin   { character is quote }
               IF control
                 THEN begin        { quote ,quote  }
                   data[i] := LocalQuote;
                   i := i+1;
                   control := false;
                   END  { quote, quote }
                 ELSE control := true     { set control on }
               END  { character is quote }
             ELSE IF control                { not quote }
                     THEN begin      { convert to control }
                       data[i] := Ctl(t);
                       i := i+1;
                       control := false
                       END  { convert to control }
                     ELSE begin       { regular data }
                       data[i] := t;
                       i := i+1;
                       END;  { regular data }
         END;  { with NextPacket }
      END;  { with PackControl }
   END;  { procedure Field4 }

$PAGE$
PROCEDURE Field5;                          { Check Sum }
{

Places the checksum character, assumed to be in PackControl.t,
followed by a terminator, into the next position of
Buf[DebugPacket].data.  Calls CheckFunction to verify the checksum; if
the checksum accumulated for the data does not match the one sent,
then outputs an error message via Verbose and sets Good to FALSE,
otherwise Good is unchanged.  Sets the PackControl.finished.

Modifies        Buf[NextPacket]
                Buf[DebugPacket]
                PackControl

Calls           Verbose
                CheckFunction

Called by       BuildPacket
}
  VAR
    test : boolean;
   BEGIN
     WITH PackControl DO
      BEGIN
        PacketPtr := PacketPtr +1;
        Buf[DebugPacket].data[PacketPtr] := t;
        Buf[DebugPacket].data[PacketPtr + 1] := ENDSTR;
        check := CheckFunction(check);
        check := MakeChar(check);
        test := (t=check);
        IF NOT test
         THEN Verbose('Bad CheckSum        ');
        good := test AND good;
        Buf[NextPacket].data[i] := ENDSTR;
        finished := true;  { set finished }
      END;
   END;

$PAGE$
PROCEDURE BuildPacket;                 { Process received character }
{

Processes received character, assumed to be in PackControl.t, and adds
it to the packet in Buf[NextPacket] according to the state information
in PackControl.  When the packet is completely received, if it is an
error packet, the data field will be printed and FinishUp
and DisplayStatistics will be called.

Errors          Error Packet Received

Modifies        PackControl
                Buf[NextPacket]
                CurrentPacket
                NextPacket
                stats.NumRecvPacks

Calls           Field1
                Field2
                Field3
                Field4
                Field5
                PutStr
                DisplayStatistics
                SendACK
                DisplayPacket
                PutCon

Called by       ReceivePacket
}
  VAR
    temp : Ppack;
    errstr : string[80];        { holds error text from error packet }
  BEGIN
    WITH PackControl DO BEGIN
      WITH Buf[NextPacket] DO BEGIN
        IF (t<>ENDSTR)        { if a character was read }
          THEN IF restart
                 THEN BEGIN    { read until we get SOH marker }
                   IF (t = SOH)
                     THEN BEGIN   { is packet mark }
                       finished := false;    { set variables }
                       control := false;
                       good := true;
                       seq := -1;   { set return values to bad packet }
                       ptype := QUESTION;
                       data[1] := ENDSTR;
                       data[MAXSTR] := ENDSTR;
                       restart := false;
                       fld := 0;
                       i := 1;
                       PacketPtr := 0;
                       check := 0;
                       END;  { is packet mark }
                   END    { read until we get SOH marker }
                 ELSE BEGIN     { have started packet }
                   IF (t=SOH)          { check for restart or EOL }
                     THEN restart := true
                     ELSE IF (t=LocalEOL)
                            THEN BEGIN
                              finished := true;
                              good := false;
                              END
                            ELSE BEGIN  { not mark or EOL }
                              CASE fld OF
                              { increment field number }
                                0:   fld := 1;
                                1:   fld := 2;
                                2:   fld := 3;
                                3:  { no data }
                                   IF (count=3)
                                     THEN fld := 5
                                     ELSE fld := 4;
                                4:       { end of data }
                                   IF (PacketPtr>=count-3)       
                                       THEN fld := 5;
                                END { case };
                              IF (fld<>5)
                                THEN { add into checksum }
                                     check := check+t;

                              CASE fld OF
                                 1:      Field1;
                                 2:      Field2;
                                 3:      Field3;
                                 4:      Field4;
                                 5:      Field5;
                              END;  { case }
                            END; { not mark or EOL }
                   END;  { have started packet }

        IF finished
          THEN BEGIN
            IF (ptype=TYPEE) AND good
              THEN BEGIN     { was error packet }
                IF Local
                  THEN begin
                    BtoS(data, errstr);
                    setstrlen(report,0);
                    strwrite(report,1,rpos,
                        'Error packet from remote - ',
                        errstr);
                    report_status(report);
                    report_log(report);
                    end;  { if local }
                Finishup;
                DisplayStatistics;
                SendACK(n);          { send ACK }
                END; { was error packet }
            stats.NumRecvPacks := stats.NumRecvPacks+1;
            IF Debug
              THEN BEGIN
                DisplayPacket('Received ...        ',DebugPacket);
                IF good
                  THEN PutErr('Is Good             ');
                END; { debug }

            temp := CurrentPacket;
            CurrentPacket := NextPacket;
            NextPacket := temp;
          END; { if finished }
      END;  { with Buf[NextPacket] }
    END;  { with PackControl }
  END;  { procedure BuildPacket }

$PAGE$
FUNCTION ReceivePacket : boolean;
{

Receives a packet into Buf[NextPacket], which is then renamed to
Buf[CurrentPacket] when complete.

Errors          Timeout while waiting for complete packet
                Abort key typed by user

References      PackControl

Modifies        stats.ChInPack

Calls           SerialIn
                ConsoleStatus
                ConsoleIn
                PutErr
                BuildPacket

Called by       ReceiveACK
                GetTheirInit
                ReceiveData
                ReceiveFile
}
  label 1000;           { here when abort key typed }
   var c : char;
   BEGIN
     WITH PackControl DO
      BEGIN
        StartTimer;
        finished := false;
        restart := true;
        REPEAT
          t := SerialIn;
          IF (RunType = Receive) AND (t <> ENDSTR)
             THEN stats.ChInPack := stats.ChInPack + 1;
          IF Local                     { see if character typed on console }
            THEN if consolestatus then begin     { if a character was typed }
                   c := consolein;              { read it }
                   if c = ConsoleAbort then begin       { if abort forced }
                       FinishUp;
                       good := false;
                       goto 1000;
                       end                      { if abort forced }
                   else t := LocalEOL;
                   END;  { if a character was typed }
          BuildPacket;
        UNTIL finished  OR (TimeLeft = 0);
        IF (TimeLeft = 0)       { if timed out waiting for packet }
         THEN BEGIN
            Buf[CurrentPacket] := TOPacket;
            restart := true;
            IF NOT ((RunType=Transmit) AND (State=RecvInit))
             THEN BEGIN
                PutErr('Timed Out           ');
                FinishUp;
             END;
          END;
 1000:
        StopTimer;
        DisplayStatistics;
        ReceivePacket := good;
      END;  { with PackControl }
   END;  { procedure ReceivePacket }

$PAGE$
FUNCTION ReceiveACK : boolean;  { Receive ACK with correct number }
{

If OneWayOnly is set, then returns TRUE immediately.  Receives a
packet into CurrentPacket.  If it is not received correctly, will
return FALSE and the NumXXXRecv counters will be invalid (!?).
Otherwise, if it is an ACK packet, increments stats.NumACKrecv.  If it is an
ACK packet, increments stats.NumNAKrecv.  If it is any other type,
increments stats.NumBADrecv.  If it is an ACK packet and the sequence number
number matches the one expected, then will return TRUE.

Modifies        stats.NumACKrecv
                stats.NumNAKrecv
                stats.NumBADrecv

Calls           ReceivePacket

Called by       SendFile
                SendData
                SendEOF
                SendBreak
                SendOurInit
}
  VAR
    Ok: boolean;
  BEGIN
    IF (NOT OneWayOnly )
     THEN  Ok := ReceivePacket;
    WITH Buf[CurrentPacket] DO
      BEGIN
        IF (ptype=TYPEY)
          THEN stats.NumACKrecv := stats.NumACKrecv+1
          ELSE IF (ptype=TYPEN)
                 THEN  stats.NumNAKrecv := stats.NumNAKrecv+1
                 ELSE  IF NOT OneWayOnly
                         THEN stats.NumBADrecv := stats.NumBADrecv +1;
        { got right one ? }
        ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
                OR  (OneWayOnly)
      END;  { with }
  END;  { function ReceiveACK }

$PAGE$
PROCEDURE DataFromFile ( VAR newstate : KermitStates );
                                      { Get data from file into ThisPacket }

{

Fills the data field of Buf[ThisPacket] with characters from DiskFile,
which is assumed to be opened.  Characters are read from file via
Getcf.  The field is terminated by ENDSTR, and the count, sequence and
packet type fields are set.  If EOF is reached, the file is closed,
and newstate and SaveState are set to FileData.  Otherwise, newstate is
set to whatever SaveState is, and SaveState is left unchanged.

References      Diskfile

Modifies        SaveState
                Buf[ThisPacket]
                stats.ChInFile

Calls           Sclose
                Getcf

Called by       SendData
}
  VAR
    x,c : byte;
    i: integer;
  BEGIN
    IF (NumTry=1)      { if first time packet sent }
      THEN BEGIN
        i := 1;
        x := ENDSTR;
        WITH Buf[ThisPacket] DO BEGIN
          { leave room for quote  & NEWLINE }
          WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)  DO begin
            x := Getcf(c,DiskFile);  { get character and quote if necessary }
            IF (x<>ENDFILE)
               THEN IF (IsControl(x)) OR (x=RemoteQuote)
                      THEN BEGIN           { control char -- quote }
                        IF (x=NEWLINE)
                          THEN  CASE EOLforFile OF    { use proper EOL }
                             LineFeed:   { ok as is };
                             CrLf:     BEGIN
                                       data[i] := RemoteQuote;
                                       i := i+1;
                                       data[i] := Ctl(CR);
                                       i := i+1; 
                                       { LF will be sent below }
                                       END;  { CrLf }
                             JustCR:   x := CR;
                            END { case };
                        data[i] := RemoteQuote;
                        i := i+1;
                        IF (x<>RemoteQuote)
                          THEN  data[i] := Ctl(x)
                          ELSE  data[i] := RemoteQuote;
                        END  { control char }
                      ELSE  data[i] := x;     { it's regular char }

               IF (x<>ENDFILE)
                THEN BEGIN
                   i := i+1;     { increase count for next char }
                   stats.ChInFile := stats.ChInFile + 1;
                   END;
             END;                { get character and quote if necessary }

            data[i] := ENDSTR;   { terminate ByteString }

            count := i-1;        { set data fieldlength }
            seq := n;            { set sequence number }
            ptype := TYPED;      { set packet type }

            IF (x=ENDFILE)
               THEN BEGIN
                    newstate := EOFile;
                    Sclose(DiskFile);
                    DiskFile := ioerror;
                  END
               ELSE newstate := FileData;
            SaveState := newstate;        { save state }
          END  { with Buf[ThisPacket] do }
       END  { if first time packet sent }
      ELSE newstate := SaveState;        { get old state }
   END;  { procedure DataFromFile }

$PAGE$
FUNCTION GetNextFile : boolean;
{

Get next file to send in ThisPacket.  Returns true if no more.

Modifies        Buf[ThisPacket]
                NextArg
                stats.ChInFile

Calls           GetStrArg
                Exists
                Sopen
                ErrorPack
                PutStr

Called by       SendFile
}
  VAR
    result : boolean;
    name : FileName;

{ get_next_name     gets the next file name in the file list and places
  it in the parameter name.  If no more names in the file name list,
  returns false.
}
   function get_next_name( var name : string ) : boolean;
     var result : boolean;
     begin
     result := false;
     name := send_file_list[send_file_next];
     if strlen(name) <> 0
        then begin
          send_file_next := send_file_next + 1;
          result := true;
          end;
     get_next_name := result;
     end;  { procedure get_next_name }

   BEGIN
     result := true;
     IF (NumTry=1)
       THEN  WITH Buf[ThisPacket] DO BEGIN      { first try at this packet }
         while get_next_name(name) and  (result)  do begin
           IF Exists(name)
             THEN BEGIN     { file already exists }
               DiskFile := Sopen(name,IOREAD);
               count := strlen(name);	{ set packet length }
               StoB(name, data);    	{ convert name to Bytestring }
                                    { in data field of packet }
               report_send_file(name);
               stats.ChInFile := stats.ChInFile + count;
               seq := n;
               ptype := TYPEF;
               IF DiskFile <= IOERROR
                 THEN ErrorPack('Cannot open file    ');
               result := false;
               END;  { file already exists }
           end;  { while }
         END  { first try at this packet }
       ELSE result := false;                     { for saved packet }
     GetNextFile := result;
   END;  { function getnextfile }

$PAGE$
PROCEDURE SendFile;                        { send file name packet }
{

Errors          Retry Count Exhausted

References      MaxTry

Modifies        NumTry
                State
                n

Calls           PutErr
                Verbose
                GetNextFile
                SendPacket
                ReceiveACK

Called by       SendSwitch
}
  var fnm : filename;
      num : integer;
  BEGIN
  IF NumTry > MaxTry
    THEN BEGIN  { retry count exhausted }
      PutErr ('Send file - Too Many');
      State := Abort;      { too many tries, abort }
      END  { retry count exhausted }
    ELSE BEGIN  { maybe send file header }
      NumTry := NumTry+1;
      IF GetNextFile         { if no more files to send }
        THEN BEGIN
          State := Break;
          NumTry := 0;
          END
        ELSE BEGIN           { send file header packet }
          IF Verbosity
            THEN begin  { report sending file header }
              IF (NumTry = 1)
                THEN begin
                  BtoS(Buf[ThisPacket].data,fnm);
                  num := Buf[ThisPacket].seq;
                  end
                ELSE begin
                  BtoS(Buf[LastPacket].data,fnm);
                  num := Buf[LastPacket].seq;
                  end;
              setstrlen(report,0);
              strwrite(report,1,rpos,'Sending file header packet #',
                       num:1,' for ',fnm);
              report_log(report);
              end;  { report sending file header }
          SendPacket;     { send this packet }
          IF ReceiveACK
            THEN BEGIN
              State := FileData;
              NumTry := 0;
              n := (n+1) MOD 64;
              END
          END;   { send file header packet }
      END;  { maybe send file header }
  END;  { procedure SendFile }

$PAGE$
PROCEDURE SendData;                     { send file data packets }
{

Errors          Retry Count Exhausted

References      MaxTry

Modifies        NumTry
                State
                n

Calls           PutCon
                PutNum
                PutErr
                DataFromFile
                SendPacket
                ReceiveACK

Called by       SendSwitch
}
  VAR
    newstate: KermitStates;
  BEGIN
    IF Verbosity
      THEN BEGIN
        setstrlen(report,0);
        strwrite(report,1,rpos,'Sending data packet #',n:1);
        report_log(report);
        END;
    IF NumTry > MaxTry
      THEN BEGIN
         State := Abort;       { too many tries, abort }
         PutErr ('Send data - Too many');
         END
      ELSE BEGIN                { send data packet }
         NumTry := NumTry+1;
         DataFromFile(newstate);
         SendPacket;
         IF ReceiveACK
           THEN BEGIN           { got acknowledgement }
             State := newstate;
             NumTry := 0;
             n := (n+1) MOD 64;
             END;  { got acknowledgement }
       END;  { send data packet }
   END;  { procedure SendData }

$PAGE$
PROCEDURE SendEOF;                         { send EOF  packet }
{


References      MaxTry

Modifies        Buf[ThisPacket]
                NumTry
                State
                n

Calls           Verbose
                SendPacket
                ReceiveACK

Called by       SendSwitch
}
   BEGIN
     Verbose ('Sending EOF         ');
     IF NumTry > MaxTry
      THEN BEGIN
         State := Abort;       { too many tries, abort }
         PutErr('Send EOF - Too Many ');
         END
      ELSE BEGIN        { send EOF packet }
        NumTry := NumTry+1;
        IF (NumTry = 1)
          THEN BEGIN  { if first time packet sent }
             WITH Buf[ThisPacket] DO BEGIN
                ptype := TYPEZ;
                seq := n;
                count := 0;
                END  { with }
             END;  { if first time packet sent }
         SendPacket;
         IF ReceiveACK
           THEN BEGIN           { got acknowledgement }
             State := FileHeader;
             NumTry := 0;
             n := (n+1) MOD 64;
             END;  { got acknowledgement }
       END;  { send EOF packet }
   END;  { procedure SendEOF }

$PAGE$
PROCEDURE SendBreak; { send break packet }
{


References      MaxTry

Modifies        Buf[ThisPacket]
                NumTry
                State
                n

Calls           Verbose
                PutErr
                SendPacket
                ReceiveACK

Called by       SendSwitch
}
   BEGIN
     Verbose ('Sending break       ');
     IF NumTry > MaxTry
      THEN BEGIN
         State := Abort;       { too many tries, abort }
         PutErr('Send break -Too Many');
         END
      ELSE BEGIN  { send break packet }
         NumTry := NumTry+1;
         { make up packet  }
         IF NumTry = 1
          THEN BEGIN
             WITH Buf[ThisPacket] DO BEGIN
                ptype := TYPEB;
                seq := n;
                count := 0;
                END
             END;  { with }
         SendPacket; { send this packet }
         IF ReceiveACK
           THEN State := Complete;
       END;  { send break packet }
   END;  { procedure SendBreak }

$PAGE$
PROCEDURE SendOurInit;  { send init packet }
{


References      MaxTry
                OneWayOnly

Modifies        Buf[ThisPacket]
                Buf[CurrentPacket]
                NumTry
                State
                n
                SizeSend
                RemoteTimeOut
                RemotePad
                RemotePadChar
                RemoteEOL
                RemoteQuote

Calls           Verbose
                PutErr
                EnCodeParm
                SendPacket
                ReceiveACK
                

Called by       SendSwitch
}
   BEGIN
     Verbose ('Sending init        ');
     IF NumTry > MaxTry
      THEN BEGIN
         State := Abort;      { too many tries, abort }
         PutErr('Cannot Initialize   ');
         END
      ELSE BEGIN        { send our send init packet }
         NumTry := NumTry+1;
         IF (NumTry = 1)
           THEN BEGIN            { if first time packet sent }
             WITH Buf[ThisPacket] DO BEGIN
                 EnCodeParm(data);
                 count := NUMPARAM;
                 seq := n;
                 ptype := TYPES;
                 END  { with }
             END;  { if first time packet sent }

         SendPacket; { send this packet }
         IF ReceiveACK
           THEN BEGIN           { got acknowledgment }
             WITH Buf[CurrentPacket] DO BEGIN
               IF OneWayOnly     { use same data if test mode }
                  THEN data := Buf[LastPacket].data;
               SizeSend := UnChar(data[1]);
               RemoteTimeOut := UnChar(data[2]);
               RemotePad := UnChar(data[3]);
               RemotePadChar := Ctl(data[4]);
               RemoteEOL := CR;  { default to CR }
               IF (length(data) >= 5)
                 THEN IF (data[5] <> 0)
                        THEN RemoteEOL := UnChar(data[5]);
               RemoteQuote := SHARP;  { default # }
               IF (length(data) >= 6)
                 THEN IF (data[6] <> 0)
                        THEN RemoteQuote := data[6];
               END;  { with }

             State := FileHeader;
             NumTry := 0;
             n := (n+1) MOD 64;
           END;  { got acknowledgement }
       END;  { send our send init packet }
   END;  { procedure SendOurInit }

$PAGE$
PROCEDURE SendSwitch( files : filename_list);
{

Send-switch is the state table switcher for sending files.
It loops until either it is finished or a fault is encountered.
Routines called by SendSwitch are responsible for changing the state.

References      OneWayOnly

Modifies        State
                NumTry

Calls           Sleep
                StartRun
                SendData
                SendFile
                SendEOF
                SendOurInit
                SendBreak

Called by       Main Program
}
   BEGIN
     State := SendInit;          { send initiate is the start state }
     NumTry := 0;                { say no tries yet }
     init_packet_display(runtype);
     IF (NOT OneWayOnly )
       THEN  Sleep(LocalDelay);
     send_file_list := files;   { get list of files to send }
     send_file_next := 1;       { point to first filename }
     StartRun;
      REPEAT
       CASE State OF
         FileData:     SendData;         { data-send state }
         FileHeader:   SendFile;         { send file name }
         EOFile:       SendEOF;          { send end-of-file }
         SendInit:     SendOurInit;      { send initialize }
         Break:        SendBreak;        { send break }
         Complete:     { nothing };
         Abort:        { nothing };
        END { case };
      UNTIL ( (State = Abort) OR (State=Complete) );
   END;

$PAGE$
PROCEDURE GetFile ( data : bytestring );
{

Creates file with name given by the bytestring data.  Assigns it to
file descriptor diskfile.

References      Verbosity

Modifies        DiskFile

Calls           Exists
                ErrorPack

Called by       DoFile
}
  VAR
    name : FileName;
    npos : integer;
  BEGIN
    IF DiskFile = IOERROR      { if we don't already have a file }
      THEN begin               { create a file }
        BtoS( data, name );    { get the filename from the packet }
                               { data field }
        IF Verbosity
          THEN begin
             setstrlen(report,0);
             strwrite(report,1,rpos,'Creating file ',name);
             report_log(report);
             end;

        { check Max length }

        IF strlen(name) > FILENAME_LENGTH
          THEN setstrlen(name, FILENAME_LENGTH);

        IF Exists(name)
          THEN BEGIN  { if file exists already }
             setstrlen(report,0);
             strwrite(report,1,rpos,'File already exists - ',name);
             setstrlen(name,0);
             strwrite(name, 1, npos, TEMPFILE:1, n:1);
             strwrite(report,rpos,rpos,
                      '.  Calling new file  ',name,' instead.');
             report_status(report);
          END;  { if file exists already }
        DiskFile := Sopen(name,IOWRITE);
        END;  { create a file }
    IF (Diskfile <= IOERROR)
      THEN    ErrorPack('Cannot create file  ');
  END;  { procedure GetFile }

$PAGE$
PROCEDURE GetTheirInit;
{

Receive init packet.  Respond with ACK and  our parameters.

Errors          Retry count exhausted
                Received Bad Init packet

References      MaxTry
                Debug

Modifies        Buf[ThisPacket]
                Buf[CurrentPacket]
                State
                NumTry
                n
                stats.NumACKsent
                OldTry

Calls           PutErr
                Verbose
                ReceivePacket
                DeCodeParm
                EnCodeParm
                SendPacket
                PutCon
                SendNAK

Called by       RecvSwitch
}
  VAR rs : boolean;
  BEGIN
    IF NumTry > MaxTry
      THEN BEGIN
        State := Abort;
        PutErr('Cannot receive init ');
        END
      ELSE BEGIN        { Receive the Send init from remote }
        Verbose ( 'Receiving Init      ');
        NumTry := NumTry+1;
        rs := ReceivePacket;
        IF rs   AND   (Buf[CurrentPacket].ptype = TYPES)
          THEN BEGIN  { Good send init packet received }
             WITH Buf[CurrentPacket] DO BEGIN
               n := seq;
               DeCodeParm(data);
               END;  { with }
 
             { now send mine }
             WITH Buf[ThisPacket] DO
               BEGIN
                 count := NUMPARAM;
                 seq := n;
                 Ptype := TYPEY;
                 EnCodeParm(data);
               END;
             SendPacket;
             stats.NumACKsent := stats.NumACKsent+1;
             State := FileHeader;
             OldTry := NumTry;
             NumTry := 0;
             n := (n+1) MOD 64
             END  { good send init packet received }
          ELSE BEGIN    { received bad init }
            IF Debug
              THEN begin
                PutErr('Received Bad init   ');
                end;
            SendNAK(n);
            END;  { received bad init }
       END;  { Receive the Send init from remote }
   END;

$PAGE$
PROCEDURE DataToFile;                      { output to file }
{

Writes the data field of Buf[CurrentPacket] to DiskFile, with the end
of line sequence dictated by EOLforFile.

Implicit Inputs
                Buf[CurrentPacket]

References      EOLForFile
                DiskFile

Modifies        stats.ChInFile

Calls           Putcf
                PutStr

Called by       DoData
}
  VAR
    len,i : integer;
    temp : ByteString;
   BEGIN
     WITH Buf[CurrentPacket] DO
      BEGIN
        len := length(data);
        stats.ChInFile := stats.ChInFile + len;
        CASE EOLforFile OF
          LineFeed:     PutStr(data,DiskFile);

          CrLf:         BEGIN  { don't output  CR }
                        FOR i:=1 TO len DO
                        IF data[i] <> CR
                          THEN  Putcf(data[i],DiskFile);
                        END; { CrLf }

          JustCR:       BEGIN   { change CR to NEWLINE }
                        FOR i:=1 TO len DO
                        IF data[i]=CR
                          THEN data[i]:=NEWLINE;
                        PutStr(data,DiskFile);
                        END; { JustCR }
         END;  { case }
      END;  { with }
   END;  { procedure DataToFile }

$PAGE$
PROCEDURE DoData;                          { Process Data packet }
{

Processes received data packet, assumed to be in CurrentPacket.  If
the packet is the expected one, writes the data to the destination
file via DataToFile.  If it is the previous packet (i.e. the ACK for
that packet got lost), ACKs that packet again if the retry count has
not reached maximum.  If it is any other packet number, the a NAK will
be sent for the expected packet.

Implicit Inputs
                Buf[CurrentPacket]

Errors          Retry count exhausted

References      MaxTry
                OldTry

Modifies        OldTry
                NumTry
                n
                State

Calls           DataToFile
                PutErr
                SendACK
                SendNAK

Called by       ReceiveData
}
   BEGIN
     WITH Buf[CurrentPacket] DO
      BEGIN
        IF  seq = ((n + 63) MOD 64)
         THEN BEGIN                { it's the previous data packet }
            IF OldTry>MaxTry   { if retried too many times }
             THEN BEGIN
                State := Abort;
                PutErr('Old data - Too many ');
                END
             ELSE BEGIN
                SendACK(seq);
                NumTry := 0;
                END;
             END   { it's the previous packet }
         ELSE BEGIN    { it's not the previous one }
            IF (n<>seq)    { if it's not the expected one }
              THEN  SendNAK(n)  { NAK the expected one }
              ELSE BEGIN
                SendACK(n); { ACK }
                DataToFile;
                OldTry := NumTry;
                NumTry := 0;
                n := (n+1) MOD 64;
              END;
          END; { it's not the previous one }
      END;  { with }
   END;  { procedure DoData }

$PAGE$
PROCEDURE DoFileLast;                      { Process File Packet }
{

Called by ReceiveData when file header packet received when a data
packet expected (ie the sender never got the ACK for the file header).

Errors          Retry count exhausted

References      Buf[CurrentPacket]
                MaxTry

Modifies        State
                OldTry
                NumTry

Calls           PutErr
                SendACK
                SendNAK

Called by       ReceiveData
}
   BEGIN          { File header - last one  }
     IF OldTry > MaxTry { tries ? }
      THEN BEGIN
         State := Abort;
         PutErr('Old file - Too many ');
         END
      ELSE BEGIN
         OldTry := OldTry+1;
         WITH Buf[CurrentPacket] DO
          BEGIN
            IF seq = ((n + 63) MOD 64)
             { packet number }
             THEN BEGIN  { send ACK }
                SendACK(seq);
                NumTry := 0
               END
             ELSE BEGIN
                SendNAK(n);   { NAK }
               END;
          END;  { with }
       END;  { retry not exhausted }
   END;  { procedure DoFileLast }

$PAGE$
PROCEDURE DoEOF;                           { Process EOF packet }
{

Called by ReceiveData to process received EOF packets.  If not the
expected sequence number, NAKs the expected packet, otherwise ACKs it
and closes the file. 

References      Buf[CurrentPacket]
                DiskFile

Modifies        DiskFile
                OldTry
                NumTry
                State
                n

Calls           SendNAK
                SendACK
                Sclose

Called by       ReceiveData
}
   BEGIN                 { EOF - this one }
     IF Buf[CurrentPacket].seq<>n    { packet number ? }
      THEN SendNAK(n)   { NAK the expected packet }
      ELSE  BEGIN       { ACK this one }
         SendACK(n);
         Sclose(DiskFile);  { close file }
         DiskFile := IOERROR;
         OldTry := NumTry;
         NumTry := 0;
         n := (n+1) MOD 64; { next packet  }
         State := FileHeader;   { change state }
        END; { ACK this one }
   END;  { procedure DoEOF }

$PAGE$
PROCEDURE ReceiveData;                     { Receive data packets }
{

Reads packet, dispatches to proper routine if data, EOF, or file header
packet.  If it is any other type, NAKs the expected data packet.

Errors          Retry Count Exhausted
                Invalid Packet Type

References      MaxTry
                Verbosity
                Local
                Buf[CurrentPacket]

Modifies        NumTry

Calls           PutStr
                ReceivePacket
                PutCon
                PutNum
                DoData
                DoFileLast
                DoEOF
                Verbose
                SendNAK

Called by       RecvSwitch
}
  VAR
    strend : integer;
    packetnum : ByteString;
    good : boolean;

  BEGIN
    IF NumTry > MaxTry          { check number of tries }
      THEN BEGIN
          State := Abort;
          CtoB('Recv data -Too many ',packetnum);
          strend := ItoC(n,packetnum,CONLENGTH+1);
          IF Local
            THEN  PutStr(packetnum,STDERR);
         END
      ELSE  BEGIN	{ retry not exhausted }
         NumTry := NumTry+1;                { increase number of tries }
         good := ReceivePacket;		    { get packet }
         WITH Buf[CurrentPacket] DO  BEGIN
            IF Verbosity
              THEN BEGIN
                 PutCon('Receiving (Data)    ',STDERR);
                 PutNum(seq,STDERR);
                END;
            IF (ptype in [TYPED, TYPEZ, TYPEF]) AND good        { check type }
              THEN  CASE ptype OF
                      TYPED:  DoData;
                      TYPEF:  DoFileLast;
                      TYPEZ:  DoEOF;
                     END { case }
              ELSE BEGIN                { not a good type }
                 Verbose('Expected data pack  ');
                 SendNAK(n);
                END;
          END;  { with }
       END;  { retry not exhausted }
  END;  { procedure ReceiveData }

$PAGE$
PROCEDURE DoBreak;                         { Process Break packet }
{

Called by ReceiveFile to process a break packet.

Errors          None

References      Buf[CurrentPacket]
                n

Modifies        State

Calls           SendNAK
                SendACK

Called by       ReceiveFile
}
   BEGIN                    { Break transmission }
     IF Buf[CurrentPacket].seq<>n    { packet number ? }
      THEN SendNAK(n) { NAK }
      ELSE BEGIN            { send  ACK }
         SendACK(n) ;
         State := Complete  { change state }
        END
   END;

$PAGE$
PROCEDURE DoFile;                          { Process file packet }
{

Called by ReceiveFile to process file header packet.

Errors          None

References      Buf[CurrentPacket]

Modifies        stats.ChInFile
                OldTry
                NumTry
                n
                State

Calls           SendNAK
                SendACK
                GetFile

Called by       ReceiveFile
}
  BEGIN
    WITH Buf[CurrentPacket] DO BEGIN
        IF seq<>n                       { packet number ? }
          THEN SendNAK(n)                { NAK }
          ELSE BEGIN                     { send ACK }
            SendACK(n);
            stats.ChInFile := stats.ChInFile + length(data);
            GetFile(data);              { get file name }
            OldTry := NumTry;
            NumTry := 0;
            n := (n+1) MOD 64;          { next packet  }
            State := FileData;          { change state }
            END;  { send ACK }
       END;  { with }
   END;  { procedure DoFile }
 
$PAGE$
PROCEDURE DoEOFLast;                       { Process EOF Packet }
{

Called by ReceiveFile to process an EOF for the last file (i.e., the
ACK for the last EOF was lost).  Resends the ACK for the EOF.

Errors          Retry count exhausted

References      Buf[CurrentPacket]
                MaxTry
                n

Modifies        State
                OldTry
                NumTry

Calls           PutErr
                SendACK
                SendNAK

Called by       ReceiveFile
}
  BEGIN               { End Of File Last One}
    IF OldTry > MaxTry { tries ? }
      THEN BEGIN
         State := Abort;
         PutErr('Old EOF - Too many  ');
         END
      ELSE BEGIN        { process last EOF packet }
        OldTry := OldTry+1;
        WITH Buf[CurrentPacket] DO BEGIN
          IF seq =((n + 63 ) MOD 64)            { packet number }
            THEN BEGIN  { send ACK }
              SendACK(seq);
              Numtry := 0;
              END
            ELSE SendNAK(n);  { NAK }
          END;  { with }
       END;  { process last EOF packet }
   END;  { procedure DoEOFLast }

$PAGE$
PROCEDURE DoInitLast;
{

Called by ReceiveFile when a Send-Init packet was received (i.e. when
the ACK for the last Send-Init was lost).  Resends the Send-Init.

Errors          Retry count exhausted

References      MaxTry
                Buf[CurrentPacket]
                NUMPARAM

Modifies        Buf[ThisPacket]
                State
                OldTry
                NumTry
                stats.NumACKsent

Calls           PutErr
                EnCodeParm
                SendPacket
                SendNAK

Called by       ReceiveFile
}
  BEGIN                { Init Packet - last one }
    IF OldTry>MaxTry   { number of tries? }
      THEN BEGIN
        State := Abort;
        PutErr('Old init - Too many ');
        END
      ELSE BEGIN  { process last init packet }
        OldTry := OldTry+1;
        IF Buf[CurrentPacket].seq = ((n + 63) MOD  64)  { packet number }
          THEN BEGIN   { send ACK }
            WITH Buf[ThisPacket] DO BEGIN
              count := NUMPARAM;
              seq := Buf[CurrentPacket].seq;
              ptype := TYPEY;
              EnCodeParm(data);
              END;
            SendPacket;
            stats.NumACKsent := stats.NumACKsent+1;
            NumTry := 0;
            END  { send ACK }
          ELSE SendNAK(n);  { NAK }
       END;  { process last init packet }
   END;  { procedure DoInitLast }

$PAGE$
PROCEDURE ReceiveFile;                     { receive file packet }
{

Errors          Retry count exhausted
                Invalid Packet Type

References      MaxTry
                Verbosity
                Debug

Modifies        Buf[CurrentPacket]
                NumTry

Calls           PutErr
                ReceivePacket
                PutCon
                PutNum
                DoInitLast
                DoEOFLast
                DoFile
                DoBreak
                SendNAK

Called by       RecvSwitch
}
  VAR
    good: boolean;
    rpos : integer;
    report, fnm : string[80];
  BEGIN
    IF NumTry > MaxTry          { check number of tries }
      THEN BEGIN        { retry count exhausted }
         State := Abort;
         PutErr('Recv file - Too many');
         END  { retry count exhausted }
      ELSE BEGIN        { get the file header packet }
        NumTry := NumTry+1;                { increase number of tries }
        good := ReceivePacket;             { get packet }
        WITH Buf[CurrentPacket] DO BEGIN
          IF VERBOSITY
            THEN BEGIN
              setstrlen(report,0);
              strwrite(report,1,rpos, 'Receiving file header packet #',
                        seq:1); 
              report_log(report);
              END;
          IF (ptype in [TYPES, TYPEZ, TYPEF, TYPEB]) AND good
            THEN
             CASE ptype OF
                TYPES:  DoInitLast;      { ACK to Init packet lost }
                TYPEZ:  DoEOFLast;       { ACK to EOF lost }
                TYPEF:  begin            { File header }
                        BtoS(data, fnm);
                        report_receive_file(fnm);
                        DoFile;
                        end;  { TYPEF }
                TYPEB:  DoBreak;         { finished receiving file group }
               END { case }
            ELSE BEGIN
              IF Debug
                THEN PutErr('Expected File Packet');
              SendNAK(n);
              END;
        END;  { with }
      END;  { get the file header packet }
  END;  { procedure ReceiveFile }

$PAGE$
procedure SendRecvInit( fnm : filename );
{

Sends receive initiate packet with the given filename to the remote server.

Called by       RecvSwitch
}
  begin
  { build the Receive Init packet in ThisPacket }
  with Buf[ThisPacket] do begin
    StoB(fnm, data);        { convert filename into bytestring in data field }
    count := strlen(fnm);
    seq := n;
    ptype := TYPER;     { type is Receive Init }
    end;  { with }
  SendPacket;           { send ThisPacket }
  end;  { procedure SendRecvInit }


$PAGE$
procedure RecvSwitch( files : filename_list );
{

Receive file group state switcher.  If filename_list is non-empty, sends
receive init packet for the files in it.

Modifies        State
                NumTry

Calls           StartRun
                ReceiveData
                GetTheirInit
                ReceiveFile

Called by       Main program
}
   var i : integer;
       fnm : filename;
   BEGIN
     State := RecvInit;
     init_packet_display(runtype);
     NumTry := 0;
     StartRun;
     i := 1;
     while strlen(files[i]) <> 0 do begin
       fnm := files[i];
       i := i + 1;
       SendRecvInit( fnm );
       REPEAT
          if debug or verbosity
            then begin          { print blank line to separate packet info }
              report := '';
              report_log(report);
              end;
          CASE State OF
            FileData:       ReceiveData;
            RecvInit:       GetTheirInit;
            Break:          { nothing };
            FileHeader:     ReceiveFile;
            EOFile:         { nothing };
            Complete:       { nothing };
            Abort:          { nothing };
           END;  { case }
         UNTIL (State = Abort ) OR ( State = Complete );
       end;  { while }
    END;  { procedure recvswitch }

end.  { module krmguts }
