!!!! Header this is a version of Kermit written for RT11 By: Michael K. Weisberg Mount Sinai Hospital Dept. of Vascular Surgery 1 Gustave-Levy Place New York, N.Y. 10029 This is NOT a portable version due to the limited I/O facilities of pascal no such animal is currently possible. This version should work on all reasonably configured RT11 sytems and has been test on several different processors. This version is largely based on the work of Philip Murton, University of Toronto Computing Services, Communications and Field Service. The main modifications are that the command structure have been modified to conform more closely to the Kermit standard although not exactly (they are documented by the Help command) and the system has been made runnable as is under RT11 at the price of adding noportable I/O routines. Finally there is still alot of work that would be nice to do here especially improving the command parser and adding timeout capabilities (ie making this kermit smart) and adding the server capabilities. My encouragements to all! INSTALLATION: 1. Extract the command file given below into Kermit.com 2. Extract the source file into Kermit.pas 3. Edit the source file so the UNIBUS (or QBUS) to conform to the remote port addresses on your system. 4. Execute the command file. !!!! Here is a command file to compile Kermit !!!! Paslib.old is the version of the OMSI pascal library distributed !!!! with Pascal 1 although they claim compatibility between this lib !!!! and the one distributed with Pascal 2 this is not the case here !!!! and you must use the lib from the Pascal 1 version or you will !!!! get strange errors. r pasc1 kermit=kermit MACRO KERMIT LINK KERMIT,PASLIB.old !!!! end of command file !!!! The source {$T-,$A-} PROGRAM Kermit(input,output); LABEL 9999; { used only to simulate a "halt" instruction } CONST bufsize=128; lf=12B; return=15B; formfeed=14B; controlbar=28; CTRLC=3; EnableInterrupt=100B; DataTerminalReady=2B; nonwaitmode=50100B; rcvvector=320B; xmtvector=324B; mask= 177B; { standard file descriptors. subscripts in open, etc. } STDIN = 1; { these are not to be changed } STDOUT = 2; STDERR = 3; lineout = 4; linein = 5; { other io-related stuff } IOERROR = 0; { status values for open files } IOAVAIL = 1; IOREAD = 2; IOWRITE = 3; MAXOPEN = 15; { 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 } { 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 *) (* SYSTEM DEPENDENT *) DEFEOL = CR; DEFEOLTYPE = 2; (* 1 = LineFeed 2 = CrLf 3 = Just Cr *) FLEN1 = 7; FLEN2 = 10; PFILE = 'KERMIT.PRM '; 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 indx=1..bufsize; bufferstatus=(empty,partuallyfilled,full); buffer=record getptr,putptr,count:indx; data:array[indx] of char end; character = -128..127; { byte-sized. ascii + other stuff } string = ARRAY [1..MAXSTR] OF character; vstring = RECORD len : integer; ch : ARRAY [1..MAXSTR] OF char; END; cstring = PACKED ARRAY [1..CONLENGTH] OF char; filedesc = IOERROR..MAXOPEN; ioblock = RECORD { to keep track of open files } filevar : text; mode : IOERROR..IOWRITE; END; (* 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 {UNIBUS addresses for remote port} rcvstatus origin 176520B:integer; rcvbuffer origin 176522B:integer; xmtstatus origin 176524B:integer; xmtbuffer origin 176526B:char; { rcvstatus origin 176510B:integer; rcvbuffer origin 176512B:integer; xmtstatus origin 176514B:integer; xmtbuffer origin 176516B:char; } breakchar:character; opencount:integer; done:boolean; jsw origin 44B:integer; xmtbuf,rcvbuf:buffer; bufferoverflow,finis,XOFFState:boolean; status:bufferstatus; ch:char; savepsw,flag:integer; XON,XOFF:char; EvenParity,HalfDuplex:boolean; TTYInputVector ORIGIN 60B:integer; TTYReadBuffer ORIGIN 177562B:char; SaveTTYInputVector:integer; SaveVECTOR:integer; CommandMode:BOOLEAN; openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files } cmdargs : 0..MAXCMD; cmdlin : string; cmdidx : ARRAY [1..MAXCMD] OF 1..MAXSTR; (* Varibles 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 *) OneWayOnly : boolean; (* used for testing *) Debug : boolean; 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 SCCA(var flag:integer);fortran; {SYSLIB routine for inhibiting Control C abort} {$C .TITLE SETINT} PROCEDURE SETINT(PROCEDURE NAME; VECTOR,PRIORITY:INTEGER); { Sets up a Pascal global procedure to process interrupts, where: NAME is the Pascal interrupt procedure VECTOR is the interrupt vector location PRIORITY(0-7) is the interrupt priority } TYPE CodeArray=ARRAY[1..9] OF integer; CodePtr=^CodeArray; VAR PrototypeCode,code:CodePtr; BEGIN new(code); {Allocate heap space for linkage code} priority:=priority*32; {Shift left 5 bits} {$C mov #pcode,prototypecode(6) ;initialize code pointer variable mov 10(6),pcode+10 ;insert procedure address in proto. code mov vector(6),%1 ;load R1 with vector address mov code(6),(1)+ ;set up vector to point to code loc in heap mov priority(6),(1) ;set up priority br over .globl $B75,$B77,$RESR5 pcode: ;prototype interrupt linkage code jsr %7,@#$B75 ;save registers mov @#$resr5,%5 ;initialize global data pointer(R5) jsr %7,@#. ;call Pascal procedure(address filled in later) jsr %7,@#$B77 ;restore registers rti over:} code^:=ProtoTypeCode^ {move prototype code to heap} END; {$C .TITLE IGETC} FUNCTION IGETC:CHAR; {Attemts to fetch a character from terminal input ring buffer using .TTYIN monitor request. A zero byte is returned if no character is available. The calling program must be running in the special TTY mode. For an example, see the program ECHO.} VAR c:char; BEGIN {$C emt ^O340 bcc 1$ clr %0 1$: movb %0,c(%6)} Igetc:=c END; {$C .title getcw} FUNCTION GETCW:char; { Reads a character from the console terminal in special mode. This has the following effects: 1. The Monitor does not echo the character. 2. CTRL/U and DELETE do not perform special functions. 3. Characters are immediately available to the program, i.e., it is not necessary to type carriage return. } CONST SpecialMode=10100B; NotSpecialMode=167677B; VAR c:char; jsw ORIGIN 44B:integer; BEGIN jsw:=jsw OR SpecialMode; REPEAT c:=Igetc UNTIL ord(c)<>0; getcw:=c; jsw:=jsw AND NotSpecialMode; END; PROCEDURE DISABLEINTERRUPTS; begin {$C .mcall .mfps,.mtps .mfps .mtps #^O340 mov (6)+,savepsw(5)} end; PROCEDURE ENABLEINTERRUPTS; begin {$C .mtps savepsw(5)} end; PROCEDURE RESETBUF(var b:buffer); {Initializes specified ring buffer} begin with b do begin getptr:=1; putptr:=1; count:=0; end; end; FUNCTION GETCHAR(var b:buffer; var s:bufferstatus):char; {Fetches a character from specified ring buffer} begin disableinterrupts; with b do begin if count=0 then s:=empty else begin getchar:=data[getptr]; getptr:=getptr+1; if getptr>bufsize then getptr:=1; count:=count-1; s:=partuallyfilled; end; end; enableinterrupts; end; PROCEDURE PutChar(c:char; var b:buffer; var s:bufferstatus); {Stores a character in specified ring buffer} BEGIN DisableInterrupts; With b DO BEGIN IF count=bufsize THEN s:=full ELSE BEGIN data[putptr]:=c; putptr:=putptr+1; IF putptr>bufsize THEN putptr:=1; count:=count+1; s:=PartuallyFilled; END; EnableInterrupts; END; {with} END; PROCEDURE RcvInt; {DL11 receive interrupt routine} VAR ch:char; status:bufferstatus; BEGIN ch:=chr(rcvbuffer AND mask); {Mask out parity bit} putchar(ch,rcvbuf,status); BufferOverflow:=status=full; END; PROCEDURE XMTINT; {DL11 transmit interrupt routine} VAR ch:char; status:bufferstatus; PROCEDURE GenerateEvenParity(VAR ch:char); VAR shifter:0..255; counter:0..7; i:1..7; BEGIN shifter:=ord(ch) AND 377B; counter:=0; FOR i:=1 TO 7 DO BEGIN IF odd(shifter) THEN counter:=counter+1; shifter:=shifter DIV 2; END; IF odd(counter) THEN ch:=chr(ord(ch) OR 200B) ELSE ch:=chr(ord(ch) AND 177B); END; {GenerateEvenParity} BEGIN ch:=getchar(xmtbuf,status); IF EvenParity THEN GenerateEvenParity(ch); IF status<>empty THEN xmtbuffer:=ch ELSE xmtstatus:=0; END; PROCEDURE XMTCHAR(ch:char); BEGIN PutChar(ch,xmtbuf,status); xmtstatus:=EnableInterrupt; END; PROCEDURE TTYInterrupt; VAR ch:char; status:BufferStatus; BEGIN ch:=TTYReadBuffer; IF (ord(ch)=CTRLC) THEN fromconsole:=ABORTNOW ELSE fromconsole:=CRIN; IF ord(ch)=BreakChar THEN FINIS:=true ELSE xmtchar(ch); IF HalfDuplex THEN putchar(ch,rcvbuf,status); END; PROCEDURE PerformXonXoffProtocol; BEGIN IF (rcvbuf.count>bufsize-100) AND NOT XOFFState THEN BEGIN XOFFState:=true; xmtchar(XOFF); END; IF (rcvbuf.count<100) AND XOFFState THEN BEGIN XOFFState:=false; xmtchar(XON); 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 openlist[STDIN].mode := IOREAD; openlist[STDOUT].mode := IOWRITE; openlist[STDERR].mode := IOWRITE; openlist[lineout].mode := IOWRITE; openlist[linein].mode := IOREAD; { connect STDERR to user's terminal ... } rewrite(openlist[STDERR].filevar, 'TT:'); { initialize rest of files } FOR i := linein+1 TO MAXOPEN DO openlist[i].mode := 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 (openlist[fd].mode <> IOREAD) THEN BEGIN writeln('called getcf without file.mode=IOREAD'); stiphalt; END; IF (fd = STDIN) THEN getcf := getc(c) ELSE IF eof(openlist[fd].filevar) THEN c := ENDFILE ELSE IF eoln(openlist[fd].filevar) THEN BEGIN readln(openlist[fd].filevar); c := NEWLINE END ELSE BEGIN read(openlist[fd].filevar, 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; { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } { putc (UCB) -- put one character on standard output } PROCEDURE putc (c : character); BEGIN IF c = NEWLINE THEN writeln ELSE write(chr(c)) END; { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } { putcf (UCB) -- put a single character on file fd } PROCEDURE putcf (c : character; fd : filedesc); BEGIN IF (fd = STDOUT) THEN putc(c) ELSE if (fd = lineout) then xmtchar(CHR(c)) ELSE IF c = NEWLINE THEN writeln(openlist[fd].filevar) ELSE write(openlist[fd].filevar, 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 (name : string; mode : integer) : filedesc; VAR i : integer; intname : PACKED ARRAY [1..MAXSTR] OF char; found : boolean; BEGIN i := 1; WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) DO BEGIN intname[i] := chr(name[i]); i := i + 1 END; FOR i := i TO MAXSTR 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 (openlist[i].mode = IOAVAIL) THEN BEGIN openlist[i].mode := mode; IF (mode = IOREAD) THEN reset(openlist[i].filevar, intname,,opencount) ELSE rewrite(openlist[i].filevar, intname); Sopen:=i; found := true END; i := i + 1 END END; PROCEDURE Sclose (fd : filedesc); BEGIN IF (fd > STDERR) AND (fd <= MAXOPEN) THEN BEGIN openlist[fd].mode := IOAVAIL; close(openlist[fd].filevar); 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 ENDFILE );} result := (opencount <> -1); Sclose(fd); Exists := result; 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; 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 TTYInputVector:=SaveTTYInputVector; prom := 'KERMIT-RT> '; (* Prompt *) PutCon(prom,STDOUT); dummy := getline(cmdlin,STDIN,MAXSTR); TTYInputVector:=SaveVector; 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; PROCEDURE Sleep((* Using *) t:integer); (* pause for t seconds *) BEGIN 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; FUNCTION GetIn (* Returning *) :character; (* get character *) (* Should return NULL (ENDSTR) if no characters *) VAR c :character; BEGIN c := ord(getchar(rcvbuf,status)); if (status=empty) then c:=endstr; GetIn := c; if (debug) and (status<>empty) then WRITELN('R: ',CHR(C)); IF (RunType = Receive) AND (c <> ENDSTR) THEN AddTo(ChInPack,1); 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 SYSinit; (* special initialization *) BEGIN breakchar:=controlbar; resetbuf(xmtbuf); resetbuf(rcvbuf); flag:=0; scca(flag); {Inhibit control C abort} finis:=false; XOFFState:=false; XON:=chr(21B); XOFF:=chr(23B); rcvstatus:=(EnableInterrupt or DataTerminalReady); setint(rcvint,rcvvector,7); setint(xmtint,xmtvector,7); EvenParity:=false; HalfDuplex:=false; SaveTTYInputVector:=TTYInputVector; SetInt(TTYInterrupt,60B,7); SaveVector:=TTYInputVector; CommandMode:=false; 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; CASE DEFEOLTYPE OF 1: EOLforFile := LineFeed; 2: EOLforFile := CrLf; 3: EOLforFile := JustCR; END (* case *); CtoS(PFILE,ParmFile); GetParm; Local := false; (* default to remote *) END; PROCEDURE SYSfinish; (* System dependent *) BEGIN rcvstatus:=rcvstatus and not EnableInterrupt; xmtstatus:=xmtstatus and not EnableInterrupt; TTYInputVector:=SaveTTYInputVector; END; PROCEDURE SYSarguments; (* process special arguments for SYSTEM *) BEGIN (* nothing *) END; PROCEDURE StartRun; (* initialization as necessary *) BEGIN RunTime := 0; END; PROCEDURE Connect; (* connect to remote *) BEGIN finis:=false; REPEAT PerformXonXoffProtocol; ch:=getchar(rcvbuf,status); {From time-sharing system} IF status<>empty THEN WriteCharacter; UNTIL finis; END; PROCEDURE Usage; (* Print writeln & exit *) BEGIN writeln; writeln('usage: KERMIT-RT> [Help] [Connect] [Send/Receive/Print] [Exit]'); 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 / only valid if local *) 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); SYSfinish; (* do System dependent *) (* print info on number of packets etc *) IF ((RunType <> Invalid) AND local ) THEN BEGIN PutCon('Packets sent: ',STDERR); PutNum(NumSendPacks,STDERR); PutCon('Packets received ',STDERR); PutNum(NumRecvPacks,STDERR); (* Calculate overhead *) OverHd(ChInPack,ChInFile,overhead); IF (Overhead <>0) THEN BEGIN PutCon('Overhead (%): ' ,STDERR); PutNum(overhead,STDERR); END; IF (RunTime <> 0) THEN BEGIN (* calculate effective rate *) CalRat(ChInFile,RunTime,effrate); PutCon('Effective Rate: ',STDERR); PutNum(effrate,STDERR); END; IF (RunType = Transmit) THEN BEGIN PutCon('Number of ACK: ',STDERR); PutNum(NumACKrecv,STDERR); PutCon('Number of NAK: ',STDERR); PutNum(NumNAKrecv,STDERR); PutCon('Number of BAD: ',STDERR); PutNum(NumBADrecv,STDERR); END ELSE BEGIN (* for Receive *) PutCon('Number of ACK: ',STDERR); PutNum(NumACK,STDERR); PutCon('Number of NAK: ',STDERR); PutNum(NumNAK,STDERR); END; putcf(NEWLINE,STDERR); END; END; PROCEDURE DebugPacket((* Using *) mes : cstring; (* Using *) VAR p : Ppack); (* Print Debugging Info *) BEGIN PutCon(mes,STDERR); WITH Buf[p] DO BEGIN PutNum(Unchar(count),STDERR); PutNum(Unchar(seq),STDERR); putcf(BLANK,STDERR); putcf(ptype,STDERR); putcf(NEWLINE,STDERR); putstr(data,STDERR); putcf(NEWLINE,STDERR); 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 Local THEN PutCon(c,STDERR) ELSE BEGIN WITH Buf[ThisPacket] DO BEGIN seq := n; ptype := TYPEE; CtoS(c,data); count := length(data); END; SendPacket; END; FinishUp; END; PROCEDURE Verbose((* Using *) c:cstring); (* Print writeln if verbosity *) BEGIN IF Verbosity THEN PutCon(c,STDERR); END; PROCEDURE PutErr((* Using *) c:cstring); (* Print error_messages *) BEGIN IF Local THEN PutCon(c,STDERR); 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 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 IF Local THEN putstr(data,STDERR); FinishUp; SendACK(n); (* send ACK *) END; NumRecvPacks := NumRecvPacks+1; IF Debug THEN BEGIN DebugPacket('Received ... ',InputPacket); IF good THEN PutCon('Is Good ',STDERR); END; temp := CurrentPacket; CurrentPacket := NextPacket; NextPacket := temp; END; END; END; END; FUNCTION ReceivePacket: boolean; BEGIN WITH PackControl DO BEGIN StartTimer; finished := false; restart := true; FromConsole := nothing; (* No Interupt *) REPEAT t := GetIn; 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 PutErr('Timed Out '); FinishUp; 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; WRITE(' SENDING...'); putstr(data,stdout); IF DiskFile <= IOERROR THEN ErrorPack('Cannot open file '); result := false; 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,STDERR) ELSE putstr(Buf[LastPacket].data,STDERR); 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 ',STDERR); PutNum(n,STDERR); 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 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) ); 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 ... ',STDERR); putstr(data,STDERR); 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 ',STDERR); putstr(data,STDERR); PutCon('Creating ... ',STDERR); CtoS(TEMPFILE,data); strend := 0; REPEAT strend := strend +1; UNTIL (data[strend] = BLANK); strend := itoc(n,data,strend); putstr(data,STDERR); 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 ',STDERR); 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); IF Local THEN putstr(packetnum,STDERR); 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) ',STDERR); PutNum(Buf[CurrentPacket].seq,STDERR); 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 *) 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) ',STDERR); PutNum(seq,STDERR); END; WRITE(' RECEIVING...'); 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 ',STDERR); SendNAK(n); END; END; END; END; PROCEDURE RecvSwitch; (* this procedure is the main receive routine *) BEGIN State := Init; NumTry := 0; 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 ); END; BEGIN initio; SYSinit; (* system dependent *) done:=false; 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]=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 connect; 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-RT Comands:'); WRITELN; WRITELN('C [H/F/D/V] - Connect [Half/Full duplex,Debug,Verbose]'); Writeln('S {} - Send files'); Writeln('R {} - Receive files'); Writeln('P {} - 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; 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 '); IF Local THEN putstr(aline,STDERR); 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 *) 9999: END.