home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
c
/
pqkerm.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
93KB
|
2,973 lines
(* <<<Connect232.Pas>>> *)
MODULE Connect232 ;
(*)
* A communications routine via the RS232 line to another host.
* Parameters are:
*
* EscChar The "escape" character, when this character is read
* from the keyboard return to caller.
* HalfDuplex The state of the host's connection, if HalfDuplex is
* true echo the keyboard characters locally.
* TabletOk If true, the yellow button on the puck causes an
* exit too.
5-Oct-83. Change cursor shape and allow ANY puck button
to cause an exit.
* RETURN: ConCharExit if <EscChar> caused exit,
* ConButtonExit for puck button.
(*)
EXPORTS (*-------------*)
IMPORTS IO_Unit FROM IO_Unit;
IMPORTS IOErrors FROM IOErrors;
TYPE
(* What caused "Connect" to exit *)
ConExitFlag = (ConCharExit, ConButtonExit) ;
FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
PRIVATE (*---------------*)
IMPORTS Screen FROM Screen ;
IMPORTS System FROM System ;
IMPORTS IO_Others FROM IO_Others;
FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
CONST
NUL = Chr(#000) ;
BS = Chr(#010) ;
TAB = Chr(#011) ;
LF = Chr(#012) ;
CR = Chr(#015) ;
CtrlQ = Chr(#021) ;
CtrlS = Chr(#023) ;
VAR
hpos: Integer ; (* current position in the line (for tabs) *)
oldX, oldY: Integer ; (* Old cursor offsets *)
quit: Boolean ; (* loop control *)
LineChr, KeyChr: Char; (* current RS232 and keyboard characters *)
OldCurs, NewCurs: CurPatPtr ; (* Old and New cursors (if TabletOk) *)
return: ConExitFlag ; (* the exit flag *)
PROCEDURE WriteChr( c: Char ) ;
BEGIN
SPutChr( c ) ;
Hpos := Hpos + 1
END ;
HANDLER CtlC ;
BEGIN
END ;
BEGIN (*-Connect-*)
(* Allocate cursor space *)
New( 0, 4, NewCurs) ;
New( 0, 4, OldCurs) ;
(* Clear the cursor area *)
RasterOp(RXor, 64, 64, 0, 0, 4, RECAST(NewCurs, RasterPtr),
0, 0, 4, RECAST(NewCurs, RasterPtr) ) ;
(* Cursor values from file: Connect3.Cursor *)
NewCurs^[ 0,0] := #40 ;
NewCurs^[ 1,0] := #120 ;
NewCurs^[ 1,1] := #1642 ;
NewCurs^[ 1,2] := #167000 ;
NewCurs^[ 2,0] := #210 ;
NewCurs^[ 2,1] := #1024 ;
NewCurs^[ 2,2] := #42000 ;
NewCurs^[ 3,0] := #404 ;
NewCurs^[ 3,1] := #1610 ;
NewCurs^[ 3,2] := #42000 ;
NewCurs^[ 4,0] := #1002 ;
NewCurs^[ 4,1] := #1024 ;
NewCurs^[ 4,2] := #42000 ;
NewCurs^[ 5,0] := #404 ;
NewCurs^[ 5,1] := #1642 ;
NewCurs^[ 5,2] := #162000 ;
NewCurs^[ 6,0] := #2211 ;
NewCurs^[ 7,0] := #5122 ;
NewCurs^[ 7,1] := #100000 ;
NewCurs^[ 8,0] := #10444 ;
NewCurs^[ 8,1] := #40000 ;
NewCurs^[ 9,0] := #20210 ;
NewCurs^[ 9,1] := #20000 ;
NewCurs^[10,0] := #40120 ;
NewCurs^[10,1] := #10000 ;
NewCurs^[11,0] := #20210 ;
NewCurs^[11,1] := #20000 ;
NewCurs^[12,0] := #10444 ;
NewCurs^[12,1] := #40000 ;
NewCurs^[13,0] := #5122 ;
NewCurs^[13,1] := #100000 ;
NewCurs^[14,0] := #2211 ;
NewCurs^[15,0] := #404 ;
NewCurs^[16,0] := #1002 ;
NewCurs^[17,0] := #404 ;
NewCurs^[18,0] := #210 ;
NewCurs^[19,0] := #120 ;
NewCurs^[20,0] := #40 ;
(* Debug :- %)
Writeln('TabletOk = ', TabletOk) ;
(% Debug *)
SCurOn ; (* ? *)
(* Set up our cursor, or turn the cursor off if we can't use a cursor *)
IF TabletOk THEN
BEGIN
IOReadCursPicture( OldCurs, oldX, oldY ) ;
IOLoadCursor( NewCurs, 0, 0) ;
IOSetModeTablet( relTablet ) ;
IOCursorMode( TrackCursor )
END
ELSE
IOCursorMode( OffCursor ) ; (* Turn it off *)
return := ConCharExit ; (* Assume the exit by escape char *)
quit := False ;
WHILE NOT quit DO
BEGIN
(*---------- RS232 Input ----------*)
IF (IOCRead(RS232In, LineChr)=IOEIOC) THEN
BEGIN
LineChr := Chr( Land( Ord(LineChr), #177) ) ;
IF (LineChr = TAB) THEN
BEGIN
WriteChr( ' ' ) ;
WHILE (Hpos MOD 8) <> 0 DO WriteChr( ' ' )
END
ELSE
IF (LineChr = BS) THEN
BEGIN
IF Hpos > 0 THEN
BEGIN (* Delete the character *)
SBackSpace( ' ' );
SPutChr( ' ' ) ;
SBackSpace( ' ' ) ;
Hpos := Hpos - 1
END
END
ELSE
IF (LineChr IN [NUL, CtrlS, CtrlQ]) THEN (* NOTHING *)
ELSE
WriteChr( LineChr ) ; (* write it *)
IF (LineChr IN [CR, LF]) THEN Hpos := 0 ; (* a new line *)
END ; (* RS232 input *)
(*---------- Keyboard Input ----------*)
IF (IOCRead(TransKey, KeyChr)=IOEIOC) THEN
BEGIN
IF (KeyChr = EscChar) THEN
BEGIN
quit := True
END
ELSE
BEGIN
IF IOCWrite(RS232Out, KeyChr)<>IOEIOC THEN
KeyChr := Chr(#277) ;
IF HalfDuplex THEN WriteChr( KeyChr )
END
END ; (* Keyboard input *)
(*---------- Tablet Input ----------*)
IF TabletOk AND TabSwitch THEN
BEGIN
return := ConButtonExit ;
quit := True
END
END ; (* while *)
(* Restore cursor *)
IF TabletOk THEN IOLoadCursor( OldCurs, oldX, oldY )
ELSE IOCursorMode( TrackCursor ) ; (* I assume it was originally on *)
Dispose( NewCurs ) ;
Connect := return
END . (*-Connect-*)
(* <<<Kermit.Pas>>> *)
PROGRAM Kermit(Input,Output);
(*)
* 29-Nov-83 Allow eight bit file transfer with SET EIGHT-BIT ON/OFF
* add global flag and extra SET command [pgt001]
* For byte value 0..255 the end of (data) string value is now -1,
* and end of file value -2.
* 1-Dec-83 Place all globals into module KermitGlobals.
(*)
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitGlobals FROM KermitGlobals ; (**********)
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS KermitParms FROM KermitParms ;
IMPORTS KermitHelp FROM KermitHelp ;
IMPORTS KermitError FROM KermitError ;
IMPORTS KermitSend FROM KermitSend ;
IMPORTS KermitRecv FROM KermitRecv ;
IMPORTS Connect232 FROM Connect232 ;
IMPORTS PMatch FROM PMatch ;
IMPORTS PopCmdParse FROM PopCmdParse ;
IMPORTS Perq_String FROM Perq_String ;
IMPORTS Screen FROM Screen ;
IMPORTS IO_Unit FROM IO_Unit ;
IMPORTS IOErrors FROM IOErrors;
IMPORTS IO_Others FROM IO_Others;
IMPORTS System FROM System;
IMPORTS Sleep FROM Sleep;
(* Handle ^C's from the console -pt*)
HANDLER CtlC ;
BEGIN (*-CtlC-*)
IOKeyClear ; (* Remove ^C from input stream *)
CtrlCPending := False ; (* Clear to prevent next ^C from aborting job *)
FromConsole := AbortNow (* Set our flag *)
END ; (*-CtlC-*)
HANDLER HelpKey(VAR str: Sys9s) ;
(* Make the HELP key generate the correct command (i.e. not a switch) -pt*)
BEGIN (*-HelpKey-*)
str := 'HELP ' ;
str[5] := Chr( CR )
END ; (*-HelpKey-*)
PROCEDURE OverHd( p,f: Stats;
VAR o:Integer);
(* Calculate OverHead as % *)
(* OverHead := (p-f)*100/f *)
BEGIN
IF (f = 0.0) THEN o := 0
ELSE o := Round( (p-f)*100/f )
END;
PROCEDURE CalRat(f: Stats;
t:Integer;
VAR r:Integer);
(* Calculate Effective Baud Rate *)
(* Rate = f*10/t *)
BEGIN
IF (t = 0) THEN r := 0
ELSE r := Round( f*10/t )
END;
PROCEDURE Statistics ;
VAR
overhead, effrate : Integer;
BEGIN (*-Statistics-*)
(* print info on number of packets etc *)
(* All output here was originally to STDERR -pt*)
Writeln ;
Writeln('Packets sent: ',NumSendPacks:1);
Writeln('Packets received: ',NumRecvPacks:1);
(* Calculate overhead *)
OverHd(ChInPack,ChInFile,overhead);
IF (Overhead <> 0) THEN
BEGIN
Writeln('Overhead (%): ' ,overhead:1);
END;
IF (RunTime <> 0) THEN
BEGIN (* calculate effective rate *)
CalRat(ChInFile,RunTime,effrate);
Writeln('Effective Rate: ',effrate:1);
END;
(* Transmit stats *)
Inverse( TRUE ) ;
Writeln(' Send :-') ;
Inverse( FALSE ) ;
Writeln('Number of ACK: ',NumACKrecv:1);
Writeln('Number of NAK: ',NumNAKrecv:1);
Writeln('Number of BAD: ',NumBADrecv:1);
(* Transmit stats *)
Inverse( TRUE ) ;
Writeln(' Receive :-') ;
Inverse( FALSE ) ;
Writeln('Number of ACK: ',NumACK:1);
Writeln('Number of NAK: ',NumNAK:1);
Writeln
END ; (*-Statistics-*)
PROCEDURE FinishUp; (* do any End of Program clean up *)
BEGIN
Sclose(DiskFile);
SYSfinish; (* do System dependent *)
END;
PROCEDURE DoConnect ;
(* Connect to the other host -pt*)
VAR
whyExit: ConExitFlag ; (* Why "connect" exited *)
ch: Char ; (* the character after the "escape" char *)
BEGIN (*-DoConnect-*)
Writeln('[Connecting to host. Type Control-', EscPrint,
' C or any button on the puck]') ;
REPEAT
whyExit := Connect( EscapeChar, HalfDuplex, TRUE) ;
(* Get the command *)
IF (whyExit = ConButtonExit) THEN (* the button was pressed *)
BEGIN
Nap( 10 ) ;
ch := 'C' (* Close the connection *)
END
ELSE
WHILE (IOCRead(TransKey, ch) <> IOEIOC) DO ;
IF (ch = EscapeChar) THEN XmtChar( EscapeChar )
ELSE
IF (ch = '?') THEN
BEGIN
Writeln ;
Writeln('When CONNECT''ed to another host, type Control-', EscPrint) ;
Writeln('followed by :-') ;
Writeln(' C to close the connection') ;
Writeln(' ^', EscPrint, ' to send that character') ;
Writeln(' ? for this information') ;
Writeln('[Back to host]')
END (* help *)
UNTIL (Uppercase(ch) = 'C') ;
Writeln ;
Writeln('[Connection closed. Returning to PERQ]')
END ; (*-DoConnect-*)
BEGIN
StdIOInit;
SYSinit; (* system dependent *)
done:=False;
Writeln ;
REPEAT
KermitInit; (* initialize *)
WHILE NOT (RunType IN [transmit, receive, setparm]) AND (NOT done)
DO
BEGIN
CmdIndex := GetCmdLine(NullIdleProc, 'Kermit-PQ',
CmdLine, CmdSpelling,
Inf, RECAST(MainMenu, pNameDesc),
firstPress, OK_to_pop) ;
ConvUpper( CmdSpelling ) ; (* Make it upper case *)
(* see what the command was *)
CASE CmdIndex OF
1: DoConnect ; (* CONNECT *)
2: done := True ; (* EXIT *)
3: DoHelp ; (* HELP *)
4: done := True ; (* QUIT *)
5: RunType := Receive ; (* RECEIVE *)
6: RunType := Transmit; (* SEND *)
7: RunType := SetParm ; (* SET *)
8: DoShow ; (* SHOW *)
9: Statistics ; (* STATISTICS *)
10: Writeln('%Not a KERMIT command: ', CmdSpelling) ;
11: Writeln('%Ambiguous command: ', CmdSpelling) ;
12: (* empty line *) ;
13: Writeln('%KERMIT does not take switches, type HELP.');
14: Writeln('?Illegal character after command') ; (* ?? *)
OTHERWISE: Writeln('?Unknown command: ', CmdSpelling)
END (* case *)
END;
CASE RunType OF
Receive:
BEGIN (* filename is optional here *)
(* Remove blanks from the cmd line *)
IF (CmdLine <> '') THEN RemDelimiters( CmdLine, ' ', dumStr) ;
IF GetArgument(aline) THEN
BEGIN
IF Exists(aline) AND FileWarning THEN
BEGIN
ErrorMsg('Overwriting: ');
ErrorStr(aline);
END;
IF EightBitFile THEN (* [pgt001] *)
DiskFile := Sopen(aline,StdIO8Write)
ELSE
DiskFile := Sopen(aline,StdIOWrite);
IF (DiskFile <= StdIOError) THEN
ErrorPack('Cannot Open File');
END;
RecvSwitch;
END;
Transmit:
BEGIN (* New version -pt*)
(* must give file name, so ask if one was not given -pt*)
IF (CmdLine = '') THEN
BEGIN
Write('File to transmit ', PromptChar) ;
Readln( CmdLine ) (* get the response *)
END ;
(* What shall we do with the line ? *)
(* First remove blanks *)
RemDelimiters( CmdLine, ' ', dumStr) ;
IF (CmdLine = '') THEN (* another empty line, do nothing *)
ELSE
IF IsPattern(CmdLine) THEN
Writeln('%SEND does not take wild file names')
ELSE
SendSwitch (* SendFile checks parameters - file exists *)
END;
Invalid: (* nothing *);
SetParm: SetParameters ;
END;
(* case *)
UNTIL done;
FinishUp; (* End of Program *)
ScreenReset (* Clear up screen data *)
END.
(* <<<KermitError.Pas>>> *)
MODULE KermitError ;
EXPORTS
IMPORTS KermitGlobals FROM KermitGlobals ;
PROCEDURE ErrorMsg(msg:MsgString ) ;
PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
PROCEDURE ErrorStr( str: istring ) ;
PROCEDURE DebugPacket(mes : MsgString;
VAR p : Ppack);
PROCEDURE Verbose(c:MsgString);
PRIVATE
IMPORTS Screen FROM Screen ;
PROCEDURE ErrorMsg(msg:MsgString ) ;
(* output literal preceeded by NEWLINE *)
(* to the PERQ error window -pt*)
BEGIN (*-ErrorMsg-*)
ChangeWindow( ErrorWindow ) ;
Writeln ;
Write( msg ) ;
ChangeWindow( KermitWindow )
END; (*-ErrorMsg-*)
PROCEDURE ErrorInt( msg:MsgString; n: Integer ) ;
(* Output a number preceeded by a message *)
(* to the PERQ error window -pt*)
BEGIN (*-ErrorInt-*)
ChangeWindow( ErrorWindow ) ;
Writeln ;
Write( msg, n:1 ) ;
ChangeWindow( KermitWindow )
END; (*-ErrorInt-*)
PROCEDURE ErrorStr( str: istring ) ;
(* Output a "istring" to the error window *)
VAR i: Integer ;
BEGIN (*-ErrorStr-*)
ChangeWindow( ErrorWindow ) ;
i := 1 ;
WHILE str[i] <> ENDSTR DO
BEGIN
IF (str[i] = LF) THEN Writeln
ELSE Write( Chr(str[i]) ) ;
i := i + 1
END ;
ChangeWindow( KermitWindow )
END ; (*-ErrorStr-*)
PROCEDURE DebugPacket(mes : MsgString;
VAR p : Ppack);
(* Print Debugging Info, into the error window -pt*)
VAR
i: Integer ; (* index into data field -pt*)
BEGIN (*-DebugPacket-*)
ChangeWindow( ErrorWindow ) ; (* Print all this in error window -pt*)
Writeln ;
Write(mes);
WITH Buf[p] DO
BEGIN
Write( '(count:', count-#40:1 ) ; (* local "UnChar" *)
Write( ') (seq:', seq-#40:1 ) ;
Writeln( ') (type:', Chr(ptype), ')' );
(* Write out the data field, straight to the screen -pt*)
i := 1 ;
WHILE (data[i] <> ENDSTR) DO
BEGIN
Write( Chr(data[i]) ) ;
i := i + 1
END ;
Writeln ;
(* done -pt*)
END;
ChangeWindow( KermitWindow ) (* back to kermit -pt*)
END; (*-DebugPacket-*)
PROCEDURE Verbose(c:MsgString);
(* Print writeln if verbosity *)
BEGIN
IF Verbosity THEN ErrorMsg(c);
END.
(* <<<KermitGlobals.Pas>>> *)
MODULE KermitGlobals;
(*)
* 1-Dec-83.
* Split the Kermit program file into: KermitGlobals which contains all
* global information, and Kermit.Pas which is the main program file.
* this allow all the kermit modules to be used by any other program.
(*)
EXPORTS
IMPORTS CmdParse FROM CmdParse ;
IMPORTS SystemDefs FROM SystemDefs ;
CONST
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
KermitWindow = 1 ; (* Window numbers - See SysInit for their creation -pt*)
ErrorWindow = 2 ; (* An error window for all messages and errors -pt*)
FF = Chr(#014) ; (* A form feed to clear the windows -pt*)
PromptChar = Chr(#032) ; (* PERQ character set: grey arrow head -pt*)
OK_to_Pop = True ; (* Allow pop-up menus -pt*)
MaxPopCmds = 10 ; (* Maximum pop-up commands -pt*)
SetCount = 7 ; (* Number of SET commands [pgt001]*)
SetNot = SetCount+1 ; (* Non-SET command index *)
SetAmbig = SetCount+2; (* Ambiguous SET command *)
ShowCount = SetCount+1;(* SET commands plus 'ALL' *)
ShowNot = ShowCount+1 ;
ShowAmbig = ShowCount+2 ;
MainCount = 9 ;
MainNot = MainCount+1 ;
MainAmbig = MainCount+2 ;
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
return = #015 ;
formfeed = #014 ;
controlbar = 28;
{ universal manifest constants }
ENDSTR = -1; (* End-of-string value [pgt001] *)
MAXSTR = 100; { longest possible string }
MsgLength = 20; { length of message string -pt}
{ ascii character set in decimal }
BACKSPACE = 8;
TAB = 9;
lf = #012 ; (* Line feed/new line *)
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 *)
DEFEOL = CR ; (* default eoln *)
DEFTRY = 10; (* default for number of retries *)
DEFTIMEOUT = 12; (* default time out *)
MAXPACK = 94; (* max is 94 ~ - ' ' *)
DEFDELAY = 1; (* 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 *)
NumBuffers = 5; (* Number of packet 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') *)
TYPE
CharBytes = -2..255; (* full 8-bits, with -1 == end-of-string [pgt001]*)
istring = ARRAY [1..MAXSTR] OF CharBytes;
MsgString = String[ MsgLength ]; (* String for various messages -pt*)
(* Data Types for Kermit *)
Packet = RECORD
mark : CharBytes; (* SOH character *)
count: CharBytes; (* # of bytes following this field *)
seq : CharBytes; (* sequence number modulo 64 *)
ptype: CharBytes; (* d,y,n,s,b,f,z,e,t packet type *)
data : istring; (* the actual data *)
(* chksum is last validchar in data array *)
(* eol is added, not considered part of packet proper *)
END;
KermitCommand = (Transmit,Receive,SetParm,Invalid);
KermitStates = (FileData,Init,Break,FileHeader,EOFile,Complete,Abort);
Stats = Real ; (* Statistic counting -pt*)
Ppack = 1..NumBuffers;
CType = RECORD
check: Integer;
PacketPtr : Integer;
i : Integer;
fld : Integer;
t : CharBytes;
finished : Boolean;
restart : Boolean;
control : Boolean;
good : Boolean;
END;
InType = (abortnow,nothing,CRin);
(* Data types for pop-up menus *)
MyCmds = ARRAY [1..MaxPopCmds] OF String[25] ; (* Menu strings *)
MyMenu = RECORD
Head: String[25] ;(* Heading *)
numcmds: Integer ;(* Number of commands *)
cmd: MyCmds (* The actual commands *)
END ;
MyMenuPtr = ^MyMenu ;
VAR
done:Boolean;
bufferoverflow, finis, XOFFState:Boolean;
ch:Char;
XON, XOFF:Char;
(* Variables for commands *)
CmdSpelling, CmdLine: CString ; (* the command and rest of line *)
CmdIndex: Integer ; (* Index from command parser *)
Inf: pCmdList ; (* Command file pointer *)
firstPress: Boolean ;(* Inital call to command parser *)
(* Variables for pop-up menus *)
MainMenu, (* Main Kermit menu *)
SetMenu: MyMenuPtr ; (* SET commands *)
OnOff: CmdArray ; (* For the SET feature ON/OFF *)
(* SET variables *)
EscapeChr: Char ; (* CONNECT 'escape' character -pt*)
EscPrint : Char ; (* Printable verion of this character -pt*)
BaudRate : String ;
FileWarning: Boolean ;
HalfDuplex:Boolean;
Verbosity: Boolean; (* true to print verbose messages *)
Debug : Boolean;
EightBitFile: Boolean ; (* 8-bit flag [pgt001]*)
(* Varibles for Kermit *)
dumStr : String ;(* Dummy string -pt*)
dumCh: Char ; (* A dummy character -pt*)
aline : istring;
DiskFile : Integer;(* Should be "filedesc" -pt*)
SaveState: kermitstates;
MaxTry : Integer;
n,J : Integer; (* packet number *)
NumTry : Integer; (* times this packet retried *)
OldTry : Integer;
NumPad : Integer; (* padding to send *)
MyPad : Integer; (* number of padding characters I need *)
PadChar : CharBytes;
MyPadChar: CharBytes;
RunType : KermitCommand;
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 : CharBytes;
myEOL,myQuote: CharBytes;
NumSendPacks : Integer;
NumRecvPacks : Integer;
NumACK : Integer;
NumNAK : Integer;
NumACKrecv : Integer;
NumNAKrecv : Integer;
NumBADrecv : Integer;
RunTime: Integer;
ChInFile, ChInPack : Stats;
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 *)
OldTime : Double ; (* Clock time -pt*)
TimeLeft : Integer; (* until Time_Out *)
FromConsole : InType;(* Input from Console during receive *)
PackControl : CType; (* variables for receive packet routine *)
PROCEDURE SYSinit; (* special initialization *)
PROCEDURE SYSfinish; (* System dependent *)
PROCEDURE KermitInit;(* initialize various parameters & defaults *)
PROCEDURE ErrorPack(c:MsgString);
(* Send the other host the an error packet with mesage <c> -pt*)
EXCEPTION GotErrorPacket(VAR ErrorMsg: istring) ;
(*)
* This is used when procedure "BuildPacket" receives an error packet
* from the other Host. Handlers in procedures "RecvSwitch" and
* "SendSwitch" are used to abort the current RECEIVE/SEND command
* and close any disk files open.
(*)
PRIVATE
IMPORTS Screen FROM Screen ;
IMPORTS PopCmdParse FROM PopCmdParse ;
IMPORTS IO_Others FROM IO_Others ;
IMPORTS RS232Baud FROM RS232Baud ;
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS KermitSend FROM KermitSend ;
PROCEDURE SYSinit; (* special initialization *)
BEGIN
Writeln( FF ) ; (* Clear the entire screen *)
(*---------- PERQ ----------*)
(* Create the windows *)
CreateWindow(KermitWindow, 0, 0, 767, 700,
'PERQ Kermit, Version 2.0') ;
(* A cursor for the Kermit window *)
SCurChr( Chr(#177) ) ; (* A black rectangle *)
SCurOn ; (* Turn it on *)
CreateWindow(ErrorWindow, 0, 701, 767, 322, 'Error and Message Window') ;
ChangeWindow( KermitWindow ) ;
(* Create pop-up menus *)
New(MainMenu) ;
WITH MainMenu^ DO
BEGIN
Head := 'Kermit' ;
numcmds := MainCount ;
cmd[1] := 'CONNECT' ;
cmd[2] := 'EXIT' ;
cmd[3] := 'HELP' ;
cmd[4] := 'QUIT' ;
cmd[5] := 'RECEIVE' ;
cmd[6] := 'SEND' ;
cmd[7] := 'SET' ;
cmd[8] := 'SHOW' ;
cmd[9] := 'STATISTICS' ;
END ; (* with main menu *)
(* ON or OFF *)
OnOff[1] := 'ON' ;
OnOff[2] := 'OFF' ;
New(SetMenu) ;
WITH SetMenu^ DO
BEGIN
Head := 'SET commands' ;
numcmds := SetCount ; (* 7 if we include "ALL" for SHOW cmd *)
cmd[1] := 'SPEED' ;
cmd[2] := 'DEBUG' ;
cmd[3] := 'ESCAPE' ;
cmd[4] := 'WARNING' ;
cmd[5] := 'LOCAL' ;
cmd[6] := 'VERBOSE' ;
cmd[7] := 'EIGHT-BIT' ; (* [pgt001] *)
cmd[8] := 'ALL' ; (* <<<< *)
END ; (* with SET menu *)
(* other initialisation *)
InitCmdFile(Inf, 0) ;
InitPopUp ;
IOCursorMode( TrackCursor ) ;
firstPress := True ;
(*---------- KERMIT ----------*)
finis:=False;
XOFFState:=False;
XON:=Chr(#021); XOFF:=Chr(#023);
(* SET values -pt*)
EscapeChr := Chr(#034) ; (* CONNECT escape character ^\ *)
EscPrint := '\' ; (* Printable version *)
BaudRate := '9600' ;
SetBaud( '9600', True ) ;
HalfDuplex:=False ;
Verbosity := False; (* default to false / only valid if local *)
Debug := False;
EightBitFile := False ; (* [pgt001] *)
FileWarning := False ;
(* Statistic counters *)
NumSendPacks := 0;
NumRecvPacks := 0;
NumACK := 0;
NumNAK := 0;
NumACKrecv := 0;
NumNAKrecv := 0;
NumBADrecv := 0;
ChInFile := 0.0; (* Statsistics are now reals. -pt*)
ChInPack := ChInFile;
(* Other values *)
NumPad := 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;
END;
PROCEDURE SYSfinish; (* System dependent *)
BEGIN
Writeln( FF ) ;
Dispose( MainMenu ) ;
Dispose( SetMenu ) ;
DstryCmdFile( Inf ) ;
END;
PROCEDURE KermitInit; (* initialize various parameters & defaults *)
BEGIN
n := 0;
RunType := invalid;
DiskFile := StdIOError; (* 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;
FROMCONSOLE:=NOTHING;
END;
PROCEDURE CtoS(x:MsgString; VAR s:istring);
(* convert constant to STIP string *)
VAR
i : Integer;
BEGIN
FOR i:=1 TO Length(x) DO
s[i] := Ord(x[i]);
s[Length(x)+1] := ENDSTR;
END;
PROCEDURE ErrorPack(c:MsgString);
(* output Error packet if necessary -- then exit *)
BEGIN
WITH Buf[ThisPacket] DO
BEGIN
seq := n;
ptype := TYPEE;
CtoS(c,data);
count := ilength(data);
END;
SendPacket;
Writeln('%Message to other Host: ', c)
END.
(* <<<KermitHelp.Pas>>> *)
MODULE KermitHelp ;
EXPORTS
PROCEDURE DoHelp ;
PRIVATE
IMPORTS KermitUtils FROM KermitUtils ;
PROCEDURE DoHelp ;
(*)
* Print out the Kermit help info. Use the utilities to write the
* commands in inverse video.
(*)
BEGIN (*-DoHelp-*)
Writeln( Chr(#014) ) ; (* Clear the screen *)
Inverse( TRUE ) ; Writeln(' CONNECT'); Inverse( FALSE ) ;
Writeln('Connect the PERQ to another host. This allows you to log into other');
Writeln('systems.');
Inverse( TRUE ) ; Writeln(' EXIT'); Inverse( FALSE ) ;
Writeln('Exit from KERMIT back to the PERQ operating system.');
Inverse( TRUE ) ; Writeln(' HELP'); Inverse( FALSE ) ;
Writeln('Print instructions on various commands available in KERMIT.');
Inverse( TRUE ) ; Writeln(' QUIT'); Inverse( FALSE ) ;
Writeln('Same as EXIT.');
Inverse( TRUE ) ; Writeln(' RECEIVE <optional file-name>'); Inverse( FALSE ) ;
Writeln('Receive a file group from the remote host. If an incoming file name');
Writeln('is not legal, then attempt to transform it to a similar legal name,');
Writeln('e.g. by deleting illegal or excessive characters. If the file');
Writeln('already exists, it will be superceded unless WARNING is ON.');
Inverse( TRUE ) ; Writeln(' SEND <file-specification>'); Inverse( FALSE ) ;
Writeln('Sends a file from the PERQ to the remote host. The name of the file');
Writeln('is passed to the remote host in a special control packet, so that the');
Writeln('remote host can store it with the same name. Wildcards are not yet');
Writeln('supported.');
Inverse( TRUE ) ; Writeln(' SET <keyword>'); Inverse( FALSE ) ;
Writeln('Change various system-dependent parameters. For a list of keywords,');
Writeln('type SET ?.');
Inverse( TRUE ) ; Writeln(' SHOW <keyword>'); Inverse( FALSE ) ;
Writeln('Display various system-dependent parameters established by the SET');
Writeln('command. For a list of available keywords type SHOW ?.');
Inverse( TRUE ) ; Writeln(' STATISTICS'); Inverse( FALSE ) ;
Writeln('Display some statistics about Kermit''s operations.');
Writeln
END (*-DoHelp-*) .
(* <<<KermitParms.Pas>>> *)
MODULE KermitParms ;
(* Deal with various Kermit Parameters: Set and Show *)
(* 29-Nov-83 Allow eight bit file transfer [pgt001] *)
EXPORTS
PROCEDURE SetParameters ;
PROCEDURE DoShow ;
PRIVATE
IMPORTS KermitGlobals FROM KermitGlobals ;
IMPORTS RS232Baud FROM RS232Baud ;
IMPORTS CmdParse FROM CmdParse ;
IMPORTS PopCmdParse FROM PopCmdParse ;
IMPORTS PopUp FROM PopUp ;
IMPORTS Perq_String FROM Perq_String ;
PROCEDURE SetParameters ;
(* Set Kermit flags and other communications features -pt*)
VAR
id, parm: String ; (* SET identifier and (possible) parameter *)
switch, parmsw: Boolean ; (* Switch flags for feature and parameter *)
index: Integer ; (* Command index *)
PROCEDURE DoBaudRate( NewRate: String ) ;
(* Try to set a new baud rate for the RS232 port *)
CONST
InputEnable = True ; (* Enable RS232 input *)
HANDLER BadBaudRate ;
BEGIN (*-BadBaudRate-*)
Writeln('?Bad baud rate given: ', NewRate) ;
EXIT( DoBaudRate )
END ; (*-BadBaudRate-*)
BEGIN (*-DoBaudRate-*)
IF (NewRate = '') THEN Writeln('%No value for SET SPEED')
ELSE
BEGIN
(* set the rate *)
SetBaud( NewRate, InputEnabled) ;
(* Here if that was successful, save the new rate *)
BaudRate := NewRate
END
END ; (*-DoBaudRate-*)
FUNCTION MkOctal( src: String ): Integer ;
(* convert the octal number in the source string into a number *)
VAR
i, sum: Integer ; (* index and summation value *)
ok: Boolean ; (* loop control *)
BEGIN (*-MkOctal-*)
ok := True ; i := 1 ; sum := 0 ;
WHILE ok DO
IF NOT (src[i] IN ['0'..'7']) THEN ok := False (* reached non-octal *)
ELSE
BEGIN
sum := sum*8 + Ord(src[i]) - #60 ;
i := i + 1 ;
ok := (i <= Length(src)) (* exit test *)
END ;
MkOctal := sum
END ; (*-MkOctal-*)
PROCEDURE DoEscChr( OctalStr: String ) ;
(* try to set a new CONNECT escape character *)
(* OctalStr contains the string representation of the octal number *)
VAR
val: Integer ; (* The escape character's ordinal *)
BEGIN (*-DoEscChr-*)
IF (OctalStr = '') THEN
Writeln('?SET ESCAPE requires an octal number')
ELSE
IF (OctalStr[1] IN ['0'..'7']) THEN
BEGIN
val := MkOctal( OctalStr ) ; (* Get the value *)
IF (val = 0) OR (val > #037) THEN
Writeln('%Illegal ESCAPE character value: ', val:1:8)
ELSE
BEGIN
(* set the character and its printable version *)
EscapeChr := Chr( val ) ;
EscPrint := Chr( val + #100 )
END
END (* octal digit *)
ELSE
Writeln('?Non-Octal digit in SET ESCAPE parameter')
END ; (*DoEscChr-*)
PROCEDURE DoOnOff(VAR flag: Boolean) ;
(*)
* For the set feature with menu index <index> see if <parm> is
* either ON or OFF. If so, set <flag> to True or False, resp.
* Otherwise write error message and leave <flag> alone.
(*)
VAR
val: Integer ; (* Value of table search ON/OFF *)
BEGIN (*-DoOnOff-*)
ConvUpper( parm ) ; (* MUST be upper case *)
IF (parm = '') THEN val := 3 (* not ON/OFF *)
ELSE
val := UniqueCmdIndex(parm, OnOff, 2) ;
CASE val OF
1: flag := True ; (* ON *)
2: flag := False ; (* OFF *)
3: Writeln('%SET ', SetMenu^.Cmd[index], ' requires ON or OFF') ;
4: Writeln('%Ambiguous ON or OFF in SET ', SetMenu^.Cmd[index] )
END ; (* case *)
END ; (*-DoOnOff-*)
PROCEDURE SetHelp ;
(* Provide help information for the command SET ? *)
BEGIN (*-SetHelp-*)
Writeln ;
Writeln('The following features are available with the SET command :') ;
Writeln ;
Writeln('SPEED <rate> Change the PERQ''s line speed') ;
Writeln('DEBUG ON|OFF Print debug information') ;
Writeln('ESCAPE <octal> Change the CONNECT escape character') ;
Writeln('WARNING ON|OFF Give warning when overwriting existing files') ;
Writeln('LOCAL ON|OFF Echo CONNECT typein locally') ;
Writeln('VERBOSE ON|OFF Display Kermit''s actions') ;
Writeln('EIGHT-BIT ON|OFF Allow eight bit file transfer');(*[pgt001]*)
Writeln
END ; (*-SetHelp-*)
BEGIN (*-SetParameter-*)
(* If the command line is empty, prompt user *)
IF (CmdLine = '') THEN
BEGIN
Write('Kermit-SET', PromptChar) ;
Readln( CmdLine )
END ;
(* get the first identifier from the line *)
dumCh := NextIDString( CmdLine, id, switch ) ;
(* and a possible parameter *)
dumCh := NextIDString( CmdLine, parm, parmsw ) ;
IF (id = '') THEN (* nothing - return *)
ELSE
IF switch OR parmsw THEN Writeln('%SET does not take switches')
ELSE
IF (id[1] = '?') THEN SetHelp
ELSE
BEGIN
index := PopUniqueCmdIndex(id, RECAST(SetMenu, pNameDesc) ) ;
(* What was the command ? *)
CASE index OF
1: DoBaudRate( parm ) ; (* SPEED *)
2: DoOnOff( debug ) ; (* DEBUG *)
3: DoEscChr( parm ) ; (* ESCAPE *)
4: DoOnOff( FileWarning ) ; (* WARNING *)
5: DoOnOff( HalfDuplex ) ; (* LOCAL *)
6: DoOnOff( Verbosity ) ; (* VERBOSE *)
7: DoOnOff( EightBitFile ) ; (* EIGHT-BIT [pgt001]*)
8: Writeln('%Not a SET feature: ', id) ;
9: Writeln('%Ambiguous SET feature: ', id)
END ; (* case *)
END (* else *)
END ; (*-SetParameter-*)
PROCEDURE DoShow ;
(* Show the Kermit flags and parameters *)
VAR
flag: ARRAY [Boolean] OF String[3] ; (* OF or OFF *)
id: String ; (* identifier *)
switch: Boolean ; (* SHOW /xxx flag *)
i: Integer ; (* Index *)
PROCEDURE Feature( index: Integer ) ;
(* write a single feature - Index into SetMenu *)
BEGIN (*-Index-*)
CASE index OF
1: Writeln('Baud rate ', BaudRate) ;
2: Writeln('Debug ', flag[debug]) ;
3: Writeln('Escape chr ^', EscPrint,' (Octal ', Ord(EscapeChr):1:8, ')') ;
4: Writeln('Warning ', flag[FileWarning]) ;
5: Writeln('Local ', flag[HalfDuplex]) ;
6: Writeln('Verbose ', flag[Verbosity]) ;
7: Writeln('Eight-Bit ', flag[EightBitFile]) (*[pgt001]*)
END (* case *)
END ; (*-Feature-*)
BEGIN (*-DoShow-*)
Writeln ;
flag[True] := 'ON' ;
flag[False]:= 'OFF' ;
(* get the show feature *)
dumCh := NextIDString(CmdLine, id, switch) ;
IF (id = '') THEN id := 'ALL' ; (* Default *)
IF switch THEN
Writeln('%SHOW does not take switches')
ELSE
IF (id[1] = '?') THEN (* simple help *)
BEGIN
Writeln('One of the following :-') ;
WITH SetMenu^ DO
FOR i := 1 TO ShowCount DO (* include 'ALL' *)
Writeln( Cmd[i] )
END
ELSE (* find feature's index *)
BEGIN
(* add 'ALL' to the search *)
SetMenu^.numcmds := ShowCount ;
i := PopUniqueCmdIndex( id, RECAST(SetMenu, pNameDesc) ) ;
SetMenu^.numcmds := SetCount ;
IF (i <= SetCount) THEN Feature( i )
ELSE
IF (i = ShowCount) THEN
BEGIN
FOR i := 1 TO SetCount DO Feature(i)
END
ELSE
IF (i = ShowNot) THEN
Writeln('?Not a SHOW parameter: ', id)
ELSE
IF (i = ShowAmbig) THEN
Writeln('%Ambiguous SHOW parameter: ', id)
END ; (* else *)
Writeln
END . (*-DoShow-*)
(* <<<KermitRecv.Pas>>> *)
MODULE KermitRecv ;
(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
(* 30-Nov-83 During a receive clear the screen and show characters *)
(* and packets received. [pgt002] *)
EXPORTS
FUNCTION ReceiveACK : (* Returning *) Boolean;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
PRIVATE
IMPORTS KermitGlobals FROM KermitGlobals ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitError FROM KermitError ;
IMPORTS KermitSend FROM KermitSend ; (* for sending ACKs and NAKs, etc *)
IMPORTS Screen FROM Screen ; (* screen control [pgt002] *)
VAR
OldChInFile: Stats ; (* Characters in file [pgt002]*)
BadPackets: Integer ; (* Bad packet count for this recv [pgt002]*)
{$RANGE-} (* Range checks off to see if it runs faster (16-Jan-84)*)
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) AND Debug THEN ErrorMsg('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) AND Debug THEN ErrorMsg('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) AND Debug THEN ErrorMsg('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) AND Debug THEN ErrorMsg('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 (* Not restart -pt*) (* have started packet *)
BEGIN
IF (t = SOH) THEN (* check for restart or EOL *)
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
SendACK(n); (* send ACK *)
RAISE GotErrorPacket( data ) ; (* ********** *)
END;
NumRecvPacks := NumRecvPacks+1;
IF Debug THEN
BEGIN
DebugPacket('Received: ',InputPacket);
IF good THEN ErrorMsg('Is Good');
END;
temp := CurrentPacket;
CurrentPacket := NextPacket;
NextPacket := temp;
END;
END;
END;
END;
FUNCTION ReceivePacket: Boolean;
BEGIN
WITH PackControl DO
BEGIN
StartTimer;
good := False ;
finished := False;
restart := True;
(* No Keyboard Interupt - Set by ^C handler -pt*)
FromConsole := nothing;
REPEAT
t := GetIn;
CheckTimer ;
IF (FromConsole = abortnow) THEN
BEGIN
State := ABORT ;
ReceivePacket := False ;
EXIT( ReceivePacket )
END;
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
ErrorInt('%Timed out ', n)
END;
END;
StopTimer;
IF NOT good THEN BadPackets := BadPackets + 1 ;
ReceivePacket := good;
END;
END;
FUNCTION ReceiveACK : (* Returning *) Boolean;
(* receive ACK with correct number *)
VAR
Ok: Boolean;
BEGIN
Ok := ReceivePacket;
WITH Buf[CurrentPacket] DO
BEGIN
IF (ptype = TYPEY) THEN NumACKrecv := NumACKrecv+1
ELSE
IF (ptype = TYPEN) THEN NumNAKrecv := NumNAKrecv+1
ELSE
NumBadrecv := NumBadrecv +1;
(* got right one ? *)
ReceiveACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
END;
END;
PROCEDURE GetFile((* Using *) data:istring);
(* create file from fileheader packet *)
VAR
len: Integer;
PROCEDURE Strip( var name: istring ) ;
(* Strip off any blanks (usually trailing) from the file name *)
VAR i, newpos: integer ;
BEGIN (*-Strip-*)
newpos := 1 ; (* this is the new character position for non-blanks *)
FOR i := 1 TO ilength(name) DO
IF (name[i] = blank) THEN (* skip it by not incrementing "newpos" *)
ELSE
BEGIN (* restore character *)
name[newpos] := name[i] ;
newpos := newpos + 1
END ;
name[newpos] := ENDSTR
END ; (*-Strip-*)
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
IF (DiskFile = StdIOError) THEN (* check if we already have a file *)
BEGIN
Strip( data ) ; (* remove any blanks *)
IF Verbosity THEN
BEGIN
ErrorMsg ('Creating file: ');
ErrorStr(data);
END;
IF Exists(data) AND FileWarning THEN
BEGIN
ErrorMsg('File already exists ');
ErrorStr(data);
ErrorMsg('Creating: ');
(* Make it <file>.A *)
len := ilength(data) + 1 ; (* first free char pos *)
data[len] := PERIOD ;
data[len+1] := leta ;
data[len+2] := ENDSTR;
ErrorStr(data)
END;
IF EightBitFile THEN
DiskFile := Sopen(data,StdIO8Write)
ELSE
DiskFile := Sopen(data,StdIOWrite);
END;
IF (Diskfile <= StdIOError) 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;
ErrorMsg('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 ErrorMsg('Received Bad init');
SendNAK(n);
END;
END;
END;
PROCEDURE DataToFile; (* output to file *)
VAR
len,i : Integer;
temp : istring;
BEGIN
WITH Buf[CurrentPacket] DO
BEGIN
len := ilength(data);
ChInFile := ChInFile + len ;
PutStr(data,DiskFile)
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) THEN (* number of tries? *)
BEGIN
State := Abort;
ErrorMsg('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) THEN (* tries ? *)
BEGIN
State := Abort;
ErrorMsg('Old file - Too many ');
END
ELSE
BEGIN
OldTry := OldTry+1;
WITH Buf[CurrentPacket] DO
BEGIN
IF (seq = ((n + 63) MOD 64)) THEN (* packet number *)
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) THEN (* packet number ? *)
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
Sclose(DiskFile); (* close file *)
DiskFile := StdIOError;
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: istring;
good : Boolean;
BEGIN
IF (NumTry > MaxTry) THEN (* check number of tries *)
BEGIN
State := Abort;
ErrorInt('Recv data -Too many ', n)
END
ELSE
BEGIN
NumTry := NumTry+1; (* increase number of tries *)
good := ReceivePacket; (* get packet *)
WITH Buf[CurrentPacket] DO
BEGIN
IF Verbosity THEN
BEGIN
ErrorInt('Receiving (Data) ', Buf[CurrentPacket].seq);
END ;
IF ((ptype = TYPED) OR (ptype=TYPEZ)
OR (ptype=TYPEF)) AND good THEN (* check type *)
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) THEN (* packet number ? *)
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) THEN (* packet number ? *)
SendNAK(n) (* NAK *)
ELSE
BEGIN (* send ACK *)
SendACK(n);
ChInFile := ChInFile + ilength(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) THEN (* tries ? *)
BEGIN
State := Abort;
ErrorMsg('Old EOF - Too many');
END
ELSE
BEGIN
OldTry := OldTry+1;
WITH Buf[CurrentPacket] DO
BEGIN
IF (seq =((n + 63 ) MOD 64)) THEN (* packet number *)
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) THEN (* number of tries? *)
BEGIN
State := Abort;
ErrorMsg('Old init - Too many');
END
ELSE
BEGIN
OldTry := OldTry+1;
(* packet number *)
IF (Buf[CurrentPacket].seq = ((n + 63) MOD 64)) 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) THEN (* check number of tries *)
BEGIN
State := Abort;
ErrorMsg('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
ErrorInt('Receiving (File) ', seq)
END;
(* Set up for new file [pgt002] *)
OldChInFile := ChInFile ; (* Start value *)
BadPackets := 0 ;
SSetCursor(250, 100) ;
Write('File: ');
PutStr(data,stdout);
Write(' ':10) ; (* blank the end of any other names *)
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 ErrorMsg('Expected File Pack');
SendNAK(n);
END;
END;
END;
END;
PROCEDURE RecvSwitch; (* this procedure is the main receive routine *)
HANDLER GotErrorPacket( VAR msg: istring ) ;
(* Handle any error packets reveived. Write msg and exit *)
BEGIN
Inverse( TRUE ) ;
Writeln ;
Writeln('?RECV received error packet from other Host');
putstr(msg, STDOUT) ;
Writeln ;
Inverse( FALSE ) ;
SClose( DiskFile ) ; (* Close the file, if open *)
State := Abort ;
EXIT( RecvSwitch )
END ;
BEGIN
State := Init;
NumTry := 0;
OldChInFile := ChInFile ; (* Start value *)
BadPackets := 0 ;
(* set up the progress reports (c.f. ReceiveFile too) [pgt002] *)
IF NOT Verbosity THEN
BEGIN
SPutChr(FF) ; (* clear the screen *)
SSetCursor(200, 150); Write( 'Current Packet' );
SSetCursor(200, 170); Write( 'Characters received' );
SSetCursor(200, 190); Write( 'Bad packets received' )
END ;
REPEAT
(* Each time thru' the loop print the values [pgt002] *)
IF NOT Verbosity THEN
BEGIN
SSetCursor(410, 150); Write( n:8 ) ;
SSetCursor(410, 170); Write( (ChInFile-OldChInFile):10:0 ) ;
SSetCursor(410, 190); Write( BadPackets:8 )
END ;
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 );
SSetCursor(10, 250) ;
Writeln
END.
(* <<<KermitSend>>> *)
MODULE KermitSend ;
(* 29-Nov-83 Allow eight bit file transfer (c.f. sopen call) [pgt001] *)
EXPORTS
PROCEDURE SendPacket;
PROCEDURE SendACK((* Using *) n:Integer); (* send ACK packet *)
PROCEDURE SendNAK((* Using *) n:Integer); (* send NAK packet *)
PROCEDURE SendSwitch;
PRIVATE
IMPORTS KermitGlobals FROM KermitGlobals ;
IMPORTS KermitUtils FROM KermitUtils ;
IMPORTS Stdio FROM Stdio ;
IMPORTS KermitError FROM KermitError ;
IMPORTS KermitRecv FROM KermitRecv ; (* for receiving ACKs and NAKs *)
IMPORTS UtilProgress FROM UtilProgress ;
IMPORTS Sleep FROM Sleep ;
{$RANGE-} (* Range checks off 16-Jan-84 *)
VAR
DataSendCount: Integer ; (* counter for progress *)
PROCEDURE PutOut( p : Ppack); (* Output Packet *)
(* Use direct calls to XmtChar to send the characters -pt*)
VAR
i : Integer;
BEGIN
IF (NumPad > 0) THEN
FOR i := 1 TO NumPad DO
XmtChar( Chr(PadChar) );
WITH Buf[p] DO
BEGIN
XmtChar( Chr(mark) );
XmtChar( Chr(count) );
XmtChar( Chr(seq) );
XmtChar( Chr(ptype) );
FOR i := 1 TO ilength(data) DO
XmtChar( Chr(data[i]) );
END;
END;
PROCEDURE ReSendPacket;
(* re -sends previous packet *)
BEGIN
NumSendPacks := NumSendPacks+1;
ChInPack := ChInPack + NumPad + 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
ChInPack := ChInPack + NumPad + 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 GetData((* Returning *) VAR newstate:KermitStates);
(* get data from file into ThisPacket *)
VAR
(* and return next state - data & EOF *)
x,c : CharBytes;
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 = LF) THEN (* use proper EOL *)
BEGIN
data[i] := SendQuote;
i := i+1;
data[i] := Ctl(CR);
i := i+1;
(* LF will sent below *)
END;
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 *)
ChInFile := 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 := StdIOError;
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 *)
(* ---- -- -pt*)
VAR
result: Boolean;
BEGIN
result := True;
IF (NumTry = 1) THEN
WITH Buf[ThisPacket] DO
BEGIN
IF GetArgument(data) THEN
BEGIN (* open file *)
IF Exists(data) THEN
BEGIN
(* Initialise counter for each file to be sent *)
DataSendCount := 0 ;
IF EightBitFile THEN (* [pgt001] *)
DiskFile := Sopen(data,StdIO8Read)
ELSE
DiskFile := Sopen(data,StdIORead);
count := ilength(data);
ChInFile := ChInFile + count ;
seq := n;
ptype := TYPEF;
Write('[Sending ');
PutStr(data,stdout);
Writeln(']') ;
IF (DiskFile <= StdIOError) THEN
ErrorMsg('?Can''t open file');
result := False;
END
ELSE (* file does not exist *)
BEGIN
ErrorMsg('?Can''t find file: ') ;
ErrorStr( data ) ;
result := True (* I.e. fail: state -> abort *)
END
END;
END
ELSE
result := False; (* for saved packet *)
GetNextFile := result;
END;
PROCEDURE SendFile; (* send file name packet *)
BEGIN
Verbose( 'Sending ');
IF (NumTry > MaxTry) THEN
BEGIN
ErrorMsg ('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 ErrorStr(Buf[ThisPacket].data)
ELSE ErrorStr(Buf[LastPacket].data);
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 (Land(DataSendCount, #03) = 0) THEN
WITH OpenList[DiskFile] DO
StreamProgress( FileVar ) ;
DataSendCount := DataSendCount + 1 ; (* next "SendData" *)
IF (NumTry > MaxTry) THEN
BEGIN
State := Abort; (* too many tries, abort *)
ErrorMsg ('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 *)
ErrorMsg('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 *)
ErrorMsg('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 *)
ErrorMsg('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
SizeSend := UnChar(data[1]);
TheirTimeOut := UnChar(data[2]);
NumPad := UnChar(data[3]);
PadChar := Ctl(data[4]);
SendEOL := CR; (* default to CR *)
IF (ilength(data) >= 5) THEN
IF (data[5] <> 0) THEN SendEOL := UnChar(data[5]);
SendQuote := SHARP; (* default # *)
IF (ilength(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.
*)
HANDLER GotErrorPacket(VAR msg: istring) ;
(* We got an error packet when trying to receive another packet. *)
(* (possibly an ACK). Write the packet data and exit SEND command *)
BEGIN
Inverse( TRUE ) ;
Writeln ;
Writeln('?SEND received an error packet from the other Host') ;
putstr(msg, STDOUT) ;
Writeln ;
Inverse( FALSE ) ;
SClose( DiskFile ) ; (* close the disk file if its open *)
State := Abort ;
EXIT( SendSwitch )
END ;
BEGIN
LoadCurs ; (* Load the progress cursors *)
State := Init; (* send initiate is the start state *)
NumTry := 0; (* say no tries yet *)
IF (Delay > 0) THEN Sleep(Delay);
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) );
QuitProgress ; (* Remove progress cursors *)
END.
(* <<<KermitUtils>>> *)
MODULE KermitUtils;
EXPORTS
IMPORTS KermitGlobals FROM KermitGlobals ;
PROCEDURE StartTimer;
PROCEDURE CheckTimer ;
PROCEDURE StopTimer;
PROCEDURE XmtChar(ch:Char); (* Perq version -pt*)
FUNCTION GetIn :CharBytes; (* get character *)
FUNCTION UnChar(c:CharBytes): CharBytes;
FUNCTION MakeChar(c:CharBytes): CharBytes;
FUNCTION IsControl(c:CharBytes): Boolean;
FUNCTION IsPrintable(c:CharBytes): Boolean;
FUNCTION Ctl(c:CharBytes): CharBytes;
FUNCTION IsValidPType(c:CharBytes): Boolean;
FUNCTION CheckFunction(c:Integer): CharBytes;
FUNCTION ilength (VAR s : istring) : Integer;
FUNCTION GetArgument(VAR arg: istring): Boolean ;
PROCEDURE EnCodeParm(VAR data:istring); (* encode parameters *)
PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
PROCEDURE Inverse( turn_on: Boolean ) ;
PRIVATE
IMPORTS IOErrors FROM IOErrors ;
IMPORTS IO_Unit FROM IO_Unit ;
IMPORTS IO_Others FROM IO_Others ;
IMPORTS CmdParse FROM CmdParse ;
IMPORTS Screen FROM Screen ;
{$RANGE-}
FUNCTION UnChar(c:CharBytes): CharBytes;
(* reverse of makechar *)
BEGIN
UnChar := c - BLANK
END;
FUNCTION MakeChar(c:CharBytes): CharBytes;
(* convert integer to printable *)
BEGIN
MakeChar := c + BLANK
END;
FUNCTION IsControl(c:CharBytes): Boolean;
(* true if control *)
BEGIN
(* Clear the 8th bit *)
c := Land( c, #177 ) ;
IsControl := (c = DEL) OR (c < BLANK)
END;
FUNCTION IsPrintable(c:CharBytes): Boolean;
(* opposite of iscontrol *)
BEGIN
IsPrintable := NOT IsControl(c)
END;
FUNCTION Ctl(c:CharBytes): CharBytes;
(* c XOR 100 *)
BEGIN
Ctl := LXor(c, #100)
END;
FUNCTION IsValidPType(c:CharBytes): Boolean;
(* true if valid packet type *)
BEGIN
IsValidPType :=
c IN [TYPEB, TYPED, TYPEE, TYPEF, TYPEN, TYPES, TYPET, TYPEY, TYPEZ]
END;
FUNCTION CheckFunction(c:Integer): CharBytes;
(* calculate checksum *)
VAR
x: Integer;
BEGIN
(* CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
x := Shift( Land(c, #300), -6) ;
CheckFunction := Land(x+c, #077)
END;
PROCEDURE EnCodeParm((* Updating *) VAR data:istring); (* 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(VAR data:istring); (* decode parameters *)
BEGIN
SizeSend := UnChar(data[1]);
TheirTimeOut := UnChar(data[2]); (* when I should time out *)
NumPad := 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;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ length -- compute length of string }
FUNCTION ilength (VAR s : istring) : Integer;
VAR
n : Integer;
BEGIN
n := 1;
WHILE (s[n] <> ENDSTR) DO
n := n + 1;
ilength := n - 1
END;
PROCEDURE StartTimer;
(* Start the time count, in clock ticks. -pt*)
BEGIN
IOGetTime( OldTime ) ; (* Current clock value *)
TimeLeft := TheirTimeOut * 60 (* in ticks *)
END;
PROCEDURE CheckTimer ;
(* Decrement "TimeLeft" by time between last call and now -pt*)
VAR now: Double ;
BEGIN
IF (TimeLeft > 0) THEN (* Still counting *)
BEGIN
IOGetTime( now ) ;
TimeLeft := TimeLeft - now[0] + OldTime[0] ;
OldTime := now
END
END ;
PROCEDURE StopTimer;
BEGIN
TimeLeft := Maxint;
END;
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
PROCEDURE XmtChar(ch:Char); (* Perq version -pt*)
BEGIN
WHILE IOCWrite(RS232Out, ch) <> IOEIOC DO (* nothing *) ;
END;
FUNCTION GetIn :CharBytes; (* get character *)
(* Should return NULL (ENDSTR) if no characters, Perq version -pt*)
VAR
byte: CharBytes ;
c :Char ;
BEGIN
IF (IOCRead(RS232In, c) = IOEIOC) THEN
BEGIN
byte := land( Ord(c), #377 ) (* [pgt001] *)
END
ELSE byte := ENDSTR ;
GetIn := byte ;
(* ChInPack := ChInPack + 1.0 (@ AddTo( x, 1) *)
END;
(*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
(* Get the next argument from the command line -pt*)
(* Return True if an argument is available - returned in "arg" too -pt*)
FUNCTION GetArgument(VAR arg: istring): Boolean ;
VAR
return: Boolean ; (* Return value *)
i, len: Integer ; (* index and argument length *)
id: String ; (* Identifier/argument from the line *)
BEGIN (*-GetArgument-*)
dumCh := NextIDString( CmdLine, id, return ) ; (* Get an identifier *)
IF (id = '') THEN return := False (* nothing *)
ELSE
BEGIN
return := True ; (* Success *)
len := Length( id ) ; (* get the string's length *)
FOR i := 1 TO len DO (* put the string in "arg" *)
arg[i] := Ord( id[i] ) ;
arg[len+1] := ENDSTR (* finish it off *)
END ;
GetArgument := return
END ; (*-GetArgument-*)
PROCEDURE Inverse( turn_on: Boolean ) ;
(* Change chrsor function for inverse video *)
BEGIN (*-Inverse-*)
IF turn_on THEN SChrFunc( RNot )
ELSE SChrFunc( RRpl )
END (*-Inverse-*).
(* <<<Stdio.Pas>>> *)
MODULE STDIO ;
(* Standard text file I/O *)
(* from Kernighan + Plauger *)
(* 29-Nov-83 Allow eight bit file transfer [pgt001] *)
(* This forces us to make the end of (data) string value -1 *)
(* and end of file value -2 because byte values can be 0..255 *)
EXPORTS
IMPORTS KermitGlobals FROM KermitGlobals ;
CONST
{ standard file descriptors. subscripts in open, etc. }
STDIN = 1; { these are not to be changed }
STDOUT = 2;
STDERR = 3;
lineout = 4;
linein = 5;
FirstUserFile = STDERR ; (* First index available for user's files -pt*)
{ other io-related stuff }
StdIOError = 0; { status values for open files }
StdIOAvail = 1;
StdIORead = 2;
StdIOWrite = 3;
StdIO8Read = 4 ; (* [pgt001] *)
StdIO8Write = 5 ; (* [pgt001] *)
MAXOPEN = 15; { maximum number of open files }
{ universal manifest constants }
ENDFILE = ENDSTR - 1; (* [pgt001] *)
TYPE
filedesc = StdIOError..MAXOPEN;
ioblock = RECORD { to keep track of open files }
filevar : Text;
mode : StdIOError..StdIO8Write;
END;
VAR
openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files }
PROCEDURE StdIOInit;
PROCEDURE putch (c : CharBytes);
PROCEDURE putcf (c : CharBytes; fd : filedesc);
PROCEDURE putstr (VAR s : istring; f : filedesc);
FUNCTION getch (VAR c : CharBytes) : CharBytes;
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
FUNCTION getline (VAR s : istring; fd : filedesc;
maxsize : Integer) : Boolean;
FUNCTION Sopen (name : istring; mode : Integer) : filedesc;
PROCEDURE Sclose (fd : filedesc);
FUNCTION Exists(s:istring): Boolean;
PRIVATE
IMPORTS Perq_string FROM Perq_String ;
IMPORTS Stream FROM Stream ;
IMPORTS FileSystem FROM FileSystem ;
{ StdIOInit -- initialize open file list }
PROCEDURE StdIOInit;
VAR
i : filedesc;
BEGIN
openlist[STDIN].mode := StdIORead;
openlist[STDOUT].mode := StdIOWrite;
{ initialize rest of files }
FOR i := FirstUserFile TO MAXOPEN DO
openlist[i].mode := StdIOAvail;
END;
{ getc (UCB) -- get one character from standard input }
FUNCTION getch (VAR c : CharBytes) : CharBytes;
VAR
ch : Char;
BEGIN
IF Eof THEN c := ENDFILE
ELSE
IF Eoln THEN
BEGIN
Readln;
c := LF
END
ELSE
BEGIN
Read(ch);
c := Ord(ch)
END;
getch := c
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getcf (UCB) -- get one character from file }
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
VAR
ch : Char;
BEGIN
WITH openlist[fd] DO (* [pgt001] *)
IF (fd = STDIN) THEN getcf := getch(c)
ELSE
IF Eof(filevar) THEN c := ENDFILE
ELSE
IF (mode = StdIO8Read) THEN (* [pgt001] *)
BEGIN
c := Ord( filevar^ ) ;
Get( filevar )
END (* [pgt001] *)
ELSE
IF Eoln(filevar) THEN
BEGIN
Readln(filevar);
c := LF
END
ELSE
BEGIN
Read(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 : istring; fd : filedesc;
maxsize : Integer) : Boolean;
VAR
i : Integer;
c : CharBytes;
BEGIN
{$RANGE-}
i := 1;
REPEAT
s[i] := getcf(c, fd);
i := i + 1
UNTIL (c = ENDFILE) OR (c = LF) OR (i >= maxsize);
IF (c = ENDFILE) THEN i := i - 1 ; { went one too far }
s[i] := ENDSTR;
getline := (c <> ENDFILE)
{$RANGE+}
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putch (UCB) -- put one character on standard output }
PROCEDURE putch (c : CharBytes);
BEGIN
IF (c = LF) 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 : CharBytes; fd : filedesc);
CONST
NUL = 0 ;
BEGIN
WITH openlist[fd] DO
IF (fd = STDOUT) THEN putch(c)
ELSE
IF (mode = StdIO8Write) THEN (* [pgt001] *)
BEGIN
filevar^ := Chr(c) ;
Put( filevar )
END
ELSE
BEGIN (* Normal text file [pgt001]*)
c := Land(c, #177) ;
IF (c = LF) THEN Writeln(filevar)
ELSE
IF (c = CR) OR (c = NUL) THEN (* ignore *)
ELSE
Write(filevar, Chr( c ))
END ;
END;
{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putstr (UCB) -- put out string on file }
PROCEDURE putstr (VAR s : istring; f : filedesc);
VAR
i : Integer;
BEGIN
{$RANGE-}
i := 1;
WHILE (s[i] <> ENDSTR) DO
BEGIN
putcf(s[i], f);
i := i + 1
END
{$RANGE+}
END;
{ MakeString -- Convert an istring into a Perq String variable -pt }
PROCEDURE MakeString(src: istring; VAR dest: String) ;
VAR
i: Integer ;
BEGIN (*-MakeString-*)
i := 1 ;
{$RANGE- Checks off because Length(dest) undefined at the moment -pt}
WHILE (src[i] <> ENDSTR) AND (src[i] <> LF) DO
BEGIN
dest[i] := Chr(src[i]) ;
i := i + 1
END ;
{$RANGE+ Checks back on -pt}
Adjust(dest, i-1) (* Set the dynamic length -pt*)
END ; (*-MakeString-*)
{ open -- open a file for reading or writing. Perq version -pt}
FUNCTION Sopen (name : istring; mode : Integer) : filedesc;
VAR
i : Integer;
filename : String ;
found : Boolean;
(* Reset and Rewrite error handlers. Both set "sopen" to IOERROR -pt*)
(* This means we set inital value of "sopen" before reset/rewrite -pt*)
HANDLER ResetError(filnam: PathName) ;
BEGIN
sopen := StdIOError
END ;
HANDLER RewriteError(filnam: PathName) ;
BEGIN
sopen := StdIOError
END ;
BEGIN
MakeString(name, filename) ; (* Convert to Perq string -pt*)
{ find a free slot in openlist }
Sopen := StdIOError;
found := False;
i := 1;
WHILE (i <= MAXOPEN) AND (NOT found) DO
BEGIN
IF (openlist[i].mode = StdIOAvail) THEN
BEGIN
openlist[i].mode := mode ;
Sopen := i; (* Here so file handlers can reset value -pt*)
IF (mode = StdIORead) OR (mode = StdIO8Read) THEN
Reset(openlist[i].filevar, filename) (* [pgt001] *)
ELSE
Rewrite(openlist[i].filevar, filename);
found := True
END;
i := i + 1
END
END;
PROCEDURE Sclose (fd : filedesc);
BEGIN
IF (fd >= FirstUserFile) AND (fd <= MAXOPEN) THEN
BEGIN
openlist[fd].mode := StdIOAvail;
close(openlist[fd].filevar);
END
END;
FUNCTION Exists(s:istring): Boolean;
(* returns true if file exists. Perq version -pt*)
VAR
name: String ;
file_id, blocks, bits: Integer ;
BEGIN (*-Exists-*)
(* Be quick and use a look-up; better than open/close sequence -pt*)
MakeString(s, name) ; (* Get the file name as a Perq string *)
file_id := FSLookUp(name, blocks, bits) ; (* Do the look-up *)
Exists := (file_id <> 0) (* Zero means it does not exist *)
END. (*-Exists-*)