PROGRAM KERMIT;
(* AN IMPLEMENTATION OF KERMIT FOR THE IBM 9000, THIS IS A BASIC SEND ONLY *)
(* KERMIT DESIGNED FOR SHORT TRANSFERS OVER A NULL MODEM LINE, NO ATTEMPT AT *)
(* TERMINAL EMULATION WAS ATTEMPTED. --- WARNING, THIS SOURCE CODE WAS TYPED IN *)
(* BY HAND AS THE ORIGINAL SOURCE FILE WAS UNAVAILABLE, THEIR MIGHT BE TYPOS *)
(* 2ND WARNING, THIS IS THE FIRST PASCAL PROGRAM I EVER WROTE *)
(* 3RD WARNING, WHEN LINKING THIS PROGRAM BE SURE TO ALLOCATE LESS THEN THE *)
(* DEFAULT STACK SPACE 28K IS FINE, THIS WILL ENABLE THIS PROGRAM TO RUN ON *)
(* COMPUTERS WITH SMALLER RAM SIZES *)

(* AUTHOR: GLENN R. HOWES --> HOWES@BERT.CHEM.WISC.EDU *)
(* DATE: MAY, 1990 *)
	USES
		SYSTEM_LIBRARY;

	TYPE
		PACKET = STRING[82];
		PKTPNT = ^PACKET;
		BUFFER = PACKED ARRAY[1..512] OF CHAR;
		BUFFPNT = ^BUFFER;
		SMPACKET = STRING[1];
	VAR
