Date: Thu, 04 Oct 84 14:51:26 EDT   
From: Edgar B. Butt <BUTT@UMD2.ARPA>
To: sy.fdc@cu20b
Subject: Oh no, another Kermit!     

Here is a Kermit implementation for the Sperry 1100 systems written 
in Pascal.  It has been run successfully here at the University of Maryland,
College Park, and at SUNY, Albany.  Please add it to your selection 
of Kermits.  I would appreciate feedback from anyone who tries it.  

The first page of code consists of comments explaining how to   
use and generate Kermit1100.

Hop someone finds it useful,

Edgar Butt (Butt@umd2.arpa) 
Computer Science Center 
University of Maryland  
College Park, Maryland 20742
(301) 454-2946  

The source for Kermit1100 version 2.0 begins on the next line.  
{Kermit1100 - see first executable line in main block for version   

   KERMIT1100 is yet another Kermit written to run on the Sperry (Univac)   
   1100 series of computers.  It is written in Pascal to be compiled on 
   the NOSC Pascal Compiler, version 2.2 or later.  This compiler is
   available from the Computer Science Center of the University of  
   Maryland, College Park, for a nominal service charge.

   Kermit aficianodos may notice that the structure of this version 
   differs from other versions in that packets are read and sequence
   checked in the main program loop and are then dispatched to the  
   proper input or output state with a single case statement.   
   This structure has allowed the various state processes to be 
   relatively uncluttered.  While doing this implementation I   
   discovered that NAK's are like tadpole tails.  They seem like
   a neat idea at first, but as the frog emerges, they serve no 
   useful purpose.  Likewise, I have been unable to find a case 
   in which NAK's are necessary.  Sending an ACK for the last   
   good packet received is just as good.  If I'm wrong, I am sure   
   that some swamp dweller out there will let me know.  
   (Not to worry, I handle incoming NAK's even though they are not  
   necessary.)  

   By way of a quick synopsys of features, this version of Kermit has:  

      Simple server mode - processes S and R packets
      8-bit quoting (Turned on by Q-option) 
      Repeat count prefixes 
      Error packet generation and processing

   Kermit 1100 is called as a processor with the following control card:

      @Q*F.KERMIT,OPTIONS 1100SPEC,REMOTESPEC   

      Q*F. is the file in which the processor resides.  
      1100SPEC is the 1100 file or element on which Kermit will operate.
      REMOTESPEC is the file name sent to the remote Kermit(a fib of sorts) 
      OPTIONS:  
         B - big buffers.  Kermit1100 normally tells the remote Kermit to send
             packets that will fit in 84 characters.  B-option causes it to
             request the maximum size Kermit packets (which ain't as big as you
             might wish)  Make sure that your communications hardware and
             software will let the long packets get through.
         C - assume for sending or receiving that records are to be separated
             by CR instead of CR-LF 
         L - log in the element KERMITLOG.MDSSS all file reads and writes and
             all communication sends and receives. MDSSS is the month, day and
             seconds/4 encoded base 32 (0,...,9,A,...,V). If a catalogued file
             'KERMITLOG' is assignable, it is used.  Otherwise a temporary file
             is created.
         Q - allow eight-bit quoting for sending or receiving.  If the file 
             being sent or received has 8-bit data and if the remote kermit 
             is capable of 8-bit quoting, then all 8-bits of data can be
             sent or received.  
         R - expect to receive data.  Put the data in 1100SPEC if specified 
             or in the file or element name sent from the remote Kermit.  No
             transformation on the incoming name is done at present so it   
             had better be good.
         S - send 1100SPEC to the remote Kermit.  If REMOTESPEC is specified,
             put it in the file header packet.  Otherwise put 1100SPEC in the
             packet.
         T - test mode.  Send (actually print on a terminal) packets as if  
             an S-option had been specified without reading ACK's.
         W - If the S-option is used, wait 30 seconds before starting to send

Kermit1100 tries not to exit until an EOF is received in order to process   
multiple requests from the remote Kermit.   

   Happy hopping,   

      Edgar Butt  (BUTT@UMD2.ARPA)  
      Computer Science Center   
      University of Maryland
      College Park, Maryland 20742  
      Phone (301) 454-2946  

}   
{$F Here we go.....}

PROCESSOR Kermit (input, output);   

CONST   
maxtry = 5; 
maxbuf = 200 ;  
maxlin = 80;
maxwrt = 132;   

