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.