home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
d
/
univac.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
31KB
|
1,278 lines
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 .