ascnul = 0; 
ascsoh = 1; 
asclf  = 10;
asccr  = 13;
ascsp  = 32; { }
ascns  = 35; {#}
ascamp = 38; {&}
ascast = 42; {*}
ascper = 46; {.}
ascb   = 66; {B}
ascd   = 68; {D}
asce   = 69; {E}
ascf   = 70; {F}
ascn   = 78; {N}
ascr   = 82; {R}
ascs   = 83; {S}
asct   = 84; {T}
ascy   = 89; {Y}
ascz   = 90; {Z}
asctil = 126; {~}   
ascdel = 127; {rubout}  

mark = ascsoh;  

TYPE
kermitstates = (kcommand,   
                kexit,  
                wexit,  
                sinitiate,  
                sheader,
                sdata,  
                sbreak, 
                rinitiate,  
                rheader,
                rdata); 
filestatus = (closed, open, endfile);   
ascval = 0..255 ;   
ascbuf = RECORD 
               ln: INTEGER; 
               ch: ARRAY[1..maxbuf] OF ascval;  
            END;
line = PACKED ARRAY [1..maxlin] OF CHAR;

{System dependent TYPE} 

ident= PACKED ARRAY[1..12] OF CHAR; 
sbits = SET of 0..35;   

VAR 

version: string;
iniflg: boolean; {Set true after first initialization}  
server: boolean; {If true, Kermit1100 waits for packets from remote}
state: kermitstates;
filbuf,wrtbuf,redbuf,sndbuf,rcvbuf: ascbuf; 
redix:  integer;
rfile,wfile,lfile: text;
fname,rfname,lname: line;   
fnlen,rfnlen: INTEGER;  
rstatus, wstatus,lstatus: filestatus;   
seq,rcvseq: INTEGER;
rlen: INTEGER;  
stype,rcvtyp: ascval;   
numtry: INTEGER;
numcserr: INTEGER;  
ineoln: boolean;
sndonly: boolean;   
sndlog, rcvlog, wrtlog, redlog: boolean;
bstrip:  boolean;   
creol:  boolean;
lfeol:  boolean;
crlfeol:  boolean;  
gotcr:  boolean;

locbsiz:  ascval;   
loctout:  ascval;   
locnpad:  ascval;   
locpad:   ascval;   
loceol:   ascval;   
locquo:   ascval;   
optqu8:   ascval;   
locqu8:   ascval;   
locrep:   ascval;   

rembsiz:  ascval;   
remdsiz:  ascval; {Maximum number of data characters to send (remdsiz-3)}   
remtout:  ascval;   
remnpad:  ascval;   
rempad:   ascval;   
remeol:   ascval;   
remquo:   ascval;   
remqu8:   ascval;   
remrep:   ascval;   

{System dependent VAR}  
ruse,wuse,luse: ident;  
a0,a1,a2: integer;  

{Forward reference procedures } 

PROCEDURE error(msg:string);FORWARD;

{System dependent procedures to read and write files}   

PROCEDURE readelt1(VAR f:text; filename:ident; name:line; VAR ok:boolean);  
   EXTERN;  
PROCEDURE openelt1(VAR f:text; filename:ident; name:line; VAR ok:boolean);  
   EXTERN;  
PROCEDURE closeelt1(VAR f:text; filename:ident; name:line); EXTERN; 
PROCEDURE param_string(field:INTEGER; VAR param:STRING); EXTERN;
PROCEDURE csf(image:line; VAR status:sbits);EXTERN; 
PROCEDURE write_now(VAR f:text);EXTERN; 

{   
System dependent procedure to get a file name from the procedure call card. 
}   
PROCEDURE getspec(field: INTEGER; VAR l: line; VAR len: INTEGER);   
VAR s: string[80];  
    i: INTEGER; 

BEGIN   
param_string(field,s);  
len:=LENGTH(s); 
FOR i:=1 TO len DO l[i]:=s[i];  
FOR i:=len+1 TO 80 DO l[i]:=' ';
END;

{$F Character manipulation routines}

{System dependent:  It is assumed that the function ord(c) where
 c is of type char will return the ASCII code for the character c.} 

{System dependent:  It is assumed that the function chr(i) where
 i is an integer ASCII code from 0 to 255 will return the appropriate   
 character} 

FUNCTION makechar (i: INTEGER): ascval; 

BEGIN   
makechar:=ascsp+i;  
END;

FUNCTION unchar (a: ascval): INTEGER;   

BEGIN   
unchar:=a-ascsp;
END;

FUNCTION tog64(a: ascval): ascval;  

BEGIN   
tog64:=bxor(64,a); {System dependent}   
END;

FUNCTION tog128(a: ascval): ascval; 

BEGIN   
tog128:=bxor(128,a); {System dependent} 
END;

FUNCTION checksum (sum: INTEGER): ascval;   

BEGIN   
checksum := (((sum MOD 256) DIV 64) +  sum)  MOD 64;
END;
{$F Open and close log file}
PROCEDURE logopn; {System dependent}
VAR i,t: INTEGER;   
    lstat: boolean; 
    csfsta: sbits;  

BEGIN   
csf('@asg,az kermitlog. ',csfsta);  
IF 35 IN csfsta THEN
   BEGIN
   csf('@asg,t kermitlog.,///256 . ',csfsta);   
   END; 
IF 35 IN csfsta THEN
   BEGIN
   writeln(lfile,'Error assigning logfile: KERMITLOG'); 
   END  
ELSE
   BEGIN
   lname:='KERMITLOG.mdttt . '; 
   er(44{TDATE$},a0);   
   a1:=bshr(band(170000000000b,a0),10)+bshr(band(3700000000b,a0),9) 
      +band(77777b,bshr(a0,2)); 
   FOR i:=1 TO 5 DO 
      BEGIN 
      t:=band(31,bshlc(a1,11+5*i))+48;  
      IF t>57 THEN t:=t+7;  
      lname[10+i]:=chr(t);  
      END;  
   luse:='L$F$I$L$E$$$';
   openelt1(lfile,luse,lname,lstat);
   IF lstat=false THEN  
      BEGIN 
      writeln('Error opening log element:  ',lname);
      END   
   ELSE 
      BEGIN 
      lstatus:=open;
      write(lfile,'Kermit1100 ',version,' Logfile ');   
      write_now(lfile); {Write date and time into logfile}  
      writeln(lfile);   
      writeln(output,'Logging to ',lname);  
      END;  
   END; 
END;

PROCEDURE logcls; {System dependent}

BEGIN   
IF lstatus=open THEN
   BEGIN
   closeelt1(lfile,luse,lname); 
   END; 
END;
{$F Buffer routines}

PROCEDURE bufinit(VAR buf:ascbuf);  

BEGIN   
buf.ln:=0;  
END;

PROCEDURE putbuf(VAR buf: ascbuf; a:ascval);

BEGIN   
IF NOT (buf.ln<maxbuf) THEN 
   BEGIN
   error('Size of ascii buffer exceeded');  
   END  
ELSE
   BEGIN
   buf.ln:=buf.ln+1;
   buf.ch[buf.ln]:=a;   
   END; 
END;

PROCEDURE lintobuf(l: line; len: integer; VAR buf: ascbuf); 
VAR i:integer;  

BEGIN   
bufinit(buf);   
FOR i:=1 TO len DO putbuf(buf,ord(l[i]));   
END;

PROCEDURE buftolin(buf: ascbuf; VAR l: line; VAR len: integer); 
VAR i:integer;  
    a:ascval;   

BEGIN   
len:=buf.ln;
IF len>maxlin THEN len:=maxlin; 
FOR i:=1 TO len DO  
   BEGIN
   a:=buf.ch[i];
   IF a>127 THEN a:=a-127;  
   l[i]:=chr(a);
   END; 
FOR i:=len+1 to maxlin DO l[i]:=' ';
END;
{$F Process parameters to and from remote Kermit}   
PROCEDURE putpar;   
VAR temp: ascval;   

BEGIN   
bufinit(filbuf);
putbuf(filbuf,makechar(locbsiz));   
putbuf(filbuf,makechar(loctout));   
putbuf(filbuf,makechar(locnpad));   
putbuf(filbuf,tog64(locpad));   
putbuf(filbuf,makechar(loceol));
putbuf(filbuf,locquo);  
temp:=ascsp;
IF locqu8<>0 THEN temp:=locqu8; 
putbuf(filbuf,temp);
putbuf(filbuf,ascsp); {Only know how do to 1 character checksum}
temp:=ascsp;
IF locrep<>0 THEN temp:=locrep; 
putbuf(filbuf,temp);
END;

PROCEDURE getpar;   

BEGIN   
IF rcvbuf.ln > 0 THEN rembsiz:=unchar(rcvbuf.ch[1]);
IF rcvbuf.ln > 1 THEN remtout:=unchar(rcvbuf.ch[2]);
IF rcvbuf.ln > 2 THEN remnpad:=unchar(rcvbuf.ch[3]);
IF rcvbuf.ln > 3 THEN rempad:=tog64(rcvbuf.ch[4]);  
IF rcvbuf.ln > 4 THEN remeol:=unchar(rcvbuf.ch[5]); 
IF rcvbuf.ln > 5 THEN remquo:=rcvbuf.ch[6]; 
IF rcvbuf.ln > 6 THEN remqu8:=rcvbuf.ch[7]; 
IF rcvbuf.ln > 8 THEN remrep:=rcvbuf.ch[9]; 

remdsiz:=rembsiz-3; 
IF state=rinitiate THEN {Our parameters have not been sent} 
   BEGIN
   IF locqu8=0 THEN remqu8:=0;  
   IF ((32<remqu8) AND (remqu8<63)) OR ((95<remqu8) AND (remqu8<127))   
   AND (remqu8<>remquo) THEN
      BEGIN 
      locqu8:=ascy; {Remote Kermit specified 8-bit quote character} 
      END   
   ELSE IF remqu8=ascy THEN 
      BEGIN 
      locqu8:=ascamp;   
      IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=asctil;
      IF (locqu8=remquo) OR (locqu8=remrep) THEN locqu8:=ascns; 
      remqu8:=locqu8;   
      END   
   ELSE 
      BEGIN 
      locqu8:=0;        {Don't do 8-bit quoting}
      remqu8:=0;
      END;  
   IF ((32<remrep) AND (remrep<63)) OR ((95<remrep) AND (remrep<127))   
   AND (remrep<>remquo) AND (remrep<>remqu8) AND (locrep<>0) THEN   
      BEGIN 
      locrep:=remrep; {Agree to do repeat counts}   
      END   
   ELSE 
      BEGIN 
      remrep:=0;
      locrep:=0;
      END;  
   END  
ELSE {Our parameters have already been sent}
   BEGIN
   IF (remqu8<>ascy) AND (remqu8<>locqu8) THEN  
      BEGIN 
      locqu8:=0; {Don't do 8-bit quoting}   
      END;  
   IF remrep<>locrep THEN locrep:=0; {Don't do repeat counts}   
   END; 
END;
{$F Input a packet or a command}
PROCEDURE rcvpkt;   
{   
This procedure reads all terminal input to Kermit, both packets and 
command lines.  On exit, the following global parameters are set:   

   rcvtyp = 0 - No SOH encountered, could be command line   
            1 - SOH encountered, but packet incomplete  
            2 - Checksum error  
            Other - ASCII value of packet type from good packet 

   rcvseq = -1 - Not a valid packet 
            -2 - End of input file encountered  
            0...63 - Sequence number from valid packet  

   rcvbuf.ln - number of ascii values input since last SOH or   
               if no SOH, from beginning of line
   rcvbuf.ch - array of ascii values input  
}   
VAR c: CHAR;
    av,rt: ascval;  
    rst,rsq,cs:INTEGER; 

BEGIN   
IF rcvlog THEN write(lfile,'rcv <');
IF ineoln THEN  
   BEGIN
   readln(input);   
   END; 
rcvtyp:=0;  
IF eof(input) THEN  
   BEGIN
   rcvseq:=-2;  
   IF rcvlog THEN write(lfile,'@'); 
   END  
ELSE
   BEGIN
   rcvseq:=-1;  
   rst:=0;  
   ineoln:=eoln(input); 
   bufinit(rcvbuf); 
   WHILE NOT ineoln DO  
      BEGIN 
      IF eoln(input) THEN   
         BEGIN  
         {  
         The 1100 EXEC truncates some trailing spaces.  Since a 
         valid packet can end in one or more spaces, we will assume 
         that short packets should end in spaces and hope that  
         the checksum filters out errors.   
         }  
         av:=ascsp; 
         END
      ELSE  
         BEGIN  
         read(input,c); 
         IF rcvlog THEN write(lfile,c); 
         av:=ord(c);
         END;   
      IF av=mark THEN rst:=1;   
      CASE rst OF   

         0: {Mark character never encountered.} 
            BEGIN   
            putbuf(rcvbuf,av);  
            ineoln:=eoln(input);
            END;

         1: {Mark character.}   
            BEGIN   
            rcvtyp:=1;  
            rcvseq:=-1; 
            bufinit(rcvbuf);
            ineoln:=eoln(input);
            rst:=2; 
            END;

         2: {Length of the packet.} 
            BEGIN   
            cs:=av; {Initialize checksum}   
            rlen:=unchar(av)-3; 
            rst:=3; 
            END;

         3: {Packet number.}
            BEGIN   
            cs:=cs+av;  
            rsq:=unchar(av);
            rst:=4; 
            END;

         4: {Packet type.}  
            BEGIN   
            cs:=cs+av;  
            rt:=av; {remember the packet type}  
            rst:=5; 
            IF rlen=0 THEN rst:=6;  
            END;

         5: {Data portion.} 
            BEGIN   
            cs:=cs+av;  
            putbuf(rcvbuf,av);  
            IF rcvbuf.ln = rlen THEN rst:=6;
            END;

         6: {Checksum.} 
            BEGIN   
            IF checksum(cs)=unchar(av) THEN 
               BEGIN
               rcvtyp:=rt;  
               rcvseq:=rsq; 
               ineoln:=true; {Ignore the rest of the line}  
               END  
            ELSE
               BEGIN
               numcserr:=numcserr+1;
               rst:=0; {Look for another mark}  
               rcvtyp:=2;  {Indicate checksum error}
               ineoln:=eoln(input); 
               END; 
            END;
         END;   
      END;  
   END; 
IF rcvlog THEN writeln(lfile,'>');  
END;
{$F Build and send packets} 
PROCEDURE makepacket(ptype: ascval; seq, len: INTEGER); 
VAR i: INTEGER; 
    c: ascval;  
    cs: INTEGER;

BEGIN   
bufinit(sndbuf);
FOR i:=1 TO remnpad DO  
   BEGIN
   putbuf(sndbuf,rempad);   
   END; 
putbuf(sndbuf,mark);
c:=makechar(len+3); 
cs:=c;                              {Initialize checksum}   
putbuf(sndbuf,c);   
c:=makechar(seq);   
cs:=cs+c;   
putbuf(sndbuf,c);   
c:=ptype;   
cs:=cs+c;   
putbuf(sndbuf,c);   
FOR i:=1 to len DO  
   BEGIN
   c:=filbuf.ch[i]; 
   cs:=cs+c;
   putbuf(sndbuf,c);
END;
c:=makechar(checksum(cs));  
putbuf(sndbuf,c);   
{   
The 1100 EXEC may strip trailing spaces from the end of output images.  
This can cause a problem if the checksum is a space.  To eliminate this 
problem, a period will be inserted in the output image after the
checksum whenever the checksum is a space.  
}   
putbuf(sndbuf,ascper);  
{   
The 1100 O/S puts a CR LF on the end of each output line.   
If the remote EOL character is not CR or LF, then it must   
be added to the packet. 
}   
IF (remeol<>asccr) AND (remeol<>asclf) THEN 
   BEGIN
   putbuf(sndbuf,remeol);   
   END; 
END;

PROCEDURE sndpkt;   
VAR 
   i:INTEGER;   

BEGIN   
IF sndlog THEN write(lfile,'snd <');
FOR i:=1 TO sndbuf.ln DO
   BEGIN
   write(output,chr(sndbuf.ch[i])); 
   IF sndlog THEN write(lfile,chr(sndbuf.ch[i]));   
END;
writeln(output);
IF sndlog THEN writeln(lfile,'>');  
END;
{$F File output}

PROCEDURE wrtrec;   
VAR 
   i:INTEGER;   
   c:char;  

BEGIN   
IF wrtlog THEN write(lfile,'wrt [');
FOR i:=1 TO wrtbuf.ln DO
   BEGIN
   {$A- Turn off range checking, ASCII value may be >127}   
   c:=chr(wrtbuf.ch[i]);
   {$A+ Turn on range checking} 
   write(wfile,c) ; 
   IF wrtlog THEN write(lfile,c);   
   END; 
writeln(wfile); 
IF wrtlog THEN writeln(lfile,']');  
bufinit(wrtbuf);
END;

PROCEDURE wrtcls; {System dependent}

BEGIN   
IF wstatus=open THEN
   BEGIN
   IF wrtbuf.ln>0 THEN wrtrec;  
   closeelt1(wfile,wuse,fname); 
   END; 
wstatus:=closed;
END;

PROCEDURE wrtopn; {System dependent}
VAR 
wstat: boolean; 

BEGIN   
wrtcls; 
wuse:='W$F$I$L$E$$$';   
openelt1(wfile,wuse,fname,wstat);   
IF wstat THEN wstatus:=open;
bufinit(wrtbuf);
END;

PROCEDURE wrtasc(a:ascval); 

BEGIN   
IF wrtbuf.ln >=maxwrt THEN wrtrec;  
putbuf(wrtbuf,a);   
END;
{$F Process data portion of data packet}
PROCEDURE putrec(buf: ascbuf);  
VAR 
   i,j,repcnt:INTEGER;  
   a:ascval;
   qflag: boolean;  

BEGIN   
i:=1;   
WHILE i<= buf.ln DO 
   BEGIN
   a:=buf.ch[i]; i:=i+1;
   repcnt:=1;   
   IF a=remrep THEN 
      BEGIN 
      repcnt:=unchar(buf.ch[i]); i:=i+1;
      a:=buf.ch[i]; i:=i+1; 
      END;  
   qflag:= a=remqu8;
   IF qflag THEN
      BEGIN 
      a:=buf.ch[i]; i:=i+1; 
      END;  
   IF a=remquo THEN 
      BEGIN 
      a:=buf.ch[i]; i:=i+1; 
      IF (a<>remquo) AND (a<>remqu8) AND (a<>remrep) THEN a:=tog64(a);  
      END;  
   IF qflag THEN a:=tog128(a);  
   FOR j:=1 to repcnt DO
      BEGIN 
      IF a=asclf THEN   
         BEGIN  
         IF lfeol OR gotcr THEN 
            BEGIN   
            wrtrec; 
            gotcr:=false;   
            END 
         ELSE   
            BEGIN   
            wrtasc(a);  
            END;
         END
      ELSE  
         BEGIN  
         IF gotcr THEN  
            BEGIN   
            wrtasc(asccr);  
            gotcr:=false;   
            END;
         IF a=asccr THEN
            BEGIN   
            IF creol THEN   
               BEGIN
               wrtrec;  
               END  
            ELSE IF crlfeol THEN
               BEGIN
               gotcr:=true; 
               END  
            ELSE
               BEGIN
               wrtasc(a);   
               END; 
            END 
         ELSE   
            BEGIN   
            wrtasc(a);  
            END;
         END;   
      END;  
   END; 
END;
{$F File input} 
PROCEDURE redrec;   
VAR c: CHAR;
    a: ascval;  
    nonblank: INTEGER;  

BEGIN   
bufinit(redbuf);
IF redix >= 0 THEN readln(rfile);   
redix:=0;   
IF NOT eof(rfile) THEN  
   BEGIN
   nonblank:=0; 
   IF redlog THEN write(lfile,'red ['); 
   WHILE NOT eoln(rfile) DO 
      BEGIN 
      read(rfile,c);
      IF redlog THEN write(lfile,c);
      a:=ord(c);
      putbuf(redbuf,a); 
      IF a <> ascsp THEN nonblank := redbuf.ln; 
      END;  
   IF redlog THEN writeln(lfile,']');   
   IF bstrip THEN redbuf.ln := nonblank;
   IF creol OR crlfeol THEN putbuf(redbuf,asccr);   
   IF lfeol OR crlfeol THEN putbuf(redbuf,asclf);   
   END; 
END;

PROCEDURE redopn; {System dependent}
VAR 
rstat: boolean; 

BEGIN   
rstatus:=closed;
ruse:='R$F$I$L$E$$$';   
readelt1(rfile,ruse,fname,rstat);   
IF rstat THEN rstatus:=open;
redix:=-1;  
redbuf.ln:=-1;  
END;

PROCEDURE redcls;   

BEGIN   
rstatus:=closed;
END;

{$F Build data portion of data packet}  
PROCEDURE getrec;   
VAR a: ascval;  
    exit: BOOLEAN;  
    prevln,previx,tix: INTEGER; 

BEGIN   
bufinit(filbuf);
IF eof(rfile) THEN  
   BEGIN
   rstatus:=endfile;
   END  
ELSE
   BEGIN
   exit:=false; 
   REPEAT   
      IF redix >= redbuf.ln THEN
         BEGIN  
         redrec; {get another record and strip spaces}  
         IF eof(rfile) THEN 
            BEGIN   
            exit:=true; 
            IF filbuf.ln=0 THEN rstatus:=endfile;   
            END;
         END;   
      IF redix < redbuf.ln THEN 
         BEGIN  
         prevln:=filbuf.ln; 
         previx:=redix; 
         redix:=redix+1;
         a:=redbuf.ch[redix];   
         IF locrep<>0 THEN  
            BEGIN   
            tix:=redix+1;   
            WHILE (a=redbuf.ch[tix]) AND (tix<=redbuf.ln) DO tix:=tix+1;
            tix:=tix-redix;   {tix is now the repeat count} 
            IF tix>3 THEN   
               BEGIN
               IF tix>94 THEN tix:=94;  
               putbuf(filbuf,locrep);   
               putbuf(filbuf,makechar(tix));
               redix:=redix-1+tix;  
               END; 
            END;
         IF (a>127) THEN
            BEGIN   
            IF locqu8<>0 THEN putbuf(filbuf,locqu8);
            a:=tog128(a);   
            END;
         IF (a<32) OR (a=ascdel) THEN   
            BEGIN   
            putbuf(filbuf,locquo);  
            a:=tog64(a);
            END;
         IF (a=locquo) OR (a=locqu8) OR (a=locrep) THEN 
            BEGIN   
            putbuf(filbuf,locquo);  
            END;
         putbuf(filbuf,a);  
         IF filbuf.ln >= remdsiz THEN   
            BEGIN   
            exit:=true; 
            IF filbuf.ln>remdsiz then   
               BEGIN
               {Character expansion caused buffer length to be  
                exceeded.  Back up.}
               filbuf.ln:=prevln;   
               redix:=previx;   
               END; 
            END;
         END;   
   UNTIL exit;  
   END; 
END;

{$F Send states}
PROCEDURE sendinitiate; 

BEGIN   
IF fnlen>0 THEN 
   BEGIN
   redopn;  
   IF rstatus=open THEN 
      BEGIN 
      putpar; {Put parameters into buffer}  
      makepacket(ascs,seq,filbuf.ln); {Make packet with our parameters} 
      numtry:=0;
      state:=sheader;   
      END   
   ELSE 
      BEGIN 
      error('Error opening read file'); 
      state:=kexit; 
      END;  
   END  
ELSE
   BEGIN
   error('No read file specified'); 
   state:=kexit;
   END; 
END;

PROCEDURE sendheader;   

BEGIN   
IF rcvtyp=ascy THEN 
   BEGIN
   IF not sndonly THEN getpar; {Get parameters from ACK of 'S' packet}  
   IF rfnlen>0 THEN 
      BEGIN 
      lintobuf(rfname,rfnlen,filbuf); {Send remote file name.}  
      END   
   ELSE 
      BEGIN 
      lintobuf(fname,fnlen,filbuf);   {Send local file name.}   
      END;  
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   makepacket(ascf,seq,filbuf.ln);  
   state:=sdata 
   END; 
END;

PROCEDURE senddata; 

BEGIN   
IF rcvtyp=ascy THEN 
   BEGIN
   getrec;  
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   IF rstatus = open THEN   
      BEGIN 
      makepacket(ascd,seq,filbuf.ln);   
      END   
   ELSE 
      BEGIN 
      makepacket(ascz,seq,0);   
      state:=sbreak;
      fnlen:=0; 
      END;  
   END; 
END;

PROCEDURE sendbreak;

BEGIN   
IF rcvtyp=ascy THEN 
   BEGIN
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   makepacket(ascb,seq,0);  
   END; 
state:=wexit;   
END;
{$F Receive states} 
PROCEDURE receiveinitiate;  

BEGIN   
IF rcvtyp=ascs  THEN
   BEGIN
   getpar; {Get parameters from packet} 
   putpar; {Put parameters into buffer} 
   makepacket(ascy,seq,filbuf.ln); {Make ACK packet with our parameters}
   seq:=rcvseq; 
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   state:=rheader;  
   END  
ELSE
   BEGIN
   error('Wrong packet in receive initiation'); 
   state:=kexit;
   END; 
END;

PROCEDURE receiveheader;

BEGIN   
IF rcvtyp=ascf THEN 
   BEGIN
   IF fnlen=0 THEN  
      BEGIN 
      buftolin(rcvbuf,fname,fnlen); 
      END;  
   IF fnlen>0 THEN  
      BEGIN 
      wrtopn;   
      IF wstatus=open THEN  
         BEGIN  
         makepacket(ascy,seq,0);
         numtry:=0; 
         seq:=(seq+1) mod 64;   
         state:=rdata;  
         END
      ELSE  
         BEGIN  
         error('Error opening write file'); 
         state:=kexit;  
         END;   
      END   
   ELSE 
      BEGIN 
      error('No output file specified');
      state:=kexit; 
      END;  
   END  
ELSE IF rcvtyp=ascb THEN
   BEGIN
   makepacket(ascy,seq,0);  
   sndpkt;  
   state:=kexit;
   END  
ELSE
   BEGIN
   error('Wrong packet receiveing file header');
   state:=kexit;
   END; 
END;

PROCEDURE receivedata;  

BEGIN   
IF rcvtyp=ascd THEN 
   BEGIN
   putrec(rcvbuf);  
   makepacket(ascy,seq,0);  
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   END  
ELSE IF rcvtyp=ascz THEN
   BEGIN
   wrtcls;  
   fnlen:=0;
   makepacket(ascy,seq,0);  
   numtry:=0;   
   seq:=(seq+1) mod 64; 
   state:=rheader;  
   END  
ELSE
   BEGIN
   error('Unexpected packet receiving data');   
   state:=kexit;
   END; 
END;
{$F Error processing}   

{Process fatal errors}  

PROCEDURE error; {parameters appear above in forward reference} 
VAR i,l:integer;

BEGIN   
l:=length(msg); 
IF l>maxbuf-6 THEN l:=maxbuf-6; 
bufinit(filbuf);
FOR i:=1 to 3 DO putbuf(filbuf,ascsp); {Make message readable in packet}
FOR i:=1 to l DO putbuf(filbuf,ord(msg[i]));
FOR i:=1 to 3 DO putbuf(filbuf,ascsp); {Make message readable in packet}
makepacket(asce,seq,filbuf.ln); 
sndpkt; 
state:=kexit;   
END;
{$F Command state}  
PROCEDURE kermitcommand;

BEGIN   
REPEAT  
   rcvpkt;  
   IF rcvseq>-1 THEN
      BEGIN 
      IF rcvtyp=ascs THEN   
         BEGIN  
         state:=rinitiate;  
         END
      ELSE IF rcvtyp=ascr THEN  
         BEGIN  
         IF fnlen=0 THEN
            BEGIN   
            buftolin(rcvbuf,fname,fnlen);   
            END;
         state:=sinitiate;  
         END
      ELSE  
         BEGIN  
         error('Unexpected packet type');   
         END;   
      END   
   ELSE IF rcvseq=-1 THEN   
      BEGIN 
      writeln('No commands implemented');   
      END   
   ELSE IF rcvseq=-2 THEN   
      BEGIN 
      state:=kexit; 
      server:=false;
      END;  
UNTIL state<>kcommand;  
END;
{$F Get processor call options and file specifications} 

PROCEDURE getoptions; {System dependent}

BEGIN   
getspec(1,fname,fnlen);   {Get local file name, if any.}
getspec(2,rfname,rfnlen); {Get remote file name, if any.}   
IF 'S' IN options THEN state:=sinitiate;
IF 'R' IN options THEN state:=rinitiate;
IF 'T' IN options THEN  
   BEGIN
   sndonly:=true;   
   state:=sinitiate;
   server:=false;   
   END; 
IF 'B' IN options THEN  
   BEGIN
   locbsiz:=94; 
   END; 
IF 'C' IN options THEN  
   BEGIN
   crlfeol:=false;  
   creol:=true; 
   lfeol:=false;
   END; 
IF 'L' IN options THEN  
   BEGIN
   sndlog:=true;
   rcvlog:=true;
   wrtlog:=true;
   redlog:=true;
   END; 
optqu8:=0; {Assume no eight-bit quoting will be done}   
IF 'Q' IN options THEN  
   BEGIN
   optqu8:=ascamp; {Eight-bit quoting may be done}  
   END; 
IF ('W' IN options) AND ('S' IN options) THEN   
   BEGIN
   a1:=30000;   
   er(48{TWAIT$},a0,a1);
   END; 
END;
{$F Initialization state}   
PROCEDURE kermitinitialize; 
VAR lstat: boolean; 

BEGIN   
state:=kcommand;
numtry:=0;  
seq:=0; 
fnlen:=0; {Indicate no file name yet}   
bstrip:=true;   

locbsiz:=78;
loctout:=12;
locnpad:=0; 
locpad:=0;  
loceol:=asccr;  
locquo:=ascns;  
{  locqu8 will be set after options are processed. }
locrep:=asctil; {Initialize to 0 to turn off repeat counts} 

rembsiz:=78;
remdsiz:=rembsiz-3; 
remtout:=12;
remnpad:=0; 
rempad:=0;  
remeol:=asccr;  
remqu8:=0;  
remrep:=0;  

bufinit(sndbuf);

{The following should only be done on the first call to initialize} 
IF iniflg=false THEN
   BEGIN
   sndonly:=false;  
   sndlog:=false;   
   rcvlog:=false;   
   wrtlog:=false;   
   redlog:=false;   
   crlfeol:=true;   
   creol:=false;
   lfeol:=false;
   rstatus:=closed; 
   wstatus:=closed; 
   lstatus:=closed; 

   {System dependent initialization}
   ineoln:=false;  {Indicate no readln necessary for first line}
   getoptions;     {Process options and file specifications}
   IF sndlog OR rcvlog OR wrtlog OR redlog THEN logopn  
   END; 
locqu8:=optqu8; {Eight-bit quoting done only with Q-option} 
iniflg:=true;   
END;
{$F Main block} 


BEGIN   
version:= '2.0';
writeln(output,'Kermit 1100 ',version); 
iniflg:=false;  
server:=true;   
WHILE server DO 
   BEGIN
   kermitinitialize;
   IF state=kcommand THEN kermitcommand;
   IF state=sinitiate THEN sendinitiate;
   IF state=rinitiate THEN receiveinitiate; 
   WHILE state<>kexit DO
      BEGIN 
      REPEAT
         sndpkt;
         numtry:=numtry+1;  
         IF sndonly THEN
            BEGIN   
            rcvseq:=seq;
            rcvtyp:=ascy;   
            rcvbuf.ln:=0;   
            END 
         ELSE   
            BEGIN   
            rcvpkt; 
            END;
         IF rcvtyp=ascn THEN
            BEGIN   
            {We have just received a NAK.  The Kermit protocol would
            be much simpler and no less effective if the NAK had never  
            been included.  However, since this is not universally  
            appreciated, one has to deal with them.  To do so, we   
            will convert a NAK into an ACK with the previous sequence   
            number.}
            rcvseq:=(rcvseq-1) mod 64;  
            rcvtyp:=ascy;   
            END 
         ELSE IF rcvseq=-2 THEN {End of file on input}  
            BEGIN   
            error('End of file on input data'); 
            state:=kexit;   
            server:=false;  
            END;
      UNTIL (rcvseq=seq) OR (numtry>=maxtry) OR (state=kexit);  
      IF (rcvseq<>seq) AND (state<>kexit) THEN  
         BEGIN  
         error('Failed to receive expected packet');
         state:=kexit;  
         END
      ELSE IF rcvtyp=asce THEN {Just received error packet} 
         BEGIN  
         state:=kexit   
         END
      ELSE  
         BEGIN  
         CASE state OF  
            sheader     :sendheader;
            sdata       :senddata;  
            sbreak      :sendbreak; 
            rheader     :receiveheader; 
            rdata       :receivedata;   
            wexit       :state:=kexit; {Go around one more time, then exit} 
            kexit       :;  
            END;
         END
   END; 
   wrtcls;  
   END; 
logcls; 
writeln('Kermit End');  
END .