(******************** GLOBAL VARIABLES ***********************)
		IRFILE: TEXT; (* UNTYPED (NON-TEXT) FILE DESCRIPTOR FOR INTERNAL USE *)
		IRBUFFER: BUFFER; (* READ 512 BYTES FROM FILE AT ONCE *)
		IRPNT: BUFFPNT;
		BLOCK: INTEGER; (* INDEX TO KEEP TRACK OF WHICH FILE BLOCK IS BEING ACCESSED *)
		ENDOFBLOCK: BOOLEAN; (* FLAG TO INDICATE ALL 512 BYTES OF A BLOCK HAVE BEEN USED *)
		ENDFILE: BOOLEAN; (* FLAG TO INDICATE THE END OF THE FILE HAS BEEN REACHED *)
		BLOCKLENGTH: INTEGER;
		IRINDEX, BUFFINDEX: INTEGER;
		PACKETNUM: INTEGER; (* INDEX TO KEEP TRACK OF HOW MANY PACKETS HAVE BEEN SENT *)
		FILENAME: STRING[100];
		S, F, D, Z, B, Y, N, E: CHAR; (* ALL THE DIFFERENT KERMIT PACKET TYPES *)
		QUIT: BOOLEAN;
		GSPACKET, GRPACKET: PACKET; (* GLOBAL SEND AND RECEIVE PACKETS *)
		SERIAL0: INTEGER; (* DEVICE LUN # FOR SERIAL PORT 1 *)
		SERIALTEXT:FILE; (* USED IN INITIALIZANG SERIAL DRIVER *)

(******************* ENCODING ROUTINES *********************)
	FUNCTION TOCHAR (X: INTEGER): CHAR;
		VAR
			MYCHAR: CHAR;
	BEGIN
		X := X + 32;
		MYCHAR := CHR(X);
		TOCHAR := MYCHAR;
	END;
	FUNCTION UNCHAR (MYCHAR: CHAR): INTEGER;
		VAR
			X: INTEGER;
	BEGIN
		X := ORD(MYCHAR);
		X := X - 32;
		UNCHAR := X;
	END;
	FUNCTION CTL (MYCHAR: CHAR): CHAR; (* THIS IS A HACK VERSION OF ORD(CHAR) X0R 64 *)
		VAR
			X: INTEGER;
			I: INTEGER;
			J: INTEGER;
	BEGIN
		X := ORD(MYCHAR);
		I := X OR 64;
		J := X AND 64;
		X := I - J;
		CTL := CHR(X);
	END;
	FUNCTION FIND_CHECK_SUM (MYPACKET: PACKET; MYLENGTH: INTEGER): CHAR;
		VAR
			SUM, I, RAWCHECK: INTEGER;
	BEGIN
		SUM := 0;
		FOR I := 1 TO (MYLENGTH) DO (* SUM OF FIELD 2 THROUGH FIELD CHECK -1*)
			BEGIN
				SUM := SUM + ORD(MYPACKET[I]);
			END;
		RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
		FIND_CHECK_SUM := TOCHAR(RAWCHECK);
	END;
	FUNCTION CONTROL_ENCODE (MYCHAR: CHAR): BOOLEAN;
		VAR
			TEMPBYTE: CHAR;
			CHARINT: INTEGER;
			TEMPINT: INTEGER;
	BEGIN
		CHARINT := ORD(MYCHAR);
		TEMPINT := CHARINT AND 127;
		IF ((TEMPINT < 32) OR (TEMPINT = 127)) THEN
			CONTROL_ENCODE := TRUE;
	END;
(******************* FILE ROUTINES **********************)
	FUNCTION OPEN_FILE: BOOLEAN;
	BEGIN
(*$I-*)
		RESET(IRFILE, FILENAME);
(*$I+*)
		IF IORESULT = 0 THEN
			OPEN_FILE := TRUE
		ELSE
			BEGIN
				WRITELN('BAD FILENAME, OR OTHER ERROR: TRY AGAIN');
				OPEN_FILE := FALSE;
			END;
	END;
	PROCEDURE GET_FILE_NAME;
	BEGIN
		IF ARGC > 0 THEN
			BEGIN
				FILENAME := ARGV[1]^;
				ARGC := 0;
			END
		ELSE
			BEGIN
				WRITE('FILENAME (OR Q TO QUIT):');
				READLN(FILENAME);
			END;
	END;
	PROCEDURE GET_N_CHECK_FILE;
		VAR
			GOODFILE: BOOLEAN;
	BEGIN
		GOODFILE := FALSE;
		REPEAT
			GET_FILE_NAME;
			IF FILENAME[1] = 'Q' THEN
				BEGIN
					QUIT := TRUE;
					GOODFILE := TRUE;
				END
			ELSE
				GOODFILE := OPEN_FILE;
		UNTIL GOODFILE = TRUE;
	END;

(********************** SERIAL  PORT INTERACTION ROUTINES **************)
	PROCEDURE OPEN_SERIAL0;
		VAR
			CTLPACKET: ARRAY[1..15] OF INTEGER;
			ERROR: INTEGER;
	BEGIN
		RESET(SERIALTEXT, '#SER00');
		SERIAL0 := GETLUN(@SERIALTEXT);
		CTLPACKET[1] := 4;
		CTLPACKET[2] := $0064; (* 5 SECOND TIMEOUT *)
		CTLPACKET[3] := 6;
		CTLPACKET[4] := $00C8; (* 10 SECOND RECEIVE TIMEOUT *)
		CTLPACKET[5] := 20;
		CTLPACKET[6] := 13; (* 9600 BAUD *)
		CTLPACKET[7] := 0;
		SYSFUNC(SERIAL0, @CTLPACKET, ERROR);
		IF ERROR <> 0 THEN
			WRITELN('ERROR NUMBER ', ERROR);
	END;
	PROCEDURE CLOSE_SERIAL0;
	BEGIN
		CLOSE(SERIALTEXT);
	END
	PROCEDURE SEND_PACKET;
		VAR
			ERROR: INTEGER;
			PAKSIZE: INTEGER;
	BEGIN
		PAKSIZE: 
		UNCHAR(GSPACKET[1]) + 3;
		SWRITE(SERIAL0, @GSPACKET, PAKSIZE, 0, 0, 0, ERROR);
		IF ERROR <> 0 THEN
			WRITELN('ERROR IN SERIAL PORT: ', ERROR);
	END;
	FUNCTION PACKET_RECEIVE: BOOLEAN;
		VAR
			ERROR: INTEGER;
			TEMPC: SMPACKET;
			I: INTEGER;
			LENGTH: INTEGER;
	BEGIN
		REPEAT
			SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
			GRPACKET[0] := TEMPC[0];
		UNTIL GRPACKET[0] = CHR(1); (* UNTIL WE SEE THE START OF PACKET SYMBOL *)
		SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
		GRPACKET[1] := TEMPC[0];
		LENGTH := UNCHAR(TEMPC[0]) + 2;
		FOR I := 2 TO LENGTH DO
			BEGIN
				SREAD(SERIAL0, @TEMPC, 1, 0, 0, 0, ERROR);
				GRPACKET[I] := TEMPC[0];
			END;
		IF ERROR <> 0 THEN
			BEGIN
				WRITELN('ERROR IN RECEIVING: ', ERROR);
				PACKET_RECEIVE := FALSE;
			END
		ELSE
			PACKET_RECEIVE := TRUE;
	END;

(****************** MAKE PACKET ROUTINES ************* *)
	PROCEDURE MAKE_INIT_PACKET;
	BEGIN
		GSPACKET[1] := TOCHAR(9); (* LENGTH OF REMAINING PACKET *)
		GSPACKET[2] := TOCHAR(0); (* THIS IS THE FIRST PACKET *)
		GSPACKET[3] := S; (* THIS IS TYPE S *)
		GSPACKET[4] := TOCHAR(80); (* MAX PACKET LENGTH IS 80 *)
		GSPACKET[5] := TOCHAR(5); (* 5 SECOND TIMEOUT *)
		GSPACKET[6] := TOCHAR(0); (* NO PADDING USED *)
		GSPACKET[7] := '@'; (* PADDING SYMBOL, DOESN'T MATTER ANYWAY *)
		GSPACKET[8] := TOCHAR(13); (* END OF LINE CHARACTER *)
		GSPACKET[9] := '#'; (* THE CONTROL PREFIX FOR CONTROL CHARACTER ENCODING *)
		GSPACKET[10] := FIND_CHECK_SUM(GSPACKET, 9);
		GSPACKET[11] := CHR(13); (* END OF LINE IS A CARRIAGE RETURN *)
	END;
	PROCEDURE MAKE_FILE_HEADER;
		VAR
			STLENGTH: INTEGER;
			PKLENGTH: INTEGER;
			I: INTEGER;
			SEQUENCE: INTEGER;
	BEGIN
		STLENGTH := LENGTH(FILENAME);
		PKLENGTH := STLENGTH + 3;
		GSPACKET[1] := TOCHAR(PKLENGTH);
		GSPACKET[3] := F;
		SEQUENCE := PACKETNUM MOD 64;
		GSPACKET[2] := TOCHAR(SEQUENCE);
		FOR I := 1 TO (STLENGTH) DO
			BEGIN
				GSPACKET[(I + 3)] := FILENAME[I];
			END;
		GSPACKET[(PKLENGTH + 1)] := FIND_CHECK_SUM(GSPACKET, PKLENGTH);
		GSPACKET[PKLENGTH + 2] := CHR(13);
		WRITELN('MADE HEADER');
	END;

	PROCEDURE MAKE_DATA_PACKET;
		VAR
			PAKSIZE: INTEGER;
			TEMPCHAR: CHAR;
			DONE: BOOLEAN;
			SEQUENCE: INTEGER;
			INDEX: INTEGER;
			SUM: INTEGER;
			RAWCHECK: INTEGER;
	BEGIN
		PAKSIZE := 5;
		SEQUENCE := PACKETNUM MOD 64;
		GSPACKET[2] := TOCHAR(SEQUENCE);
		SUM := ORD(GSPACKET[2]);
		INDEX := 4;
		REPEAT
			TEMPCHAR := IRBUFFER[IRINDEX];
			IF CONTROL_ENCODE(TEMPCHAR) = TRUE THEN
				BEGIN
					TEMPCHAR := CTL(TEMPCHAR);
					GSPACKET[INDEX] := '#';
					INDEX := INDEX + 1;
					PAKSIZE := PAKSIZE + 1;
					SUM := SUM + 35; (* ASCII NUMBER OF '#' SIGN *)
				END
			ELSE IF TEMPCHAR = '#' THEN
				BEGIN
					GSPACKET[INDEX] := '#';
					INDEX := INDEX + 1;
					PAKSIZE := PAKSIZE + 1;
					SUM := SUM + 35;
				END;
			GSPACKET[INDEX] := TEMPCHAR;
			INDEX := INDEX + 1;
			PAKSIZE := PAKSIZE + 1;
			IRINDEX := IRINDEX + 1;
			SUM := SUM + ORD(TEMPCHAR);
			IF IRINDEX = (BLOCKLENGTH + 1) THEN
				ENDOFBLOCK := TRUE;
		UNTIL ((ENDOFBLOCK = TRUE) OR (PAKSIZE >= 80));
		GSPACKET[1] := TOCHAR((INDEX - 1));
		SUM := SUM + ORD(GSPACKET[1]) + ORD(D); (* ADDING THE LENGTH AND THE TYPE *)
		RAWCHECK := (SUM + ((SUM AND 192) DIV 64)) AND 63;
		GSPACKET[INDEX] := TOCHAR(RAWCHECK);
		GSPACKET[(INDEX + 1)] := CHR(13);
	END;
	PROCEDURE MAKE_EOF;
		VAR
			SEQUENCE: INTEGER;
	BEGIN
		GSPACKET[3] := Z;
		GSPACKET[1] := TOCHAR(3);
		SEQUENCE := PACKETNUM MOD 64;
		GSPACKET[2] := TOCHAR(SEQUENCE);
		GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
		GSPACKET[5] := CHR(13);
	END;
	PROCEDURE MAKE_END_OF_TRANS;
		VAR
			SEQUENCE: INTEGER;
	BEGIN
		GSPACKET[3] := B;
		GSPACKET[1] := TOCHAR(3);
		SEQUENCE := PACKETNUM MOD 64;
		GSPACKET[2] := TOCHAR(SEQUENCE);
		GSPACKET[4] := FIND_CHECK_SUM(GSPACKET, 3);
		GSPACKET[5] := CHR(13);
	END;
(********************* INITIALIZATION ROUTINES ***************)
	PROCEDURE INITPACKTYPES;

	BEGIN
		S := 'S';
		F := 'F';
		D := 'D';
		Z := 'Z';
		B := 'B';
		Y := 'Y';
		N := 'N';
		E := 'E';
		GRPACKET := '                       ';
		GSPACKET := '                                                             ';
	END;
(********************** MISCELANEOUS ROUTINES *************)
	PROCEDURE DISPLAY_INSTRUCTIONS;
		VAR
			TEMPSTRING: STRING[25];
	BEGIN
		WRITELN('MAKE SURE THE OTHER COMPUTER IS READY TO RECEIVE. ');
		WRITELN('HIT RETURN TO PROCEED');
		READLN(TEMPSTRING);
	END;
	PROCEDURE READ_FILE_BLOCK;
		VAR
			TEMPCHAR: CHR;
	BEGIN
		BLOCKLENGTH := 0;
		REPEAT
			ENDFILE := EOF(IRFILE);
			IF ENDFILE = FALSE THEN
				BEGIN

					IF EOLN(IRFILE) = FALSE THEN
						BEGIN
							BLOCKLENGTH := BLOCKLENGTH + 1;
							READ(IRFILE, TEMPCHAR);
							IRBUFFER[BLOCKLENGTH] := TEMPCHAR;
						END
					ELSE
						BEGIN
							BLOCKLENGTH := BLOCKLENGTH + 1;
							READ(IRFILE, TEMPCHAR);
							IRBUFFER[BLOCKLENGTH] := CHR(13);
						END;
				END;
		UNTIL ((ENDFILE = TRUE) OR (BLOCKLENGTH = 512))
	END;
(************************* DECISION MAKING ROUTINES ************)
	PROCEDURE RECEIVE_AND_CONFIRM;
		VAR
			CHECKCHAR: CHAR;
			PAKLENGTH: INTEGER;
			SEQUENCE: INTEGER;
			SEQCHAR: CHAR;
			CONFIRMED: BOOLEAN;
	BEGIN
		CONFIRMED := TRUE;
		REPEAT
			SEND_PACKET;
			IF ((PACKET_RECEIVE = TRUE) AND (GRPACKET[3] = Y)) THEN
				BEGIN
					PAKLENGTH := UNCHAR(GRPACKET[1]);
					CHECKCHAR := FIND_CHECK_SUM(GRPACKET, PAKLENGTH);
					SEQUENCE := PACKETNUM MOD 64;
					SEQCHAR := TOCHAR(SEQUENCE);
					IF ((CHECKCHR <> GRPACKET[PAKLENGTH + 1]) OR (SEQCHAR <> GRPACKT[2])) THEN
						BEGIN
							CONFIRMED := FALSE;
						END
					ELSE
						CONFIRMED := TRUE;
				END
			ELSE
				BEGIN
					WRITELN('FALSE');
					CONFIRMED := FALSE;
					IF GRPACKET[3] = E THEN
						WRITELN('FATAL ERROR');
				END;
		UNTIL CONFIRMED = TRUE;
	END;
	PROCEDURE INITIATE_TRANSFER;
	BEGIN
		BLOCK := 0; (* WE ARE STARTING TO READ THE FILE FROM DISK *)
		READ_FILE_BLOCK;
		IF BLOCKLENGTH > 0 THEN
			BEGIN
				MAKE_INIT_PACKET;
				RECEIVE_AND_CONFIRM;
				PACKETNUM := 1;
				MAKE_FILE_HEADER;
				RECEIVE_AND_CONFIRM;
				PACKETNUM := 2;
				IRPNT := @IRBUFFER;
				REPEAT
					ENDOFBLOCK := FALSE;
					IRINDEX := 1;
					GSPACKET[3] := D;
					REPEAT
						MAKE_DATA_PACKET;
						WRITE('.');
						RECEIVE_AND_CONFIRM;
						PACKETNUM := PAKETNUM + 1;

					UNTIL ENDOFBLOCK = TRUE;
					WRITELN('+');
					BLOCK := BLOCK + 1;
					READ_FILE_BLOCK;
				UNTIL BLOCKLENGTH = 0; (* END OF FILE *)
				MAKE_EOF;
				WRITELN('END OF FILE SENT');
				RECEIVE_AND_CONFIRM;
			END
		ELSE
			WRITELN('NO APPARENT FILE TO READ');
	END;
(******************** MAIN PROGRAM ******************)
BEGIN
	INITPACKTYPES;
	GSPACKET[0] := CHR(1);
	OPEN_SERIAL0;
	QUIT := FALSE;
	GET_N_CHECK_FILE;
	WHILE QUIT = FALSE DO
		BEGIN
			DISPLAY_INSTRUCTIONS;
			PACKETNUM := 0;
			INITIATE_TRANSFER;
			GET_N_CHECK_FILE;
		END;
	CLOSE_SERIAL0;
END.