home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
harris800.tar.gz
/
harris800.tar
/
h800ker.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-08-16
|
70KB
|
2,642 lines
PROGRAM Kermit(input,output,file3,file4,file5,
file6,file7,file8,file9,filen,filet);
LABEL
9999; { used only to simulate a "halt" instruction }
CONST
bufsize=128;
lf=12B;
return=15B;
formfeed=14B;
controlbar=28;
CTRLC=3;
mask= 177B;
{ standard file descriptors. subscripts in open, etc. }
STDIN = 1; { these are not to be changed }
STDOUT = 2;
lineout = 3;
linein = 4;
{ other io-related stuff }
IOERROR = 0; { status values for open files }
IOAVAIL = 1;
IOREAD = 2;
IOWRITE = 3;
MAXOPEN = 9; { maximum number of open files }
{ universal manifest constants }
ENDFILE = -1;
ENDSTR = 0; { null-terminated strings }
MAXSTR = 100; { longest possible string }
CONLENGTH = 20; { length of constant string }
FILENAMELENGTH = 17; { length of file name for Bind }
MAXERRORS = 50; { maximum number of errors kept if remote }
{ ascii character set in decimal }
BACKSPACE = 8;
TAB = 9;
NEWLINE = 10;
BLANK = 32;
EXCLAM = 33; { ! }
DQUOTE = 34; { " }
SHARP = 35; { # }
DOLLAR = 36; { $ }
PERCENT = 37; { % }
AMPER = 38; { & }
SQUOTE = 39; { ' }
ACUTE = SQUOTE;
LPAREN = 40; { ( }
RPAREN = 41; { ) }
STAR = 42; { * }
PLUS = 43; { + }
COMMA = 44; { , }
MINUS = 45; { - }
DASH = MINUS;
PERIOD = 46; { . }
SLASH = 47; { / }
COLON = 58; { : }
SEMICOL = 59; { ; }
LESS = 60; { < }
EQUALS = 61; { = }
GREATER = 62; { > }
QUESTION = 63; { ? }
ATSIGN = 64; { @ }
LBRACK = 91; { [ }
BACKSLASH = 92; { \ }
ESCAPE = BACKSLASH; { changed - used to be @ }
RBRACK = 93; { ] }
CARET = 94; { ^ }
UNDERLINE = 95; { _ }
GRAVE = 96; { ` }
LETA = 97; { lower case ... }
LETB = 98;
LETC = 99;
LETD = 100;
LETE = 101;
LETF = 102;
LETG = 103;
LETH = 104;
LETI = 105;
LETJ = 106;
LETK = 107;
LETL = 108;
LETM = 109;
LETN = 110;
LETO = 111;
LETP = 112;
LETQ = 113;
LETR = 114;
LETS = 115;
LETT = 116;
LETU = 117;
LETV = 118;
LETW = 119;
LETX = 120;
LETY = 121;
LETZ = 122;
LBRACE = 123; { left brace }
BAR = 124; { | }
RBRACE = 125; { right brace }
TILDE = 126; { ~ }
SOH = 1; (* ascii SOH character *)
CR = 13; (* CR *)
DEL = 127; (* rubout *)
DEFTRY = 10; (* default for number of retries *)
DEFTIMEOUT = 12; (* default time out *)
MAXPACK = 94; (* max is 94 ~ - ' ' *)
DEFDELAY = 5; (* delay before sending first init *)
NUMPARAM = 6; (* number of parameters in init packet *)
DEFQUOTE = SHARP; (* default quote character *)
DEFPAD = 0; (* default number OF padding chars *)
DEFPADCHAR = 0; (* default padding character *)
DEFDUPLEX = false; (* default duplex is full duplex *)
(* SYSTEM DEPENDENT *)
DEFEOL = CR;
DEFEOLTYPE = 2;
(* 1 = LineFeed
2 = CrLf
3 = Just Cr *)
FLEN1 = 8;
FLEN2 = 8;
PFILE = 'KERMIT.P ';
TRACEFILE = 'KERMIT.T ';
TEMPFILE = 'TEMP.K ';
lp = 'LP: ';
NUMBUFFERS = 5; (* Number of buffers *)
(* packet types *)
TYPEB = 66; (* ord('B') *)
TYPED = 68; (* ord('D') *)
TYPEE = 69; (* ord('E') *)
TYPEF = 70; (* ord('F') *)
TYPEN = 78; (* ord('N') *)
TYPES = 83; (* ord('S') *)
TYPET = 84; (* ord('T') *)
TYPEY = 89; (* ord('Y') *)
TYPEZ = 90; (* ord('Z') *)
MAXCMD = 10;
TYPE
character = -128..127; { byte-sized. ascii + other stuff }
string = ARRAY [1..MAXSTR] OF character;
mstring = PACKED ARRAY [1..FILENAMELENGTH] OF char;
vstring = RECORD
len : integer;
ch : ARRAY [1..MAXSTR] OF char;
END;
cstring = PACKED ARRAY [1..CONLENGTH] OF char;
filedesc = IOERROR..MAXOPEN;
(* Data Types for Kermit *)
Packet = RECORD
mark : character; (* SOH character *)
count: character; (* # of bytes following this field *)
seq : character; (* sequence number modulo 64 *)
ptype: character; (* d,y,n,s,b,f,z,e,t packet type *)
data : string; (* the actual data *)
(* chksum is last validchar in data array *)
(* eol is added, not considered part of packet proper *)
END;
Command = (Transmit,Receive,Print,SetParm,Invalid);
KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
EOLtype = (LineFeed,CrLf,JustCr);
Words = (Low,High);
Stats = ARRAY [Low..High] OF integer;
Ppack = 1..NUMBUFFERS;
CType = RECORD
check: integer;
PacketPtr : integer;
i : integer;
fld : integer;
t : character;
finished : boolean;
restart : boolean;
control : boolean;
good : boolean;
END;
InType = (abortnow,nothing,CRin);
VAR
ch : char;
done : boolean;
HalfDuplex : boolean;
BindStatus : integer;
file3 : text; { output to other computer }
file4 : text; { input from other computer }
file5 : text; { assigned to a file to send or receive }
file6 : text;
file7 : text;
file8 : text;
file9 : text;
filen : text; { check for a file's existance }
filet : text; { trace output }
filemode : ARRAY [1..MAXOPEN] OF IOERROR..IOWRITE;
cmdargs : 0..MAXCMD;
cmdlin : string;
cmdidx : ARRAY [1..MAXCMD] OF 1..MAXSTR;
(* Variables for Kermit *)
aline : string;
DiskFile : filedesc;
SaveState : kermitstates;
NextArg : integer; (* next argument to process *)
Local : boolean; (* local/remote flag *)
MaxTry : integer;
n,J : integer; (* packet number *)
NumTry : integer; (* times this packet retried *)
OldTry : integer;
Pad : integer; (* padding to send *)
MyPad : integer; (* number of padding characters I need *)
PadChar : character;
MyPadChar: character;
RunType : command;
State : kermitstates; (* current state of the automaton *)
MyTimeOut: integer; (* when i want to be timed out *)
TheirTimeOut : integer;
Delay : integer;
SizeRecv, SizeSend : integer;
SendEOL, SendQuote : character;
myEOL,myQuote: character;
EOLforFile : EOLtype;
ParmFile : string;
NumSendPacks : integer;
NumRecvPacks : integer;
NumACK : integer;
NumNAK : integer;
NumACKrecv : integer;
NumNAKrecv : integer;
NumBADrecv : integer;
RunTime: integer;
ChInFile, ChInPack : Stats;
Verbosity: boolean; (* true to print verbose messages *)
Trace: boolean; (* true to write trace info in KERMIT.T file *)
OneWayOnly : boolean; (* used for testing *)
Debug : boolean;
TtyMode : (Cooked,Raw);
KeptErrors : ARRAY [1..MAXERRORS] OF cstring; (* keep errors if remote *)
NumKeptErrors : integer;
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 *)
InputPacket : Ppack; (* save input to do debug *)
TOPacket : packet; (* Time_Out Packet *)
TimeLeft : integer; (* until Time_Out *)
FromConsole : InType; (* Input from Console during receive *)
PackControl : CType; (* variables for receive packet routine *)
{ prims -- primitive functions and procedures }
PROCEDURE SYSINIT; ALIEN;
{ System dependent initialize }
FUNCTION CONNECT(DUPLEX : BOOLEAN): BOOLEAN; ALIEN;
{ Connect to remote host computer--we are local.
Echange characters between host and terminal until
user presses escape code. DUPLEX is false for full
duplex, true for half duplex. Return false if this
Kermit is host only (no connection possible) }
FUNCTION GETIN(VAR TIMEREMAINING : INTEGER; VAR FROMCONSOLE : INTYPE):
CHARACTER; ALIEN;
{ If connected, get character from host;
otherwise, get character from terminal.
Decrement timeremaining for each full second you wait;
give up when timeleft gets to zero.
If connected to host computer, and user types a character,
set fromconsole accordingly }
PROCEDURE XMTCHAR(C : CHAR); ALIEN;
{ If connected, send character to host;
otherwise send character to terminal }
PROCEDURE SYSFINISH; ALIEN;
{ If connected, disconnect. System depedent clean up. }
PROCEDURE SLEEP(T: INTEGER); ALIEN;
{ Delay for T seconds }
PROCEDURE TTYRAW; ALIEN;
{ For host mode--put terminal into character by character mode.
When in this mode, only GETIN and XMTCHAR are used to talk
to the tty }
PROCEDURE TTYCOOKED; ALIEN;
{ Return terminal to normal I/O mode }
PROCEDURE FLUSH; ALIEN;
{ Flush any pending output }
PROCEDURE FILECREATE(FILENAME : MSTRING); ALIEN;
{ Create a file }
PROCEDURE FIXNAME(VAR FILENAME : STRING); ALIEN;
{ Fix up file name before sending it to other Kermit.
Argument is 1 character per word in least significant bits }
FUNCTION BITWISE(i,j,result00,result01,result10,result11:integer):integer;
{ Perform bit-wise logical operation on two integers given the
truth table:
| bit in j=0 | bit in j=1 |
------------+--------------+--------------+
bit in i=0 | result00 | result01 |
------------+--------------+--------------+
bit in i=1 | result10 | result11 |
------------+--------------+--------------+
For negative numbers, use the fact that on a two's complement
machine the bit-wise NOT of an integer "n" is "-1 - n".
This works on machines that are not two's complement also,
as long as we consistently use "-1 - n" as the NOT,
and know how to interpret negative results. }
VAR bit, result: integer;
BEGIN
if i < 0 then
BITWISE := BITWISE(-1-i,j,result10,result11,result00,result01)
else if j < 0 then
BITWISE := BITWISE(i,-1-j,result01,result00,result11,result10)
else if result00 <> 0 then
BITWISE := -1 - BITWISE(i,j,0,1-result01,1-result10,1-result11)
else
BEGIN
result := 0;
bit := 1;
WHILE (i > 0) AND (j > 0) DO
BEGIN
IF odd(i) THEN
IF odd(j) THEN result := result + bit*result11
ELSE result := result + bit*result10
ELSE IF odd(j) THEN result := result + bit*result01;
i := i DIV 2;
j := j DIV 2;
bit := bit + bit;
END;
BITWISE := result + bit*(i*result10 + j*result01);
END;
END;
FUNCTION IAND(i,j:integer):integer;
BEGIN
IAND := BITWISE(i,j,0,0,0,1);
END;
FUNCTION IOR(i,j:integer):integer;
BEGIN
IOR := BITWISE(i,j,0,1,1,1);
END;
PROCEDURE fdbind(fd: filedesc; intname: mstring);
BEGIN
CASE fd OF
1: bind(input,intname,BindStatus);
2: bind(output,intname,BindStatus);
3: bind(file3,intname,BindStatus);
4: bind(file4,intname,BindStatus);
5: bind(file5,intname,BindStatus);
6: bind(file6,intname,BindStatus);
7: bind(file7,intname,BindStatus);
8: bind(file8,intname,BindStatus);
9: bind(file9,intname,BindStatus);
END;
END;
PROCEDURE fdclose(fd: filedesc);
BEGIN
CASE fd OF
1: close(input);
2: close(output);
3: close(file3);
4: close(file4);
5: close(file5);
6: close(file6);
7: close(file7);
8: close(file8);
9: close(file9);
END;
END;
FUNCTION fdeof(fd: filedesc): boolean;
BEGIN
CASE fd OF
1: fdeof := eof(input);
2: fdeof := eof(output);
3: fdeof := eof(file3);
4: fdeof := eof(file4);
5: fdeof := eof(file5);
6: fdeof := eof(file6);
7: fdeof := eof(file7);
8: fdeof := eof(file8);
9: fdeof := eof(file9);
END;
END;
FUNCTION fdeoln(fd: filedesc): boolean;
BEGIN
CASE fd OF
1: fdeoln := eoln(input);
2: fdeoln := eoln(output);
3: fdeoln := eoln(file3);
4: fdeoln := eoln(file4);
5: fdeoln := eoln(file5);
6: fdeoln := eoln(file6);
7: fdeoln := eoln(file7);
8: fdeoln := eoln(file8);
9: fdeoln := eoln(file9);
END;
END;
PROCEDURE fdread(fd: filedesc; VAR ch: char);
BEGIN
CASE fd OF
1: read(input,ch);
2: read(output,ch);
3: read(file3,ch);
4: read(file4,ch);
5: read(file5,ch);
6: read(file6,ch);
7: read(file7,ch);
8: read(file8,ch);
9: read(file9,ch);
END;
END;
PROCEDURE fdreadln(fd: filedesc);
BEGIN
CASE fd OF
1: readln(input);
2: readln(output);
3: readln(file3);
4: readln(file4);
5: readln(file5);
6: readln(file6);
7: readln(file7);
8: readln(file8);
9: readln(file9);
END;
END;
PROCEDURE fdreset(fd: filedesc);
BEGIN
CASE fd OF
1: reset(input);
2: reset(output);
3: reset(file3);
4: reset(file4);
5: reset(file5);
6: reset(file6);
7: reset(file7);
8: reset(file8);
9: reset(file9);
END;
END;
PROCEDURE fdrewrite(fd: filedesc);
BEGIN
CASE fd OF
1: rewrite(input);
2: rewrite(output);
3: rewrite(file3);
4: rewrite(file4);
5: rewrite(file5);
6: rewrite(file6);
7: rewrite(file7);
8: rewrite(file8);
9: rewrite(file9);
END;
END;
PROCEDURE fdwrite(fd: filedesc; ch: char);
BEGIN
CASE fd OF
1: write(input,ch);
2: IF TtyMode = Cooked THEN write(output,ch)
ELSE IF Trace THEN write(filet,ch);
3: write(file3,ch);
4: write(file4,ch);
5: write(file5,ch);
6: write(file6,ch);
7: write(file7,ch);
8: write(file8,ch);
9: write(file9,ch);
END;
END;
PROCEDURE fdwriteln(fd: filedesc);
BEGIN
CASE fd OF
1: writeln(input);
2: IF TtyMode = Cooked THEN writeln(output)
ELSE IF Trace THEN writeln(filet);
3: writeln(file3);
4: writeln(file4);
5: writeln(file5);
6: writeln(file6);
7: writeln(file7);
8: writeln(file8);
9: writeln(file9);
END;
END;
PROCEDURE WriteCharacter;
BEGIN
write(ch);
END;
PROCEDURE stiphalt; (* used by external procedures for halt *)
BEGIN
GOTO 9999;
END;
{ initio -- initialize open file list }
PROCEDURE initio;
VAR
i : filedesc;
BEGIN
filemode[STDIN] := IOREAD;
filemode[STDOUT] := IOWRITE;
filemode[lineout] := IOWRITE;
filemode[linein] := IOREAD;
{ connect STDOUT to user's terminal ... }
fdrewrite(STDOUT);
{ initialize rest of files }
FOR i := linein+1 TO MAXOPEN DO
filemode[i] := IOAVAIL;
END;
{ getc (UCB) -- get one character from standard input }
FUNCTION getc (VAR c : character) : character;
VAR
ch : char;
BEGIN
IF eof
THEN
c := ENDFILE
ELSE
IF eoln
THEN
BEGIN
readln;
c := NEWLINE
END
ELSE
BEGIN
read(ch);
c := ord(ch)
END;
getc := c
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getcf (UCB) -- get one character from file }
FUNCTION getcf (VAR c: character; fd : filedesc) : character;
VAR
ch : char;
BEGIN
IF (filemode[fd] <> IOREAD)
THEN
BEGIN
writeln('called getcf without file.mode=IOREAD'); stiphalt;
END;
IF (fd = STDIN)
THEN
getcf := getc(c)
ELSE
IF fdeof(fd)
THEN
c := ENDFILE
ELSE
IF fdeoln(fd)
THEN
BEGIN
fdreadln(fd);
c := NEWLINE
END
ELSE
BEGIN
fdread(fd, ch);
c := ord(ch)
END;
getcf := c
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getline (UCB) -- get a line from file }
FUNCTION getline (VAR s : string; fd : filedesc;
maxsize : integer) : boolean;
VAR
i : integer;
c : character;
BEGIN
i := 1;
REPEAT
s[i] := getcf(c, fd);
i := i + 1
UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
IF (c = ENDFILE)
THEN { went one too far }
i := i - 1;
s[i] := ENDSTR;
getline := (c <> ENDFILE)
END;
{ putcf (UCB) -- put a single character on file fd }
PROCEDURE putcf (c : character; fd : filedesc);
BEGIN
if (fd = lineout) then
xmtchar(CHR(c))
ELSE
IF c = NEWLINE
THEN
fdwriteln(fd)
ELSE
fdwrite(fd, chr(c))
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putstr (UCB) -- put out string on file }
PROCEDURE putstr (VAR s : string; f : filedesc);
VAR
i : integer;
BEGIN
i := 1;
WHILE (s[i] <> ENDSTR) DO
BEGIN
putcf(s[i], f);
i := i + 1
END
END;
{ open -- open a file for reading or writing }
FUNCTION Sopen (VAR name : string; mode : integer) : filedesc;
VAR
i : integer;
intname : mstring;
found : boolean;
BEGIN
i := 1;
WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) AND
(i <= FILENAMELENGTH) DO
BEGIN
if name[i] >= LETA then name[i] := name[i] - 32; { upper case }
intname[i] := chr(name[i]);
i := i + 1
END;
FOR i := i TO FILENAMELENGTH DO
intname[i] := ' '; { pad name with blanks }
{ find a free slot in openlist }
Sopen := IOERROR;
found := false;
i := 1;
WHILE (i <= MAXOPEN) AND (NOT found) DO
BEGIN
IF (filemode[i] = IOAVAIL)
THEN
BEGIN
fdbind(i,intname);
IF (BindStatus <> 0) AND (mode = IOWRITE) THEN
BEGIN
FILECREATE(intname);
fdbind(i,intname);
END;
IF BindStatus = 0 THEN
BEGIN
filemode[i] := mode;
IF (mode = IOREAD)
THEN
fdreset(i)
ELSE
fdrewrite(i);
Sopen:=i;
END
ELSE Sopen := 0;
found := true
END;
i := i + 1
END
END;
PROCEDURE Sclose (fd : filedesc);
BEGIN
IF (fd > STDOUT) AND (fd <= MAXOPEN)
THEN
BEGIN
filemode[fd] := IOAVAIL;
fdclose(fd);
END
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ itoc - convert integer n to char string in s[i]... }
FUNCTION itoc (n : integer; VAR s : string; i : integer)
: integer; { returns end of s }
BEGIN
IF (n < 0)
THEN
BEGIN
s[i] := ord('-');
itoc := itoc(-n, s, i+1)
END
ELSE
BEGIN
IF (n >= 10)
THEN
i := itoc(n DIV 10, s, i);
s[i] := n MOD 10 + ord('0');
s[i+1] := ENDSTR;
itoc := i + 1
END
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ length -- compute length of string }
FUNCTION length (VAR s : string) : integer;
VAR
n : integer;
BEGIN
n := 1;
WHILE (s[n] <> ENDSTR) DO
n := n + 1;
length := n - 1
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ scopy -- copy string at src[i] to dest[j] }
PROCEDURE scopy (VAR src : string; i : integer;
VAR dest : string; j : integer);
BEGIN
WHILE (src[i] <> ENDSTR) DO
BEGIN
dest[j] := src[i];
i := i + 1;
j := j + 1
END;
dest[j] := ENDSTR
END;
{ copyright (c) 1981 university of toronto computing services }
{ isupper -- true if c is upper case letter }
{ kludge version for omsi pascal }
FUNCTION isupper (c : character) : boolean;
BEGIN
isupper := (c >= ord('A')) AND (c <= ord('Z'))
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ index -- find position of character c in string s }
FUNCTION index (VAR s : string; c : character) : integer;
VAR
i : integer;
BEGIN
i := 1;
WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
i := i + 1;
IF (s[i] = ENDSTR)
THEN
index := 0
ELSE
index := i
END;
FUNCTION getarg(n:integer;VAR s:string;maxsize:integer): BOOLEAN;
(* return the nth argument *)
BEGIN
IF ((n<1) OR (cmdargs<n))
THEN
getarg := false
ELSE
BEGIN
scopy(cmdlin,cmdidx[n],s,1);
getarg := true
END;
END;
FUNCTION nargs: integer; (* returns number arguments *)
BEGIN
nargs := cmdargs
END;
PROCEDURE CtoS((* Using *) x:cstring; (* Returning *) VAR s:string);
(* convert constant to STIP string *)
VAR
i : integer;
BEGIN
FOR i:=1 TO CONLENGTH DO
s[i] := ord(x[i]);
s[CONLENGTH+1] := ENDSTR;
END;
PROCEDURE PutCon((* Using *) x:cstring;
(* Using *) fd:filedesc);
(* output literal preceeded by NEWLINE *)
VAR
i: integer;
s: string;
BEGIN
s[1] := NEWLINE;
s[2] := ENDSTR;
putstr(s,fd);
CtoS(x,s);
putstr(s,fd);
END;
FUNCTION Exists((* Using *) name:string): (* Returning *) boolean;
(* returns true if file exists *)
VAR
i : integer;
intname : mstring;
BEGIN
i := 1;
WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) AND
(i <= FILENAMELENGTH) DO
BEGIN
intname[i] := chr(name[i]);
i := i + 1
END;
FOR i := i TO FILENAMELENGTH DO
intname[i] := ' '; { pad name with blanks }
bind(filen,intname,BindStatus);
Exists := (BindStatus = 0);
END;
PROCEDURE PutNum((* Using *) n:integer;
(* Using *) fd:filedesc);
(* Ouput number *)
VAR
s: string;
dummy: integer;
BEGIN
s[1] := BLANK;
dummy := itoc(n,s,2);
putstr(s,fd);
END;
PROCEDURE initcmd; (* read command line *)
VAR
idx : 1.. MAXSTR;
i:integer;
prom:cstring;
dummy : boolean;
BEGIN
prom := 'KERMIT-H> '; (* Prompt *)
PutCon(prom,STDOUT);
dummy := getline(cmdlin,STDIN,MAXSTR);
IF (cmdlin[1] <> ENDSTR)
THEN
FOR i:= 1 TO length(cmdlin) DO begin
IF isupper(cmdlin[i])
THEN cmdlin[i]:=cmdlin[i] + 32;
IF (cmdlin[i]=newline) then CMDLIN[I]:=ENDSTR;
end;
cmdargs := 0; (* initialize *)
idx := 1;
WHILE (cmdlin[idx]<>endstr)
DO
BEGIN
WHILE (cmdlin[idx]=blank) DO
idx := idx+1;
IF (cmdlin[idx]<>endstr)
THEN
BEGIN
cmdargs := cmdargs+1;
cmdidx[cmdargs] := idx;
WHILE (cmdlin[idx]<>endstr)
AND (cmdlin[idx]<>BLANK) DO
idx := idx+1;
cmdlin[idx] := ENDSTR;
idx := idx+1;
END;
END;
END;
PROCEDURE AddTo((* Updating *) VAR sum : Stats;
(* Using *) inc:integer);
(* This is used to avoid integer overflows
without using 'reals' *)
BEGIN
sum[Low] := sum[Low] + inc;
IF (sum[Low] >= 1000)
THEN
BEGIN
sum[High] := sum[High] +1;
sum[Low ] := sum[Low] - 1000;
END;
END;
PROCEDURE OverHd((* Using *) p,f: Stats;
(* Returning *) VAR o:integer);
(* Calculate OverHead as % *)
(* 0verHead := (p-f)*100/f *)
BEGIN
o:= 0;
END;
PROCEDURE CalRat((* Using *) f: Stats;
(* Using *) t:integer;
(* Returning *) VAR r:integer);
(* Calculate Effective Baud Rate *)
(* Rate = f*10/t *)
BEGIN
r := 0;
END;
FUNCTION UnChar((* Using *) c:character): (* Returning *) character;
(* reverse of makechar *)
BEGIN
UnChar := c-BLANK
END;
PROCEDURE PutOut( p : Ppack); (* Output Packet *)
VAR
i : integer;
BEGIN
IF (Pad >0)
THEN
FOR i := 1 TO Pad DO
putcf(PadChar,LineOut);
WITH Buf[p] DO
BEGIN
putcf(mark,LineOut);
putcf(count,LineOut);
PutCon ( 'Sending Packet... ',STDout);
PutNum(Unchar(seq),STDout);
putcf(seq,LineOut);
putcf(ptype,LineOut);
putstr(data,LineOut);
END;
END;
PROCEDURE StartTimer;
BEGIN
TimeLeft := TheirTimeOut;
END;
PROCEDURE StopTimer;
BEGIN
TimeLeft := MaxInt;
END;
FUNCTION MakeChar((* Using *) c:character): (* Returning *) character;
(* convert integer to printable *)
BEGIN
MakeChar := c+BLANK;
END;
FUNCTION IsControl((* Using *) c:character): (* Returning *) boolean;
(* true if control *)
BEGIN
IsControl := (c=DEL ) OR (c < BLANK );
END;
FUNCTION IsPrintable((* Using *) c:character): (* Returning *) boolean;
(* opposite of iscontrol *)
BEGIN
IsPrintable := NOT IsControl(c);
END;
FUNCTION Ctl((* Using *) c:character): (* Returning *) character;
(* c XOR 100 *)
BEGIN
IF IsControl(c)
THEN
c := c+64
ELSE
c := c-64;
Ctl := c;
END;
FUNCTION IsValidPType((* Using *) c:character): (* Returning *) boolean;
(* true if valid packet type *)
BEGIN
IsValidPType := (c =TYPEB) OR (c=TYPED) OR (c=TYPEE) OR (c=TYPEF)
OR (c=TYPEN) OR (c=TYPES) OR (c=TYPET) OR (c=TYPEY) OR (c=TYPEZ)
END;
FUNCTION CheckFunction((* Using *) c:integer): (* Returning *) character;
(* calculate checksum *)
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;
PROCEDURE EnCodeParm((* Updating *) VAR data:string); (* encode parameters *)
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(MyTimeOut); (* when I want timeout*)
data[3] := MakeChar(MyPad); (* how much padding *)
data[4] := Ctl(MyPadChar); (* my padding character *)
data[5] := MakeChar(myEOL); (* my EOL *)
data[6] := MyQuote; (* my quote char *)
END;
PROCEDURE DeCodeParm((* Using *) VAR data:string); (* decode parameters *)
BEGIN
SizeSend := UnChar(data[1]);
TheirTimeOut := UnChar(data[2]); (* when I should time out *)
Pad := UnChar(data[3]); (* padding characters to send *)
PadChar := Ctl(data[4]); (* padding character *)
SendEOL := UnChar(data[5]); (* EOL to send *)
SendQuote := data[6]; (* quote to send *)
END;
PROCEDURE ReadParm ((* Updating *) VAR Parms:string);
VAR
dummy : boolean;
fd : filedesc;
BEGIN;
(* read parameters *)
Parms[1]:=ENDSTR;
IF Exists(ParmFile)
THEN
BEGIN
fd := Sopen(ParmFile,IOREAD);
dummy := getline(Parms,fd,MAXSTR);
Sclose(fd);
END;
END;
PROCEDURE GetParm; (* get parameters from file *)
VAR
data:string;
BEGIN;
ReadParm(data);
IF (length(data) > 0)
THEN (* get parameters *)
BEGIN
SizeRecv := UnChar(data[1]);
MyTimeOut := UnChar(data[2]); (* when I should time out *)
MyPad := UnChar(data[3]); (* padding characters to send *)
MyPadChar := Ctl(data[4]); (* padding character *)
MyEOL := UnChar(data[5]); (* EOL to send *)
MyQuote := data[6]; (* quote to send *)
END;
END;
PROCEDURE SYSarguments;
(* process special arguments for SYSTEM *)
BEGIN
(* nothing *)
END;
PROCEDURE StartRun; (* initialization as necessary *)
BEGIN
RunTime := 0;
END;
PROCEDURE Usage; (* Print writeln & exit *)
BEGIN
writeln;
writeln(
'usage: KERMIT-H> [Help] [Connect] [Send/Receive/Print<filenames>]');
END;
PROCEDURE SetParameters;
(* set new Parameter File Name *)
BEGIN
IF (length(aline) > 2)
THEN
BEGIN
scopy(aline,3,ParmFile,1);
GetParm; (* read new parameters *)
END;
END;
PROCEDURE KermitInit; (* initialize various parameters & defaults *)
BEGIN
n := 0;
NumSendPacks := 0;
NumRecvPacks := 0;
NumACK := 0;
NumNAK := 0;
NumACKrecv := 0;
NumNAKrecv := 0;
NumBADrecv := 0;
ChInFile[Low] := 0;
ChInFile[High] := 0;
ChInPack := ChInFile;
OneWayOnly := false;
Verbosity := false; (* default to false *)
Trace := false; (* default to no trace *)
Debug := false;
RunType := invalid;
DiskFile := IOERROR; (* to indicate not open yet *)
ThisPacket := 1;
LastPacket := 2;
CurrentPacket := 3;
NextPacket := 4;
InputPacket := 5;
WITH TOPacket DO
BEGIN
count := 3;
seq := 0;
ptype := TYPEN;
data[1] := ENDSTR;
END;
NextArg := 1; (* get first argument *)
IF (NextArg<=nargs)
THEN
IF NOT getarg(NextArg,aline,MAXSTR)
THEN
Usage;
FROMCONSOLE:=NOTHING;
END;
PROCEDURE FinishUp; (* do any End of Program clean up *)
VAR
overhead ,effrate : integer;
BEGIN
Sclose(DiskFile);
(* print info on number of packets etc *)
IF ((RunType <> Invalid) AND Local )
THEN
BEGIN
PutCon('Packets sent: ',STDOUT);
PutNum(NumSendPacks,STDOUT);
PutCon('Packets received ',STDOUT);
PutNum(NumRecvPacks,STDOUT);
(* Calculate overhead *)
OverHd(ChInPack,ChInFile,overhead);
IF (Overhead <>0)
THEN
BEGIN
PutCon('Overhead (%): ' ,STDOUT);
PutNum(overhead,STDOUT);
END;
IF (RunTime <> 0)
THEN
BEGIN (* calculate effective rate *)
CalRat(ChInFile,RunTime,effrate);
PutCon('Effective Rate: ',STDOUT);
PutNum(effrate,STDOUT);
END;
IF (RunType = Transmit)
THEN
BEGIN
PutCon('Number of ACK: ',STDOUT);
PutNum(NumACKrecv,STDOUT);
PutCon('Number of NAK: ',STDOUT);
PutNum(NumNAKrecv,STDOUT);
PutCon('Number of BAD: ',STDOUT);
PutNum(NumBADrecv,STDOUT);
END
ELSE
BEGIN (* for Receive *)
PutCon('Number of ACK: ',STDOUT);
PutNum(NumACK,STDOUT);
PutCon('Number of NAK: ',STDOUT);
PutNum(NumNAK,STDOUT);
END;
putcf(NEWLINE,STDOUT);
END;
State := Abort;
Local := false;
END;
PROCEDURE DebugPacket((* Using *) mes : cstring;
(* Using *) VAR p : Ppack);
(* Print Debugging Info *)
BEGIN
PutCon(mes,STDOUT);
WITH Buf[p] DO
BEGIN
PutNum(Unchar(count),STDOUT);
PutNum(Unchar(seq),STDOUT);
putcf(BLANK,STDOUT);
putcf(ptype,STDOUT);
putcf(NEWLINE,STDOUT);
putstr(data,STDOUT);
putcf(NEWLINE,STDOUT);
END;
END;
PROCEDURE ReSendPacket;
(* re -sends previous packet *)
BEGIN
NumSendPacks := NumSendPacks+1;
AddTo(ChInPack,Pad + UnChar(Buf[LastPacket].count) + 3);
IF Debug
THEN DebugPacket('Re-Sending ... ',LastPacket);
PutOut(LastPacket);
END;
PROCEDURE SendPacket;
(* expects count as length of data portion *)
(* and seq as number of packet *)
(* builds & sends packet *)
VAR
i,len,chksum : integer;
temp : Ppack;
BEGIN
IF (NumTry <> 1) AND (RunType = Transmit )
THEN
ReSendPacket
ELSE
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
mark :=SOH; (* 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)
THEN (* is there data ? *)
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] := SendEOL; (* EOL *)
data[len+3] := ENDSTR;
END;
NumSendPacks := NumSendPacks+1;
IF Debug
THEN DebugPacket('Sending ... ',ThisPacket);
PutOut(ThisPacket);
IF RunType = Transmit
THEN
BEGIN
AddTo(ChInPack,Pad + len + 6);
temp := LastPacket;
LastPacket := ThisPacket;
ThisPacket := temp;
END;
END
END;
PROCEDURE SendACK((* Using *) n:integer); (* send ACK packet *)
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
count := 0;
seq := n;
ptype := TYPEY;
END;
SendPacket;
NumACK := NumACK+1;
END;
PROCEDURE SendNAK((* Using *) n:integer); (* send NAK packet *)
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
count := 0;
seq := n;
ptype := TYPEN;
END;
SendPacket;
NumNAK := NumNAK+1;
END;
PROCEDURE ErrorPack((* Using *) c:cstring);
(* output Error packet if necessary -- then exit *)
BEGIN
IF (TTYmode = Cooked)
THEN
PutCon(c,STDOUT)
ELSE
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
seq := n;
ptype := TYPEE;
CtoS(c,data);
count := length(data);
END;
SendPacket;
END;
FinishUp;
State := Abort;
END;
PROCEDURE Verbose((* Using *) c:cstring);
(* Print writeln if verbosity *)
BEGIN
IF Verbosity
THEN
PutCon(c,STDOUT);
END;
PROCEDURE PutErr((* Using *) c:cstring);
(* Print error_messages *)
BEGIN
PutCon(c,STDOUT);
IF (TtyMode = Raw) AND (NumKeptErrors < MAXERRORS)
THEN
BEGIN
NumKeptErrors := NumKeptErrors + 1;
KeptErrors[NumKeptErrors] := c;
END;
END;
PROCEDURE Field1; (* Count *)
VAR
test: boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
Buf[InputPacket].count := t;
count := UnChar(t);
test := (count >= 3) OR (count <= SizeRecv-2);
IF NOT test
THEN
Verbose('Bad count ');
good := good AND test;
END;
END;
END;
PROCEDURE Field2; (* Packet Number *)
VAR
test : boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
Buf[InputPacket].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;
PROCEDURE Field3; (* Packet Type *)
VAR
test : boolean;
BEGIN
WITH Buf[NextPacket] DO
BEGIN
WITH PackControl DO
BEGIN
ptype := t;
Buf[InputPacket].ptype := t;
test := IsValidPType(ptype);
IF NOT test
THEN
Verbose('Bad Packet Type ');
good := test AND good;
END;
END;
END;
PROCEDURE Field4; (* Data *)
BEGIN
WITH PackControl DO
BEGIN
PacketPtr := PacketPtr+1;
Buf[InputPacket].data[PacketPtr] := t;
WITH Buf[NextPacket] DO
BEGIN
IF (t=MyQuote) AND (ptype <> TYPEY) AND (ptype <> TYPES)
THEN (* character is quote *)
BEGIN
IF control
THEN (* quote ,quote *)
BEGIN
data[i] := MyQuote;
i := i+1;
control := false;
END
ELSE (* set control on *)
control := true
END
ELSE (* not quote *)
IF control
THEN (* convert to control *)
BEGIN
data[i] := ctl(t);
i := i+1;
control := false
END
ELSE (* regular data *)
BEGIN
data[i] := t;
i := i+1;
END;
END;
END;
END;
PROCEDURE Field5; (* Check Sum *)
VAR
test : boolean;
BEGIN
WITH PackControl DO
BEGIN
PacketPtr := PacketPtr +1;
Buf[InputPacket].data[PacketPtr] := t;
Buf[InputPacket].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;
PROCEDURE BuildPacket;
(* receive packet & validate checksum *)
VAR
temp : Ppack;
BEGIN
WITH PackControl DO
BEGIN
WITH Buf[NextPacket] DO
BEGIN
IF (t<>ENDSTR)
THEN
IF restart
THEN
BEGIN
(* read until get SOH marker *)
IF (t = SOH)
THEN
BEGIN
finished := false; (* set varibles *)
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;
END
ELSE (* have started packet *)
BEGIN
IF (t=SOH) (* check for restart or EOL *)
THEN
restart := true
ELSE
IF (t=myEOL)
THEN
BEGIN
finished := true;
good := false;
END
ELSE
BEGIN
CASE fld OF
(* increment field number *)
0: fld := 1;
1: fld := 2;
2: fld := 3;
3:
IF (count=3) (* no data *)
THEN
fld := 5
ELSE
fld := 4;
4:
IF (PacketPtr>=count-3) (* end of data *)
THEN
fld := 5;
END (* case *);
IF (fld<>5)
THEN
check := check+t; (* add into checksum *)
CASE fld OF
1: Field1;
2: Field2;
3: Field3;
4: Field4;
5: Field5;
END;
(* case *)
END;
END;
IF finished
THEN
BEGIN
IF (ptype=TYPEE) AND good
THEN (* error_packets *)
BEGIN
putstr(data,STDOUT);
FinishUp;
SendACK(n); (* send ACK *)
END;
NumRecvPacks := NumRecvPacks+1;
IF Debug
THEN
BEGIN
DebugPacket('Received ... ',InputPacket);
IF good
THEN
PutCon('Is Good ',STDOUT);
END;
temp := CurrentPacket;
CurrentPacket := NextPacket;
NextPacket := temp;
END;
END;
END;
END;
FUNCTION ReceivePacket: boolean;
BEGIN
WITH PackControl DO
BEGIN
StartTimer;
IF (Runtype = Receive) AND (State = Init) THEN
TimeLeft := 10 * TimeLeft; { Long wait for first message }
finished := false;
restart := true;
good := false;
FromConsole := nothing; (* No Interupt *)
REPEAT
t := GetIn(TimeLeft,FromConsole);
IF Local (* check Interupt *)
THEN BEGIN
CASE FromConsole OF
abortnow:
BEGIN
FinishUp;
STIPHALT;
END;
nothing: (* nothing *);
CRin:
BEGIN
t := MyEOL;
FromConsole := nothing;
END;
END;
end;
(* case *)
BuildPacket;
UNTIL finished OR (TimeLeft = 0);
IF (TimeLeft = 0)
THEN
BEGIN
Buf[CurrentPacket] := TOPacket;
restart := true;
IF NOT ((RunType=Transmit) AND (State=Init))
THEN
BEGIN
PutCon('Timed Out ',STDOUT);
END;
END;
StopTimer;
ReceivePacket := good;
END;
END;
FUNCTION ReceiveACK : (* Returning *) boolean;
(* receive ACK with correct number *)
VAR
Ok: boolean;
BEGIN
IF (NOT OneWayOnly )
THEN
Ok := ReceivePacket;
WITH Buf[CurrentPacket] DO
BEGIN
IF (ptype=TYPEY)
THEN
NumACKrecv := NumACKrecv+1
ELSE
IF (ptype=TYPEN)
THEN
NumNAKrecv := NumNAKrecv+1
ELSE
IF NOT OneWayOnly
THEN
NumBadrecv := NumBadrecv +1;
(* got right one ? *)
ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
OR ( OneWayOnly)
END;
END;
PROCEDURE GetData((* Returning *) VAR newstate:KermitStates);
(* get data from file into ThisPacket *)
VAR
(* and return next state - data & EOF *)
x,c : character;
i: integer;
BEGIN
IF (NumTry=1)
THEN
BEGIN
i := 1;
x := ENDSTR;
WITH Buf[ThisPacket] DO
BEGIN
WHILE (i< SizeSend - 8 ) AND (x <> ENDFILE)
(* leave room for quote & NEWLINE *)
DO
BEGIN
x := getcf(c,DiskFile);
IF (x<>ENDFILE)
THEN
IF (IsControl(x)) OR (x=SendQuote)
THEN
BEGIN (* control char -- quote *)
IF (x=NEWLINE)
THEN (* use proper EOL *)
CASE EOLforFile OF
LineFeed: (* ok as is *);
CrLf:
BEGIN
data[i] := SendQuote;
i := i+1;
data[i] := Ctl(CR);
i := i+1;
(* LF will sent
below *)
END;
JustCR: x := CR;
END (* case *);
data[i] := SendQuote;
i := i+1;
IF (x<>SendQuote)
THEN
data[i] := Ctl(x)
ELSE
data[i] := SendQuote;
END
ELSE (* regular char *)
data[i] := x;
IF (x<>ENDFILE)
THEN
BEGIN
i := i+1; (* increase count for next char *)
AddTo(ChInFile,1);
END;
END;
data[i] := ENDSTR; (* to terminate string *)
count := i -1; (* length *)
seq := n;
ptype := TYPED;
IF (x=ENDFILE)
THEN
BEGIN
newstate := EOFile;
Sclose(DiskFile);
DiskFile := ioerror;
END
ELSE
newstate := FileData;
SaveState := newstate; (* save state *)
END
END
ELSE
newstate := SaveState; (* get old state *)
END;
FUNCTION GetNextFile: (* Returning *) boolean;
(* get next file to send in ThisPacket *)
(* returns true if no more *)
VAR
result: boolean;
BEGIN
result := true;
IF (NumTry=1)
THEN
WITH Buf[ThisPacket] DO
BEGIN
REPEAT
IF getarg(NextArg,data,MAXSTR)
THEN
BEGIN (* open file *)
IF Exists(data)
THEN
BEGIN
DiskFile := Sopen(data,IOREAD);
count := length(data);
AddTo(ChInFile , count);
seq := n;
ptype := TYPEF;
PutCon(' SENDING... ',STDOUT);
putstr(data,stdout);
IF DiskFile <= IOERROR
THEN
ErrorPack('Cannot open file ');
result := false;
FIXNAME(data);
END;
END;
NextArg := NextArg+1;
UNTIL ( NextArg > nargs ) OR ( NOT result )
END
ELSE
result := false; (* for saved packet *)
GetNextFile := result;
END;
PROCEDURE SendFile; (* send file name packet *)
BEGIN
Verbose( 'Sending .... ');
IF NumTry > MaxTry
THEN
BEGIN
PutErr ('Send file - Too Many');
State := Abort; (* too many tries, abort *)
END
ELSE
BEGIN
NumTry := NumTry+1;
IF GetNextFile
THEN
BEGIN
State := Break;
NumTry := 0;
END
ELSE
BEGIN
IF Verbosity
THEN
IF (NumTry = 1)
THEN putstr(Buf[ThisPacket].data,STDOUT)
ELSE putstr(Buf[LastPacket].data,STDOUT);
SendPacket; (* send this packet *)
IF ReceiveACK
THEN
BEGIN
State := FileData;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
END;
PROCEDURE SendData; (* send file data packets *)
VAR
newstate: KermitStates;
BEGIN
IF Verbosity
THEN
BEGIN
PutCon ( 'Sending data ',STDOUT);
PutNum(n,STDOUT);
END;
IF NumTry > MaxTry
THEN
BEGIN
State := Abort; (* too many tries, abort *)
PutErr ('Send data - Too many');
END
ELSE
BEGIN
NumTry := NumTry+1;
GetData(newstate);
SendPacket;
IF ReceiveACK
THEN
BEGIN
State := newstate;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
PROCEDURE SendEOF; (* send EOF packet *)
BEGIN
Verbose ('Sending EOF ');
IF NumTry > MaxTry
THEN
BEGIN
State := Abort; (* too many tries, abort *)
PutErr('Send EOF - Too Many ');
END
ELSE
BEGIN
NumTry := NumTry+1;
IF (NumTry = 1)
THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
ptype := TYPEZ;
seq := n;
count := 0;
END
END;
SendPacket;
IF ReceiveACK
THEN
BEGIN
State := FileHeader;
NumTry := 0;
n := (n+1) MOD 64;
END
END;
END;
PROCEDURE SendBreak; (* send break packet *)
BEGIN
Verbose ('Sending break ');
IF NumTry > MaxTry
THEN
BEGIN
State := Abort; (* too many tries, abort *)
PutErr('Send break -Too Many');
END
ELSE
BEGIN
NumTry := NumTry+1;
(* make up packet *)
IF NumTry = 1
THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
ptype := TYPEB;
seq := n;
count := 0;
END
END;
SendPacket; (* send this packet *)
IF ReceiveACK
THEN
BEGIN
State := Complete;
END
END;
END;
PROCEDURE SendInit; (* send init packet *)
BEGIN
Verbose ('Sending init ');
IF NumTry > MaxTry
THEN
BEGIN
State := Abort; (* too many tries, abort *)
PutErr('Cannot Initialize ');
END
ELSE
BEGIN
NumTry := NumTry+1;
IF (NumTry = 1)
THEN
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
EnCodeParm(data);
count := NUMPARAM;
seq := n;
ptype := TYPES;
END
END;
SendPacket; (* send this packet *)
IF ReceiveACK
THEN
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
IF OneWayOnly
THEN (* use same data if test mode *)
data := Buf[LastPacket].data;
SizeSend := UnChar(data[1]);
TheirTimeOut := UnChar(data[2]);
Pad := UnChar(data[3]);
PadChar := Ctl(data[4]);
SendEOL := CR; (* default to CR *)
IF (length(data) >= 5)
THEN
IF (data[5] <> 0)
THEN
SendEOL := UnChar(data[5]);
SendQuote := SHARP; (* default # *)
IF (length(data) >= 6)
THEN
IF (data[6] <> 0)
THEN
SendQuote := data[6];
END;
State := FileHeader;
NumTry := 0;
n := (n+1) MOD 64;
END;
END;
END;
PROCEDURE SendSwitch;
(* 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.
*)
BEGIN
State := Init; (* send initiate is the start state *)
NumTry := 0; (* say no tries yet *)
IF NOT Local THEN
BEGIN
TTYRAW; (* if host--put tty in raw mode *)
TtyMode := Raw;
END;
IF (NOT OneWayOnly )
THEN
Sleep(Delay);
StartRun;
REPEAT
CASE State OF
FileData: SendData; (* data-send state *)
FileHeader: SendFile; (* send file name *)
EOFile: SendEOF; (* send end-of-file *)
Init: SendInit; (* send initialize *)
Break: SendBreak; (* send break *)
Complete: (* nothing *);
Abort: (* nothing *);
END (* case *);
UNTIL ( (State = Abort) OR (State=Complete) );
FLUSH; (* flush output buffer *)
IF TtyMode = Raw THEN
BEGIN
TTYCOOKED; (* if host--return tty to cooked mode *)
TtyMode := Cooked;
END;
END;
PROCEDURE GetFile((* Using *) data:string);
(* create file from fileheader packet *)
VAR
strend: integer;
BEGIN
putstr(aline,stdout);
IF (RUNTYPE=PRINT) THEN DiskFile := Sopen(aline,IOWRITE) ELSE
WITH Buf[CurrentPacket] DO
BEGIN
IF DiskFile = IOERROR (* check if we already have a file *)
THEN
BEGIN
IF Verbosity
THEN
BEGIN
PutCon ('Creating file ... ',STDOUT);
putstr(data,STDOUT);
END;
(* check position of '.' -- truncate if bad *)
IF (index(data,PERIOD) > FLEN1 )
THEN
BEGIN
data[FLEN1] := PERIOD;
data[FLEN1 + 1] := ENDSTR;
END;
(* check Max length *)
IF length(data) > FLEN2
THEN
data[FLEN2 +1] := ENDSTR;
IF Exists(data)
THEN
BEGIN
PutCon('File already exists ',STDOUT);
putstr(data,STDOUT);
PutCon('Creating ... ',STDOUT);
CtoS(TEMPFILE,data);
strend := 0;
REPEAT
strend := strend +1;
UNTIL (data[strend] = BLANK);
strend := itoc(n,data,strend);
putstr(data,STDOUT);
END;
DiskFile := Sopen(data,IOWRITE);
END;
IF (Diskfile <= IOERROR)
THEN
ErrorPack('Cannot create file ');
END;
END;
PROCEDURE ReceiveInit;
(* receive init packet *)
(* respond with ACK and our parameters *)
BEGIN
IF NumTry > MaxTry
THEN
BEGIN
State := Abort;
PutErr('Cannot receive init ');
END
ELSE
BEGIN
Verbose ( 'Receiving Init ');
NumTry := NumTry+1;
IF ReceivePacket
AND (Buf[CurrentPacket].ptype = TYPES)
THEN
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
n := seq;
DeCodeParm(data);
END;
(* now send mine *)
WITH Buf[ThisPacket] DO
BEGIN
count := NUMPARAM;
seq := n;
Ptype := TYPEY;
EnCodeParm(data);
END;
SendPacket;
NumACK := NumACK+1;
State := FileHeader;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64
END
ELSE
BEGIN
IF Debug
THEN
PutCon('Received Bad init ',STDOUT);
SendNAK(n);
END;
END;
END;
PROCEDURE DataToFile; (* output to file *)
VAR
len,i : integer;
temp : string;
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
len := length(data);
AddTo(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;
JustCR:
BEGIN (* change CR to NEWLINE *)
FOR i:=1 TO len DO
IF data[i]=CR
THEN
data[i]:=NEWLINE;
putstr(data,DiskFile);
END;
END;
(* case *)
END;
END;
PROCEDURE Dodata; (* Process Data packet *)
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
IF seq = ((n + 63) MOD 64)
THEN
BEGIN (* data last one *)
IF OldTry>MaxTry
(* number of tries? *)
THEN
BEGIN
State := Abort;
PutErr('Old data - Too many ');
END
ELSE
BEGIN
SendACK(seq);
NumTry := 0;
END;
END
ELSE
BEGIN (* data - this one *)
IF (n<>seq)
THEN
SendNAK(n)
ELSE
BEGIN
SendACK(n); (* ACK *)
DataToFile;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64;
END;
END;
END;
END;
PROCEDURE DoFileLast; (* Process File Packet *)
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;
END;
END;
PROCEDURE DoEOF; (* Process EOF packet *)
BEGIN (* EOF - this one *)
IF Buf[CurrentPacket].seq<>n (* packet number ? *)
THEN
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
Sclose(DiskFile); (* close file *)
DiskFile := IOERROR;
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64; (* next packet *)
State := FileHeader; (* change state *)
END;
END;
PROCEDURE ReceiveData; (* Receive data packets *)
VAR
strend: integer;
packetnum: string;
good : boolean;
BEGIN
IF NumTry > MaxTry (* check number of tries *)
THEN
BEGIN
State := Abort;
CtoS('Recv data -Too many ',packetnum);
strend := itoc(n,packetnum,CONLENGTH+1);
putstr(packetnum,STDOUT);
END
ELSE
BEGIN
NumTry := NumTry+1; (* increase number of tries *)
good := ReceivePacket; (* get packet *)
WITH Buf[CurrentPacket] DO
BEGIN
IF Verbosity
THEN
BEGIN
PutCon('Receiving (Data) ',STDOUT);
PutNum(Buf[CurrentPacket].seq,STDOUT);
END;
IF ((ptype = TYPED) OR (ptype=TYPEZ)
OR (ptype=TYPEF)) AND good (* check type *)
THEN
CASE ptype OF
TYPED: DoData;
TYPEF: DoFileLast;
TYPEZ: DoEOF;
END (* case *)
ELSE
BEGIN
Verbose('Expected data pack ');
SendNAK(n);
END;
END;
END;
END;
PROCEDURE DoBreak; (* Process Break packet *)
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;
PROCEDURE DoFile; (* Process file packet *)
BEGIN (* File Header *)
WITH Buf[CurrentPacket] DO
BEGIN
IF seq<>n (* packet number ? *)
THEN
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
AddTo(ChInFile, length(data));
GetFile(data); (* get file name *)
OldTry := NumTry;
NumTry := 0;
n := (n+1) MOD 64; (* next packet *)
IF (State <> Abort) THEN State := FileData; (* change state *)
END;
END;
END;
PROCEDURE DoEOFLast; (* Process EOF Packet *)
BEGIN (* End Of File Last One*)
IF OldTry > MaxTry (* tries ? *)
THEN
BEGIN
State := Abort;
PutErr('Old EOF - 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;
END;
END;
PROCEDURE DoInitLast;
BEGIN (* Init Packet - last one *)
IF OldTry>MaxTry (* number of tries? *)
THEN
BEGIN
State := Abort;
PutErr('Old init - Too many ');
END
ELSE
BEGIN
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;
NumACK := NumACK+1;
NumTry := 0;
END
ELSE
BEGIN
SendNAK(n); (* NAK *)
END;
END;
END;
PROCEDURE ReceiveFile; (* receive file packet *)
VAR
good: boolean;
BEGIN
IF NumTry > MaxTry (* check number of tries *)
THEN
BEGIN
State := Abort;
PutErr('Recv file - Too many');
END
ELSE
BEGIN
NumTry := NumTry+1; (* increase number of tries *)
good := ReceivePacket; (* get packet *)
WITH Buf[CurrentPacket] DO
BEGIN
IF VERBOSITY THEN BEGIN
PutCon('Receiving (File) ',STDOUT);
PutNum(seq,STDOUT);
END;
PutCon(' RECEIVING... ',STDOUT);
putstr(data,stdout);
IF ((ptype = TYPES) OR (ptype=TYPEZ)
OR (ptype=TYPEF) OR (ptype=TYPEB)) (* check type *)
AND good
THEN
CASE ptype OF
TYPES: DoInitLast;
TYPEZ: DoEOFLast;
TYPEF: DoFile;
TYPEB: DoBreak;
END (* case *)
ELSE
BEGIN
IF Debug
THEN
PutCon('Expected File Pack ',STDOUT);
SendNAK(n);
END;
END;
END;
END;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
BEGIN
State := Init;
NumTry := 0;
IF NOT Local THEN
BEGIN
TTYRAW; (* if host--put tty in raw mode *)
TtyMode := Raw;
END;
StartRun;
REPEAT
CASE State OF
FileData: ReceiveData;
Init: ReceiveInit;
Break: (* nothing *);
FileHeader: ReceiveFile;
EOFile: (* nothing *);
Complete: (* nothing *);
Abort: (* nothing *);
END;
(* case *)
UNTIL (State = Abort ) OR ( State = Complete );
FLUSH; (* flush output buffer *)
IF TtyMode = Raw THEN
BEGIN
TTYCOOKED; (* if host--return tty to cooked mode *)
TtyMode := Cooked;
END;
END;
BEGIN
SYSinit; (* system dependent *)
initio;
done:=false;
NumTry:=0;
NumKeptErrors := 0;
Pad := DEFPAD; (* set defaults *)
MyPad := DEFPAD;
PadChar := DEFPADCHAR;
MyPadChar := DEFPADCHAR;
TheirTimeOut := DEFTIMEOUT;
MyTimeOut := DEFTIMEOUT;
Delay := DEFDELAY;
SizeRecv := MAXPACK;
SizeSend := MAXPACK;
SendEOL := DEFEOL;
MyEOL := DEFEOL;
SendQuote := DEFQUOTE;
MyQuote := DEFQUOTE;
MaxTry := DEFTRY;
Halfduplex := DEFDUPLEX;
CASE DEFEOLTYPE OF
1: EOLforFile := LineFeed;
2: EOLforFile := CrLf;
3: EOLforFile := JustCR;
END (* case *);
CtoS(PFILE,ParmFile);
GetParm;
Local := false; (* default to remote *)
TtyMode := Cooked;
repeat
initcmd;
KermitInit; (* initialize *)
WHILE ( NextArg <= nargs ) AND (RUNTYPE<>transmit) and
(RUNTYPE<>receive) and (RUNTYPE<>print) and (not done)
DO
BEGIN
(* check for valid commands *)
(* r s c M x u z *)
IF
(aline[1]=LETS) OR
(aline[1]=LETR) OR
(aline[1]=LETP) OR
(aline[1]=LETC) OR
(aline[1]=LETM) OR
(aline[1]=LETX) OR
(aline[1]=LETU) OR
(aline[1]=LETZ) OR
(aline[1]=LETH) OR
(aline[1]=LETQ) OR
(aline[1]=LETT) OR
(aline[1]=LETE)
THEN
CASE aline[1] OF
LETS: RunType := Transmit;
LETR: RunType := Receive;
LETP: RunType := PRINT;
LETE,LETQ: done:=true;
LETC:
BEGIN (* look for -lvd *)
FOR j := length(aline) DOWNTO 1 DO
BEGIN
IF (aline[j]=LETC)
THEN
BEGIN
Local := true;
IF NOT OneWayOnly
THEN
BEGIN
Local := connect(Halfduplex);
IF NOT Local THEN
PutErr('Cannot connect ');
END;
END;
IF (aline[j]=LETV)
THEN
Verbosity := true;
IF (aline[j]=LETD)
THEN
Debug := true;
IF (aline[j]=LETH)
THEN
Halfduplex := true;
IF (aline[j]=LETF)
THEN
Halfduplex := false;
END;
END;
LETH: BEGIN WRITELN;
WRITELN('KERMIT-H Comands:');
WRITELN;
(*
WRITELN('C [H/F/D/V] - Connect [Half/Full duplex,Debug,Verbose]');
*)
Writeln('S <filename> {<filename>} - Send files');
Writeln('R {<filename>} - Receive files');
(*
Writeln('P {<filename>] - Print files');
*)
Writeln('H - Help {this message}');
Writeln('E - Exit');
Writeln('Q - Quit');
END;
LETX: OneWayOnly := true;
LETM: SetParameters;
LETU: SYSarguments; (* do special for SYSTEM *)
LETZ:
BEGIN
IF (aline[2]=LETL) OR (aline[2]=LETC)
OR (aline[2]=LETR)
THEN
CASE aline[2] OF
LETL: EOLforFile := LineFeed;
LETC: EOLforFile := CrLf;
LETR: EOLforFile := JustCR;
END (* case *);
END;
LETT:
BEGIN
FILECREATE(TRACEFILE);
bind(filet,TRACEFILE,BindStatus);
IF BindStatus = 0 THEN Trace := true;
Verbosity := true;
Debug := true;
TtyMode := RAW;
PutCon('Kermit Trace Output ',STDOUT);
PutCon(' ',STDOUT);
TtyMode := COOKED;
END;
END (* case *)
ELSE
Usage;
(* get next argument *)
NextArg := NextArg+1;
IF (NextArg <= nargs )
THEN
IF NOT getarg(NextArg,aline,MAXSTR)
THEN
Usage;
END;
CASE RunType OF
Receive:
BEGIN (* filename is optional here *)
IF getarg(NextArg,aline,MAXSTR)
THEN
BEGIN
IF Exists(aline)
THEN
BEGIN
PutErr('Overwriting ');
putstr(aline,STDOUT);
END;
DiskFile := Sopen(aline,IOWRITE);
IF DiskFile <= IOERROR
THEN
ErrorPack('Cannot Open File ');
END;
RecvSwitch;
END;
PRINT:
BEGIN
CtoS(LP,aline);
DiskFile := Sopen(aline,IOWRITE);
IF DiskFile <= IOERROR
THEN
ErrorPack('Cannot Open File ');
RecvSwitch;
END;
Transmit:
BEGIN (* must give filename *)
FOR j:= NextArg TO nargs DO
BEGIN
IF NOT getarg(NextArg,aline,MAXSTR)
THEN
Usage;
IF NOT Exists(aline)
THEN
ErrorPack('File not found ');
END;
IF getarg(NextArg,aline,MAXSTR)
THEN SendSwitch;
END;
Invalid: (* nothing *);
SetParm: (* nothing *);
END;
(* case *)
until done;
FinishUp; (* End of Program *)
IF (NumKeptErrors > 0) (* Print any message we couldn't before *)
THEN
BEGIN
PutCon(' Delayed Messages:',STDOUT);
FOR J := 1 TO NumKeptErrors DO PutCon(KeptErrors[J],STDOUT);
END;
9999:
SYSFINISH; (* do System dependent *)
END.