home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
aospascal.tar.gz
/
aospascal.tar
/
aosk2.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-02-08
|
22KB
|
922 lines
PROGRAM KERMIT (INPUT,OUTPUT);
CONST
OUTPUTFILE = '@LIST';
INPUTFILE = '@DATA';
NL = '<012>';
CR = '<015>';
SEND_QCHR = '#';
REC_ELN = '<4>';
MARK = '<1>';
NAMELENGTH = 15;
MAXBUFF = 100; (* Maximun packet length can handle *)
TYPE
PACHEADER = RECORD
SEQ : INTEGER;
PTYPE : CHAR;
CHECK : CHAR;
END;
PACDATA = RECORD
DATA : PACKED ARRAY [ 1 .. MAXBUFF] OF CHAR;
LENGTH : INTEGER
END;
NAMETYPE = PACKED ARRAY [ 1 .. NAMELENGTH] OF CHAR;
VAR
DISK,OUTSCREEN,INSCREEN: TEXT;
SEND_ELN, REC_QCHR: CHAR;
SEND_MLEN, REC_MLEN :INTEGER;
EIGHTBIT,CENDLN,KCHAR_ELN, DEBUG , IGNORE_PARMS:BOOLEAN;
INCLUDE BOOLEAN.PAS; (* Need for XXOR and XAND funtion call *)
(* _______________________________________________________________
Opens screen files
*)
PROCEDURE OPEN_SCREEN;
BEGIN
RESET(OUTSCREEN,OUTPUTFILE);
RESET(INSCREEN,INPUTFILE,MAXBUFF*2)
END;
(* _______________________________________________________________
opens files
1. Opens the three files
2. Enacts a delay
3. Possible MODES
'C' = rewrite file
'R' = reset file
*)
PROCEDURE OPEN_FILE(DATANAME:NAMETYPE;MODE:CHAR);
VAR
FILENAME: STRING 20;
Y,INDEX :INTEGER;
BEGIN
FOR Y := 1 TO NAMELENGTH DO
IF DATANAME[Y] <> ' '
THEN APPEND(FILENAME,DATANAME[Y]);
IF DEBUG = TRUE THEN
BEGIN
WRITELN('OPENING FILE MODE - ',MODE);
WRITELN(' LENGTH OF STRING: ',LENGTH(FILENAME));
END;
IF MODE = 'C'
THEN REWRITE(DISK,FILENAME)
ELSE RESET (DISK,FILENAME, 200);
OPEN_SCREEN;
END;
(* _______________________________________________________________
Increments the sequence number
*)
FUNCTION ADDSEQ (INDEX:INTEGER):INTEGER;
BEGIN
IF (INDEX+1) = 64 THEN ADDSEQ := 0
ELSE ADDSEQ := INDEX+1
END;
(* _______________________________________________________________
Returns the KERMIT type Ascii character
*)
FUNCTION KCHAR (NUMBER:INTEGER) :CHAR;
BEGIN
KCHAR := CHR (NUMBER + 32)
END;
(* _______________________________________________________________
Return the KERMIT type integer value of a CHAR
*)
FUNCTION UNKCHAR (BYTE:CHAR) :INTEGER;
BEGIN
UNKCHAR := (ORD(BYTE) - 32);
END;
(* _______________________________________________________________
Returns the integer value for a control character
*)
FUNCTION CTL (VALUE:INTEGER):INTEGER;
BEGIN
CTL := XXOR (VALUE , 64)
END;
(* _______________________________________________________________
Return a one byte checksum
1. If CTYPE = 'C' then the sum is Changed if the character is
a control character, REC_QCHR or NL then then actual
sent value is automatically added to SUM
2. If CTYPE <> 'C' then just a Straight checksum is produced
3. The XAND function is used
*)
FUNCTION CHECKSUM (HEADER:PACHEADER ; DATA:PACDATA; CTYPE:CHAR): CHAR;
VAR
VAL,HVAL:INTEGER;
X,SUM :WHOLE;
BEGIN
SUM := DATA.LENGTH + 3 + 32;
SUM := SUM + HEADER.SEQ + 32;
SUM := SUM + ORD (HEADER.PTYPE);
FOR X := 1 TO DATA.LENGTH DO
BEGIN
HVAL := ORD(DATA.DATA[X]);
VAL := XAND(HVAL,127);
IF ((VAL <= 31) OR (VAL = 127)) AND (CTYPE = 'C')
THEN SUM := SUM + ORD(REC_QCHR) + CTL(HVAL)+1
ELSE IF (VAL=ORD(REC_QCHR)) AND (CTYPE = 'C')
THEN SUM := SUM + ORD(REC_QCHR)+HVAL+1
ELSE SUM := SUM + HVAL;
END;
SUM := XAND(SUM,255);
X := SUM + ( XAND(SUM,192) DIV 64 );
CHECKSUM := KCHAR ( XAND(X,63) )
END;
(* _______________________________________________________________
Assembles packet form and writes Packet out
*)
PROCEDURE SEND_PACKET (HEADER:PACHEADER ; DATA:PACDATA);
VAR
PACKET : PACKED ARRAY [ 1 .. MAXBUFF+10] OF CHAR;
X, INDEX :INTEGER;
BEGIN
IF DEBUG THEN
BEGIN
WRITELN('SENDING PACKET');
WRITELN(' SEQUENCE: ',HEADER.SEQ);
WRITELN(' DATA.LENGTH: ',DATA.LENGTH)
END;
X := 0;
PACKET[(X+1)] := MARK;
PACKET[(X+2)] := KCHAR(DATA.LENGTH+3);
PACKET[(X+3)] := KCHAR(HEADER.SEQ);
PACKET[(X+4)] := HEADER.PTYPE;
X := X+4;
FOR INDEX := 1 TO DATA.LENGTH DO
PACKET[(X+INDEX)] := DATA.DATA[INDEX];
X := X + DATA.LENGTH;
PACKET[(X+1)] := HEADER.CHECK;
PACKET[(X+2)] := SEND_ELN;
WRITE (OUTSCREEN, PACKET:(X+2) );
IF DEBUG THEN
BEGIN
WRITELN('Packet length: ',X+2);
WRITELN('SENT PACKET')
END;
END;
(* _______________________________________________________________
Creates a zero length data control packet
*)
PROCEDURE CREATE_CONTROL_PACKET (VAR HEADER:PACHEADER; VAR DATA:PACDATA;
PACTYPE:CHAR; INDEX:INTEGER);
BEGIN
HEADER.PTYPE := PACTYPE;
HEADER.SEQ := INDEX;
DATA.LENGTH := 0;
HEADER.CHECK := CHECKSUM (HEADER, DATA, 'S')
END;
(* _______________________________________________________________
Reads in a packet from the screen
1. MARK must contain the mark character
2. Default for HEADER.PTYPE = ' '
3. Default for HEADER.SEQ = -1
4. Packet must not contain the EOF character - REC_ELN -
5. If CHECK = S at entry control de-quoting is not done
6. There are three possible returned values for CHECK
' ' = receive okay
'E' = Checksum wrong, EOF marker before whole
Packet can be read, or can't find MARK
'T' = timed out when reading packet (Unimplimented)
*)
PROCEDURE RECEIVE_PACKET (VAR HEADER:PACHEADER; VAR DATA:PACDATA; VAR CHECK:CHAR);
VAR
PACKET : PACKED ARRAY [1 .. MAXBUFF+10] OF CHAR;
X,Y, LOOP :INTEGER;
HCHECK,BYTE : CHAR;
DEQUOTE :BOOLEAN;
BEGIN
IF DEBUG THEN
BEGIN
WRITELN ('RECEIVING: ')
END;
X := 0;
IF CHECK <> 'S' THEN DEQUOTE := TRUE
ELSE DEQUOTE := FALSE;
CHECK := ' ';
REPEAT
X := X+1;
IF EOF(INSCREEN) THEN
BEGIN
RESET(INSCREEN);
X := X+1
END;
READ (INSCREEN, BYTE);
IF DEBUG THEN
WRITELN('SEARCH FOR MARK, GOT: ',ORD(BYTE))
UNTIL (BYTE = MARK) OR (X = 6);
IF X = 6 THEN CHECK := 'E';
X := 1;
HEADER.SEQ := -1;
HEADER.PTYPE := ' ';
FOR X := 1 TO 3 DO
BEGIN
IF EOF(INSCREEN) THEN CHECK := 'E'
ELSE READ(INSCREEN,BYTE);
IF DEBUG THEN
WRITELN('READING BYTE- GOT: ',ORD(BYTE));
IF X = 1 THEN
DATA.LENGTH := UNKCHAR(BYTE) - 3;
IF X = 2 THEN
HEADER.SEQ := UNKCHAR (BYTE);
IF X = 3 THEN
HEADER.PTYPE := BYTE
END;
Y := 0;
X := 1;
LOOP := 1;
IF EOF(INSCREEN) THEN CHECK := 'E'
ELSE READ(INSCREEN,BYTE);
WHILE (LOOP <= DATA.LENGTH) AND (CHECK <> 'E') DO
BEGIN
IF DEBUG THEN
WRITELN(DATA.LENGTH,' READING BYTE, GOT: ',ORD(BYTE));
IF Y = 1 THEN
BEGIN
Y := 2;
IF CHR(XAND(ORD(BYTE),127)) = REC_QCHR
THEN DATA.DATA[X] := BYTE
ELSE DATA.DATA[X] := CHR(CTL(ORD(BYTE)))
END;
IF (BYTE=REC_QCHR) AND (Y=0) AND DEQUOTE
THEN BEGIN
Y := 1;
DATA.LENGTH := DATA.LENGTH - 1
END;
IF Y = 0
THEN DATA.DATA[X] := BYTE
ELSE IF Y=2 THEN Y := 0;
IF EOF(INSCREEN) THEN CHECK := 'E'
ELSE READ(INSCREEN,BYTE);
IF Y <> 1 THEN
BEGIN
X:= X+1;
LOOP := LOOP +1
END
END;
IF CHECK <> 'E' THEN
BEGIN
HEADER.CHECK := BYTE;
IF DEQUOTE
THEN HCHECK := CHECKSUM(HEADER,DATA,'C')
ELSE HCHECK := CHECKSUM(HEADER,DATA,'S');
IF NOT( HEADER.CHECK = HCHECK)
THEN CHECK := 'E'
END;
RESET(INSCREEN);
IF DEBUG THEN
BEGIN
WRITELN('FINISHED RECEIVING PACKET');
WRITELN(' SEQUENCE: ',HEADER.SEQ);
WRITELN(' HEADER.PTYPE: ',HEADER.PTYPE);
WRITELN(' DATA-LENGTH: ',DATA.LENGTH);
WRITELN(' CHECK:',CHECK);
WRITELN(' HEADER.CHECK: ',HEADER.CHECK);
WRITELN(' RETURNED CHECKSUM: ',HCHECK)
END
END;
(* _______________________________________________________________
Extracts the information from initial packet
1. sets SEND_MLEN, SEND_ELN
*)
PROCEDURE SET_DEFAULTS ( HEADER:PACHEADER; DATA:PACDATA );
BEGIN
IF DEBUG THEN WRITELN('SETTING DEFAULTS');
IF (DATA.LENGTH => 1) AND (DATA.DATA[1] <> ' ')
THEN SEND_MLEN := UNKCHAR (DATA.DATA[1])
ELSE SEND_MLEN := 80;
IF (DATA.LENGTH => 5) AND (DATA.DATA[5] <> ' ')
THEN IF KCHAR_ELN
THEN SEND_ELN := CHR(UNKCHAR(DATA.DATA[5]))
ELSE SEND_ELN := DATA.DATA[5]
ELSE SEND_ELN := CR;
IF (DATA.LENGTH => 6) AND (DATA.DATA[6] <> ' ')
THEN REC_QCHR := DATA.DATA[6]
ELSE REC_QCHR := '#';
IF DEBUG THEN
BEGIN
WRITELN('HAVE SET DEFAULTS');
WRITELN(' QUOTE CHAR FROM OTHER KERMIT: ',REC_QCHR);
WRITELN(' MAX LENGTH OF SEND PACKET: ', SEND_MLEN);
WRITELN(' SEND-EOLN CHAR (ASCII): ',ORD(SEND_ELN))
END
END;
(* _______________________________________________________________
Creates a packet for the initial connection
*)
PROCEDURE CREATE_SEND_INIT (VAR HEADER:PACHEADER; VAR DATA:PACDATA; INDEX: INTEGER);
VAR
X : INTEGER;
BEGIN
IF DEBUG THEN WRITELN('CREATING SEND-INIT PACKET');
HEADER.PTYPE := 'S';
HEADER.SEQ := INDEX;
DATA.LENGTH := 10;
WITH DATA
DO BEGIN
DATA[1] := KCHAR(REC_MLEN); (* Max packet lenth *)
DATA[2] := KCHAR(15); (* sec. before time out *)
DATA[3] := KCHAR(0); (* # of pad char need *)
DATA[4] := ' '; (* pad character *)
IF KCHAR_ELN
THEN DATA[5] := KCHAR(ORD(REC_ELN))
ELSE DATA[5] := REC_ELN;
DATA[6] := SEND_QCHR; (* Char for control quote *)
DATA[7] := 'N'; (* No 8 Bit quote *)
DATA[8] := '1'; (* Normal checksum *)
DATA[9] := ' '; (* No repeat char *)
DATA[10] := KCHAR(0) (* Capacity byte *)
END;
FOR X := 11 TO 14 DO
DATA.DATA[X] := ' ';
HEADER.CHECK := CHECKSUM (HEADER,DATA,'S');
IF DEBUG THEN WRITELN('HAVE CREATED SEND INIT PACKET')
END;
(* _______________________________________________________________
Sends packet until E or Y or B reply received
1. Will not do anything if REPLY initially E
2. Possible values of REPLY on exit are E and Y
3. If Initial value of REPLY = S
dequoting will not be done on receive
*)
PROCEDURE SEND_LOOP (HEADER:PACHEADER; DATA:PACDATA; VAR REPLY:CHAR);
VAR
HOLD :PACHEADER;
HOLDDATA :PACDATA;
CHECK ,HREPLY :CHAR;
TRYS :INTEGER;
BEGIN
IF DEBUG THEN WRITELN('STARTING SEND LOOP');
TRYS := 1;
IF REPLY = 'S' THEN HREPLY := 'S'
ELSE HREPLY := ' ';
IF NOT(REPLY = 'E') THEN REPLY := ' ';
WHILE NOT ((REPLY = 'Y') OR (REPLY = 'E'))
DO BEGIN
SEND_PACKET (HEADER, DATA);
REPEAT
CHECK := HREPLY;
RECEIVE_PACKET (HOLD, HOLDDATA, CHECK);
IF CHECK = 'E' THEN HOLD.SEQ := -1;
IF CHECK = 'T' THEN HOLD.SEQ := -1;
IF HOLD.SEQ = ADDSEQ(HEADER.SEQ) THEN
HOLD.SEQ := -1;
UNTIL (HOLD.SEQ = -1) OR (HOLD.SEQ=HEADER.SEQ);
IF HOLD.SEQ = -1 THEN REPLY := ' '
ELSE REPLY := HOLD.PTYPE;
IF TRYS <= 5
THEN TRYS := TRYS+1
ELSE REPLY := 'E'
END;
IF DEBUG THEN WRITELN('FINISHING SEND LOOP')
END;
(* _______________________________________________________________
Creates file header packet
*)
PROCEDURE CREATE_FILE_HEADER (VAR HEADER:PACHEADER; VAR DATA:PACDATA;
INDEX:INTEGER ;DATAFILE:NAMETYPE);
VAR
X :INTEGER;
BEGIN
IF DEBUG THEN
WRITELN('CREATING FILE HEADER');
HEADER.PTYPE := 'F';
HEADER.SEQ := INDEX;
X := 1;
WHILE (X < NAMELENGTH) AND (DATAFILE[X] <> ' ') DO
BEGIN
DATA.DATA[X] := DATAFILE[X];
X := X+1
END;
DATA.LENGTH := X - 1;
HEADER.CHECK := CHECKSUM (HEADER,DATA,'S');
IF DEBUG THEN
WRITELN('CREATED FILE HEADER')
END;
(* _______________________________________________________________
Creates a data packet
1. The XAND function is used, and a character is QUOTED if
it should be quoted with the high bit turned OFF
regardless of the actual value of the high bit
*)
PROCEDURE CREATE_DATA_PACKET (VAR HEADER:PACHEADER; VAR DATA:PACDATA; INDEX:INTEGER);
VAR
X,Y,VALUE,HVALUE :INTEGER;
BYTE :CHAR ;
BEGIN
IF DEBUG THEN
BEGIN
WRITELN('CREATING DATA PACKET');
WRITELN(' SEND_MLEN:', SEND_MLEN);
END;
HEADER.PTYPE := 'D';
HEADER.SEQ := INDEX;
X := 1;
WHILE NOT( EOF(DISK) ) AND ((X+4) <= (SEND_MLEN-7)) DO
BEGIN
READ (DISK,BYTE);
VALUE := ORD (BYTE);
HVALUE := XAND(VALUE,127);
IF NOT EIGHTBIT THEN
BEGIN
VALUE := HVALUE;
BYTE := CHR(VALUE)
END;
Y := X;
IF (HVALUE <= 31) OR (HVALUE = 127) THEN
BEGIN
DATA.DATA[X] := SEND_QCHR;
X := X+1;
DATA.DATA[X] := CHR( CTL(VALUE) )
END;
IF HVALUE = ORD(SEND_QCHR) THEN
BEGIN
DATA.DATA[X] := SEND_QCHR;
X := X+1;
DATA.DATA[X] := BYTE;
END;
IF (BYTE = NL) AND CENDLN THEN
BEGIN
DATA.DATA[X] := 'M';
X := X+1;
DATA.DATA[X] := SEND_QCHR;
X := X+1;
DATA.DATA[X] := 'J'
END;
IF Y = X THEN
DATA.DATA[X] := BYTE;
X := X+1;
END;
DATA.LENGTH := X-1;
HEADER.CHECK := CHECKSUM (HEADER, DATA,'S');
IF DEBUG THEN WRITELN('HAVE CREATED DATA PACKET')
END;
(* _______________________________________________________________
Does the send routine to send DATAFILE
1. the files must be open
2. closes the files
*)
PROCEDURE SEND_ROUTINE(DATAFILE:NAMETYPE);
VAR
HEADER, HOLD_HEADER:PACHEADER;
DATA, HOLD_DATA : PACDATA;
INDEX : INTEGER;
REPLY : CHAR;
BEGIN
INDEX := 0;
CREATE_SEND_INIT (HEADER, DATA, INDEX);
REPEAT
SEND_PACKET(HEADER,DATA);
REPLY := 'S';
RECEIVE_PACKET(HOLD_HEADER,HOLD_DATA,REPLY);
IF DEBUG THEN
BEGIN
WRITELN(HOLD_HEADER.PTYPE,'-',REPLY,'-');
REPLY := ' ';
END;
UNTIL ((HOLD_HEADER.PTYPE = 'Y') AND (REPLY = ' '));
IF NOT IGNORE_PARMS THEN
SET_DEFAULTS (HOLD_HEADER, HOLD_DATA);
INDEX := ADDSEQ(INDEX);
CREATE_FILE_HEADER ( HEADER, DATA, INDEX, DATAFILE);
SEND_LOOP (HEADER, DATA, REPLY);
WHILE NOT( EOF(DISK) OR (REPLY = 'E') )
DO BEGIN
INDEX := ADDSEQ (INDEX);
CREATE_DATA_PACKET (HEADER,DATA,INDEX);
SEND_LOOP (HEADER, DATA, REPLY)
END;
INDEX := ADDSEQ (INDEX);
CREATE_CONTROL_PACKET (HEADER, DATA, 'Z' , INDEX);
SEND_LOOP (HEADER, DATA, REPLY );
INDEX := ADDSEQ (INDEX);
CREATE_CONTROL_PACKET (HEADER,DATA, 'B', INDEX);
SEND_LOOP (HEADER, DATA, REPLY);
CLOSE (DISK);
CLOSE (OUTSCREEN);
CLOSE (INSCREEN)
END;
(* ------------------------------------------------------------------
*)
PROCEDURE SEND;
VAR
X:INTEGER;
DATAFILE:NAMETYPE;
BEGIN
WRITE(' Name of the file: ');
FOR X:= 1 TO NAMELENGTH DO
IF NOT(EOLN(INPUT))
THEN READ(DATAFILE[X])
ELSE DATAFILE[X] := ' ';
READLN;
OPEN_FILE(DATAFILE,'R');
SEND_ROUTINE(DATAFILE);
END;
(* ------------------------------------------------------------------
Receives data packets and constructs file
1. Opens up DISK and closes it
2. HEADER and DATA must be the F packet
3. Will receive D packets until Z packet (end of file)
4. Changes CR LF to NL
*)
PROCEDURE RECEIVE_LOOP(VAR HEADER:PACHEADER; VAR DATA:PACDATA);
VAR
X,F,R,INDEX:INTEGER;
REPLY,RTYPE :CHAR;
DATAFILE :NAMETYPE;
BEGIN
IF DEBUG THEN WRITELN('STARTING RECEIVE_LOOP');
INDEX := HEADER.SEQ+1;
FOR X:= 1 TO NAMELENGTH DO
IF (DATA.DATA[X] <> ' ') AND (X <= DATA.LENGTH)
THEN DATAFILE[X] := DATA.DATA[X]
ELSE DATAFILE[X] := ' ';
OPEN_FILE(DATAFILE,'C');
CREATE_CONTROL_PACKET(HEADER,DATA,'Y',HEADER.SEQ);
SEND_PACKET(HEADER,DATA);
RTYPE := ' ';
WHILE (RTYPE <> 'Z') AND (RTYPE <> 'E') DO
BEGIN
RECEIVE_PACKET(HEADER,DATA,REPLY);
RTYPE := HEADER.PTYPE;
IF DEBUG THEN WRITELN('Index - ',INDEX);
IF REPLY = ' ' THEN
BEGIN
IF (HEADER.SEQ = INDEX) AND (RTYPE = 'D')
THEN BEGIN
INDEX := ADDSEQ(INDEX);
R := 0;
F := -3;
FOR X:= 1 TO DATA.LENGTH DO
BEGIN
DATA.DATA[(X-R)] := DATA.DATA[X];
IF DATA.DATA[X] = '<15>' THEN F := X;
IF (DATA.DATA[X] = '<12>') AND (F=X-1)
AND CENDLN THEN
BEGIN
R := R+1;
DATA.DATA[(X-R)] := NL
END;
END;
DATA.LENGTH := DATA.LENGTH - R;
IF DEBUG THEN
BEGIN
WRITELN('R offset is - ',R);
WRITELN('Writting Disk- ',DATA.LENGTH);
END;
WRITE(DISK,DATA.DATA:DATA.LENGTH)
END;
CREATE_CONTROL_PACKET(HEADER,DATA,'Y',HEADER.SEQ)
END;
IF REPLY <> ' ' THEN
CREATE_CONTROL_PACKET(HEADER,DATA,'N',HEADER.SEQ);
SEND_PACKET(HEADER,DATA)
END;
CLOSE(DISK);
IF DEBUG THEN WRITELN('FINISHING RECEIVE_LOOP')
END;
(* ------------------------------------------------------------------
The secondary Receive Routine
set up this way to facilitate server implimentation
*)
PROCEDURE RECEIVE_ROUTINE(VAR HEADER:PACHEADER; VAR DATA:PACDATA);
VAR
X:INTEGER;
REPLY:CHAR;
BEGIN
IF NOT IGNORE_PARMS THEN
SET_DEFAULTS(HEADER,DATA);
CREATE_SEND_INIT(HEADER,DATA,0);
HEADER.PTYPE := 'Y';
HEADER.CHECK := CHR(ORD(HEADER.CHECK) +6);
SEND_PACKET(HEADER,DATA);
REPEAT
REPLY := 'S';
RECEIVE_PACKET(HEADER,DATA,REPLY);
IF REPLY <> ' ' THEN
BEGIN
CREATE_CONTROL_PACKET(HEADER,DATA,'N',HEADER.SEQ);
SEND_PACKET(HEADER,DATA)
END;
IF (REPLY = ' ') AND (HEADER.PTYPE<>'B') THEN
RECEIVE_LOOP(HEADER,DATA)
UNTIL (HEADER.PTYPE = 'E') OR (HEADER.PTYPE = 'B');
IF HEADER.PTYPE <> 'E' THEN
BEGIN
CREATE_CONTROL_PACKET(HEADER,DATA,'Y',HEADER.SEQ);
SEND_PACKET(HEADER,DATA)
END
END;
(* ------------------------------------------------------------------
*)
PROCEDURE RECEIVE;
VAR
HEADER:PACHEADER;
DATA:PACDATA;
REPLY :CHAR;
BEGIN
OPEN_SCREEN;
REPLY := 'S';
RECEIVE_PACKET(HEADER,DATA,REPLY);
WHILE (REPLY <> ' ') DO
BEGIN
CREATE_CONTROL_PACKET(HEADER,DATA,'N',0);
SEND_PACKET(HEADER,DATA);
REPLY := 'S';
RECEIVE_PACKET(HEADER,DATA,REPLY);
END;
RECEIVE_ROUTINE(HEADER,DATA);
END;
(* ------------------------------------------------------------------
*)
PROCEDURE SERVER;
VAR
DATAFILE:NAMETYPE;
CHECK:CHAR;
HEADER:PACHEADER;
DATA:PACDATA;
X:INTEGER;
BEGIN
WRITELN('Server started. You may return to micro');
REPEAT
OPEN_SCREEN;
REPEAT
CHECK := 'S';
RECEIVE_PACKET(HEADER,DATA,CHECK);
UNTIL (CHECK=' ');
IF HEADER.PTYPE = 'R' THEN
BEGIN
IF DEBUG THEN WRITELN('SERVER BEGINNING SEND');
FOR X:= 1 TO NAMELENGTH DO
IF DATA.LENGTH => X
THEN DATAFILE[X] := DATA.DATA[X]
ELSE DATAFILE[X] := ' ';
OPEN_FILE(DATAFILE,'R');
SEND_ROUTINE(DATAFILE);
END;
IF HEADER.PTYPE = 'S' THEN
BEGIN
IF DEBUG THEN WRITELN('SERVER BEGINNING RECEIVE');
RECEIVE_ROUTINE(HEADER,DATA);
END;
UNTIL HEADER.PTYPE = 'G';
CREATE_CONTROL_PACKET(HEADER,DATA,'Y',HEADER.SEQ);
SEND_PACKET(HEADER,DATA);
END;
(* ------------------------------------------------------------------
USER INTERFACE ROUTINES
----------------------------------------------------------------- *)
(* _______________________________________________________________
Displays value of Kermit parameters
*)
PROCEDURE DISPLAY_DEFAULTS;
BEGIN
WRITELN;
WRITELN(' Sending End of line character (ASCII): ',ORD(SEND_ELN));
WRITELN(' Maximum Sending packet length: ',SEND_MLEN);
WRITELN(' Maximum Receiving packet length: ',REC_MLEN);
WRITELN(' Quote character used in receiving: ',REC_QCHR);
WRITE(' Eigth bit I-O: ');
IF DEBUG THEN WRITELN('ON')
ELSE WRITELN('OFF');
WRITE(' Debug flag: ');
IF DEBUG THEN WRITELN('ON')
ELSE WRITELN('OFF');
WRITE(' Ignore the parameters other Kermit sends: ');
IF IGNORE_PARMS THEN WRITELN('ON')
ELSE WRITELN('OFF');
WRITE(' Make the EOLN character printable in SEND INIT: ');
IF KCHAR_ELN THEN WRITELN('ON')
ELSE WRITELN('OFF');
WRITE(' Change CRLF to NL on input and the reverse on output: ');
IF CENDLN THEN WRITELN('ON')
ELSE WRITELN('OFF');
WRITELN
END;
(* _______________________________________________________________
Allows one to change the initial default settings
*)
PROCEDURE CHANGE_DEFAULTS;
VAR
STATE,CHOICE :CHAR;
OPTION :CHAR;
VALUE : INTEGER;
FUNCTION GET_ON:BOOLEAN;
BEGIN
REPEAT
WRITE('Input choice (Y=ON , N=OFF): ');
READLN(CHOICE);
IF NOT((CHOICE='Y') OR (CHOICE='N'))
THEN WRITELN('Invalid entry')
UNTIL (CHOICE='Y') OR (CHOICE='N');
IF CHOICE = 'Y'
THEN GET_ON := TRUE
ELSE GET_ON := FALSE
END;
BEGIN
WRITE('Change: ');
IF EOLN(INPUT)
THEN OPTION := ' '
ELSE READ(OPTION);
READLN;
WRITE('<27>','<30>','<30>','<30>','<30>','<30>','<30>');
WRITE('<30>','<30>','<30>',' ');
CASE OPTION OF
'E' : BEGIN
VALUE := ORD(CR);
WRITE('ASCII number of SEND EOL character: ');
READLN(VALUE);
SEND_ELN := CHR(VALUE)
END;
'S' : BEGIN
WRITE('Maximum Length of Send Packet: ');
READLN(VALUE);
IF EIGHTBIT
THEN SEND_MLEN := VALUE
ELSE SEND_MLEN := XAND(VALUE,95);
END;
'R' : BEGIN
WRITE('Maximum Length of Receive Packet: ');
READLN(VALUE);
IF EIGHTBIT
THEN REC_MLEN := VALUE
ELSE REC_MLEN := XAND(VALUE,95);
END;
'Q' : BEGIN
VALUE := ORD('#');
WRITE('ASCII number of QUOTE character: ');
READLN(VALUE);
REC_QCHR := CHR(VALUE)
END;
'8' : EIGHTBIT := GET_ON;
'D' : DEBUG := GET_ON;
'C' : CENDLN := GET_ON;
'I' : IGNORE_PARMS := GET_ON;
'M' : KCHAR_ELN := GET_ON;
'H' : BEGIN
WRITELN;
WRITELN;
WRITELN(' E - End of line character for sending packets');
WRITELN(' D - Debug flag');
WRITELN(' S - Maximun Length of Send Packet');
WRITELN(' R - Maximun Length of Receive Packet');
WRITELN(' M - Make EOLN printable in SEND INIT');
WRITELN(' 8 - Use eight bit I-O');
WRITELN(' C - Change NL to CRLF and CRLF to NL');
WRITELN(' Q - Quote character in receiving');
WRITELN(' H - this Help message');
WRITELN(' I - Ignore the parameters set by other Kermit');
WRITELN
END;
OTHERWISE
WRITELN('INVALID ENTRY');
END;
WRITELN
END;
(* _______________________________________________________________
*)
PROCEDURE MAIN;
VAR
OPTION: CHAR;
BEGIN
REC_QCHR := '#';
SEND_ELN := CR;
SEND_MLEN := 74;
REC_MLEN := 94;
KCHAR_ELN := TRUE;
IGNORE_PARMS := TRUE;
DEBUG := FALSE;
EIGHTBIT := FALSE;
CENDLN := TRUE;
REPEAT
WRITE ('KERMIT-DG> ');
READLN (OPTION);
CASE OPTION OF
'S' : SEND ;
'R' : RECEIVE;
'I' : SERVER;
'E' : WRITELN('TERMINATING');
'C' : CHANGE_DEFAULTS;
'D' : DISPLAY_DEFAULTS;
OTHERWISE
WRITELN ('BAD INPUT')
END
UNTIL ( OPTION = 'E');
END;
(* ------------------------------------------------------------------
The Program block
-----------------------------------------------------------------
*)
BEGIN
MAIN
END.